1!****h* root/fortran/test/fflush2.f90 2! 3! NAME 4! fflush2.f90 5! 6! FUNCTION 7! This is the second half of a two-part test that makes sure 8! that a file can be read after an application crashes as long 9! as the file was flushed first. This half tries to read the 10! file created by the first half. 11! 12! COPYRIGHT 13! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14! Copyright by The HDF Group. * 15! Copyright by the Board of Trustees of the University of Illinois. * 16! All rights reserved. * 17! * 18! This file is part of HDF5. The full HDF5 copyright notice, including * 19! terms governing use, modification, and redistribution, is contained in * 20! the COPYING file, which can be found at the root of the source code * 21! distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases. * 22! If you do not have access to either file, you may request a copy from * 23! help@hdfgroup.org. * 24! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 25! 26!***** 27 28 PROGRAM FFLUSH2EXAMPLE 29 30 USE HDF5 ! This module contains all necessary modules 31 USE TH5_MISC 32 33 IMPLICIT NONE 34 35 CHARACTER(LEN=7), PARAMETER :: filename = "fflush1" 36 CHARACTER(LEN=80) :: fix_filename 37 38 ! 39 !data space rank and dimensions 40 ! 41 INTEGER, PARAMETER :: NX = 4 42 INTEGER, PARAMETER :: NY = 5 43 44 ! 45 ! File identifiers 46 ! 47 INTEGER(HID_T) :: file_id 48 49 ! 50 ! Group identifier 51 ! 52 INTEGER(HID_T) :: gid 53 54 ! 55 ! dataset identifier 56 ! 57 INTEGER(HID_T) :: dset_id 58 59 60 ! 61 ! data type identifier 62 ! 63 INTEGER(HID_T) :: dtype_id 64 65 ! 66 !flag to check operation success 67 ! 68 INTEGER :: error 69 70 ! 71 !general purpose integer 72 ! 73 INTEGER :: i, j, total_error = 0 74 75 ! 76 !data buffers 77 ! 78 INTEGER, DIMENSION(NX,NY) :: data_out 79 INTEGER(HSIZE_T), DIMENSION(2) :: data_dims 80 data_dims(1) = NX 81 data_dims(2) = NY 82 83 ! 84 !Initialize FORTRAN predifined datatypes 85 ! 86 CALL h5open_f(error) 87 CALL check("h5open_f",error,total_error) 88 89 ! 90 !Open the file. 91 ! 92 CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) 93 if (error .ne. 0) then 94 write(*,*) "Cannot modify filename" 95 CALL h5_exit_f (1) 96 endif 97 CALL h5fopen_f(fix_filename, H5F_ACC_RDONLY_F, file_id, error) 98 CALL check("h5fopen_f",error,total_error) 99 100 ! 101 !Open the dataset 102 ! 103 CALL h5dopen_f(file_id, "/D", dset_id, error) 104 CALL check("h5dopen_f",error,total_error) 105 106 ! 107 !Get dataset's data type. 108 ! 109 CALL h5dget_type_f(dset_id, dtype_id, error) 110 CALL check("h5dget_type_f",error,total_error) 111 112 ! 113 !Read the dataset. 114 ! 115 CALL h5dread_f(dset_id, dtype_id, data_out, data_dims, error) 116 CALL check("h5dread_f",error,total_error) 117 118 ! 119 !Print the dataset. 120 ! 121 do i = 1, NX 122 write(*,*) (data_out(i,j), j = 1, NY) 123 end do 124! 125!result of the print statement 126! 127! 0, 1, 2, 3, 4 128! 1, 2, 3, 4, 5 129! 2, 3, 4, 5, 6 130! 3, 4, 5, 6, 7 131 132 ! 133 !Open the group. 134 ! 135 CALL h5gopen_f(file_id, "G", gid, error) 136 CALL check("h5gopen_f",error,total_error) 137 138 ! 139 !In case error happens, exit. 140 ! 141 IF (error == -1) CALL h5_exit_f (1) 142 ! 143 !Close the datatype 144 ! 145 CALL h5tclose_f(dtype_id, error) 146 CALL check("h5tclose_f",error,total_error) 147 148 ! 149 !Close the dataset. 150 ! 151 CALL h5dclose_f(dset_id, error) 152 CALL check("h5dclose_f",error,total_error) 153 154 ! 155 !Close the group. 156 ! 157 CALL h5gclose_f(gid, error) 158 CALL check("h5gclose_f",error,total_error) 159 160 ! 161 !Close the file. 162 ! 163 CALL h5fclose_f(file_id, error) 164 CALL check("h5fclose_f",error,total_error) 165 166 ! 167 !Close FORTRAN predifined datatypes 168 ! 169 CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) 170 CALL h5close_f(error) 171 CALL check("h5close_types_f",error,total_error) 172 173 ! if errors detected, exit with non-zero code. 174 IF (total_error .ne. 0) CALL h5_exit_f (1) 175 176 END PROGRAM FFLUSH2EXAMPLE 177