summaryrefslogtreecommitdiffstats
path: root/hl/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'hl/fortran')
-rw-r--r--hl/fortran/src/H5LTfc.c4
-rw-r--r--hl/fortran/src/H5TBff.F901
-rw-r--r--hl/fortran/test/tstds.F9084
-rw-r--r--hl/fortran/test/tstimage.F9054
-rw-r--r--hl/fortran/test/tstlite.F9082
-rw-r--r--hl/fortran/test/tsttable.F9074
6 files changed, 187 insertions, 112 deletions
diff --git a/hl/fortran/src/H5LTfc.c b/hl/fortran/src/H5LTfc.c
index 3a94664..a90c24b 100644
--- a/hl/fortran/src/H5LTfc.c
+++ b/hl/fortran/src/H5LTfc.c
@@ -327,8 +327,10 @@ h5ltset_attribute_c(hid_t_f *loc_id,
ret = H5LT_set_attribute_numerical(c_loc_id,c_name,c_attrname, c_size, H5T_NATIVE_INT, (const int *)buf);
else if ((size_t)*sizeof_val == sizeof(long))
ret = H5LT_set_attribute_numerical(c_loc_id,c_name,c_attrname, c_size, H5T_NATIVE_LONG, (const long *)buf);
+#if H5_SIZEOF_LONG != H5_SIZEOF_LONG_LONG
else if ((size_t)*sizeof_val == sizeof(long long))
ret = H5LT_set_attribute_numerical(c_loc_id,c_name,c_attrname, c_size, H5T_NATIVE_LLONG, (const long long *)buf);
+#endif /* H5_SIZEOF_LONG != H5_SIZEOF_LONG_LONG */
else
goto done;
} else if ( HDstrncmp(dtype,"R",1) == 0 ) {
@@ -420,8 +422,10 @@ h5ltget_attribute_c(hid_t_f *loc_id,
ret = H5LTget_attribute(c_loc_id,c_name,c_attrname,H5T_NATIVE_INT,buf);
else if ((size_t)*sizeof_val == sizeof(long))
ret = H5LTget_attribute(c_loc_id,c_name,c_attrname,H5T_NATIVE_LONG,buf);
+#if H5_SIZEOF_LONG != H5_SIZEOF_LONG_LONG
else if ((size_t)*sizeof_val == sizeof(long long))
ret = H5LTget_attribute(c_loc_id,c_name,c_attrname,H5T_NATIVE_LLONG,buf);
+#endif /* H5_SIZEOF_LONG != H5_SIZEOF_LONG_LONG */
else
goto done;
} else if ( HDstrncmp(dtype,"R",1) == 0 ) {
diff --git a/hl/fortran/src/H5TBff.F90 b/hl/fortran/src/H5TBff.F90
index 266f74a..a31c751 100644
--- a/hl/fortran/src/H5TBff.F90
+++ b/hl/fortran/src/H5TBff.F90
@@ -380,7 +380,6 @@ CONTAINS
INTEGER :: errcode ! error code
INTEGER(size_t) :: namelen ! name length
- INTEGER(hsize_t) :: i ! general purpose integer
INTERFACE
INTEGER FUNCTION h5tbread_table_c(loc_id,&
diff --git a/hl/fortran/test/tstds.F90 b/hl/fortran/test/tstds.F90
index cbf6c38..f5df4ef 100644
--- a/hl/fortran/test/tstds.F90
+++ b/hl/fortran/test/tstds.F90
@@ -12,25 +12,59 @@
! * http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have *
! * access to either file, you may request a copy from help@hdfgroup.org. *
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-PROGRAM test_ds
+
+MODULE TSTDS
+
+CONTAINS
+
+!-------------------------------------------------------------------------
+! test_begin
+!-------------------------------------------------------------------------
+
+SUBROUTINE test_begin(string)
+ CHARACTER(LEN=*), INTENT(IN) :: string
+ WRITE(*, fmt = '(A)', advance = 'no') ADJUSTL(string)
+END SUBROUTINE test_begin
+
+!-------------------------------------------------------------------------
+! passed/failed
+!-------------------------------------------------------------------------
+SUBROUTINE write_test_status( test_result)
+
+! Writes the results of the tests
IMPLICIT NONE
- INTEGER :: err
+ INTEGER, INTENT(IN) :: test_result ! negative, failed
+ ! 0 , passed
- CALL test_testds(err)
+! Controls the output style for reporting test results
- IF(err.LT.0)THEN
- WRITE(*,'(5X,A)') "DIMENSION SCALES TEST *FAILED*"
+ CHARACTER(LEN=8) :: error_string
+ CHARACTER(LEN=8), PARAMETER :: success = ' PASSED '
+ CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*'
+
+ error_string = failure
+ IF (test_result .EQ. 0) THEN
+ error_string = success
ENDIF
+
+ WRITE(*, fmt = '(T34, A)') error_string
-END PROGRAM test_ds
+END SUBROUTINE write_test_status
+
+END MODULE TSTDS
+
+MODULE TSTDS_TESTS
+
+CONTAINS
SUBROUTINE test_testds(err)
USE HDF5
USE H5LT
USE H5DS
+ USE TSTDS ! module for testing dataset support routines
IMPLICIT NONE
@@ -44,7 +78,6 @@ SUBROUTINE test_testds(err)
CHARACTER(LEN=6), PARAMETER :: DSET_NAME = "Mydata"
CHARACTER(LEN=5), PARAMETER :: DS_1_NAME = "Yaxis"
- CHARACTER(LEN=5), PARAMETER :: DS_1_NAME_A = "Yaxiz"
CHARACTER(LEN=5), PARAMETER :: DS_2_NAME = "Xaxis"
@@ -316,38 +349,21 @@ SUBROUTINE test_testds(err)
END SUBROUTINE test_testds
-!-------------------------------------------------------------------------
-! test_begin
-!-------------------------------------------------------------------------
-
-SUBROUTINE test_begin(string)
- CHARACTER(LEN=*), INTENT(IN) :: string
- WRITE(*, fmt = '(A)', advance = 'no') ADJUSTL(string)
-END SUBROUTINE test_begin
+END MODULE TSTDS_TESTS
-!-------------------------------------------------------------------------
-! passed/failed
-!-------------------------------------------------------------------------
-SUBROUTINE write_test_status( test_result)
-
-! Writes the results of the tests
+PROGRAM test_ds
+ USE TSTDS_TESTS ! module for testing dataset routines
+
IMPLICIT NONE
- INTEGER, INTENT(IN) :: test_result ! negative, failed
- ! 0 , passed
-
-! Controls the output style for reporting test results
+ INTEGER :: err
- CHARACTER(LEN=8) :: error_string
- CHARACTER(LEN=8), PARAMETER :: success = ' PASSED '
- CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*'
+ CALL test_testds(err)
- error_string = failure
- IF (test_result .EQ. 0) THEN
- error_string = success
+ IF(err.LT.0)THEN
+ WRITE(*,'(5X,A)') "DIMENSION SCALES TEST *FAILED*"
ENDIF
-
- WRITE(*, fmt = '(T34, A)') error_string
-END SUBROUTINE write_test_status
+END PROGRAM test_ds
+
diff --git a/hl/fortran/test/tstimage.F90 b/hl/fortran/test/tstimage.F90
index 0bff6b2..7e90664 100644
--- a/hl/fortran/test/tstimage.F90
+++ b/hl/fortran/test/tstimage.F90
@@ -17,12 +17,34 @@
! This file contains the FORTRAN90 tests for H5LT
!
-program image_test
+MODULE TSTIMAGE
-call make_image1()
+CONTAINS
-end program image_test
+!-------------------------------------------------------------------------
+! test_begin
+!-------------------------------------------------------------------------
+
+subroutine test_begin(string)
+character(len=*), intent(in) :: string
+write(*, fmt = '(14a)', advance = 'no') string
+write(*, fmt = '(40x,a)', advance = 'no') ' '
+end subroutine test_begin
+
+!-------------------------------------------------------------------------
+! passed
+!-------------------------------------------------------------------------
+
+subroutine passed()
+write(*, fmt = '(6a)') 'PASSED'
+end subroutine passed
+
+END MODULE TSTIMAGE
+
+
+MODULE TSTIMAGE_TESTS
+CONTAINS
!-------------------------------------------------------------------------
! make_image1
@@ -32,6 +54,7 @@ subroutine make_image1()
use h5im ! module of H5IM
use hdf5 ! module of HDF5 library
+USE TSTIMAGE ! module for testing image support routines
implicit none
@@ -320,20 +343,17 @@ call h5close_f(errcode)
!
end subroutine make_image1
-!-------------------------------------------------------------------------
-! test_begin
-!-------------------------------------------------------------------------
+END MODULE TSTIMAGE_TESTS
-subroutine test_begin(string)
-character(len=*), intent(in) :: string
-write(*, fmt = '(14a)', advance = 'no') string
-write(*, fmt = '(40x,a)', advance = 'no') ' '
-end subroutine test_begin
-!-------------------------------------------------------------------------
-! passed
-!-------------------------------------------------------------------------
+program image_test
+
+USE TSTIMAGE_TESTS ! module for testing dataset routines
+
+IMPLICIT NONE
+
+call make_image1()
+
+end program image_test
+
-subroutine passed()
-write(*, fmt = '(6a)') 'PASSED'
-end subroutine passed
diff --git a/hl/fortran/test/tstlite.F90 b/hl/fortran/test/tstlite.F90
index 3937c3c..9d47c59 100644
--- a/hl/fortran/test/tstlite.F90
+++ b/hl/fortran/test/tstlite.F90
@@ -18,19 +18,33 @@
!
#include <H5config_f.inc>
-PROGRAM lite_test
-
- CALL test_dataset1D()
- CALL test_dataset2D()
- CALL test_dataset3D()
- CALL test_datasetND(4)
- CALL test_datasetND(5)
- CALL test_datasetND(6)
- CALL test_datasetND(7)
- CALL test_datasets()
- CALL test_attributes()
+MODULE TSTLITE
-END PROGRAM lite_test
+CONTAINS
+
+!-------------------------------------------------------------------------
+! test_begin
+!-------------------------------------------------------------------------
+
+SUBROUTINE test_begin(string)
+ CHARACTER(LEN=*), INTENT(IN) :: string
+ WRITE(*, fmt = '(14a)', advance = 'no') string
+ WRITE(*, fmt = '(40x,a)', advance = 'no') ' '
+END SUBROUTINE test_begin
+
+!-------------------------------------------------------------------------
+! passed
+!-------------------------------------------------------------------------
+
+SUBROUTINE passed()
+ WRITE(*, fmt = '(6a)') 'PASSED'
+END SUBROUTINE passed
+
+END MODULE TSTLITE
+
+MODULE TSTLITE_TESTS
+
+CONTAINS
!-------------------------------------------------------------------------
@@ -42,6 +56,7 @@ SUBROUTINE test_dataset1D()
USE, INTRINSIC :: ISO_C_BINDING
USE H5LT ! module of H5LT
USE HDF5 ! module of HDF5 library
+ USE TSTLITE ! module for testing lite support routines
IMPLICIT NONE
@@ -191,6 +206,7 @@ SUBROUTINE test_dataset2D()
USE, INTRINSIC :: ISO_C_BINDING
USE H5LT ! module of H5LT
USE HDF5 ! module of HDF5 library
+ USE TSTLITE ! module for testing lite support routines
IMPLICIT NONE
@@ -387,6 +403,7 @@ SUBROUTINE test_dataset3D()
USE, INTRINSIC :: ISO_C_BINDING
USE H5LT ! module of H5LT
USE HDF5 ! module of HDF5 library
+ USE TSTLITE ! module for testing lite support routines
IMPLICIT NONE
@@ -702,6 +719,7 @@ SUBROUTINE test_datasetND(rank)
USE, INTRINSIC :: ISO_C_BINDING
USE H5LT ! module of H5LT
USE HDF5 ! module of HDF5 library
+ USE TSTLITE ! module for testing lite support routines
IMPLICIT NONE
@@ -1293,6 +1311,7 @@ SUBROUTINE test_datasets()
USE, INTRINSIC :: ISO_C_BINDING
USE H5LT ! module of H5LT
USE HDF5 ! module of HDF5 library
+ USE TSTLITE ! module for testing lite support routines
IMPLICIT NONE
@@ -1302,7 +1321,6 @@ SUBROUTINE test_datasets()
INTEGER, PARAMETER :: DIM1 = 10 ! Dimension of array
INTEGER, PARAMETER :: LEN0 = 3
INTEGER, PARAMETER :: LEN1 = 12
- CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name
@@ -1665,21 +1683,21 @@ SUBROUTINE test_attributes()
USE, INTRINSIC :: ISO_C_BINDING
USE H5LT ! module of H5LT
USE HDF5 ! module of HDF5 library
+ USE TSTLITE ! module for testing lite support routines
IMPLICIT NONE
CHARACTER(len=9), PARAMETER :: filename = "dsetf5.h5"! File name
- CHARACTER(len=9), PARAMETER :: filename1 ="tattr.h5" ! C written attribute file
+!!$ CHARACTER(len=9), PARAMETER :: filename1 ="tattr.h5" ! C written attribute file
INTEGER(HID_T) :: file_id ! File identifier
! INTEGER(HID_T) :: file_id1
INTEGER, PARAMETER :: DIM1 = 10 ! Dimension of array
- CHARACTER(LEN=5), PARAMETER :: attrname1 = "attr1" ! Attribute name
CHARACTER(LEN=5), PARAMETER :: attrname2 = "attr2" ! Attribute name
CHARACTER(LEN=5), PARAMETER :: attrname3 = "attr3" ! Attribute name
CHARACTER(LEN=5), PARAMETER :: attrname4 = "attr4" ! Attribute name
CHARACTER(LEN=5), PARAMETER :: attrname5 = "attr5" ! Attribute name
CHARACTER(LEN=8), PARAMETER :: buf1 = "mystring" ! Data buffer
- CHARACTER(LEN=16), PARAMETER :: buf_c = "string attribute"
+!!$ CHARACTER(LEN=16), PARAMETER :: buf_c = "string attribute"
CHARACTER(LEN=8) :: bufr1 ! Data buffer
CHARACTER(LEN=10) :: bufr1_lg ! Data buffer
! CHARACTER(LEN=16) :: bufr_c ! Data buffer
@@ -1969,20 +1987,24 @@ SUBROUTINE test_attributes()
!
END SUBROUTINE test_attributes
-!-------------------------------------------------------------------------
-! test_begin
-!-------------------------------------------------------------------------
+END MODULE TSTLITE_TESTS
-SUBROUTINE test_begin(string)
- CHARACTER(LEN=*), INTENT(IN) :: string
- WRITE(*, fmt = '(14a)', advance = 'no') string
- WRITE(*, fmt = '(40x,a)', advance = 'no') ' '
-END SUBROUTINE test_begin
+PROGRAM lite_test
+
+ USE TSTLITE_TESTS ! module for testing lite routines
+
+ IMPLICIT NONE
+
+ CALL test_dataset1D()
+ CALL test_dataset2D()
+ CALL test_dataset3D()
+ CALL test_datasetND(4)
+ CALL test_datasetND(5)
+ CALL test_datasetND(6)
+ CALL test_datasetND(7)
+ CALL test_datasets()
+ CALL test_attributes()
+
+END PROGRAM lite_test
-!-------------------------------------------------------------------------
-! passed
-!-------------------------------------------------------------------------
-SUBROUTINE passed()
- WRITE(*, fmt = '(6a)') 'PASSED'
-END SUBROUTINE passed
diff --git a/hl/fortran/test/tsttable.F90 b/hl/fortran/test/tsttable.F90
index 5c55a66..822f116 100644
--- a/hl/fortran/test/tsttable.F90
+++ b/hl/fortran/test/tsttable.F90
@@ -18,29 +18,33 @@
!
#include <H5config_f.inc>
-PROGRAM table_test
+MODULE TSTTABLE
- USE H5TB ! module of H5TB
- USE HDF5 ! module of HDF5 library
+CONTAINS
- IMPLICIT NONE
- INTEGER :: errcode = 0
+!-------------------------------------------------------------------------
+! test_begin
+!-------------------------------------------------------------------------
- !
- ! Initialize FORTRAN predefined datatypes.
- !
- CALL h5open_f(errcode)
+SUBROUTINE test_begin(string)
+ CHARACTER(LEN=*), INTENT(IN) :: string
+ WRITE(*, fmt = '(A)', ADVANCE = 'no') string
+END SUBROUTINE test_begin
- CALL test_table1()
- CALL test_table2()
+!-------------------------------------------------------------------------
+! passed
+!-------------------------------------------------------------------------
- !
- ! Close FORTRAN predefined datatypes.
- !
- CALL h5close_f(errcode)
+SUBROUTINE passed()
+ WRITE(*, fmt = '(T12,A6)') 'PASSED'
+END SUBROUTINE passed
+
+END MODULE TSTTABLE
-END PROGRAM table_test
+MODULE TSTTABLE_TESTS
+
+CONTAINS
!-------------------------------------------------------------------------
! test_table1
@@ -50,6 +54,7 @@ SUBROUTINE test_table1()
USE H5TB ! module of H5TB
USE HDF5 ! module of HDF5 library
+ USE TSTTABLE ! module for testing table support routines
IMPLICIT NONE
@@ -536,6 +541,7 @@ SUBROUTINE test_table2()
USE H5TB ! module of H5TB
USE HDF5 ! module of HDF5 library
+ USE TSTTABLE ! module for testing table support routines
IMPLICIT NONE
@@ -574,7 +580,6 @@ SUBROUTINE test_table2()
INTEGER(hsize_t), PARAMETER :: chunk_size = 10
TYPE(particle_t), DIMENSION(1:nrecords), TARGET :: fill_data
INTEGER :: compress
- INTEGER :: status
INTEGER :: i
INTEGER(SIZE_T) :: dst_size
TYPE(particle_t), DIMENSION(1:nrecords), TARGET :: dst_buf
@@ -711,22 +716,31 @@ SUBROUTINE test_table2()
END SUBROUTINE test_table2
+END MODULE TSTTABLE_TESTS
-!-------------------------------------------------------------------------
-! test_begin
-!-------------------------------------------------------------------------
-SUBROUTINE test_begin(string)
- CHARACTER(LEN=*), INTENT(IN) :: string
- WRITE(*, fmt = '(A)', ADVANCE = 'no') string
-END SUBROUTINE test_begin
+PROGRAM table_test
-!-------------------------------------------------------------------------
-! passed
-!-------------------------------------------------------------------------
+ USE H5TB ! module of H5TB
+ USE HDF5 ! module of HDF5 library
+ USE TSTTABLE_TESTS ! module for testing table routines
-SUBROUTINE passed()
- WRITE(*, fmt = '(T12,A6)') 'PASSED'
-END SUBROUTINE passed
+ IMPLICIT NONE
+ INTEGER :: errcode = 0
+
+ !
+ ! Initialize FORTRAN predefined datatypes.
+ !
+ CALL h5open_f(errcode)
+
+ CALL test_table1()
+ CALL test_table2()
+
+ !
+ ! Close FORTRAN predefined datatypes.
+ !
+ CALL h5close_f(errcode)
+
+END PROGRAM table_test
generated by cgit v0.12 at 2024-11-16 09:44:29 (GMT)