1
1
module stdlib_experimental_io
2
2
use iso_fortran_env, only: sp= >real32, dp= >real64, qp= >real128
3
+ use stdlib_experimental_error, only: error_stop
4
+ use stdlib_experimental_optval, only: optval
3
5
implicit none
4
6
private
5
- public :: loadtxt, savetxt
7
+ ! Public API
8
+ public :: loadtxt, savetxt, open
9
+
10
+ ! Private API that is exposed so that we can test it in tests
11
+ public :: parse_mode
12
+
6
13
7
14
interface loadtxt
8
15
module procedure sloadtxt
@@ -46,7 +53,7 @@ subroutine sloadtxt(filename, d)
46
53
integer :: s
47
54
integer :: nrow,ncol,i
48
55
49
- open (newunit = s, file = filename, status = " old " , action = " read " )
56
+ s = open (filename )
50
57
51
58
! determine number of columns
52
59
ncol = number_of_columns(s)
@@ -89,7 +96,7 @@ subroutine dloadtxt(filename, d)
89
96
integer :: s
90
97
integer :: nrow,ncol,i
91
98
92
- open (newunit = s, file = filename, status = " old " , action = " read " )
99
+ s = open (filename )
93
100
94
101
! determine number of columns
95
102
ncol = number_of_columns(s)
@@ -132,7 +139,7 @@ subroutine qloadtxt(filename, d)
132
139
integer :: s
133
140
integer :: nrow,ncol,i
134
141
135
- open (newunit = s, file = filename, status = " old " , action = " read " )
142
+ s = open (filename )
136
143
137
144
! determine number of columns
138
145
ncol = number_of_columns(s)
@@ -164,7 +171,7 @@ subroutine ssavetxt(filename, d)
164
171
! call savetxt("log.txt", data)
165
172
166
173
integer :: s, i
167
- open (newunit = s, file = filename, status = " replace " , action = " write " )
174
+ s = open ( filename, " w " )
168
175
do i = 1 , size (d, 1 )
169
176
write (s, * ) d(i, :)
170
177
end do
@@ -187,7 +194,7 @@ subroutine dsavetxt(filename, d)
187
194
! call savetxt("log.txt", data)
188
195
189
196
integer :: s, i
190
- open (newunit = s, file = filename, status = " replace " , action = " write " )
197
+ s = open ( filename, " w " )
191
198
do i = 1 , size (d, 1 )
192
199
write (s, * ) d(i, :)
193
200
end do
@@ -210,7 +217,7 @@ subroutine qsavetxt(filename, d)
210
217
! call savetxt("log.txt", data)
211
218
212
219
integer :: s, i
213
- open (newunit = s, file = filename, status = " replace " , action = " write " )
220
+ s = open ( filename, " w " )
214
221
do i = 1 , size (d, 1 )
215
222
write (s, * ) d(i, :)
216
223
end do
@@ -268,4 +275,108 @@ logical function whitechar(char) ! white character
268
275
end if
269
276
end function
270
277
278
+ integer function open (filename , mode ) result(u)
279
+ ! Open a file
280
+ !
281
+ ! To open a file to read:
282
+ !
283
+ ! u = open("somefile.txt") # The default `mode` is "rt"
284
+ ! u = open("somefile.txt", "r")
285
+ !
286
+ ! To open a file to write:
287
+ !
288
+ ! u = open("somefile.txt", "w")
289
+
290
+ ! To append to the end of the file if it exists:
291
+ !
292
+ ! u = open("somefile.txt", "a")
293
+
294
+ character (* ), intent (in ) :: filename
295
+ character (* ), intent (in ), optional :: mode
296
+ integer :: io
297
+ character (3 ):: mode_
298
+ character (:),allocatable :: action_, position_, status_, access_, form_
299
+
300
+
301
+ mode_ = parse_mode(optval(mode, " " ))
302
+
303
+ if (mode_(1 :2 ) == ' r ' ) then
304
+ action_= ' read'
305
+ position_= ' asis'
306
+ status_= ' old'
307
+ else if (mode_(1 :2 ) == ' w ' ) then
308
+ action_= ' write'
309
+ position_= ' asis'
310
+ status_= ' replace'
311
+ else if (mode_(1 :2 ) == ' a ' ) then
312
+ action_= ' write'
313
+ position_= ' append'
314
+ status_= ' old'
315
+ else if (mode_(1 :2 ) == ' x ' ) then
316
+ action_= ' write'
317
+ position_= ' asis'
318
+ status_= ' new'
319
+ else if (mode_(1 :2 ) == ' r+' ) then
320
+ action_= ' readwrite'
321
+ position_= ' asis'
322
+ status_= ' old'
323
+ else if (mode_(1 :2 ) == ' w+' ) then
324
+ action_= ' readwrite'
325
+ position_= ' asis'
326
+ status_= ' replace'
327
+ else if (mode_(1 :2 ) == ' a+' ) then
328
+ action_= ' readwrite'
329
+ position_= ' append'
330
+ status_= ' old'
331
+ else if (mode_(1 :2 ) == ' x+' ) then
332
+ action_= ' readwrite'
333
+ position_= ' asis'
334
+ status_= ' new'
335
+ else
336
+ call error_stop(" Unsupported mode: " // mode_(1 :2 ))
337
+ end if
338
+
339
+ if (mode_(3 :3 ) == ' t' ) then
340
+ access_= ' sequential'
341
+ form_= ' formatted'
342
+ else if (mode_(3 :3 ) == ' b' .or. mode_(3 :3 ) == ' s' ) then
343
+ access_= ' stream'
344
+ form_= ' unformatted'
345
+ else
346
+ call error_stop(" Unsupported mode: " // mode_(3 :3 ))
347
+ endif
348
+
349
+ open (newunit= u, file= filename, &
350
+ action = action_, position = position_, status = status_, &
351
+ access = access_, form = form_, &
352
+ iostat = io)
353
+
354
+ end function
355
+
356
+ character (3 ) function parse_mode(mode) result(mode_)
357
+ character (* ), intent (in ) :: mode
358
+
359
+ mode_ = ' r t'
360
+ if (len_trim (mode) == 0 ) return
361
+ mode_(1 :1 ) = mode(1 :1 )
362
+
363
+ if (len_trim (adjustl (mode)) > 1 ) then
364
+ if (mode(2 :2 ) == ' +' )then
365
+ mode_(2 :2 ) = ' +'
366
+ else
367
+ mode_(3 :3 ) = mode(2 :2 )
368
+ endif
369
+ end if
370
+
371
+ if (len_trim (adjustl (mode)) > 2 ) then
372
+ mode_(3 :3 ) = mode(3 :3 )
373
+ end if
374
+
375
+ if (mode_(1 :1 ) == ' b' ) then
376
+ mode_(1 :1 ) = mode_(3 :3 )
377
+ mode_(3 :3 ) = ' b'
378
+ end if
379
+
380
+ end function
381
+
271
382
end module
0 commit comments