Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
csv_file.f90
Go to the documentation of this file.
1! Copyright (c) 2020-2024, The Neko Authors
2! All rights reserved.
3!
4! Redistribution and use in source and binary forms, with or without
5! modification, are permitted provided that the following conditions
6! are met:
7!
8! * Redistributions of source code must retain the above copyright
9! notice, this list of conditions and the following disclaimer.
10!
11! * Redistributions in binary form must reproduce the above
12! copyright notice, this list of conditions and the following
13! disclaimer in the documentation and/or other materials provided
14! with the distribution.
15!
16! * Neither the name of the authors nor the names of its
17! contributors may be used to endorse or promote products derived
18! from this software without specific prior written permission.
19!
20! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31! POSSIBILITY OF SUCH DAMAGE.
32!
36 use vector, only: vector_t
37 use matrix, only: matrix_t
39 use utils, only: neko_error
40 use num_types, only: rp
41 use logger, only: neko_log, log_size
42 use comm
43 implicit none
44
45 type, public, extends(generic_file_t) :: csv_file_t
46 character(len=1024) :: header = ""
47 logical :: header_is_written = .false.
48 contains
50 procedure :: write => csv_file_write
52 procedure :: read => csv_file_read
54 procedure :: set_header => csv_file_set_header
56 procedure :: set_overwrite => csv_file_set_overwrite
58 procedure :: count_lines => csv_file_count_lines
59 end type csv_file_t
60
61contains
62
67 subroutine csv_file_write(this, data, t)
68 class(csv_file_t), intent(inout) :: this
69 class(*), target, intent(in) :: data
70 real(kind=rp), intent(in), optional :: t
71
72 type(vector_t), pointer :: vec
73 type(matrix_t), pointer :: mat
74
75 nullify(vec)
76 nullify(mat)
77
78 select type (data)
79 type is (vector_t)
80 if (.not. allocated(data%x)) then
81 call neko_error("Vector is not allocated. Use &
82 &vector%init() to associate your array &
83 &with a vector_t object")
84 end if
85 vec => data
86
87 type is (matrix_t)
88 if (.not. allocated(data%x)) then
89 call neko_error("Matrix is not allocated. Use &
90 &matrix%init() to associate your array &
91 &with a matrix_t object")
92 end if
93 mat => data
94
95 class default
96 call neko_error("Invalid data. Expected vector_t or &
97 &matrix_t")
98 end select
99
100 ! Write is performed on rank 0
101 if (pe_rank .eq. 0) then
102
103 call neko_log%message("Writing to " // trim(this%get_fname()))
104 if (associated(vec)) then
105 call csv_file_write_vector(this, vec, t)
106 else if (associated(mat)) then
107 call csv_file_write_matrix(this, mat, t)
108 end if
109
110 end if
111
112 end subroutine csv_file_write
113
122 subroutine csv_file_write_vector(f, data, t)
123 class(csv_file_t), intent(inout) :: f
124 type(vector_t), intent(in) :: data
125 real(kind=rp), intent(in), optional :: t
126 integer :: file_unit, ierr, n
127
128 ! Delete file if overwrite is enabled and header hasn't been written yet
129 if (f%overwrite .and. .not. f%header_is_written) then
130 open(unit=999, file=trim(f%get_fname()), status="old", iostat=ierr)
131 if (ierr == 0) close(999, status="delete")
132 end if
133
134 open(file = trim(f%get_fname()), position = "append", iostat = ierr, &
135 newunit = file_unit)
136 if (ierr .ne. 0) then
137 call neko_error("Error while opening " // trim(f%get_fname()))
138 end if
139
140 ! write header if not empty and if not already written
141 if (f%header .ne. "" .and. .not. f%header_is_written) then
142 write (file_unit, '(A)') trim(f%header)
143 f%header_is_written = .true.
144 end if
145
146 ! Add time at the beginning if specified
147 if (present(t)) write (file_unit, '(g0,",")', advance = "no") t
148
149 n = data%size()
150 write (file_unit, '(*(g0,","))', advance = "no") data%x(1:n-1)
151 write (file_unit,'(g0)') data%x(n)
152
153 close(file_unit)
154
155 end subroutine csv_file_write_vector
156
162 subroutine csv_file_write_matrix(f, data, t)
163 class(csv_file_t), intent(inout) :: f
164 type(matrix_t), intent(in) :: data
165 real(kind=rp), intent(in), optional :: t
166 integer :: file_unit, i, ierr, nc
167
168 ! Delete file if overwrite is enabled and header hasn't been written yet
169 if (f%overwrite .and. .not. f%header_is_written) then
170 open(unit=999, file=trim(f%get_fname()), status="old", iostat=ierr)
171 if (ierr == 0) close(999, status="delete")
172 end if
173
174 open(file = trim(f%get_fname()), position = "append", iostat = ierr, &
175 newunit = file_unit)
176 if (ierr .ne. 0) then
177 call neko_error("Error while opening " // trim(f%get_fname()))
178 end if
179
180 ! write header if not empty and if not already written
181 if (f%header .ne. "" .and. .not. f%header_is_written) then
182 write (file_unit, '(A)') trim(f%header)
183 f%header_is_written = .true.
184 end if
185
186 do i = 1, data%get_nrows()
187 if (present(t)) write (file_unit, '(g0,",")', advance = "no") t
188 nc = data%get_ncols()
189 write (file_unit, '(*(g0,","))', advance = "no") &
190 data%x(i, 1:nc-1)
191 write (file_unit, '(g0)') data%x(i, nc)
192 end do
193
194 close(file_unit)
195
196 end subroutine csv_file_write_matrix
197
201 subroutine csv_file_read(this, data)
202 class(csv_file_t) :: this
203 class(*), target, intent(inout) :: data
204 type(vector_t), pointer :: vec
205 type(matrix_t), pointer :: mat
206
207 call this%check_exists()
208
209 nullify(vec)
210 nullify(mat)
211
212 select type (data)
213 type is (vector_t)
214 vec => data
215 if (.not. allocated(data%x)) then
216 call neko_error("Vector is not allocated. Use &
217 &vector%init() to associate your array &
218 &with a vector_t object")
219 end if
220
221 type is (matrix_t)
222 mat => data
223 if (.not. allocated(data%x)) then
224 call neko_error("Matrix is not allocated. Use &
225 &matrix%init() to associate your array &
226 &with a matrix_t object")
227 end if
228
229
230 class default
231 call neko_error("Invalid data type for csv_file (expected: vector_t, &
232 &matrix_t)")
233 end select
234
235 if (pe_rank .eq. 0) then
236
237 call neko_log%newline()
238 call neko_log%message("Reading csv file " // trim(this%get_fname()))
239 if (associated(vec)) then
240 call csv_file_read_vector(this, vec)
241 else if (associated(mat)) then
242 call csv_file_read_matrix(this, mat)
243 end if
244
245 end if
246
247 end subroutine csv_file_read
248
256 subroutine csv_file_read_vector(f, vec)
257 type(csv_file_t), intent(inout) :: f
258 type(vector_t), intent(inout) :: vec
259 integer :: ierr, file_unit, n_lines
260 character(len=80) :: tmp
261
262 n_lines = f%count_lines()
263
264 open(file = trim(f%get_fname()), status = 'old', newunit = file_unit, &
265 iostat = ierr)
266 if (ierr .ne. 0) then
267 call neko_error("Error while opening " // trim(f%get_fname()))
268 end if
269
270 ! If there is more than 1 line, assume that means there is a header
271 if (n_lines .gt. 1) then
272 read (file_unit, '(A)') tmp
273 f%header = trim(tmp)
274 end if
275
276 read (file_unit,*) vec%x
277 close(unit = file_unit)
278
279
280 end subroutine csv_file_read_vector
281
287 subroutine csv_file_read_matrix(f, mat)
288 type(csv_file_t), intent(inout) :: f
289 type(matrix_t), intent(inout) :: mat
290 integer :: ierr, file_unit, i, n_lines
291 character(len=80) :: tmp
292
293 n_lines = f%count_lines()
294
295 open(file = trim(f%get_fname()), status = 'old', newunit = file_unit, &
296 iostat = ierr)
297 if (ierr .ne. 0) then
298 call neko_error("Error while opening " // trim(f%get_fname()))
299 end if
300
301 ! If the number of lines is larger than the number of rows in the
302 ! matrix, assume that means there is a header
303 if (n_lines .gt. mat%get_nrows()) then
304 read (file_unit, '(A)') tmp
305 f%header = trim(tmp)
306 end if
307
308 do i = 1, mat%get_nrows()
309 read (file_unit,*) mat%x(i,:)
310 end do
311 close(unit = file_unit)
312
313 end subroutine csv_file_read_matrix
314
319 subroutine csv_file_set_header(this, hd)
320 class(csv_file_t), intent(inout) :: this
321 character(len=*), intent(in) :: hd
322
323 this%header = trim(hd)
324
325 end subroutine csv_file_set_header
326
329 function csv_file_count_lines(this) result(n)
330 class(csv_file_t), intent(in) :: this
331
332 integer :: n
333 integer :: ierr, file_unit
334
335 call this%check_exists()
336
337 open(file = trim(this%get_fname()), status = 'old', newunit = file_unit, &
338 iostat = ierr)
339 if (ierr .ne. 0) then
340 call neko_error("Error while opening " // trim(this%get_fname()))
341 end if
342 rewind(file_unit)
343
344 n = 0
345
346 ! Keep reading (ierr = 0) until we reach the end (ierr != 0)
347 do
348 read (file_unit, *, iostat = ierr)
349 if (ierr .ne. 0) exit
350 n = n + 1
351 end do
352 rewind(file_unit)
353 close(unit = file_unit)
354
355 end function csv_file_count_lines
356
360 subroutine csv_file_set_overwrite(this, overwrite)
361 class(csv_file_t), intent(inout) :: this
362 logical, intent(in) :: overwrite
363
364 this%overwrite = overwrite
365
366 end subroutine csv_file_set_overwrite
367
368end module csv_file
Definition comm.F90:1
integer, public pe_rank
MPI rank.
Definition comm.F90:55
File format for .csv files, used for any read/write operations involving floating point data.
Definition csv_file.f90:35
subroutine csv_file_set_header(this, hd)
Sets the header for a csv file. For example: hd = "u,v,w,p".
Definition csv_file.f90:320
subroutine csv_file_write_matrix(f, data, t)
Writes a matrix_t object to an output file. If the parameter t is present, it will be appended at the...
Definition csv_file.f90:163
subroutine csv_file_write_vector(f, data, t)
Writes a vector_t object to an output file, in a row format. If the parameter t is present,...
Definition csv_file.f90:123
subroutine csv_file_write(this, data, t)
Writes data to an output file.
Definition csv_file.f90:68
subroutine csv_file_set_overwrite(this, overwrite)
Sets the overwrite flag for a csv file.
Definition csv_file.f90:361
subroutine csv_file_read(this, data)
Reads data from an input file.
Definition csv_file.f90:202
subroutine csv_file_read_matrix(f, mat)
Read a matrix from a csv file.
Definition csv_file.f90:288
integer function csv_file_count_lines(this)
Count the number of lines in a file by going through it entirely until the end is reached.
Definition csv_file.f90:330
subroutine csv_file_read_vector(f, vec)
Read a vector (i.e. data on a single row) from a csv file.
Definition csv_file.f90:257
Module for file I/O operations.
Definition file.f90:34
Logging routines.
Definition log.f90:34
type(log_t), public neko_log
Global log stream.
Definition log.f90:70
integer, parameter, public log_size
Definition log.f90:46
Defines a matrix.
Definition matrix.f90:34
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Utilities.
Definition utils.f90:35
Defines a vector.
Definition vector.f90:34
A generic file handler.