1!****h* root/fortran/test/tH5Z.f90 2! 3! NAME 4! tH5Z.f90 5! 6! FUNCTION 7! Basic testing of Fortran H5Z szip 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! CONTAINS SUBROUTINES 24! filters_test, szip_test 25! 26!***** 27MODULE TH5Z 28 29CONTAINS 30 31 SUBROUTINE filters_test(total_error) 32 33! This subroutine tests following functionalities: h5zfilter_avail_f, h5zunregister_f 34 35 USE HDF5 ! This module contains all necessary modules 36 USE TH5_MISC 37 38 IMPLICIT NONE 39 INTEGER, INTENT(OUT) :: total_error 40 LOGICAL :: status 41 INTEGER(HID_T) :: crtpr_id, xfer_id 42 INTEGER :: nfilters 43 INTEGER :: error 44 INTEGER(HSIZE_T) :: ch_dims(2) 45 INTEGER :: RANK = 2 46 INTEGER :: dlevel = 6 47 INTEGER :: edc_flag 48 49 ch_dims(1) = 10 50 ch_dims(2) = 3 51! 52! Deflate filter 53! 54 CALL h5zfilter_avail_f(H5Z_FILTER_DEFLATE_F, status, error) 55 CALL check("h5zfilter_avail_f", error, total_error) 56 if(status) then 57 CALL h5pcreate_f(H5P_DATASET_CREATE_F, crtpr_id, error) 58 CALL check("h5pcreate_f", error, total_error) 59 CALL h5pset_chunk_f(crtpr_id, RANK, ch_dims, error) 60 CALL check("h5pset_chunk_f",error, total_error) 61 CALL h5pset_deflate_f(crtpr_id, dlevel, error) 62 CALL check("h5pset_deflate_f", error, total_error) 63 CALL h5pclose_f(crtpr_id,error) 64 CALL check("h5pclose_f", error, total_error) 65 endif 66 67! 68! Shuffle filter 69! 70 CALL h5zfilter_avail_f(H5Z_FILTER_SHUFFLE_F, status, error) 71 CALL check("h5zfilter_avail_f", error, total_error) 72 if(status) then 73 CALL h5pcreate_f(H5P_DATASET_CREATE_F, crtpr_id, error) 74 CALL check("h5pcreate_f", error, total_error) 75 CALL h5pset_chunk_f(crtpr_id, RANK, ch_dims, error) 76 CALL check("h5pset_chunk_f",error, total_error) 77 CALL h5pset_shuffle_f(crtpr_id, error) 78 CALL check("h5pset_shuffle_f", error, total_error) 79 CALL h5pclose_f(crtpr_id,error) 80 CALL check("h5pclose_f", error, total_error) 81 endif 82 83! 84! Checksum filter 85! 86 CALL h5zfilter_avail_f(H5Z_FILTER_FLETCHER32_F, status, error) 87 CALL check("h5zfilter_avail_f", error, total_error) 88 if(status) then 89 CALL h5pcreate_f(H5P_DATASET_CREATE_F, crtpr_id, error) 90 CALL check("h5pcreate_f", error, total_error) 91 CALL h5pset_chunk_f(crtpr_id, RANK, ch_dims, error) 92 CALL check("h5pset_chunk_f",error, total_error) 93 CALL h5pset_fletcher32_f(crtpr_id, error) 94 CALL check("h5pset_fletcher32_f", error, total_error) 95 CALL h5pclose_f(crtpr_id,error) 96 CALL check("h5pclose_f", error, total_error) 97 CALL h5pcreate_f(H5P_DATASET_XFER_F, xfer_id, error) 98 CALL check("h5pcreate_f", error, total_error) 99 CALL h5pset_edc_check_f( xfer_id, H5Z_DISABLE_EDC_F, error) 100 CALL check("h5pset_edc_check_f", error, total_error) 101 CALL h5pget_edc_check_f( xfer_id, edc_flag, error) 102 CALL check("h5pget_edc_check_f", error, total_error) 103 if (edc_flag .ne. H5Z_DISABLE_EDC_F) then 104 write(*,*) "EDC status is wrong" 105 total_error = total_error + 1 106 endif 107 CALL h5pclose_f(xfer_id, error) 108 CALL check("h5pclose_f", error, total_error) 109 110 endif 111 112! 113! Verify h5premove_filter_f 114! 115 CALL h5zfilter_avail_f(H5Z_FILTER_FLETCHER32_F, status, error) 116 CALL check("h5zfilter_avail_f", error, total_error) 117 if(status) then 118 CALL h5zfilter_avail_f(H5Z_FILTER_SHUFFLE_F, status, error) 119 CALL check("h5zfilter_avail_f", error, total_error) 120 if(status) then 121 CALL h5pcreate_f(H5P_DATASET_CREATE_F, crtpr_id, error) 122 CALL check("h5pcreate_f", error, total_error) 123 CALL h5pset_fletcher32_f(crtpr_id, error) 124 CALL check("h5pset_fletcher32_f", error, total_error) 125 CALL h5pset_shuffle_f(crtpr_id, error) 126 CALL check("h5pset_shuffle_f", error, total_error) 127 CALL h5pget_nfilters_f(crtpr_id, nfilters, error) 128 CALL check("h5pget_nfilters_f", error, total_error) 129 130 ! Verify the correct number of filters 131 if (nfilters .ne. 2) then 132 write(*,*) "number of filters is wrong" 133 total_error = total_error + 1 134 endif 135 136 ! Delete a single filter 137 CALL h5premove_filter_f(crtpr_id, H5Z_FILTER_SHUFFLE_F, error) 138 CALL check("h5pset_shuffle_f", error, total_error) 139 140 ! Verify the correct number of filters now 141 CALL h5pget_nfilters_f(crtpr_id, nfilters, error) 142 CALL check("h5pget_nfilters_f", error, total_error) 143 if (nfilters .ne. 1) then 144 write(*,*) "number of filters is wrong" 145 total_error = total_error + 1 146 endif 147 148 ! Delete all filters 149 CALL h5premove_filter_f(crtpr_id, H5Z_FILTER_ALL_F, error) 150 CALL check("h5premove_filter_f", error, total_error) 151 152 ! Verify the correct number of filters now 153 CALL h5pget_nfilters_f(crtpr_id, nfilters, error) 154 CALL check("h5pget_nfilters_f", error, total_error) 155 if (nfilters .ne. 0) then 156 write(*,*) "number of filters is wrong" 157 total_error = total_error + 1 158 endif 159 CALL h5pclose_f(crtpr_id,error) 160 CALL check("h5pclose_f", error, total_error) 161 endif 162 endif 163 164 RETURN 165 END SUBROUTINE filters_test 166 167 SUBROUTINE szip_test(szip_flag, cleanup, total_error) 168 USE HDF5 ! This module contains all necessary modules 169 USE TH5_MISC 170 171 IMPLICIT NONE 172 LOGICAL, INTENT(OUT) :: szip_flag 173 LOGICAL, INTENT(IN) :: cleanup 174 INTEGER, INTENT(OUT) :: total_error 175 176 177 CHARACTER(LEN=4), PARAMETER :: filename = "szip" ! File name 178 CHARACTER(LEN=80) :: fix_filename 179 CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name 180 INTEGER, PARAMETER :: N = 1024 181 INTEGER, PARAMETER :: NN = 64 182 INTEGER, PARAMETER :: M = 512 183 INTEGER, PARAMETER :: MM = 32 184 185 INTEGER(HID_T) :: file_id ! File identifier 186 INTEGER(HID_T) :: dset_id ! Dataset identifier 187 INTEGER(HID_T) :: dspace_id ! Dataspace identifier 188 INTEGER(HID_T) :: dtype_id ! Datatype identifier 189 190 191 INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/N,M/) ! Dataset dimensions 192 INTEGER(HSIZE_T), DIMENSION(2) :: chunk_dims = (/NN, MM/) 193 INTEGER :: rank = 2 ! Dataset rank 194 195 INTEGER, DIMENSION(N,M) :: dset_data, data_out ! Data buffers 196 INTEGER :: error ! Error flag 197 INTEGER :: num_errors = 0 ! Number of data errors 198 199 INTEGER :: i, j !general purpose integers 200 INTEGER(HSIZE_T), DIMENSION(2) :: data_dims 201 INTEGER(HID_T) :: crp_list 202 INTEGER :: options_mask, pix_per_block 203 LOGICAL :: flag 204 CHARACTER(LEN=4) filter_name 205 206 INTEGER :: filter_flag = -1 207 INTEGER(SIZE_T) :: cd_nelemnts = 4 208 INTEGER(SIZE_T) :: filter_name_len = 4 209 INTEGER, DIMENSION(4) :: cd_values 210 INTEGER :: config_flag = 0 ! for h5zget_filter_info_f 211 INTEGER :: config_flag_both = 0 ! for h5zget_filter_info_f 212 213 ! 214 ! Verify that SZIP exists and has an encoder 215 ! 216 CALL h5zfilter_avail_f(H5Z_FILTER_SZIP_F, szip_flag, error) 217 CALL check("h5zfilter_avail", error, total_error) 218 219 ! Quit if failed 220 if (error .ne. 0) return 221 222 ! Skip if no SZIP available 223 if (.NOT. szip_flag)then 224 return 225 226 else !SZIP available 227 228 ! Continue 229 CALL h5zget_filter_info_f(H5Z_FILTER_SZIP_F, config_flag, error) 230 CALL check("h5zget_filter_info_f", error, total_error) 231 ! Quit if failed 232 if (error .ne. 0) return 233 ! 234 ! Make sure h5zget_filter_info_f returns the right flag 235 ! 236 config_flag_both=IOR(H5Z_FILTER_ENCODE_ENABLED_F,H5Z_FILTER_DECODE_ENABLED_F) 237 if( szip_flag ) then 238 if (config_flag .NE. config_flag_both) then 239 if(config_flag .NE. H5Z_FILTER_DECODE_ENABLED_F) then 240 error = -1 241 CALL check("h5zget_filter_info_f config_flag", error, total_error) 242 endif 243 endif 244 endif 245 246 ! Continue only when encoder is available 247 if ( IAND(config_flag, H5Z_FILTER_ENCODE_ENABLED_F) .EQ. 0 ) return 248 249 options_mask = H5_SZIP_NN_OM_F 250 pix_per_block = 32 251 ! 252 ! Initialize the dset_data array. 253 ! 254 do i = 1, N 255 do j = 1, M 256 dset_data(i,j) = (i-1)*6 + j; 257 end do 258 end do 259 260 261 ! 262 ! Create a new file using default properties. 263 ! 264 CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) 265 if (error .ne. 0) then 266 write(*,*) "Cannot modify filename" 267 stop 268 endif 269 CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) 270 CALL check("h5fcreate_f", error, total_error) 271 272 273 ! 274 ! Create the dataspace. 275 ! 276 CALL h5screate_simple_f(rank, dims, dspace_id, error) 277 CALL check("h5screate_simple_f", error, total_error) 278 279 CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error) 280 CALL check("h5pcreat_f",error,total_error) 281 282 CALL h5pset_chunk_f(crp_list, rank, chunk_dims, error) 283 CALL check("h5pset_chunk_f",error,total_error) 284 CALL h5pset_szip_f(crp_list, options_mask, pix_per_block, error) 285 CALL check("h5pset_szip_f",error,total_error) 286 CALL h5pall_filters_avail_f(crp_list, flag, error) 287 CALL check("h5pall_filters_avail_f",error,total_error) 288 if (.NOT. flag) then 289 CALL h5pclose_f(crp_list, error) 290 CALL h5sclose_f(dspace_id, error) 291 CALL h5fclose_f(file_id, error) 292 szip_flag = .FALSE. 293 total_error = -1 294 return 295 endif 296 297 CALL h5pget_filter_by_id_f(crp_list, H5Z_FILTER_SZIP_F, filter_flag, & 298 299 cd_nelemnts, cd_values,& 300 301 filter_name_len, filter_name, error) 302 CALL check("h5pget_filter_by_id_f",error,total_error) 303 ! 304 ! Create the dataset with default properties. 305 ! 306 CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dspace_id, & 307 dset_id, error, crp_list) 308 CALL check("h5dcreate_f", error, total_error) 309 310 ! 311 ! Write the dataset. 312 ! 313 data_dims(1) = N 314 data_dims(2) = M 315 CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error) 316 CALL check("h5dwrite_f", error, total_error) 317 318 319 ! 320 ! End access to the dataset and release resources used by it. 321 ! 322 CALL h5dclose_f(dset_id, error) 323 CALL check("h5dclose_f", error, total_error) 324 325 ! 326 ! Terminate access to the data space. 327 ! 328 CALL h5sclose_f(dspace_id, error) 329 CALL check("h5sclose_f", error, total_error) 330 331 ! 332 ! Close the file. 333 ! 334 CALL h5pclose_f(crp_list, error) 335 CALL h5fclose_f(file_id, error) 336 CALL check("h5fclose_f", error, total_error) 337 338 ! 339 ! Open the existing file. 340 ! 341 CALL h5fopen_f (fix_filename, H5F_ACC_RDWR_F, file_id, error) 342 CALL check("h5fopen_f", error, total_error) 343 344 ! 345 ! Open the existing dataset. 346 ! 347 CALL h5dopen_f(file_id, dsetname, dset_id, error) 348 CALL check("h5dopen_f", error, total_error) 349 CALL check("h5pget_filter_by_id_f",error,total_error) 350 351 ! 352 ! Get the dataset type. 353 ! 354 CALL h5dget_type_f(dset_id, dtype_id, error) 355 CALL check("h5dget_type_f", error, total_error) 356 357 ! 358 ! Get the data space. 359 ! 360 CALL h5dget_space_f(dset_id, dspace_id, error) 361 CALL check("h5dget_space_f", error, total_error) 362 363 ! 364 ! Read the dataset. 365 ! 366 CALL h5dread_f (dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error) 367 CALL check("h5dread_f", error, total_error) 368 369 ! 370 !Compare the data. 371 ! 372 do i = 1, N 373 do j = 1, M 374 IF (data_out(i,j) .NE. dset_data(i, j)) THEN 375 write(*, *) "dataset test error occured" 376 write(*,*) "data read is not the same as the data written" 377 num_errors = num_errors + 1 378 IF (num_errors .GE. 512) THEN 379 write(*, *) "maximum data errors reached" 380 goto 100 381 END IF 382 END IF 383 end do 384 end do 385100 IF (num_errors .GT. 0) THEN 386 total_error=total_error + 1 387 END IF 388 389 ! 390 ! End access to the dataset and release resources used by it. 391 ! 392 CALL h5dclose_f(dset_id, error) 393 CALL check("h5dclose_f", error, total_error) 394 395 ! 396 ! Terminate access to the data space. 397 ! 398 CALL h5sclose_f(dspace_id, error) 399 CALL check("h5sclose_f", error, total_error) 400 401 ! 402 ! Terminate access to the data type. 403 ! 404 CALL h5tclose_f(dtype_id, error) 405 CALL check("h5tclose_f", error, total_error) 406 ! 407 ! Close the file. 408 ! 409 CALL h5fclose_f(file_id, error) 410 CALL check("h5fclose_f", error, total_error) 411 if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) 412 CALL check("h5_cleanup_f", error, total_error) 413 endif ! SZIP available 414 415 RETURN 416 END SUBROUTINE szip_test 417END MODULE TH5Z 418