1!****h* root/fortran/test/tH5S.f90
2!
3! NAME
4!  tH5S.f90
5!
6! FUNCTION
7!  Basic testing of Fortran H5S, Dataspace Interface, APIs.
8!
9! COPYRIGHT
10! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
11!   Copyright by The HDF Group.                                               *
12!   Copyright by the Board of Trustees of the University of Illinois.         *
13!   All rights reserved.                                                      *
14!                                                                             *
15!   This file is part of HDF5.  The full HDF5 copyright notice, including     *
16!   terms governing use, modification, and redistribution, is contained in    *
17!   the COPYING file, which can be found at the root of the source code       *
18!   distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases.  *
19!   If you do not have access to either file, you may request a copy from     *
20!   help@hdfgroup.org.                                                        *
21! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
22!
23! NOTES
24!  Tests the following functionalities:
25!   h5screate_f, h5scopy_f, h5screate_simple_f, h5sis_simple_f,
26!   h5sget_simple_extent_dims_f,h5sget_simple_extent_ndims_f
27!   h5sget_simple_extent_npoints_f, h5sget_simple_extent_type_f,
28!   h5sextent_copy_f, h5sset_extent_simple_f, h5sset_extent_none_f
29!
30! CONTAINS SUBROUTINES
31!  dataspace_basic_test
32!
33!*****
34MODULE TH5S
35
36CONTAINS
37
38        SUBROUTINE dataspace_basic_test(cleanup, total_error)
39
40        USE HDF5 ! This module contains all necessary modules
41        USE TH5_MISC
42
43          IMPLICIT NONE
44          LOGICAL, INTENT(IN)  :: cleanup
45          INTEGER, INTENT(INOUT) :: total_error
46
47          CHARACTER(LEN=10), PARAMETER :: filename1 = "basicspace" ! File1 name
48          CHARACTER(LEN=9), PARAMETER :: filename2 = "copyspace"  ! File2 name
49          CHARACTER(LEN=80) :: fix_filename1
50          CHARACTER(LEN=80) :: fix_filename2
51          CHARACTER(LEN=9), PARAMETER :: dsetname = "basicdset"       ! Dataset name
52
53          INTEGER(HID_T) :: file1_id, file2_id     ! File identifiers
54          INTEGER(HID_T) :: dset1_id, dset2_id     ! Dataset identifiers
55          INTEGER(HID_T) :: space1_id, space2_id   ! Dataspace identifiers
56
57          INTEGER(HSIZE_T), DIMENSION(2) :: dims1 = (/4,6/) ! Dataset dimensions
58          INTEGER(HSIZE_T), DIMENSION(2) :: maxdims1 = (/4,6/) ! maximum dimensions
59          INTEGER(HSIZE_T), DIMENSION(2) :: dims2 = (/6,6/) ! Dataset dimensions
60          INTEGER(HSIZE_T), DIMENSION(2) :: maxdims2 = (/6,6/) ! maximum dimensions
61          INTEGER(HSIZE_T), DIMENSION(2) :: dimsout, maxdimsout ! dimensions
62          INTEGER(HSIZE_T)   ::   npoints  !number of elements in the dataspace
63
64          INTEGER     ::   rank1 = 2               ! Dataspace1 rank
65          INTEGER     ::   rank2 = 2               ! Dataspace2 rank
66          INTEGER     ::   classtype               ! Dataspace class type
67
68          INTEGER, DIMENSION(4,6) :: data1_in, data1_out   ! Data input buffers
69          INTEGER, DIMENSION(6,6) :: data2_in, data2_out  ! Data output buffers
70          INTEGER     ::   error ! Error flag
71
72          LOGICAL     ::   flag  !flag to test datyspace is simple or not
73          INTEGER     :: i, j    !general purpose integers
74          INTEGER(HSIZE_T), DIMENSION(2) :: data_dims
75
76          !
77          ! Initialize the dset_data array.
78          !
79          do i = 1, 4
80             do j = 1, 6
81                data1_in(i,j) = (i-1)*6 + j;
82             end do
83          end do
84
85          do i = 1, 6
86             do j = 1, 6
87                data2_in(i,j) = i*6 + j;
88             end do
89          end do
90
91          !
92          !  Initialize FORTRAN predefined datatypes.
93          !
94!          CALL h5init_types_f(error)
95!              CALL check("h5init_types_f", error, total_error)
96
97          !
98          ! Create new files using default properties.
99          !
100          CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error)
101          if (error .ne. 0) then
102              write(*,*) "Cannot modify filename"
103              stop
104          endif
105          CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error)
106              CALL check("h5fcreate_f", error, total_error)
107
108          CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error)
109          if (error .ne. 0) then
110              write(*,*) "Cannot modify filename"
111              stop
112          endif
113          CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error)
114              CALL check("h5fcreate_f", error, total_error)
115
116          !
117          ! Create dataspace for file1.
118          !
119          CALL h5screate_simple_f(rank1, dims1, space1_id, error, maxdims1)
120              CALL check("h5screate_simple_f", error, total_error)
121          !
122          ! Copy space1_id to space2_id.
123          !
124          CALL h5scopy_f(space1_id, space2_id, error)
125              CALL check("h5scopy_f", error, total_error)
126
127          !
128          !Check whether copied space is simple.
129          !
130          CALL h5sis_simple_f(space2_id, flag, error)
131              CALL check("h5sissimple_f", error, total_error)
132          IF (.NOT. flag) write(*,*) "dataspace is not simple type"
133
134          !
135          !set the copied space to none.
136          !
137          CALL h5sset_extent_none_f(space2_id, error)
138              CALL check("h5sset_extent_none_f", error, total_error)
139
140          !
141          !copy the extent of space1_id to space2_id.
142          !
143          CALL h5sextent_copy_f(space2_id, space1_id, error)
144              CALL check("h5sextent_copy_f", error, total_error)
145
146          !
147          !get the copied space's dimensions.
148          !
149          CALL h5sget_simple_extent_dims_f(space2_id, dimsout, maxdimsout, error)
150              CALL check("h5sget_simple_extent_dims_f", error, total_error)
151          IF ((dimsout(1) .NE. dims1(1)) .OR. (dimsout(2) .NE. dims1(2)) ) THEN
152              write(*,*)"error occured, copied dims not same"
153          END IF
154
155          !
156          !get the copied space's rank.
157          !
158          CALL h5sget_simple_extent_ndims_f(space2_id, rank2, error)
159              CALL check("h5sget_simple_extent_ndims_f", error, total_error)
160          IF (rank2 .NE. rank1) write(*,*)"error occured, copied ranks not same"
161
162          !
163          !get the copied space's number of elements.
164          !
165          CALL h5sget_simple_extent_npoints_f(space2_id, npoints, error)
166              CALL check("h5sget_simple_extent_npoints_f", error, total_error)
167          IF (npoints .NE. 24) write(*,*)"error occured, number of elements not correct"
168
169
170          !
171          !get the copied space's class type.
172          !
173          CALL h5sget_simple_extent_type_f(space2_id, classtype, error)
174              CALL check("h5sget_simple_extent_type_f", error, total_error)
175          IF (classtype .NE. 1) write(*,*)"class type not H5S_SIMPLE_f"
176
177          !
178          !set the copied space to none before extend the dimensions.
179          !
180          CALL h5sset_extent_none_f(space2_id, error)
181              CALL check("h5sset_extent_none_f", error, total_error)
182
183          !
184          !set the copied space to dim2 size.
185          !
186          CALL h5sset_extent_simple_f(space2_id, rank2, dims2, maxdims2, error)
187              CALL check("h5sset_extent_simple_f", error, total_error)
188
189          !
190          !get the copied space's dimensions.
191          !
192          CALL h5sget_simple_extent_dims_f(space2_id, dimsout, maxdimsout, error)
193              CALL check("h5sget_simple_extent_dims_f", error, total_error)
194          IF ((dimsout(1) .NE. dims2(1)) .OR. (dimsout(2) .NE. dims2(2)) ) THEN
195              write(*,*)"error occured, copied dims not same"
196          END IF
197
198          !
199          ! Create the datasets with default properties in two files.
200          !
201          CALL h5dcreate_f(file1_id, dsetname, H5T_NATIVE_INTEGER, space1_id, &
202                           dset1_id, error)
203              CALL check("h5dcreate_f", error, total_error)
204
205          CALL h5dcreate_f(file2_id, dsetname, H5T_NATIVE_INTEGER, space2_id, &
206                           dset2_id, error)
207              CALL check("h5dcreate_f", error, total_error)
208
209          !
210          ! Write the datasets.
211          !
212          data_dims(1) = 4
213          data_dims(2) = 6
214          CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, data1_in, data_dims, error)
215              CALL check("h5dwrite_f", error, total_error)
216
217          data_dims(1) = 6
218          data_dims(2) = 6
219          CALL h5dwrite_f(dset2_id, H5T_NATIVE_INTEGER, data2_in, data_dims, error)
220              CALL check("h5dwrite_f", error, total_error)
221
222          !
223          ! Read the first dataset.
224          !
225          data_dims(1) = 4
226          data_dims(2) = 6
227          CALL h5dread_f(dset1_id, H5T_NATIVE_INTEGER, data1_out, data_dims, error)
228              CALL check("h5dread_f", error, total_error)
229
230          !
231          !Compare the data.
232          !
233          do i = 1, 4
234              do j = 1, 6
235                  IF (data1_out(i,j) .NE. data1_in(i, j)) THEN
236                      write(*, *) "dataset test error occured"
237                      write(*,*) "data read is not the same as the data writen"
238                  END IF
239              end do
240          end do
241
242
243          !
244          ! Read the second dataset.
245          !
246          data_dims(1) = 6
247          data_dims(2) = 6
248          CALL h5dread_f(dset2_id, H5T_NATIVE_INTEGER, data2_out, data_dims, error)
249              CALL check("h5dread_f", error, total_error)
250
251          !
252          !Compare the data.
253          !
254          do i = 1, 6
255              do j = 1, 6
256                  IF (data2_out(i,j) .NE. data2_in(i, j)) THEN
257                      write(*, *) "dataset test error occured"
258                      write(*,*) "data read is not the same as the data writen"
259                  END IF
260              end do
261          end do
262
263          !
264          !Close the datasets.
265          !
266          CALL h5dclose_f(dset1_id, error)
267              CALL check("h5dclose_f", error, total_error)
268          CALL h5dclose_f(dset2_id, error)
269              CALL check("h5dclose_f", error, total_error)
270
271          !
272          ! Terminate access to the data spaces.
273          !
274          CALL h5sclose_f(space1_id, error)
275              CALL check("h5sclose_f", error, total_error)
276          CALL h5sclose_f(space2_id, error)
277              CALL check("h5sclose_f", error, total_error)
278          !
279          ! Close the files.
280          !
281          CALL h5fclose_f(file1_id, error)
282              CALL check("h5fclose_f", error, total_error)
283          CALL h5fclose_f(file2_id, error)
284              CALL check("h5fclose_f", error, total_error)
285
286
287          if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error)
288              CALL check("h5_cleanup_f", error, total_error)
289          if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error)
290              CALL check("h5_cleanup_f", error, total_error)
291          RETURN
292        END SUBROUTINE dataspace_basic_test
293
294END MODULE TH5S
295