loadtxt - load a 2D array from a text fileExperimental
Loads a rank-2 array from a text file.
call loadtxt (filename, array [, skiprows] [, max_rows] [, fmt] [, delimiter])
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, complex or integer.
skiprows (optional): Skip the first skiprows lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0.
max_rows (optional): Read max_rows lines of content after skiprows lines. A negative value results in reading all lines. A value of zero results in no lines to be read. The default value is -1.
fmt (optional): Fortran format specifier for the text read. Defaults to the write format for the data type. Setting fmt='*' will specify list directed read.
delimiter (optional): Shall be a character expression of length 1 that contains the delimiter used to separate the columns. The default is ' '.
Returns an allocated rank-2 array with the content of filename.
program example_loadtxt
use stdlib_io, only: loadtxt
implicit none
real, allocatable :: x(:, :)
call loadtxt('example.dat', x)
! Can also use list directed format if the default read fails.
call loadtxt('example.dat', x, fmt='*')
call loadtxt('example.csv', x, delimiter=',')
end program example_loadtxt
open - open a fileExperimental
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. Text files are opened using a sequential access, while binary files are opened using a streamed access.
u = open (filename [, mode] [, iostat])
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 |
'+' |
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').
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.
The result is a scalar of type integer.
program example_open
use stdlib_io, only: open
implicit none
integer :: u
u = open ('example.dat', 'wt')
write (u, '(a)') 'This is an example for open'
close (u)
end program example_open
savetxt - save a 2D array into a text fileExperimental
Saves a rank-2 array into a text file.
call savetxt (filename, array [, delimiter])
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, complex or integer.
delimiter (optional): Shall be a character expression of length 1 that contains the delimiter used to separate the columns. The default is ' '.
Provides a text file called filename that contains the rank-2 array.
program example_savetxt
use stdlib_io, only: savetxt
implicit none
real :: x(3, 2) = 1
call savetxt('example.dat', x)
call savetxt('example.csv', x, delimiter=',')
end program example_savetxt
load_npyExperimental
Loads an array from a npy formatted binary file.
call load_npy (filename, array[, iostat][, iomsg])
filename: Shall be a character expression containing the file name from which to load the array.
This argument is intent(in).
array: Shall be an allocatable array of any rank of type real, complex or integer.
This argument is intent(out).
iostat: Default integer, contains status of loading to file, zero in case of success.
It is an optional argument, in case not present the program will halt for non-zero status.
This argument is intent(out).
iomsg: Deferred length character value, contains error message in case iostat is non-zero.
It is an optional argument, error message will be dropped if not present.
This argument is intent(out).
Returns an allocated array with the content of filename in case of success.
program example_loadnpy
use stdlib_io_npy, only: load_npy
implicit none
real, allocatable :: x(:, :)
call load_npy('example.npy', x)
end program example_loadnpy
save_npyExperimental
Saves an array into a npy formatted binary file.
call save_npy (filename, array[, iostat][, iomsg])
filename: Shall be a character expression containing the name of the file that will contain the array.
This argument is intent(in).
array: Shall be an array of any rank of type real, complex or integer.
This argument is intent(in).
iostat: Default integer, contains status of saving to file, zero in case of success.
It is an optional argument, in case not present the program will halt for non-zero status.
This argument is intent(out).
iomsg: Deferred length character value, contains error message in case iostat is non-zero.
It is an optional argument, error message will be dropped if not present.
This argument is intent(out).
Provides a npy file called filename that contains the rank-2 array.
program example_savenpy
use stdlib_io_npy, only: save_npy
implicit none
real :: x(3, 2) = 1
call save_npy('example.npy', x)
end program example_savenpy
get_lineExperimental
Read a whole line from a formatted unit into a string variable
call get_line (unit, line[, iostat][, iomsg])
call get_line (line[, iostat][, iomsg])
unit: Formatted input unit.
This argument is intent(in).
If unit is not specified standard input is used.
line: Deferred length character or string_type variable.
This argument is intent(out).
iostat: Default integer, contains status of reading from unit, zero in case of success.
It is an optional argument, in case not present the program will halt for non-zero status.
This argument is intent(out).
iomsg: Deferred length character value, contains error message in case iostat is non-zero.
It is an optional argument, error message will be dropped if not present.
This argument is intent(out).
program example_getline
use, intrinsic :: iso_fortran_env, only: input_unit, output_unit
use stdlib_io, only: get_line
implicit none
character(len=:), allocatable :: line
integer :: stat
call get_line(input_unit, line, stat)
do while (stat == 0)
write (output_unit, '(a)') line
call get_line(input_unit, line, stat)
end do
end program example_getline
Experimental
Formatting constants for printing out integer, floating point, and complex numbers at their full precision.
Provides formats for all kinds as defined in the stdlib_kinds module.
program example_fmt_constants
use stdlib_kinds, only: int32, int64, sp, dp
use stdlib_io, only: FMT_INT, FMT_REAL_SP, FMT_REAL_DP, FMT_COMPLEX_SP, FMT_COMPLEX_DP
implicit none
integer(kind=int32) :: i32
integer(kind=int64) :: i64
real(kind=sp) :: r32
real(kind=dp) :: r64
complex(kind=sp) :: c32
complex(kind=dp) :: c64
i32 = 100_int32
i64 = 100_int64
r32 = 100.0_sp
r64 = 100.0_dp
c32 = cmplx(100.0_sp, kind=sp)
c64 = cmplx(100.0_dp, kind=dp)
print "(2("//FMT_INT//",1x))", i32, i64 ! outputs: 100 100
print FMT_REAL_SP, r32 ! outputs: 1.00000000E+02
print FMT_REAL_DP, r64 ! outputs: 1.0000000000000000E+002
print FMT_COMPLEX_SP, c32 ! outputs: 1.00000000E+02 0.00000000E+00
print FMT_COMPLEX_DP, c64 ! outputs: 1.0000000000000000E+002 0.0000000000000000E+000
end program example_fmt_constants
get_file - Read a whole ASCII file into a character or a string variableExperimental
This subroutine interface reads the entirety of a specified ASCII file and returns its content as a string or an allocatable character variable.
The function provides an optional error-handling mechanism via the state_type class. If the err argument is not provided, exceptions will trigger an error stop. The function also supports an optional flag to delete the file after reading.
call [[stdlib_io(module):get_file(subroutine)]] (filename, file [, err] [, delete=.false.])
Function
filename: Shall be a character input containing the path to the ASCII file to read. It is an intent(in) argument.
file: Shall be a type(string_type) or an allocatable character variable containing the full content of the specified file. It is an intent(out) argument.
err (optional): Shall be a type(state_type) variable. It is an intent(out) argument used for error handling.
delete (optional): Shall be a logical flag. If .true., the file is deleted after reading. Default is .false.. It is an intent(in) argument.
Output variable file will contain the full content of the specified file.
Raises STDLIB_IO_ERROR if the file is not found, cannot be opened, read, or deleted.
Exceptions trigger an error stop unless the optional err argument is provided.
! Demonstrate usage of `get_file`
program example_get_file
use stdlib_io, only: get_file
use stdlib_string_type, only: string_type
use stdlib_error, only: state_type
implicit none
character(*), parameter :: filename = "example.txt"
type(string_type) :: filecontent
type(state_type) :: err
! Read a file into a string
call get_file(filename, filecontent, err=err)
if (err%error()) then
print *, err%print()
else
print *, "Success! File "//filename//" imported."
end if
end program example_get_file