46 character(len=1024) :: header =
""
47 logical :: header_is_written = .false.
69 class(*),
target,
intent(in) :: data
70 real(kind=
rp),
intent(in),
optional :: 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")
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")
96 call neko_error(
"Invalid data. Expected vector_t or &
103 call neko_log%message(
"Writing to " // trim(this%get_fname()))
104 if (
associated(vec))
then
106 else if (
associated(mat))
then
125 real(kind=
rp),
intent(in),
optional :: t
126 integer :: file_unit, ierr, n
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")
134 open(
file = trim(f%get_fname()), position =
"append", iostat = ierr, &
136 if (ierr .ne. 0)
then
137 call neko_error(
"Error while opening " // trim(f%get_fname()))
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.
147 if (
present(t))
write (file_unit,
'(g0,",")', advance =
"no") t
150 write (file_unit,
'(*(g0,","))', advance =
"no") data%x(1:n-1)
151 write (file_unit,
'(g0)') data%x(n)
165 real(kind=
rp),
intent(in),
optional :: t
166 integer :: file_unit, i, ierr, nc
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")
174 open(
file = trim(f%get_fname()), position =
"append", iostat = ierr, &
176 if (ierr .ne. 0)
then
177 call neko_error(
"Error while opening " // trim(f%get_fname()))
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.
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") &
191 write (file_unit,
'(g0)') data%x(i, nc)
203 class(*),
target,
intent(inout) :: data
207 call this%check_exists()
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")
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")
231 call neko_error(
"Invalid data type for csv_file (expected: vector_t, &
238 call neko_log%message(
"Reading csv file " // trim(this%get_fname()))
239 if (
associated(vec))
then
241 else if (
associated(mat))
then
258 type(
vector_t),
intent(inout) :: vec
259 integer :: ierr, file_unit, n_lines
260 character(len=80) :: tmp
262 n_lines = f%count_lines()
264 open(
file = trim(f%get_fname()), status =
'old', newunit = file_unit, &
266 if (ierr .ne. 0)
then
267 call neko_error(
"Error while opening " // trim(f%get_fname()))
271 if (n_lines .gt. 1)
then
272 read (file_unit,
'(A)') tmp
276 read (file_unit,*) vec%x
277 close(unit = file_unit)
289 type(
matrix_t),
intent(inout) :: mat
290 integer :: ierr, file_unit, i, n_lines
291 character(len=80) :: tmp
293 n_lines = f%count_lines()
295 open(
file = trim(f%get_fname()), status =
'old', newunit = file_unit, &
297 if (ierr .ne. 0)
then
298 call neko_error(
"Error while opening " // trim(f%get_fname()))
303 if (n_lines .gt. mat%get_nrows())
then
304 read (file_unit,
'(A)') tmp
308 do i = 1, mat%get_nrows()
309 read (file_unit,*) mat%x(i,:)
311 close(unit = file_unit)
321 character(len=*),
intent(in) :: hd
323 this%header = trim(hd)
333 integer :: ierr, file_unit
335 call this%check_exists()
337 open(
file = trim(this%get_fname()), status =
'old', newunit = file_unit, &
339 if (ierr .ne. 0)
then
340 call neko_error(
"Error while opening " // trim(this%get_fname()))
348 read (file_unit, *, iostat = ierr)
349 if (ierr .ne. 0)
exit
353 close(unit = file_unit)
362 logical,
intent(in) :: overwrite
364 this%overwrite = overwrite
integer, public pe_rank
MPI rank.
File format for .csv files, used for any read/write operations involving floating point data.
subroutine csv_file_set_header(this, hd)
Sets the header for a csv file. For example: hd = "u,v,w,p".
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...
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,...
subroutine csv_file_write(this, data, t)
Writes data to an output file.
subroutine csv_file_set_overwrite(this, overwrite)
Sets the overwrite flag for a csv file.
subroutine csv_file_read(this, data)
Reads data from an input file.
subroutine csv_file_read_matrix(f, mat)
Read a matrix from a csv file.
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.
subroutine csv_file_read_vector(f, vec)
Read a vector (i.e. data on a single row) from a csv file.
Module for file I/O operations.
type(log_t), public neko_log
Global log stream.
integer, parameter, public log_size
integer, parameter, public rp
Global precision used in computations.