diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2008-09-08 15:02:44 (GMT) |
---|---|---|
committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2008-09-08 15:02:44 (GMT) |
commit | 077b6446063d54ab7ebd4bfa15f952404adfcc05 (patch) | |
tree | 9882a9f68a1413236ccdd7bad94f92a410561551 /fortran/src/H5Pff.f90 | |
parent | e43736b22b2a68268b134a042cf193b56834a4b5 (diff) | |
download | hdf5-077b6446063d54ab7ebd4bfa15f952404adfcc05.zip hdf5-077b6446063d54ab7ebd4bfa15f952404adfcc05.tar.gz hdf5-077b6446063d54ab7ebd4bfa15f952404adfcc05.tar.bz2 |
[svn-r15598] Description:
Moved all the windows DLL function declarations to one file (hdf5_fortrandll.def).
Diffstat (limited to 'fortran/src/H5Pff.f90')
-rw-r--r-- | fortran/src/H5Pff.f90 | 1036 |
1 files changed, 116 insertions, 920 deletions
diff --git a/fortran/src/H5Pff.f90 b/fortran/src/H5Pff.f90 index 81ab9fe..b0b9933 100644 --- a/fortran/src/H5Pff.f90 +++ b/fortran/src/H5Pff.f90 @@ -95,13 +95,7 @@ ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pcreate_f(class, prp_id, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pcreate_f -!DEC$endif -! + SUBROUTINE h5pcreate_f(class, prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: class ! The type of the property list ! to be created. Possible values @@ -162,13 +156,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pset_preserve_f(prp_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_preserve_f -!DEC$endif -! + SUBROUTINE h5pset_preserve_f(prp_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier LOGICAL, INTENT(IN) :: flag ! TRUE/FALSE flag to set the dataset @@ -223,13 +211,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_preserve_f(prp_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_preserve_f -!DEC$endif -! + SUBROUTINE h5pget_preserve_f(prp_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier LOGICAL, INTENT(OUT) :: flag ! TRUE/FALSE flag. Shows status of the dataset's @@ -289,13 +271,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_class_f(prp_id, classtype, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_class_f -!DEC$endif -! + 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 @@ -353,13 +329,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pcopy_f(prp_id, new_prp_id, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pcopy_f -!DEC$endif -! + SUBROUTINE h5pcopy_f(prp_id, new_prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HID_T), INTENT(OUT) :: new_prp_id @@ -410,13 +380,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pclose_f(prp_id, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pclose_f -!DEC$endif -! + SUBROUTINE h5pclose_f(prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -465,13 +429,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pset_chunk_f(prp_id, ndims, dims, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_chunk_f -!DEC$endif -! + SUBROUTINE h5pset_chunk_f(prp_id, ndims, dims, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: ndims ! Number of chunk dimensions @@ -526,13 +484,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pget_chunk_f(prp_id, ndims, dims, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_chunk_f -!DEC$endif -! + SUBROUTINE h5pget_chunk_f(prp_id, ndims, dims, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: ndims ! Number of chunk dimensions to @@ -588,13 +540,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pset_deflate_f(prp_id, level, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_deflate_f -!DEC$endif -! + SUBROUTINE h5pset_deflate_f(prp_id, level, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: level ! Compression level @@ -648,13 +594,7 @@ SUBROUTINE h5pset_fill_value_integer(prp_id, type_id, fillvalue, & - hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fill_value_integer -!DEC$endif -! + hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of @@ -683,13 +623,7 @@ SUBROUTINE h5pget_fill_value_integer(prp_id, type_id, fillvalue, & - hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_fill_value_integer -!DEC$endif -! + hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of @@ -718,13 +652,7 @@ SUBROUTINE h5pset_fill_value_real(prp_id, type_id, fillvalue, & - hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fill_value_real -!DEC$endif -! + hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of @@ -753,13 +681,7 @@ SUBROUTINE h5pget_fill_value_real(prp_id, type_id, fillvalue, & - hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_fill_value_real -!DEC$endif -! + hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of @@ -789,13 +711,7 @@ SUBROUTINE h5pset_fill_value_char(prp_id, type_id, fillvalue, & - hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fill_value_char -!DEC$endif -! + hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of @@ -824,13 +740,7 @@ END SUBROUTINE h5pset_fill_value_char SUBROUTINE h5pget_fill_value_char(prp_id, type_id, fillvalue, & - hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_fill_value_char -!DEC$endif -! + hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of @@ -889,13 +799,6 @@ SUBROUTINE h5pget_version_f(prp_id, boot, freelist, & stab, shhdr, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_version_f -!DEC$endif -! - IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, DIMENSION(:), INTENT(OUT) :: boot !array to put boot @@ -954,13 +857,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_userblock_f (prp_id, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_userblock_f -!DEC$endif -! + SUBROUTINE h5pset_userblock_f (prp_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(IN) :: size !Size of the user-block in bytes @@ -1009,13 +906,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pget_userblock_f(prp_id, block_size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_userblock_f -!DEC$endif -! + SUBROUTINE h5pget_userblock_f(prp_id, block_size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(OUT) :: block_size !Size of the @@ -1065,13 +956,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_sizes_f (prp_id, sizeof_addr, sizeof_size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_sizes_f -!DEC$endif -! + SUBROUTINE h5pset_sizes_f (prp_id, sizeof_addr, sizeof_size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(SIZE_T), INTENT(IN) :: sizeof_addr !Size of an object @@ -1126,13 +1011,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pget_sizes_f(prp_id, sizeof_addr, sizeof_size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_sizes_f -!DEC$endif -! + SUBROUTINE h5pget_sizes_f(prp_id, sizeof_addr, sizeof_size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(SIZE_T), INTENT(OUT) :: sizeof_addr !Size of an object @@ -1187,13 +1066,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_sym_k_f (prp_id, ik, lk, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_sym_k_f -!DEC$endif -! + SUBROUTINE h5pset_sym_k_f (prp_id, ik, lk, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: ik ! Symbol table tree rank @@ -1247,13 +1120,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pget_sym_k_f(prp_id, ik, lk, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_sym_k_f -!DEC$endif -! + SUBROUTINE h5pget_sym_k_f(prp_id, ik, lk, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: ik !Symbol table tree rank @@ -1304,13 +1171,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_istore_k_f (prp_id, ik, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_istore_k_f -!DEC$endif -! + SUBROUTINE h5pset_istore_k_f (prp_id, ik, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: ik ! 1/2 rank of chunked storage B-tree @@ -1360,13 +1221,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pget_istore_k_f(prp_id, ik, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_istore_k_f -!DEC$endif -! + SUBROUTINE h5pget_istore_k_f(prp_id, ik, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: ik !1/2 rank of chunked storage B-tree @@ -1415,13 +1270,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_driver_f(prp_id, driver, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_driver_f -!DEC$endif -! + SUBROUTINE h5pget_driver_f(prp_id, driver, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HID_T), INTENT(OUT) :: driver !low-level file driver identifier @@ -1468,13 +1317,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_fapl_stdio_f (prp_id, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fapl_stdio_f -!DEC$endif -! + SUBROUTINE h5pset_fapl_stdio_f (prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1518,12 +1361,7 @@ ! Comment: !---------------------------------------------------------------------- -! SUBROUTINE h5pget_stdio_f (prp_id, io, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_stdio_f -!DEC$endif +! SUBROUTINE h5pget_stdio_f (prp_id, io, hdferr) ! ! IMPLICIT NONE ! INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1559,13 +1397,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_fapl_sec2_f (prp_id, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fapl_sec2_f -!DEC$endif -! + SUBROUTINE h5pset_fapl_sec2_f (prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1646,13 +1478,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_alignment_f(prp_id, threshold, alignment, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_alignment_f -!DEC$endif -! + SUBROUTINE h5pset_alignment_f(prp_id, threshold, alignment, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(IN) :: threshold ! Threshold value @@ -1704,13 +1530,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_alignment_f(prp_id, threshold, alignment, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_alignment_f -!DEC$endif -! + SUBROUTINE h5pget_alignment_f(prp_id, threshold, alignment, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(OUT) :: threshold ! Threshold value @@ -1762,13 +1582,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_fapl_core_f(prp_id, increment, backing_store, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fapl_core_f -!DEC$endif -! + SUBROUTINE h5pset_fapl_core_f(prp_id, increment, backing_store, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(SIZE_T), INTENT(IN) :: increment ! File block size in bytes. @@ -1824,13 +1638,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_fapl_core_f(prp_id, increment, backing_store, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_fapl_core_f -!DEC$endif -! + SUBROUTINE h5pget_fapl_core_f(prp_id, increment, backing_store, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(SIZE_T), INTENT(OUT) :: increment ! File block size in bytes. @@ -1887,13 +1695,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_fapl_family_f(prp_id, memb_size, memb_plist , hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fapl_family_f -!DEC$endif -! + SUBROUTINE h5pset_fapl_family_f(prp_id, memb_size, memb_plist , hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(IN) :: memb_size ! Logical size, in bytes, @@ -1949,13 +1751,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pget_fapl_family_f(prp_id, memb_size, memb_plist , hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_fapl_family_f -!DEC$endif -! + SUBROUTINE h5pget_fapl_family_f(prp_id, memb_size, memb_plist , hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(OUT) :: memb_size ! Logical size, in bytes, @@ -2014,13 +1810,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_cache_f(prp_id, mdc_nelmts,rdcc_nelmts, rdcc_nbytes, rdcc_w0, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_cache_f -!DEC$endif -! + SUBROUTINE h5pset_cache_f(prp_id, mdc_nelmts,rdcc_nelmts, rdcc_nbytes, rdcc_w0, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: mdc_nelmts !Number of elements (objects) @@ -2086,13 +1876,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_cache_f(prp_id, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, rdcc_w0, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_cache_f -!DEC$endif -! + SUBROUTINE h5pget_cache_f(prp_id, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, rdcc_w0, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: mdc_nelmts !Number of elements (objects) @@ -2155,13 +1939,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_fapl_split_f(prp_id, meta_ext, meta_plist, raw_ext, raw_plist, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fapl_split_f -!DEC$endif -! + SUBROUTINE h5pset_fapl_split_f(prp_id, meta_ext, meta_plist, raw_ext, raw_plist, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: meta_ext !Name of the extension for @@ -2274,13 +2052,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pset_gc_references_f (prp_id, gc_reference, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_gc_references_f -!DEC$endif -! + SUBROUTINE h5pset_gc_references_f (prp_id, gc_reference, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: gc_reference !the flag for garbage collecting @@ -2330,13 +2102,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_gc_references_f (prp_id, gc_reference, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_gc_references_f -!DEC$endif -! + SUBROUTINE h5pget_gc_references_f (prp_id, gc_reference, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: gc_reference !the flag for garbage collecting @@ -2390,13 +2156,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_layout_f (prp_id, layout, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_layout_f -!DEC$endif -! + SUBROUTINE h5pset_layout_f (prp_id, layout, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: layout !Type of storage layout for raw data @@ -2452,13 +2212,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_layout_f (prp_id, layout, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_layout_f -!DEC$endif -! + SUBROUTINE h5pget_layout_f (prp_id, layout, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: layout !Type of storage layout for raw data @@ -2513,13 +2267,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_filter_f(prp_id, filter, flags, cd_nelmts, cd_values, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_filter_f -!DEC$endif -! + SUBROUTINE h5pset_filter_f(prp_id, filter, flags, cd_nelmts, cd_values, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: filter !Filter to be added to the pipeline. @@ -2576,13 +2324,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_nfilters_f (prp_id, nfilters, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_nfilters_f -!DEC$endif -! + SUBROUTINE h5pget_nfilters_f (prp_id, nfilters, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: nfilters !the number of filters in the pipeline @@ -2638,13 +2380,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_filter_f(prp_id, filter_number, flags, cd_nelmts, cd_values, namelen, name, filter_id, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_filter_f -!DEC$endif -! + SUBROUTINE h5pget_filter_f(prp_id, filter_number, flags, cd_nelmts, cd_values, namelen, name, filter_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: filter_number !Sequence number within the filter @@ -2716,13 +2452,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_external_f(prp_id, name, offset,bytes, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_external_f -!DEC$endif -! + SUBROUTINE h5pset_external_f(prp_id, name, offset,bytes, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name !Name of an external file @@ -2783,13 +2513,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_external_count_f (prp_id, count, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_external_count_f -!DEC$endif -! + SUBROUTINE h5pget_external_count_f (prp_id, count, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: count !number of external files for the @@ -2845,13 +2569,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pget_external_f(prp_id, idx, name_size, name, offset,bytes, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_external_f -!DEC$endif -! + SUBROUTINE h5pget_external_f(prp_id, idx, name_size, name, offset,bytes, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: idx !External file index. @@ -2915,13 +2633,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_btree_ratios_f(prp_id, left, middle, right, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_btree_ratios_f -!DEC$endif -! + SUBROUTINE h5pset_btree_ratios_f(prp_id, left, middle, right, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier REAL, INTENT(IN) :: left !The B-tree split ratio for left-most nodes. @@ -2978,13 +2690,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_btree_ratios_f(prp_id, left, middle, right, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_btree_ratios_f -!DEC$endif -! + SUBROUTINE h5pget_btree_ratios_f(prp_id, left, middle, right, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier REAL, INTENT(OUT) :: left !The B-tree split ratio for left-most nodes. @@ -3042,13 +2748,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_fclose_degree_f(fapl_id, degree, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_fclose_degree_f -!DEC$endif -! + SUBROUTINE h5pget_fclose_degree_f(fapl_id, degree, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier INTEGER, INTENT(OUT) :: degree ! Possible values @@ -3105,13 +2805,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_fclose_degree_f(fapl_id, degree, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fclose_degree_f -!DEC$endif -! + SUBROUTINE h5pset_fclose_degree_f(fapl_id, degree, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier INTEGER, INTENT(IN) :: degree ! Possible values @@ -3162,13 +2856,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pequal_f(plist1_id, plist2_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pequal_f -!DEC$endif -! + SUBROUTINE h5pequal_f(plist1_id, plist2_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist1_id ! Property list identifier INTEGER(HID_T), INTENT(IN) :: plist2_id ! Property list identifier @@ -3216,13 +2904,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_buffer_f(plist_id, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_buffer_f -!DEC$endif -! + SUBROUTINE h5pset_buffer_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Data transfer property list identifier INTEGER(HSIZE_T), INTENT(IN) :: size ! Buffer size in bytes; @@ -3267,13 +2949,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_buffer_f(plist_id, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_buffer_f -!DEC$endif -! + SUBROUTINE h5pget_buffer_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Data transfer property list identifier INTEGER(HSIZE_T), INTENT(OUT) :: size ! Buffer size in bytes; @@ -3323,13 +2999,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pfill_value_defined_f(plist_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pfill_value_defined_f -!DEC$endif -! + SUBROUTINE h5pfill_value_defined_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id INTEGER, INTENT(OUT) :: flag @@ -3378,13 +3048,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_alloc_time_f(plist_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_alloc_time_f -!DEC$endif -! + SUBROUTINE h5pset_alloc_time_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id INTEGER, INTENT(IN) :: flag @@ -3433,13 +3097,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_alloc_time_f(plist_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_alloc_time_f -!DEC$endif -! + SUBROUTINE h5pget_alloc_time_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id INTEGER, INTENT(OUT) :: flag @@ -3486,13 +3144,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_fill_time_f(plist_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fill_time_f -!DEC$endif -! + SUBROUTINE h5pset_fill_time_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id INTEGER, INTENT(IN) :: flag @@ -3539,13 +3191,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_fill_time_f(plist_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_fill_time_f -!DEC$endif -! + SUBROUTINE h5pget_fill_time_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id INTEGER, INTENT(OUT) :: flag @@ -3588,13 +3234,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_meta_block_size_f(plist_id, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_meta_block_size_f -!DEC$endif -! + SUBROUTINE h5pset_meta_block_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier INTEGER(HSIZE_T), INTENT(IN) :: size ! Block size in bytes; @@ -3637,13 +3277,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_meta_block_size_f(plist_id, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_meta_block_size_f -!DEC$endif -! + SUBROUTINE h5pget_meta_block_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier INTEGER(HSIZE_T), INTENT(OUT) :: size ! Block size in bytes; @@ -3686,13 +3320,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_sieve_buf_size_f(plist_id, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_sieve_buf_size_f -!DEC$endif -! + SUBROUTINE h5pset_sieve_buf_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier INTEGER(SIZE_T), INTENT(IN) :: size ! Buffer size in bytes; @@ -3735,13 +3363,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_sieve_buf_size_f(plist_id, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_sieve_buf_size_f -!DEC$endif -! + SUBROUTINE h5pget_sieve_buf_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier INTEGER(SIZE_T), INTENT(OUT) :: size ! Buffer size in bytes @@ -3784,13 +3406,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_small_data_block_size_f(plist_id, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_small_data_block_size_f -!DEC$endif -! + SUBROUTINE h5pset_small_data_block_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier INTEGER(HSIZE_T), INTENT(IN) :: size ! Small raw data block size @@ -3833,13 +3449,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_small_data_block_size_f(plist_id, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_small_data_block_size_f -!DEC$endif -! + SUBROUTINE h5pget_small_data_block_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier INTEGER(HSIZE_T), INTENT(OUT) :: size ! Small raw data block size @@ -3882,13 +3492,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_hyper_vector_size_f(plist_id, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_hyper_vector_size_f -!DEC$endif -! + SUBROUTINE h5pset_hyper_vector_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset transfer property list identifier INTEGER(SIZE_T), INTENT(IN) :: size ! Vector size @@ -3931,13 +3535,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_hyper_vector_size_f(plist_id, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_hyper_vector_size_f -!DEC$endif -! + SUBROUTINE h5pget_hyper_vector_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset transfer property list identifier INTEGER(SIZE_T), INTENT(OUT) :: size ! Vector size @@ -3981,13 +3579,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_integer(prp_id, name, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_integer -!DEC$endif -! + SUBROUTINE h5pset_integer(prp_id, name, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to modify @@ -4037,13 +3629,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_real(prp_id, name, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_real -!DEC$endif -! + SUBROUTINE h5pset_real(prp_id, name, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to modify @@ -4094,13 +3680,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_char(prp_id, name, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_char -!DEC$endif -! + SUBROUTINE h5pset_char(prp_id, name, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to modify @@ -4154,13 +3734,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_integer(prp_id, name, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_integer -!DEC$endif -! + SUBROUTINE h5pget_integer(prp_id, name, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to modify @@ -4210,13 +3784,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_real(prp_id, name, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_real -!DEC$endif -! + SUBROUTINE h5pget_real(prp_id, name, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to modify @@ -4267,13 +3835,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_char(prp_id, name, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_char -!DEC$endif -! + SUBROUTINE h5pget_char(prp_id, name, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to modify @@ -4327,13 +3889,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pexist_f(prp_id, name, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pexist_f -!DEC$endif -! + SUBROUTINE h5pexist_f(prp_id, name, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to modify @@ -4387,13 +3943,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_size_f(prp_id, name, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_size_f -!DEC$endif -! + SUBROUTINE h5pget_size_f(prp_id, name, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to query @@ -4441,13 +3991,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_nprops_f(prp_id, nprops, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_nprops_f -!DEC$endif -! + SUBROUTINE h5pget_nprops_f(prp_id, nprops, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(SIZE_T), INTENT(OUT) :: nprops ! iNumber of properties @@ -4493,13 +4037,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_class_name_f(prp_id, name, size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_class_name_f -!DEC$endif -! + SUBROUTINE h5pget_class_name_f(prp_id, name, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(OUT) :: name ! Buffer to retireve class name @@ -4553,13 +4091,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_class_parent_f(prp_id, parent_id, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_class_parent_f -!DEC$endif -! + SUBROUTINE h5pget_class_parent_f(prp_id, parent_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HID_T), INTENT(OUT) :: parent_id ! Parent class property list @@ -4604,13 +4136,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pisa_class_f(plist, pclass, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pisa_class_f -!DEC$endif -! + SUBROUTINE h5pisa_class_f(plist, pclass, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist ! Property list identifier INTEGER(HID_T), INTENT(IN) :: pclass ! Class identifier @@ -4660,13 +4186,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pcopy_prop_f(dst_id, src_id, name, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pcopy_prop_f -!DEC$endif -! + SUBROUTINE h5pcopy_prop_f(dst_id, src_id, name, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dst_id ! Destination property list ! identifier @@ -4717,13 +4237,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5premove_f(plid, name, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5premove_f -!DEC$endif -! + SUBROUTINE h5premove_f(plid, name, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plid ! property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! name of property to remove @@ -4771,13 +4285,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5punregister_f(class, name, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5punregister_f -!DEC$endif -! + SUBROUTINE h5punregister_f(class, name, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: class ! property list class identifier CHARACTER(LEN=*), INTENT(IN) :: name ! name of property to remove @@ -4824,13 +4332,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pclose_class_f(class, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pclose_class_f -!DEC$endif -! + SUBROUTINE h5pclose_class_f(class, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: class ! property list class identifier INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -4880,13 +4382,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pcreate_class_f(parent, name, class, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pcreate_class_f -!DEC$endif -! + SUBROUTINE h5pcreate_class_f(parent, name, class, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: parent ! parent property list class ! identifier @@ -4941,13 +4437,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pregister_integer(class, name, size, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pregister_integer -!DEC$endif -! + SUBROUTINE h5pregister_integer(class, name, size, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: class ! Property list class identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to register @@ -5002,13 +4492,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pregister_real(class, name, size, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pregister_real -!DEC$endif -! + SUBROUTINE h5pregister_real(class, name, size, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: class ! Property list class identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to register @@ -5063,13 +4547,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pregister_char(class, name, size, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pregister_char -!DEC$endif -! + SUBROUTINE h5pregister_char(class, name, size, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: class ! Property list class identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to register @@ -5127,13 +4605,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pinsert_integer(plist, name, size, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pinsert_integer -!DEC$endif -! + SUBROUTINE h5pinsert_integer(plist, name, size, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to insert @@ -5187,13 +4659,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pinsert_real(plist, name, size, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pinsert_real -!DEC$endif -! + SUBROUTINE h5pinsert_real(plist, name, size, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to insert @@ -5248,13 +4714,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pinsert_char(plist, name, size, value, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pinsert_char -!DEC$endif -! + SUBROUTINE h5pinsert_char(plist, name, size, value, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to insert @@ -5309,13 +4769,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pset_shuffle_f(prp_id, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_shuffle_f -!DEC$endif -! + SUBROUTINE h5pset_shuffle_f(prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -5362,13 +4816,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pset_edc_check_f(prp_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_edc_check_f -!DEC$endif -! + SUBROUTINE h5pset_edc_check_f(prp_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: flag ! Checksum filter flag @@ -5414,13 +4862,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pget_edc_check_f(prp_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_edc_check_f -!DEC$endif -! + SUBROUTINE h5pget_edc_check_f(prp_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset transfer property list identifier INTEGER, INTENT(OUT) :: flag ! Checksum filter flag @@ -5471,13 +4913,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pset_fletcher32_f(prp_id, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fletcher32_f -!DEC$endif -! + SUBROUTINE h5pset_fletcher32_f(prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -5522,13 +4958,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pset_family_offset_f(prp_id, offset, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_family_offset_f -!DEC$endif -! + SUBROUTINE h5pset_family_offset_f(prp_id, offset, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(IN) :: offset ! Offset in bytes @@ -5578,13 +5008,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pset_fapl_multi_l(prp_id, memb_map, memb_fapl, memb_name, memb_addr, relax, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fapl_multi_l -!DEC$endif -! + SUBROUTINE h5pset_fapl_multi_l(prp_id, memb_map, memb_fapl, memb_name, memb_addr, relax, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier INTEGER, DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(IN) :: memb_map @@ -5654,13 +5078,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pset_fapl_multi_s(prp_id, relax, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fapl_multi_s -!DEC$endif -! + SUBROUTINE h5pset_fapl_multi_s(prp_id, relax, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier LOGICAL, INTENT(IN) :: relax @@ -5712,13 +5130,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pget_fapl_multi_f(prp_id, memb_map, memb_fapl, memb_name, memb_addr, relax, hdferr, maxlen_out) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_fapl_multi_f -!DEC$endif -! + SUBROUTINE h5pget_fapl_multi_f(prp_id, memb_map, memb_fapl, memb_name, memb_addr, relax, hdferr, maxlen_out) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier INTEGER, DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(OUT) :: memb_map @@ -5792,12 +5204,6 @@ SUBROUTINE h5pset_szip_f(prp_id, options_mask, pixels_per_block, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_szip_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset creation property ! list identifier @@ -5849,13 +5255,7 @@ !---------------------------------------------------------------------- - SUBROUTINE h5pall_filters_avail_f(prp_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pall_filters_avail_f -!DEC$endif -! + SUBROUTINE h5pall_filters_avail_f(prp_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset creation property ! list identifier @@ -5912,13 +5312,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_filter_by_id_f(prp_id, filter_id, flags, cd_nelmts, cd_values, namelen, name, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_filter_by_id_f -!DEC$endif -! + SUBROUTINE h5pget_filter_by_id_f(prp_id, filter_id, flags, cd_nelmts, cd_values, namelen, name, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -5986,13 +5380,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pmodify_filter_f(prp_id, filter, flags, cd_nelmts, cd_values, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pmodify_filter_f -!DEC$endif -! + SUBROUTINE h5pmodify_filter_f(prp_id, filter, flags, cd_nelmts, cd_values, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: filter !Filter to be modified @@ -6048,12 +5436,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5premove_filter_f(prp_id, filter, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5premove_filter_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset creation property list ! identifier @@ -6104,12 +5486,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pget_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_attr_phase_change_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (dataset or group) creation property list identifier INTEGER, INTENT(OUT) :: max_compact ! Maximum number of attributes to be stored in compact storage @@ -6160,12 +5536,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pset_attr_creation_order_f(ocpl_id, crt_order_flags , hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_attr_creation_order_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (dataset or group) creation property list identifier INTEGER, INTENT(IN) :: crt_order_flags ! Flags specifying whether to track and index attribute creation order @@ -6214,12 +5584,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pset_shared_mesg_nindexes_f( plist_id, nindexes, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_shared_mesg_nindexes_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! file creation property list INTEGER, INTENT(IN) :: nindexes ! Number of shared object header message indexes @@ -6272,12 +5636,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pset_shared_mesg_index_f(fcpl_id, index_num, mesg_type_flags, min_mesg_size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_shared_mesg_index_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fcpl_id ! file creation property list INTEGER, INTENT(IN) :: index_num ! Index being configured. @@ -6332,12 +5690,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pget_attr_creation_order_f(ocpl_id, crt_order_flags, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_attr_creation_order_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (group or dataset) creation property list identifier INTEGER, INTENT(OUT) :: crt_order_flags ! Flags specifying whether to track and index attribute creation order @@ -6388,12 +5740,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pset_libver_bounds_f(fapl_id, low, high, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_libver_bounds_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier INTEGER, INTENT(IN) :: low ! The earliest version of the library that will be used for writing objects. @@ -6450,12 +5796,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pset_link_creation_order_f(gcpl_id, crt_order_flags, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_link_creation_order_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! File access property list identifier INTEGER, INTENT(IN) :: crt_order_flags ! Creation order flag(s) @@ -6505,12 +5845,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pget_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_link_phase_change_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier INTEGER, INTENT(OUT) :: max_compact ! Maximum number of attributes to be stored in compact storage @@ -6559,13 +5893,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_obj_track_times_f(plist_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_obj_track_times_f -!DEC$endif -! + SUBROUTINE h5pget_obj_track_times_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property ! list identifier @@ -6629,13 +5957,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_obj_track_times_f(plist_id, flag, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_obj_track_times_f -!DEC$endif -! + SUBROUTINE h5pset_obj_track_times_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property ! list identifier @@ -6689,13 +6011,7 @@ ! so had to shorten the name !-------------------------------------------------------------------------------------- - SUBROUTINE h5pset_create_inter_group_f(lcpl_id, crt_intermed_group, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_create_inter_group_f -!DEC$endif -! + SUBROUTINE h5pset_create_inter_group_f(lcpl_id, crt_intermed_group, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: lcpl_id ! Link creation property list identifier INTEGER, INTENT(IN) :: crt_intermed_group ! specifying whether to create intermediate groups @@ -6744,12 +6060,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pget_link_creation_order_f(gcpl_id, crt_order_flags, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_link_creation_order_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier INTEGER, INTENT(OUT) :: crt_order_flags ! Creation order flag(s) @@ -6801,12 +6111,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pset_char_encoding_f(plist_id, encoding, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_char_encoding_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Property list identifier @@ -6861,12 +6165,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pget_char_encoding_f(plist_id, encoding, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_char_encoding_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Property list identifier @@ -6917,13 +6215,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_copy_object_f(ocp_plist_id, copy_options, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_copy_object_f -!DEC$endif -! + SUBROUTINE h5pset_copy_object_f(ocp_plist_id, copy_options, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocp_plist_id ! Object copy property list identifier INTEGER, INTENT(IN) :: copy_options ! Copy option(s) to be set, valid options are: @@ -6973,13 +6265,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_copy_object_f(ocp_plist_id, copy_options, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_copy_object_f -!DEC$endif -! + SUBROUTINE h5pget_copy_object_f(ocp_plist_id, copy_options, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocp_plist_id ! Object copy property list identifier INTEGER, INTENT(OUT) :: copy_options ! valid copy options returned are: @@ -7032,13 +6318,7 @@ ! Comment: Should hdferr return just 0 or 1 and add another arguement for the size? !---------------------------------------------------------------------- - SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_data_transform_f -!DEC$endif -! + SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Identifier of the property list or class CHARACTER(LEN=*), INTENT(OUT) :: expression ! Buffer to hold transform expression @@ -7097,13 +6377,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_data_transform_f(plist_id, expression, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_data_transform_f -!DEC$endif -! + SUBROUTINE h5pset_data_transform_f(plist_id, expression, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Identifier of the property list or class CHARACTER(LEN=*), INTENT(IN) :: expression ! Buffer to hold transform expression @@ -7152,13 +6426,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_local_heap_size_hint_f(gcpl_id, size_hint, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_local_heap_size_hint_f -!DEC$endif -! + SUBROUTINE h5pget_local_heap_size_hint_f(gcpl_id, size_hint, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier INTEGER(SIZE_T), INTENT(OUT) :: size_hint ! Hint for size of local heap @@ -7205,13 +6473,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_est_link_info_f(gcpl_id, est_num_entries, est_name_len, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_est_link_info_f -!DEC$endif -! + SUBROUTINE h5pget_est_link_info_f(gcpl_id, est_num_entries, est_name_len, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier INTEGER, INTENT(OUT) :: est_num_entries ! Estimated number of links to be inserted into group @@ -7259,13 +6521,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_local_heap_size_hint_f(gcpl_id, size_hint, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_local_heap_size_hint_f -!DEC$endif -! + SUBROUTINE h5pset_local_heap_size_hint_f(gcpl_id, size_hint, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier INTEGER(SIZE_T), INTENT(IN) :: size_hint ! Hint for size of local heap @@ -7312,13 +6568,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_est_link_info_f(gcpl_id, est_num_entries, est_name_len, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_est_link_info_f -!DEC$endif -! + SUBROUTINE h5pset_est_link_info_f(gcpl_id, est_num_entries, est_name_len, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier INTEGER, INTENT(IN) :: est_num_entries ! Estimated number of links to be inserted into group @@ -7368,12 +6618,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pset_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_link_phase_change_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier INTEGER, INTENT(IN) :: max_compact ! Maximum number of attributes to be stored in compact storage @@ -7424,12 +6668,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pset_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_fapl_direct_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier INTEGER(SIZE_T), INTENT(IN) :: alignment ! Required memory alignment boundary! @@ -7481,12 +6719,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pget_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_fapl_direct_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier INTEGER(SIZE_T), INTENT(OUT) :: alignment ! Required memory alignment boundary! @@ -7539,12 +6771,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_attr_phase_change_f -!DEC$endif -! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (dataset or group) creation property list identifier INTEGER, INTENT(IN) :: max_compact ! Maximum number of attributes to be stored in compact storage @@ -7595,13 +6821,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_nbit_f(plist_id, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_nbit_f -!DEC$endif -! + SUBROUTINE h5pset_nbit_f(plist_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property list identifier INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -7646,13 +6866,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_scaleoffset_f(plist_id, scale_type, scale_factor, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_scaleoffset_f -!DEC$endif -! + SUBROUTINE h5pset_scaleoffset_f(plist_id, scale_type, scale_factor, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property list identifier INTEGER, INTENT(IN) :: scale_type ! Flag indicating compression method. @@ -7701,13 +6915,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pset_nlinks_f(lapl_id, nlinks, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pset_nlinks_f -!DEC$endif -! + SUBROUTINE h5pset_nlinks_f(lapl_id, nlinks, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: lapl_id ! File access property list identifier INTEGER(SIZE_T), INTENT(IN) :: nlinks ! Maximum number of links to traverse @@ -7754,13 +6962,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_nlinks_f(lapl_id, nlinks, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_nlinks_f -!DEC$endif -! + SUBROUTINE h5pget_nlinks_f(lapl_id, nlinks, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: lapl_id ! File access property list identifier INTEGER(SIZE_T), INTENT(OUT) :: nlinks ! Maximum number of links to traverse @@ -7808,13 +7010,7 @@ ! so had to shorten the name !-------------------------------------------------------------------------------------- - SUBROUTINE h5pget_create_inter_group_f(lcpl_id, crt_intermed_group, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5pget_create_inter_group_f -!DEC$endif -! + SUBROUTINE h5pget_create_inter_group_f(lcpl_id, crt_intermed_group, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: lcpl_id ! Link creation property list identifier INTEGER, INTENT(IN) :: crt_intermed_group ! Flag specifying whether to create intermediate groups |