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