summaryrefslogtreecommitdiffstats
path: root/fortran/src/H5Pff.f90
diff options
context:
space:
mode:
authorQuincey Koziol <koziol@hdfgroup.org>2003-07-07 19:02:46 (GMT)
committerQuincey Koziol <koziol@hdfgroup.org>2003-07-07 19:02:46 (GMT)
commit4e23c807585ed705173f32e374884a46e4a4f2dd (patch)
treedf458773252f84a19720b4d8b3588db955f4b6d1 /fortran/src/H5Pff.f90
parent2d5f8835fd9851c65d8e33a9c4bbe5da64d5427e (diff)
downloadhdf5-4e23c807585ed705173f32e374884a46e4a4f2dd.zip
hdf5-4e23c807585ed705173f32e374884a46e4a4f2dd.tar.gz
hdf5-4e23c807585ed705173f32e374884a46e4a4f2dd.tar.bz2
[svn-r7181] Purpose:
Version update Description: Removed 1.4 compatibility code in the library. Platforms tested: FreeBSD 4.8 (sleipnir) h5committest
Diffstat (limited to 'fortran/src/H5Pff.f90')
-rw-r--r--fortran/src/H5Pff.f90122
1 files changed, 0 insertions, 122 deletions
diff --git a/fortran/src/H5Pff.f90 b/fortran/src/H5Pff.f90
index c59ad55..e70a573 100644
--- a/fortran/src/H5Pff.f90
+++ b/fortran/src/H5Pff.f90
@@ -2970,128 +2970,6 @@
END SUBROUTINE h5pget_external_f
!----------------------------------------------------------------------
-! Name: h5pset_hyper_cache_f
-!
-! Purpose: Indicates whether to cache hyperslab blocks during I/O
-!
-! Inputs:
-! prp_id - dataset transfer property list identifier
-! cache - A flag indicating whether caching is to
-! be set to on (1) or off (0).
-! limit - maximum size of the hyperslab block to
-! cache; 0 (zero) indicates no limit
-! Outputs:
-! hdferr: - error code
-! Success: 0
-! Failure: -1
-! Optional parameters:
-! NONE
-!
-! Programmer: Elena Pourmal
-! August 12, 1999
-!
-! Modifications: Explicit Fortran interfaces were added for
-! called C functions (it is needed for Windows
-! port). March 14, 2001
-!
-! Comment:
-!----------------------------------------------------------------------
-
- SUBROUTINE h5pset_hyper_cache_f(prp_id, cache, limit, hdferr)
-!
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_DLL)
-!DEC$attributes dllexport :: h5pset_hyper_cache_f
-!DEC$endif
-!
- IMPLICIT NONE
- INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier
- INTEGER, INTENT(IN) :: cache !
- INTEGER, INTENT(IN) :: limit ! Maximum size of the hyperslab block to
- !cache. 0 (zero) indicates no limit.
- INTEGER, INTENT(OUT) :: hdferr ! Error code
-
-! INTEGER, EXTERNAL :: h5pset_hyper_cache_c
-! MS FORTRAN needs explicit interface for C functions called here.
-!
- INTERFACE
- INTEGER FUNCTION h5pset_hyper_cache_c(prp_id, cache, limit)
- USE H5GLOBAL
- !DEC$ IF DEFINED(HDF5F90_WINDOWS)
- !MS$ATTRIBUTES C,reference,alias:'_H5PSET_HYPER_CACHE_C'::h5pset_hyper_cache_c
- !DEC$ ENDIF
- INTEGER(HID_T), INTENT(IN) :: prp_id
- INTEGER, INTENT(IN) :: cache
- INTEGER, INTENT(IN) :: limit
- END FUNCTION h5pset_hyper_cache_c
- END INTERFACE
-
- hdferr = h5pset_hyper_cache_c(prp_id, cache, limit)
- END SUBROUTINE h5pset_hyper_cache_f
-
-!----------------------------------------------------------------------
-! Name: h5pget_hyper_cache_f
-!
-! Purpose: Returns information regarding the caching of hyperslab
-! blocks during I/O.
-!
-! Inputs:
-! prp_id - dataset transfer property list identifier
-! Outputs:
-! cache - a flag indicating whether caching is
-! set to on (1) or off (0).
-! limit - maximum size of the hyperslab block to
-! cache; 0 (zero) indicates no limit
-! hdferr: - error code
-! Success: 0
-! Failure: -1
-! Optional parameters:
-! NONE
-!
-! Programmer: Elena Pourmal
-! August 12, 1999
-!
-! Modifications: Explicit Fortran interfaces were added for
-! called C functions (it is needed for Windows
-! port). March 14, 2001
-!
-! Comment:
-!----------------------------------------------------------------------
-
- SUBROUTINE h5pget_hyper_cache_f(prp_id, cache, limit, hdferr)
-!
-!This definition is needed for Windows DLLs
-!DEC$if defined(BUILD_HDF5_DLL)
-!DEC$attributes dllexport :: h5pget_hyper_cache_f
-!DEC$endif
-!
- IMPLICIT NONE
- INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier
- INTEGER, INTENT(OUT) :: cache !
- INTEGER, INTENT(OUT) :: limit ! Maximum size of the hyperslab block to
- !cache. 0 (zero) indicates no limit.
- INTEGER, INTENT(OUT) :: hdferr ! Error code
-
-
-! INTEGER, EXTERNAL :: h5pget_hyper_cache_c
-! MS FORTRAN needs explicit interface for C functions called here.
-!
- INTERFACE
- INTEGER FUNCTION h5pget_hyper_cache_c(prp_id, cache, limit)
- USE H5GLOBAL
- !DEC$ IF DEFINED(HDF5F90_WINDOWS)
- !MS$ATTRIBUTES C,reference,alias:'_H5PGET_HYPER_CACHE_C'::h5pget_hyper_cache_c
- !DEC$ ENDIF
- INTEGER(HID_T), INTENT(IN) :: prp_id
- INTEGER, INTENT(OUT) :: cache
- INTEGER, INTENT(OUT) :: limit
- END FUNCTION h5pget_hyper_cache_c
- END INTERFACE
-
- hdferr = h5pget_hyper_cache_c(prp_id, cache, limit)
- END SUBROUTINE h5pget_hyper_cache_f
-
-!----------------------------------------------------------------------
! Name: h5pset_btree_ratios_f
!
! Purpose: Sets B-tree split ratios for a dataset transfer