Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

loadtxt/savetxt: do not require space after last entry #877

Merged
merged 8 commits into from
Oct 22, 2024
102 changes: 54 additions & 48 deletions src/stdlib_io.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,6 @@ module stdlib_io
use, intrinsic :: iso_fortran_env, only : input_unit
use stdlib_kinds, only: sp, dp, xdp, qp, &
int8, int16, int32, int64
use stdlib_error, only: error_stop
use stdlib_optval, only: optval
use stdlib_ascii, only: is_blank
use stdlib_string_type, only : string_type
Expand Down Expand Up @@ -120,7 +119,8 @@ contains
!! ...
!!
integer :: s
integer :: nrow, ncol, i, skiprows_, max_rows_
integer :: nrow, ncol, i, ios, skiprows_, max_rows_
character(len=128) :: iomsg, msgout

skiprows_ = max(optval(skiprows, 0), 0)
max_rows_ = optval(max_rows, -1)
Expand All @@ -142,56 +142,51 @@ contains
allocate(d(max_rows_, ncol))

do i = 1, skiprows_
read(s, *)
read(s, *, iostat=ios, iomsg=iomsg)

if (ios/=0) then
write(msgout,1) trim(iomsg),i,trim(filename)
error stop trim(msgout)
end if

end do

#:if 'real' in t1

! Default to format used for savetxt if fmt not specified.
fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))")

if ( fmt_ == '*' ) then
! Use list directed read if user has specified fmt='*'
do i = 1, max_rows_
read (s,*) d(i, :)
enddo
else
! Otherwise pass default or user specified fmt string.
do i = 1, max_rows_
read (s,fmt_) d(i, :)
enddo
endif
#:if 'real' in t1
fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,1x))")
#:elif 'complex' in t1
! Default to format used for savetxt if fmt not specified.
fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))")
if ( fmt_ == '*' ) then
! Use list directed read if user has specified fmt='*'
do i = 1, max_rows_
read (s,*) d(i, :)
enddo
else
! Otherwise pass default or user specified fmt string.
do i = 1, max_rows_
read (s,fmt_) d(i, :)
enddo
endif
fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,1x))")
#:else
! Default to list directed for integer
fmt_ = optval(fmt, "*")
! Use list directed read if user has specified fmt='*'
#:endif

if ( fmt_ == '*' ) then
! Use list directed read if user has specified fmt='*'
do i = 1, max_rows_
read (s,*) d(i, :)
read (s,*,iostat=ios,iomsg=iomsg) d(i, :)

if (ios/=0) then
write(msgout,1) trim(iomsg),i,trim(filename)
error stop trim(msgout)
end if

enddo
else
! Otherwise pass default user specified fmt string.
! Otherwise pass default or user specified fmt string.
do i = 1, max_rows_
read (s,fmt_) d(i, :)
read (s,fmt_,iostat=ios,iomsg=iomsg) d(i, :)

if (ios/=0) then
write(msgout,1) trim(iomsg),i,trim(filename)
error stop trim(msgout)
end if

enddo
endif

#:endif

close(s)

1 format('loadtxt: error <',a,'> reading line ',i0,' of ',a,'.')

end subroutine loadtxt_${t1[0]}$${k1}$
#:endfor
Expand All @@ -218,20 +213,31 @@ contains
!!```
!!

integer :: s, i
integer :: s, i, ios
character(len=128) :: iomsg, msgout
s = open(filename, "w")
do i = 1, size(d, 1)
#:if 'real' in t1
write(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))") d(i, :)
write(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,1x))", &
#:elif 'complex' in t1
write(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))") d(i, :)
write(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,1x))", &
#:elif 'integer' in t1
write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",1x))") d(i, :)
write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",:,1x))", &
#:else
write(s, *) d(i, :)
write(s, *, &
#:endif
iostat=ios,iomsg=iomsg) d(i, :)

if (ios/=0) then
write(msgout,1) trim(iomsg),i,trim(filename)
error stop trim(msgout)
end if

end do
close(s)

1 format('savetxt: error <',a,'> writing line ',i0,' of ',a,'.')

end subroutine savetxt_${t1[0]}$${k1}$
#:endfor

Expand Down Expand Up @@ -360,7 +366,7 @@ contains
position_='asis'
status_='new'
case default
call error_stop("Unsupported mode: "//mode_(1:2))
error stop "Unsupported mode: "//mode_(1:2)
end select

select case (mode_(3:3))
Expand All @@ -369,7 +375,7 @@ contains
case('b')
form_='unformatted'
case default
call error_stop("Unsupported mode: "//mode_(3:3))
error stop "Unsupported mode: "//mode_(3:3)
end select

access_ = 'stream'
Expand Down Expand Up @@ -415,9 +421,9 @@ contains
else if (a(i:i) == ' ') then
cycle
else if(any(.not.lfirst)) then
call error_stop("Wrong mode: "//trim(a))
error stop "Wrong mode: "//trim(a)
else
call error_stop("Wrong character: "//a(i:i))
error stop "Wrong character: "//a(i:i)
endif
end do

Expand Down Expand Up @@ -466,7 +472,7 @@ contains
if (present(iostat)) then
iostat = stat
else if (stat /= 0) then
call error_stop(trim(msg))
error stop trim(msg)
end if
end subroutine getline_char

Expand Down
Loading