#:include "common.fypp" #:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES module stdlib_io !! Provides a support for file handling !! ([Specification](../page/specs/stdlib_io.html)) use stdlib_kinds, only: sp, dp, qp, & int8, int16, int32, int64 use stdlib_error, only: error_stop use stdlib_optval, only: optval use stdlib_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 !! version: experimental !! !! Loads a 2D array from a text file !! ([Specification](../page/specs/stdlib_io.html#description)) #:for k1, t1 in KINDS_TYPES module procedure loadtxt_${t1[0]}$${k1}$ #:endfor end interface loadtxt interface savetxt !! version: experimental !! !! Saves a 2D array into a text file !! ([Specification](../page/specs/stdlib_io.html#description_2)) #:for k1, t1 in KINDS_TYPES module procedure savetxt_${t1[0]}$${k1}$ #:endfor end interface contains #:for k1, t1 in KINDS_TYPES subroutine loadtxt_${t1[0]}$${k1}$(filename, d) !! version: experimental !! !! 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 !! ------- !! !!```fortran !! ${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 loadtxt_${t1[0]}$${k1}$ #:endfor #:for k1, t1 in KINDS_TYPES subroutine savetxt_${t1[0]}$${k1}$(filename, d) !! version: experimental !! !! 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 !! ------- !! !!```fortran !! ${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 savetxt_${t1[0]}$${k1}$ #:endfor integer function number_of_columns(s) !! version: experimental !! !! 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 number_of_columns integer function number_of_rows_numeric(s) result(nrows) !! version: experimental !! !! determine number or rows integer,intent(in)::s integer :: ios real :: r complex :: z rewind(s) nrows = 0 do read(s, *, iostat=ios) r if (ios /= 0) exit nrows = nrows + 1 end do rewind(s) ! If there are no rows of real numbers, it may be that they are complex if( nrows == 0) then do read(s, *, iostat=ios) z if (ios /= 0) exit nrows = nrows + 1 end do rewind(s) end if end function number_of_rows_numeric integer function open(filename, mode, iostat) result(u) !! version: experimental !! !! Opens a file !! ([Specification](../page/specs/stdlib_io.html#description_1)) !! !!##### Behavior !! !! !! To open a file to read: !! !!```fortran !! u = open("somefile.txt") ! The default `mode` is "rt" !! u = open("somefile.txt", "r") !!``` !! !! To open a file to write: !! !!```fortran !! u = open("somefile.txt", "w") !!``` !! !! To append to the end of the file if it exists: !! !!```fortran !! 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 open 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 parse_mode end module