From e2a92ac7f5328c2d78bc490c747cc52974a9b9ca Mon Sep 17 00:00:00 2001 From: "Vandenplas, Jeremie" Date: Wed, 22 Jan 2020 18:03:06 +0100 Subject: [PATCH 1/3] stdlib_experimental_io: addition of a spec and extension of loadtxt and savetxt to support integers --- src/stdlib_experimental_io.f90 | 309 +++++++++++++++++++++++++++++--- src/stdlib_experimental_io.fypp | 272 ++++++++++++++++++++++++++++ src/stdlib_experimental_io.md | 120 +++++++++++++ src/tests/io/test_loadtxt.f90 | 10 +- src/tests/io/test_savetxt.f90 | 21 ++- 5 files changed, 704 insertions(+), 28 deletions(-) create mode 100644 src/stdlib_experimental_io.fypp create mode 100644 src/stdlib_experimental_io.md diff --git a/src/stdlib_experimental_io.f90 b/src/stdlib_experimental_io.f90 index 8a0058c20..8aace4637 100644 --- a/src/stdlib_experimental_io.f90 +++ b/src/stdlib_experimental_io.f90 @@ -1,5 +1,8 @@ module stdlib_experimental_io -use stdlib_experimental_kinds, only: sp, dp, qp + + +use stdlib_experimental_kinds, only: sp, dp, qp, & + int8, int16, int32, int64 use stdlib_experimental_error, only: error_stop use stdlib_experimental_optval, only: optval use stdlib_experimental_ascii, only: is_blank @@ -11,22 +14,29 @@ module stdlib_experimental_io ! Private API that is exposed so that we can test it in tests public :: parse_mode - interface loadtxt - module procedure sloadtxt - module procedure dloadtxt - module procedure qloadtxt + module procedure loadtxt_sp + module procedure loadtxt_dp + module procedure loadtxt_qp + module procedure loadtxt_int8 + module procedure loadtxt_int16 + module procedure loadtxt_int32 + module procedure loadtxt_int64 end interface interface savetxt - module procedure ssavetxt - module procedure dsavetxt - module procedure qsavetxt + module procedure savetxt_sp + module procedure savetxt_dp + module procedure savetxt_qp + module procedure savetxt_int8 + module procedure savetxt_int16 + module procedure savetxt_int32 + module procedure savetxt_int64 end interface contains -subroutine sloadtxt(filename, d) +subroutine loadtxt_sp(filename, d) ! Loads a 2D array from a text file. ! ! Arguments @@ -68,8 +78,7 @@ subroutine sloadtxt(filename, d) end do close(s) end subroutine - -subroutine dloadtxt(filename, d) +subroutine loadtxt_dp(filename, d) ! Loads a 2D array from a text file. ! ! Arguments @@ -111,8 +120,7 @@ subroutine dloadtxt(filename, d) end do close(s) end subroutine - -subroutine qloadtxt(filename, d) +subroutine loadtxt_qp(filename, d) ! Loads a 2D array from a text file. ! ! Arguments @@ -154,10 +162,177 @@ subroutine qloadtxt(filename, d) end do close(s) end subroutine +subroutine loadtxt_int8(filename, d) +! Loads a 2D array from a text file. +! +! Arguments +! --------- +! +! Filename to load the array from +character(len=*), intent(in) :: filename +! The array 'd' will be automatically allocated with the correct dimensions +integer(int8), allocatable, intent(out) :: d(:,:) +! +! Example +! ------- +! +! integer(int8), allocatable :: data(:, :) +! call loadtxt("log.txt", data) ! 'data' will be automatically allocated +! +! Where 'log.txt' contains for example:: +! +! 1 2 3 +! 2 4 6 +! 8 9 10 +! 11 12 13 +! ... +! +integer :: s +integer :: nrow,ncol,i + +s = open(filename) + +! determine number of columns +ncol = number_of_columns(s) + +! determine number or rows +nrow = number_of_rows_numeric(s) + +allocate(d(nrow, ncol)) +do i = 1, nrow + read(s, *) d(i, :) +end do +close(s) +end subroutine +subroutine loadtxt_int16(filename, d) +! Loads a 2D array from a text file. +! +! Arguments +! --------- +! +! Filename to load the array from +character(len=*), intent(in) :: filename +! The array 'd' will be automatically allocated with the correct dimensions +integer(int16), allocatable, intent(out) :: d(:,:) +! +! Example +! ------- +! +! integer(int16), allocatable :: data(:, :) +! call loadtxt("log.txt", data) ! 'data' will be automatically allocated +! +! Where 'log.txt' contains for example:: +! +! 1 2 3 +! 2 4 6 +! 8 9 10 +! 11 12 13 +! ... +! +integer :: s +integer :: nrow,ncol,i + +s = open(filename) +! determine number of columns +ncol = number_of_columns(s) + +! determine number or rows +nrow = number_of_rows_numeric(s) -subroutine ssavetxt(filename, d) -! Saves a 2D array into a textfile. +allocate(d(nrow, ncol)) +do i = 1, nrow + read(s, *) d(i, :) +end do +close(s) +end subroutine +subroutine loadtxt_int32(filename, d) +! Loads a 2D array from a text file. +! +! Arguments +! --------- +! +! Filename to load the array from +character(len=*), intent(in) :: filename +! The array 'd' will be automatically allocated with the correct dimensions +integer(int32), allocatable, intent(out) :: d(:,:) +! +! Example +! ------- +! +! integer(int32), allocatable :: data(:, :) +! call loadtxt("log.txt", data) ! 'data' will be automatically allocated +! +! Where 'log.txt' contains for example:: +! +! 1 2 3 +! 2 4 6 +! 8 9 10 +! 11 12 13 +! ... +! +integer :: s +integer :: nrow,ncol,i + +s = open(filename) + +! determine number of columns +ncol = number_of_columns(s) + +! determine number or rows +nrow = number_of_rows_numeric(s) + +allocate(d(nrow, ncol)) +do i = 1, nrow + read(s, *) d(i, :) +end do +close(s) +end subroutine +subroutine loadtxt_int64(filename, d) +! Loads a 2D array from a text file. +! +! Arguments +! --------- +! +! Filename to load the array from +character(len=*), intent(in) :: filename +! The array 'd' will be automatically allocated with the correct dimensions +integer(int64), allocatable, intent(out) :: d(:,:) +! +! Example +! ------- +! +! integer(int64), allocatable :: data(:, :) +! call loadtxt("log.txt", data) ! 'data' will be automatically allocated +! +! Where 'log.txt' contains for example:: +! +! 1 2 3 +! 2 4 6 +! 8 9 10 +! 11 12 13 +! ... +! +integer :: s +integer :: nrow,ncol,i + +s = open(filename) + +! determine number of columns +ncol = number_of_columns(s) + +! determine number or rows +nrow = number_of_rows_numeric(s) + +allocate(d(nrow, ncol)) +do i = 1, nrow + read(s, *) d(i, :) +end do +close(s) +end subroutine + +subroutine savetxt_sp(filename, d) +! Saves a 2D array into a text file. ! ! Arguments ! --------- @@ -178,9 +353,8 @@ subroutine ssavetxt(filename, d) end do close(s) end subroutine - -subroutine dsavetxt(filename, d) -! Saves a 2D array into a textfile. +subroutine savetxt_dp(filename, d) +! Saves a 2D array into a text file. ! ! Arguments ! --------- @@ -201,9 +375,8 @@ subroutine dsavetxt(filename, d) end do close(s) end subroutine - -subroutine qsavetxt(filename, d) -! Saves a 2D array into a textfile. +subroutine savetxt_qp(filename, d) +! Saves a 2D array into a text file. ! ! Arguments ! --------- @@ -214,16 +387,101 @@ subroutine qsavetxt(filename, d) ! Example ! ------- ! -! real(dp) :: data(3, 2) +! real(qp) :: data(3, 2) ! call savetxt("log.txt", data) integer :: s, i -character(len=14) :: format_string +s = open(filename, "w") +do i = 1, size(d, 1) + write(s, *) d(i, :) +end do +close(s) +end subroutine +subroutine savetxt_int8(filename, d) +! Saves a 2D array into a text file. +! +! Arguments +! --------- +! +character(len=*), intent(in) :: filename ! File to save the array to +integer(int8), intent(in) :: d(:,:) ! The 2D array to save +! +! Example +! ------- +! +! integer(int8) :: data(3, 2) +! call savetxt("log.txt", data) + +integer :: s, i +s = open(filename, "w") +do i = 1, size(d, 1) + write(s, *) d(i, :) +end do +close(s) +end subroutine +subroutine savetxt_int16(filename, d) +! Saves a 2D array into a text file. +! +! Arguments +! --------- +! +character(len=*), intent(in) :: filename ! File to save the array to +integer(int16), intent(in) :: d(:,:) ! The 2D array to save +! +! Example +! ------- +! +! integer(int16) :: data(3, 2) +! call savetxt("log.txt", data) + +integer :: s, i +s = open(filename, "w") +do i = 1, size(d, 1) + write(s, *) d(i, :) +end do +close(s) +end subroutine +subroutine savetxt_int32(filename, d) +! Saves a 2D array into a text file. +! +! Arguments +! --------- +! +character(len=*), intent(in) :: filename ! File to save the array to +integer(int32), intent(in) :: d(:,:) ! The 2D array to save +! +! Example +! ------- +! +! integer(int32) :: data(3, 2) +! call savetxt("log.txt", data) -write(format_string, '(a1,i06,a7)') '(', size(d, 2), 'f40.34)' +integer :: s, i s = open(filename, "w") do i = 1, size(d, 1) - write(s, format_string) d(i, :) + write(s, *) d(i, :) +end do +close(s) +end subroutine +subroutine savetxt_int64(filename, d) +! Saves a 2D array into a text file. +! +! Arguments +! --------- +! +character(len=*), intent(in) :: filename ! File to save the array to +integer(int64), intent(in) :: d(:,:) ! The 2D array to save +! +! Example +! ------- +! +! integer(int64) :: data(3, 2) +! call savetxt("log.txt", data) + +integer :: s, i +s = open(filename, "w") +do i = 1, size(d, 1) + write(s, *) d(i, :) end do close(s) end subroutine @@ -289,7 +547,6 @@ integer function open(filename, mode, iostat) result(u) character(*), intent(in), optional :: mode integer, intent(out), optional :: iostat -integer :: io_ character(3) :: mode_ character(:),allocatable :: action_, position_, status_, access_, form_ diff --git a/src/stdlib_experimental_io.fypp b/src/stdlib_experimental_io.fypp new file mode 100644 index 000000000..145da5f63 --- /dev/null +++ b/src/stdlib_experimental_io.fypp @@ -0,0 +1,272 @@ +module stdlib_experimental_io + +#:set REALKINDS = ["sp", "dp", "qp"] +#:set INTKINDS = ["int8", "int16", "int32", "int64"] +#:set REALTYPES = ["real({})".format(k) for k in REALKINDS] +#:set INTTYPES = ["integer({})".format(k) for k in INTKINDS] +#:set KINDS = REALKINDS + INTKINDS +#:set TYPES = REALTYPES + INTTYPES +#:set ikt = list(zip(range(len(KINDS)), KINDS, TYPES)) + +use stdlib_experimental_kinds, only: sp, dp, qp, & + int8, int16, int32, int64 +use stdlib_experimental_error, only: error_stop +use stdlib_experimental_optval, only: optval +use stdlib_experimental_ascii, only: is_blank +implicit none +private +! Public API +public :: loadtxt, savetxt, open + +! Private API that is exposed so that we can test it in tests +public :: parse_mode + +interface loadtxt +#:for i1, k1, t1 in ikt + module procedure loadtxt_${k1}$ +#:endfor +end interface + +interface savetxt +#:for i1, k1, t1 in ikt + module procedure savetxt_${k1}$ +#:endfor +end interface + +contains + +#:for i1, k1, t1 in ikt +subroutine loadtxt_${k1}$(filename, d) +! Loads a 2D array from a text file. +! +! Arguments +! --------- +! +! Filename to load the array from +character(len=*), intent(in) :: filename +! The array 'd' will be automatically allocated with the correct dimensions +${t1}$, allocatable, intent(out) :: d(:,:) +! +! Example +! ------- +! +! ${t1}$, allocatable :: data(:, :) +! call loadtxt("log.txt", data) ! 'data' will be automatically allocated +! +! Where 'log.txt' contains for example:: +! +! 1 2 3 +! 2 4 6 +! 8 9 10 +! 11 12 13 +! ... +! +integer :: s +integer :: nrow,ncol,i + +s = open(filename) + +! determine number of columns +ncol = number_of_columns(s) + +! determine number or rows +nrow = number_of_rows_numeric(s) + +allocate(d(nrow, ncol)) +do i = 1, nrow + read(s, *) d(i, :) +end do +close(s) +end subroutine +#:endfor + +#:for i1, k1, t1 in ikt +subroutine savetxt_${k1}$(filename, d) +! Saves a 2D array into a text file. +! +! Arguments +! --------- +! +character(len=*), intent(in) :: filename ! File to save the array to +${t1}$, intent(in) :: d(:,:) ! The 2D array to save +! +! Example +! ------- +! +! ${t1}$ :: data(3, 2) +! call savetxt("log.txt", data) + +integer :: s, i +s = open(filename, "w") +do i = 1, size(d, 1) + write(s, *) d(i, :) +end do +close(s) +end subroutine +#:endfor + + +integer function number_of_columns(s) + ! determine number of columns + integer,intent(in)::s + + integer :: ios + character :: c + logical :: lastblank + + rewind(s) + number_of_columns = 0 + lastblank = .true. + do + read(s, '(a)', advance='no', iostat=ios) c + if (ios /= 0) exit + if (lastblank .and. .not. is_blank(c)) number_of_columns = number_of_columns + 1 + lastblank = is_blank(c) + end do + rewind(s) + +end function + +integer function number_of_rows_numeric(s) + ! determine number or rows + integer,intent(in)::s + integer :: ios + + real::r + + rewind(s) + number_of_rows_numeric = 0 + do + read(s, *, iostat=ios) r + if (ios /= 0) exit + number_of_rows_numeric = number_of_rows_numeric + 1 + end do + + rewind(s) + +end function + +integer function open(filename, mode, iostat) result(u) +! Open a file +! +! To open a file to read: +! +! u = open("somefile.txt") # The default `mode` is "rt" +! u = open("somefile.txt", "r") +! +! To open a file to write: +! +! u = open("somefile.txt", "w") + +! To append to the end of the file if it exists: +! +! u = open("somefile.txt", "a") + +character(*), intent(in) :: filename +character(*), intent(in), optional :: mode +integer, intent(out), optional :: iostat + +character(3) :: mode_ +character(:),allocatable :: action_, position_, status_, access_, form_ + + +mode_ = parse_mode(optval(mode, "")) + +select case (mode_(1:2)) +case('r') + action_='read' + position_='asis' + status_='old' +case('w') + action_='write' + position_='asis' + status_='replace' +case('a') + action_='write' + position_='append' + status_='old' +case('x') + action_='write' + position_='asis' + status_='new' +case('r+') + action_='readwrite' + position_='asis' + status_='old' +case('w+') + action_='readwrite' + position_='asis' + status_='replace' +case('a+') + action_='readwrite' + position_='append' + status_='old' +case('x+') + action_='readwrite' + position_='asis' + status_='new' +case default + call error_stop("Unsupported mode: "//mode_(1:2)) +end select + +select case (mode_(3:3)) +case('t') + form_='formatted' +case('b') + form_='unformatted' +case default + call error_stop("Unsupported mode: "//mode_(3:3)) +end select + +access_ = 'stream' + +if (present(iostat)) then + open(newunit=u, file=filename, & + action = action_, position = position_, status = status_, & + access = access_, form = form_, & + iostat = iostat) +else + open(newunit=u, file=filename, & + action = action_, position = position_, status = status_, & + access = access_, form = form_) +end if + +end function + +character(3) function parse_mode(mode) result(mode_) +character(*), intent(in) :: mode + +integer :: i +character(:),allocatable :: a +logical :: lfirst(3) + +mode_ = 'r t' + +if (len_trim(mode) == 0) return +a=trim(adjustl(mode)) + +lfirst = .true. +do i=1,len(a) + if (lfirst(1) & + .and. (a(i:i) == 'r' .or. a(i:i) == 'w' .or. a(i:i) == 'a' .or. a(i:i) == 'x') & + ) then + mode_(1:1) = a(i:i) + lfirst(1)=.false. + else if (lfirst(2) .and. a(i:i) == '+') then + mode_(2:2) = a(i:i) + lfirst(2)=.false. + else if (lfirst(3) .and. (a(i:i) == 't' .or. a(i:i) == 'b')) then + mode_(3:3) = a(i:i) + lfirst(3)=.false. + else if (a(i:i) == ' ') then + cycle + else if(any(.not.lfirst)) then + call error_stop("Wrong mode: "//trim(a)) + else + call error_stop("Wrong character: "//a(i:i)) + endif +end do + +end function + +end module diff --git a/src/stdlib_experimental_io.md b/src/stdlib_experimental_io.md new file mode 100644 index 000000000..a95c6064c --- /dev/null +++ b/src/stdlib_experimental_io.md @@ -0,0 +1,120 @@ +# IO + +## Implemented + + * `loadtxt` + * `open` + * `savetxt` + + +## `loadtxt` - load a 2D array from a text file + +### Description +Loads a rank-2 `array` from a text file. + +### Syntax + +`call loadtxt(filename, array)` + +### Arguments + +`filename`: Shall be a character expression containing the file name from which to load the rank-2 `array`. + +`array`: Shall be an allocatable rank-2 array of type `real` or `integer`. + +### Return value + +Returns an allocated rank-2 `array` with the content of `filename`. + +### Example + +```fortran +program test + use stdlib_experimental_io, only: loadtxt + implicit none + real, allocatable :: x(:,:) + call loadtxt('example.dat', x) +end program +``` + + +## `open` - open a file + +### Description + +Returns the unit number of a file opened to read, to write, or to read and write. The file might be a text file or a binary file. All files are opened using a streamed access. + +### Syntax + +`u = open(filename [, mode] [, iostat])` + +### Arguments + +`filename`: Shall be a character expression containing the name of the file to open. + +`mode` (optional): Shall be a character expression containing characters describing the way in which the file will be used. The available modes are: + + +| Character | Meaning | +| --------- | ------- | +| `r` | open for reading (default) | +| `w` | open for writing, truncating the file first | +| `x` | open for exclusive creation, failing if the file already exists | +| `a` | open for writing, appending to the end of the file if it exists | +| `b` | binary mode | +| `t` | text mode (default) | +| `+` | open for updating (reading and writing) | + + +The default mode is `rt` (i.e. open for reading a text file). + +`iostat` (optional): Shall be a scalar of type `integer` that receives the error status of `open`, if provided. If no error exists, `iostat` is zero. + +`u`: Shall be a scalar of type `integer` that specifies the unit number associated with the file `filename`. + + +### Return value + +The result is a scalar of type `integer`. + +### Example + +```fortran +program test + use stdlib_experimental_stats, only: mean + implicit none + integer :: io, u + u = open('example.dat', 'rt', iostat = io) +end program +``` + + +## `savetxt` - save a 2D array into a text file + +### Description +Saves a rank-2 `array` into a text file. + +### Syntax + +`call savetxt(filename, array)` + +### Arguments + +`filename`: Shall be a character expression containing the name of the file that will contain the 2D `array`. + +`array`: Shall be a rank-2 array of type `real` or `integer`. + +### Output + +Provides a text file called `filename` that contains the rank-2 `array`. + +### Example + +```fortran +program test + use stdlib_experimental_io, only: savetxt + implicit none + real :: x(3,2) = 1 + call savetxt('example.dat', x) +end program +``` diff --git a/src/tests/io/test_loadtxt.f90 b/src/tests/io/test_loadtxt.f90 index fbd520e28..32d152223 100644 --- a/src/tests/io/test_loadtxt.f90 +++ b/src/tests/io/test_loadtxt.f90 @@ -1,12 +1,16 @@ program test_loadtxt -use stdlib_experimental_kinds, only: sp, dp +use stdlib_experimental_kinds, only: int32, sp, dp use stdlib_experimental_io, only: loadtxt use stdlib_experimental_error, only: error_stop implicit none +integer(int32), allocatable :: i(:, :) real(sp), allocatable :: s(:, :) real(dp), allocatable :: d(:, :) +call loadtxt("array1.dat", i) +call print_array(i) + call loadtxt("array1.dat", s) call print_array(s) @@ -30,6 +34,10 @@ subroutine print_array(a) print *, "Array, shape=(", size(a, 1), ",", size(a, 2), ")" select type(a) + type is(integer(int32)) + do i = 1, size(a, 1) + print *, a(i, :) + end do type is(real(sp)) do i = 1, size(a, 1) print *, a(i, :) diff --git a/src/tests/io/test_savetxt.f90 b/src/tests/io/test_savetxt.f90 index 5ef4b5647..288a7b1aa 100644 --- a/src/tests/io/test_savetxt.f90 +++ b/src/tests/io/test_savetxt.f90 @@ -1,5 +1,5 @@ program test_savetxt -use stdlib_experimental_kinds, only: sp, dp +use stdlib_experimental_kinds, only: int32, sp, dp use stdlib_experimental_io, only: loadtxt, savetxt use stdlib_experimental_error, only: assert implicit none @@ -8,6 +8,7 @@ program test_savetxt outpath = get_outpath() // "/tmp.dat" +call test_int32(outpath) call test_sp(outpath) call test_dp(outpath) @@ -26,6 +27,24 @@ function get_outpath() result(outpath) endif end function get_outpath + subroutine test_int32(outpath) + character(*), intent(in) :: outpath + integer(int32) :: d(3, 2), e(2, 3) + integer(int32), allocatable :: d2(:, :) + d = reshape([1, 2, 3, 4, 5, 6], [3, 2]) + call savetxt(outpath, d) + call loadtxt(outpath, d2) + call assert(all(shape(d2) == [3, 2])) + call assert(all(abs(d-d2) == 0)) + + e = reshape([1, 2, 3, 4, 5, 6], [2, 3]) + call savetxt(outpath, e) + call loadtxt(outpath, d2) + call assert(all(shape(d2) == [2, 3])) + call assert(all(abs(e-d2) == 0)) + end subroutine + + subroutine test_sp(outpath) character(*), intent(in) :: outpath real(sp) :: d(3, 2), e(2, 3) From 47569cf6648dd2231b2af79c6979f098627e6db6 Mon Sep 17 00:00:00 2001 From: "Vandenplas, Jeremie" Date: Fri, 24 Jan 2020 20:14:36 +0100 Subject: [PATCH 2/3] io_dev: changes following comments in PR --- src/stdlib_experimental_io.md | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/stdlib_experimental_io.md b/src/stdlib_experimental_io.md index a95c6064c..d2558334c 100644 --- a/src/stdlib_experimental_io.md +++ b/src/stdlib_experimental_io.md @@ -57,16 +57,16 @@ Returns the unit number of a file opened to read, to write, or to read and write | Character | Meaning | | --------- | ------- | -| `r` | open for reading (default) | -| `w` | open for writing, truncating the file first | -| `x` | open for exclusive creation, failing if the file already exists | -| `a` | open for writing, appending to the end of the file if it exists | -| `b` | binary mode | -| `t` | text mode (default) | -| `+` | open for updating (reading and writing) | +| '`r`' | open for reading (default) | +| '`w`' | open for writing, truncating the file first | +| '`x`' | open for exclusive creation, failing if the file already exists | +| '`a`' | open for writing, appending to the end of the file if it exists | +| '`+`' | open for updating (reading and writing) | +| '`b`' | binary mode | +| '`t`' | text mode (default) | -The default mode is `rt` (i.e. open for reading a text file). +The default `mode` is '`rt`' (i.e. open for reading a text file). The `mode` may include one of the four different methods for opening a file (i.e., '`r`', '`w`', '`x`', and '`a`'). These four methods can be associated with the character '`+`' to open the file for updating. In addition, it can be specified if the file should be handled as a binary file ('`b`') or a text file ('`t`'). `iostat` (optional): Shall be a scalar of type `integer` that receives the error status of `open`, if provided. If no error exists, `iostat` is zero. From 5ded50ca2938ad1119bc4b2cd7bdeec5048b1ed9 Mon Sep 17 00:00:00 2001 From: "Vandenplas, Jeremie" Date: Fri, 24 Jan 2020 20:47:46 +0100 Subject: [PATCH 3/3] io_dev: quotes inside the inline code block --- src/stdlib_experimental_io.md | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/stdlib_experimental_io.md b/src/stdlib_experimental_io.md index d2558334c..941459c02 100644 --- a/src/stdlib_experimental_io.md +++ b/src/stdlib_experimental_io.md @@ -57,16 +57,16 @@ Returns the unit number of a file opened to read, to write, or to read and write | Character | Meaning | | --------- | ------- | -| '`r`' | open for reading (default) | -| '`w`' | open for writing, truncating the file first | -| '`x`' | open for exclusive creation, failing if the file already exists | -| '`a`' | open for writing, appending to the end of the file if it exists | -| '`+`' | open for updating (reading and writing) | -| '`b`' | binary mode | -| '`t`' | text mode (default) | +| `'r'` | open for reading (default) | +| `'w'` | open for writing, truncating the file first | +| `'x'` | open for exclusive creation, failing if the file already exists | +| `'a'` | open for writing, appending to the end of the file if it exists | +| `'+'` | open for updating (reading and writing) | +| `'b'` | binary mode | +| `'t'` | text mode (default) | -The default `mode` is '`rt`' (i.e. open for reading a text file). The `mode` may include one of the four different methods for opening a file (i.e., '`r`', '`w`', '`x`', and '`a`'). These four methods can be associated with the character '`+`' to open the file for updating. In addition, it can be specified if the file should be handled as a binary file ('`b`') or a text file ('`t`'). +The default `mode` is `'rt'` (i.e. open for reading a text file). The `mode` may include one of the four different methods for opening a file (i.e., `'r'`, `'w'`, `'x'`, and `'a'`). These four methods can be associated with the character `'+'` to open the file for updating. In addition, it can be specified if the file should be handled as a binary file (`'b'`) or a text file (`'t'`). `iostat` (optional): Shall be a scalar of type `integer` that receives the error status of `open`, if provided. If no error exists, `iostat` is zero.