@@ -9,7 +9,6 @@ module stdlib_io
9
9
use, intrinsic :: iso_fortran_env, only : input_unit
10
10
use stdlib_kinds, only: sp, dp, xdp, qp, &
11
11
int8, int16, int32, int64
12
- use stdlib_error, only: error_stop
13
12
use stdlib_optval, only: optval
14
13
use stdlib_ascii, only: is_blank
15
14
use stdlib_string_type, only : string_type
@@ -120,7 +119,8 @@ contains
120
119
!! ...
121
120
!!
122
121
integer :: s
123
- integer :: nrow, ncol, i, skiprows_, max_rows_
122
+ integer :: nrow, ncol, i, ios, skiprows_, max_rows_
123
+ character(len=128) :: iomsg, msgout
124
124
125
125
skiprows_ = max(optval(skiprows, 0), 0)
126
126
max_rows_ = optval(max_rows, -1)
@@ -142,56 +142,51 @@ contains
142
142
allocate(d(max_rows_, ncol))
143
143
144
144
do i = 1, skiprows_
145
- read(s, *)
145
+ read(s, *, iostat=ios, iomsg=iomsg)
146
+
147
+ if (ios/=0) then
148
+ write(msgout,1) trim(iomsg),i,trim(filename)
149
+ error stop trim(msgout)
150
+ end if
151
+
146
152
end do
147
-
148
- #:if 'real' in t1
153
+
149
154
! Default to format used for savetxt if fmt not specified.
150
- fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))")
151
-
152
- if ( fmt_ == '*' ) then
153
- ! Use list directed read if user has specified fmt='*'
154
- do i = 1, max_rows_
155
- read (s,*) d(i, :)
156
- enddo
157
- else
158
- ! Otherwise pass default or user specified fmt string.
159
- do i = 1, max_rows_
160
- read (s,fmt_) d(i, :)
161
- enddo
162
- endif
155
+ #:if 'real' in t1
156
+ fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,1x))")
163
157
#:elif 'complex' in t1
164
- ! Default to format used for savetxt if fmt not specified.
165
- fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))")
166
- if ( fmt_ == '*' ) then
167
- ! Use list directed read if user has specified fmt='*'
168
- do i = 1, max_rows_
169
- read (s,*) d(i, :)
170
- enddo
171
- else
172
- ! Otherwise pass default or user specified fmt string.
173
- do i = 1, max_rows_
174
- read (s,fmt_) d(i, :)
175
- enddo
176
- endif
158
+ fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,1x))")
177
159
#:else
178
- ! Default to list directed for integer
179
160
fmt_ = optval(fmt, "*")
180
- ! Use list directed read if user has specified fmt='*'
161
+ #:endif
162
+
181
163
if ( fmt_ == '*' ) then
164
+ ! Use list directed read if user has specified fmt='*'
182
165
do i = 1, max_rows_
183
- read (s,*) d(i, :)
166
+ read (s,*,iostat=ios,iomsg=iomsg) d(i, :)
167
+
168
+ if (ios/=0) then
169
+ write(msgout,1) trim(iomsg),i,trim(filename)
170
+ error stop trim(msgout)
171
+ end if
172
+
184
173
enddo
185
174
else
186
- ! Otherwise pass default user specified fmt string.
175
+ ! Otherwise pass default or user specified fmt string.
187
176
do i = 1, max_rows_
188
- read (s,fmt_) d(i, :)
177
+ read (s,fmt_,iostat=ios,iomsg=iomsg) d(i, :)
178
+
179
+ if (ios/=0) then
180
+ write(msgout,1) trim(iomsg),i,trim(filename)
181
+ error stop trim(msgout)
182
+ end if
183
+
189
184
enddo
190
185
endif
191
186
192
- #:endif
193
-
194
187
close(s)
188
+
189
+ 1 format('loadtxt: error <',a,'> reading line ',i0,' of ',a,'.')
195
190
196
191
end subroutine loadtxt_${t1[0]}$${k1}$
197
192
#:endfor
@@ -218,20 +213,31 @@ contains
218
213
!!```
219
214
!!
220
215
221
- integer :: s, i
216
+ integer :: s, i, ios
217
+ character(len=128) :: iomsg, msgout
222
218
s = open(filename, "w")
223
219
do i = 1, size(d, 1)
224
220
#:if 'real' in t1
225
- write(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))") d(i, :)
221
+ write(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:, 1x))", &
226
222
#:elif 'complex' in t1
227
- write(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))") d(i, :)
223
+ write(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:, 1x))", &
228
224
#:elif 'integer' in t1
229
- write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",1x))") d(i, :)
225
+ write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",:, 1x))", &
230
226
#:else
231
- write(s, *) d(i, :)
227
+ write(s, *, &
232
228
#:endif
229
+ iostat=ios,iomsg=iomsg) d(i, :)
230
+
231
+ if (ios/=0) then
232
+ write(msgout,1) trim(iomsg),i,trim(filename)
233
+ error stop trim(msgout)
234
+ end if
235
+
233
236
end do
234
237
close(s)
238
+
239
+ 1 format('savetxt: error <',a,'> writing line ',i0,' of ',a,'.')
240
+
235
241
end subroutine savetxt_${t1[0]}$${k1}$
236
242
#:endfor
237
243
@@ -360,7 +366,7 @@ contains
360
366
position_='asis'
361
367
status_='new'
362
368
case default
363
- call error_stop( "Unsupported mode: "//mode_(1:2) )
369
+ error stop "Unsupported mode: "//mode_(1:2)
364
370
end select
365
371
366
372
select case (mode_(3:3))
@@ -369,7 +375,7 @@ contains
369
375
case('b')
370
376
form_='unformatted'
371
377
case default
372
- call error_stop( "Unsupported mode: "//mode_(3:3))
378
+ error stop "Unsupported mode: "//mode_(3:3)
373
379
end select
374
380
375
381
access_ = 'stream'
@@ -415,9 +421,9 @@ contains
415
421
else if (a(i:i) == ' ') then
416
422
cycle
417
423
else if(any(.not.lfirst)) then
418
- call error_stop( "Wrong mode: "//trim(a) )
424
+ error stop "Wrong mode: "//trim(a)
419
425
else
420
- call error_stop( "Wrong character: "//a(i:i) )
426
+ error stop "Wrong character: "//a(i:i)
421
427
endif
422
428
end do
423
429
@@ -466,7 +472,7 @@ contains
466
472
if (present(iostat)) then
467
473
iostat = stat
468
474
else if (stat /= 0) then
469
- call error_stop( trim(msg))
475
+ error stop trim(msg)
470
476
end if
471
477
end subroutine getline_char
472
478
0 commit comments