summaryrefslogtreecommitdiffstats
path: root/fortran/test/tH5G.f90
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2014-04-12 03:26:21 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2014-04-12 03:26:21 (GMT)
commit19c485a128e4d860a537a14c91e38bc87dc6db25 (patch)
tree7333e607cf9093aa8020f5a2fa9af159379d845a /fortran/test/tH5G.f90
parent33956e594a10ecab24867ab0c3347452f22b4e11 (diff)
downloadhdf5-19c485a128e4d860a537a14c91e38bc87dc6db25.zip
hdf5-19c485a128e4d860a537a14c91e38bc87dc6db25.tar.gz
hdf5-19c485a128e4d860a537a14c91e38bc87dc6db25.tar.bz2
[svn-r25027] Merged changes from the trunk to the branch,
svn merge -r24929:25009 https://svn.hdfgroup.uiuc.edu/hdf5/trunk/fortran tested: jam (gnu)
Diffstat (limited to 'fortran/test/tH5G.f90')
-rw-r--r--fortran/test/tH5G.f909
1 files changed, 8 insertions, 1 deletions
diff --git a/fortran/test/tH5G.f90 b/fortran/test/tH5G.f90
index 6befa94..2ba174c 100644
--- a/fortran/test/tH5G.f90
+++ b/fortran/test/tH5G.f90
@@ -27,6 +27,10 @@
!
!*****
+MODULE TH5G
+
+CONTAINS
+
SUBROUTINE group_test(cleanup, total_error)
! This subroutine tests following functionalities:
@@ -35,10 +39,11 @@
! h5gget_comment_f
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(OUT) :: total_error
+ INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=5), PARAMETER :: filename = "gtest" !File name
CHARACTER(LEN=80) :: fix_filename
@@ -254,3 +259,5 @@
if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
CALL check("h5_cleanup_f", error, total_error)
END SUBROUTINE group_test
+
+END MODULE TH5G