summaryrefslogtreecommitdiffstats
path: root/fortran/src/H5Pff.f90
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2008-09-08 15:02:44 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2008-09-08 15:02:44 (GMT)
commit077b6446063d54ab7ebd4bfa15f952404adfcc05 (patch)
tree9882a9f68a1413236ccdd7bad94f92a410561551 /fortran/src/H5Pff.f90
parente43736b22b2a68268b134a042cf193b56834a4b5 (diff)
downloadhdf5-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.f901036
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