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