46 character(len=1024) :: header =
""
47 logical :: header_is_written = .false.
67 class(*),
target,
intent(in) :: data
68 real(kind=
rp),
intent(in),
optional :: t
78 if (.not.
allocated(data%x))
then
79 call neko_error(
"Vector is not allocated. Use &
80 &vector%init() to associate your array &
81 &with a vector_t object")
86 if (.not.
allocated(data%x))
then
87 call neko_error(
"Matrix is not allocated. Use &
88 &matrix%init() to associate your array &
89 &with a matrix_t object")
94 call neko_error(
"Invalid data. Expected vector_t or &
101 call neko_log%message(
"Writing to " // trim(this%fname))
102 if (
associated(vec))
then
104 else if (
associated(mat))
then
123 real(kind=
rp),
intent(in),
optional :: t
124 integer :: file_unit, ierr
126 open(
file = trim(f%fname), position =
"append", iostat = ierr, &
128 if (ierr .ne. 0)
call neko_error(
"Error while opening " // trim(f%fname))
131 if (f%header .ne.
"" .and. .not. f%header_is_written)
then
132 write (file_unit,
'(A)') trim(f%header)
133 f%header_is_written = .true.
137 if (
present(t))
write (file_unit,
'(g0,",")', advance =
"no") t
139 write (file_unit,
'(*(g0,","))', advance =
"no") data%x(1:data%n-1)
140 write (file_unit,
'(g0)') data%x(data%n)
154 real(kind=
rp),
intent(in),
optional :: t
155 integer :: file_unit, i, ierr
157 open(
file = trim(f%fname), position =
"append", iostat = ierr, &
159 if (ierr .ne. 0)
call neko_error(
"Error while opening " // trim(f%fname))
162 if (f%header .ne.
"" .and. .not. f%header_is_written)
then
163 write (file_unit,
'(A)') trim(f%header)
164 f%header_is_written = .true.
168 if (
present(t))
write (file_unit,
'(g0,",")', advance =
"no") t
169 write (file_unit,
'(*(g0,","))', advance =
"no") &
170 data%x(i, 1:data%ncols-1)
171 write (file_unit,
'(g0)') data%x(i, data%ncols)
183 class(*),
target,
intent(inout) :: data
187 call this%check_exists()
195 if (.not.
allocated(data%x))
then
196 call neko_error(
"Vector is not allocated. Use &
197 &vector%init() to associate your array &
198 &with a vector_t object")
203 if (.not.
allocated(data%x))
then
204 call neko_error(
"Matrix is not allocated. Use &
205 &matrix%init() to associate your array &
206 &with a matrix_t object")
211 call neko_error(
"Invalid data type for csv_file (expected: vector_t, &
218 call neko_log%message(
"Reading csv file " // trim(this%fname))
219 if (
associated(vec))
then
221 else if (
associated(mat))
then
238 type(
vector_t),
intent(inout) :: vec
239 integer :: ierr, file_unit, n_lines
240 character(len=80) :: tmp
242 n_lines = f%count_lines()
244 open(
file = trim(f%fname), status =
'old', newunit = file_unit, &
246 if (ierr .ne. 0)
call neko_error(
"Error while opening " // trim(f%fname))
249 if (n_lines .gt. 1)
then
250 read (file_unit,
'(A)') tmp
254 read (file_unit,*) vec%x
255 close(unit = file_unit)
267 type(
matrix_t),
intent(inout) :: mat
268 integer :: ierr, file_unit, i, n_lines
269 character(len=80) :: tmp
271 n_lines = f%count_lines()
273 open(
file = trim(f%fname), status =
'old', newunit = file_unit, &
275 if (ierr .ne. 0)
call neko_error(
"Error while opening " // trim(f%fname))
279 if (n_lines .gt. mat%nrows)
then
280 read (file_unit,
'(A)') tmp
285 read (file_unit,*) mat%x(i,:)
287 close(unit = file_unit)
297 character(len=*),
intent(in) :: hd
299 this%header = trim(hd)
309 integer :: ierr, file_unit
311 call this%check_exists()
313 open(
file = trim(this%fname), status =
'old', newunit = file_unit, &
315 if (ierr .ne. 0)
call neko_error(
"Error while opening " // trim(this%fname))
322 read (file_unit, *, iostat = ierr)
323 if (ierr .ne. 0)
exit
327 close(unit = file_unit)
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_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.