diff --git a/README.md b/README.md index 910e6c0..c5eae80 100644 --- a/README.md +++ b/README.md @@ -1 +1,10 @@ # stdlib_modules +## io +- module name: `stdlib_io`, `stdlib_io_npy` +- dependent branches: stdlib_version-fpm, stdlib_kinds-fpm, stdlib_optval-fpm, stdlib_ascii, stdlib_error, stdlib_string_type +- reference: add following to your `fpm.toml`. + +```toml +[dependencies] +stdlib_io = {git = "https://github.com/degawa/stdlib_modules", branch="stdlib_io-fpm"} +``` diff --git a/fpm.toml b/fpm.toml new file mode 100644 index 0000000..6448fd4 --- /dev/null +++ b/fpm.toml @@ -0,0 +1,14 @@ +name = "stdlib_io" +version = "0.2.2" +license = "MIT" +author = "Tomohiro Degawa" +maintainer = "@degawa/stdlib_modules" +copyright = "2021-2022 Tomohiro Degawa" + +[dependencies] +stdlib_version = {git = "https://github.com/degawa/stdlib_modules", branch="stdlib_version-fpm"} +stdlib_kinds = {git = "https://github.com/degawa/stdlib_modules", branch="stdlib_kinds-fpm"} +stdlib_optval = {git = "https://github.com/degawa/stdlib_modules", branch="stdlib_optval-fpm"} +stdlib_ascii = {git = "https://github.com/degawa/stdlib_modules", branch="stdlib_ascii-fpm"} +stdlib_error = {git = "https://github.com/degawa/stdlib_modules", branch="stdlib_error-fpm"} +stdlib_string_type = {git = "https://github.com/degawa/stdlib_modules", branch="stdlib_string_type-fpm"} diff --git a/src/stdlib_io.f90 b/src/stdlib_io.f90 new file mode 100644 index 0000000..8fba407 --- /dev/null +++ b/src/stdlib_io.f90 @@ -0,0 +1,1114 @@ + + +module stdlib_io + !! Provides a support for file handling + !! ([Specification](../page/specs/stdlib_io.html)) + + 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 + implicit none + private + ! Public API + public :: loadtxt, savetxt, open, getline + + ! Private API that is exposed so that we can test it in tests + public :: parse_mode + + !> Version: experimental + !> + !> Format strings with edit descriptors for each type and kind + !> ([Specification](../page/specs/stdlib_io.html)) + character(*), parameter :: & + !> Format string for integers + FMT_INT = '(i0)', & + !> Format string for single precision real numbers + FMT_REAL_SP = '(es15.8e2)', & + !> Format string for souble precision real numbers + FMT_REAL_DP = '(es24.16e3)', & + !> Format string for extended double precision real numbers + FMT_REAL_XDP = '(es26.18e3)', & + !> Format string for quadruple precision real numbers + FMT_REAL_QP = '(es44.35e4)', & + !> Format string for single precision complex numbers + FMT_COMPLEX_SP = '(es15.8e2,1x,es15.8e2)', & + !> Format string for double precision complex numbers + FMT_COMPLEX_DP = '(es24.16e3,1x,es24.16e3)', & + !> Format string for extended double precision complex numbers + FMT_COMPLEX_XDP = '(es26.18e3,1x,es26.18e3)', & + !> Format string for quadruple precision complex numbers + FMT_COMPLEX_QP = '(es44.35e4,1x,es44.35e4)' + + public :: FMT_INT, FMT_REAL_SP, FMT_REAL_DP, FMT_REAL_XDP, FMT_REAL_QP + public :: FMT_COMPLEX_SP, FMT_COMPLEX_DP, FMT_COMPLEX_XDP, FMT_COMPLEX_QP + + !> Version: experimental + !> + !> Read a whole line from a formatted unit into a string variable + interface getline + module procedure :: getline_char + module procedure :: getline_string + module procedure :: getline_input_char + module procedure :: getline_input_string + end interface getline + + interface loadtxt + !! version: experimental + !! + !! Loads a 2D array from a text file + !! ([Specification](../page/specs/stdlib_io.html#description)) + module procedure loadtxt_rsp + module procedure loadtxt_rdp + module procedure loadtxt_iint8 + module procedure loadtxt_iint16 + module procedure loadtxt_iint32 + module procedure loadtxt_iint64 + module procedure loadtxt_csp + module procedure loadtxt_cdp + end interface loadtxt + + interface savetxt + !! version: experimental + !! + !! Saves a 2D array into a text file + !! ([Specification](../page/specs/stdlib_io.html#description_2)) + module procedure savetxt_rsp + module procedure savetxt_rdp + module procedure savetxt_iint8 + module procedure savetxt_iint16 + module procedure savetxt_iint32 + module procedure savetxt_iint64 + module procedure savetxt_csp + module procedure savetxt_cdp + end interface + +contains + + subroutine loadtxt_rsp(filename, d, skiprows, max_rows) + !! 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 + real(sp), allocatable, intent(out) :: d(:,:) + !! Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. + integer, intent(in), optional :: skiprows + !! 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. + integer, intent(in), optional :: max_rows + !! + !! Example + !! ------- + !! + !!```fortran + !! real(sp), 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, skiprows_, max_rows_ + + skiprows_ = max(optval(skiprows, 0), 0) + max_rows_ = optval(max_rows, -1) + + s = open(filename) + + ! determine number or rows + nrow = number_of_rows(s) + skiprows_ = min(skiprows_, nrow) + if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_) ) max_rows_ = nrow - skiprows_ + + ! determine number of columns + ncol = 0 + if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_) + + allocate(d(max_rows_, ncol)) + + do i = 1, skiprows_ + read(s, *) + end do + + do i = 1, max_rows_ + read(s, "(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))") d(i, :) + end do + close(s) + + end subroutine loadtxt_rsp + subroutine loadtxt_rdp(filename, d, skiprows, max_rows) + !! 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 + real(dp), allocatable, intent(out) :: d(:,:) + !! Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. + integer, intent(in), optional :: skiprows + !! 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. + integer, intent(in), optional :: max_rows + !! + !! Example + !! ------- + !! + !!```fortran + !! real(dp), 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, skiprows_, max_rows_ + + skiprows_ = max(optval(skiprows, 0), 0) + max_rows_ = optval(max_rows, -1) + + s = open(filename) + + ! determine number or rows + nrow = number_of_rows(s) + skiprows_ = min(skiprows_, nrow) + if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_) ) max_rows_ = nrow - skiprows_ + + ! determine number of columns + ncol = 0 + if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_) + + allocate(d(max_rows_, ncol)) + + do i = 1, skiprows_ + read(s, *) + end do + + do i = 1, max_rows_ + read(s, "(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))") d(i, :) + end do + close(s) + + end subroutine loadtxt_rdp + subroutine loadtxt_iint8(filename, d, skiprows, max_rows) + !! 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 + integer(int8), allocatable, intent(out) :: d(:,:) + !! Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. + integer, intent(in), optional :: skiprows + !! 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. + integer, intent(in), optional :: max_rows + !! + !! Example + !! ------- + !! + !!```fortran + !! integer(int8), 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, skiprows_, max_rows_ + + skiprows_ = max(optval(skiprows, 0), 0) + max_rows_ = optval(max_rows, -1) + + s = open(filename) + + ! determine number or rows + nrow = number_of_rows(s) + skiprows_ = min(skiprows_, nrow) + if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_) ) max_rows_ = nrow - skiprows_ + + ! determine number of columns + ncol = 0 + if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_) + + allocate(d(max_rows_, ncol)) + + do i = 1, skiprows_ + read(s, *) + end do + + do i = 1, max_rows_ + read(s, *) d(i, :) + end do + close(s) + + end subroutine loadtxt_iint8 + subroutine loadtxt_iint16(filename, d, skiprows, max_rows) + !! 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 + integer(int16), allocatable, intent(out) :: d(:,:) + !! Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. + integer, intent(in), optional :: skiprows + !! 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. + integer, intent(in), optional :: max_rows + !! + !! Example + !! ------- + !! + !!```fortran + !! integer(int16), 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, skiprows_, max_rows_ + + skiprows_ = max(optval(skiprows, 0), 0) + max_rows_ = optval(max_rows, -1) + + s = open(filename) + + ! determine number or rows + nrow = number_of_rows(s) + skiprows_ = min(skiprows_, nrow) + if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_) ) max_rows_ = nrow - skiprows_ + + ! determine number of columns + ncol = 0 + if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_) + + allocate(d(max_rows_, ncol)) + + do i = 1, skiprows_ + read(s, *) + end do + + do i = 1, max_rows_ + read(s, *) d(i, :) + end do + close(s) + + end subroutine loadtxt_iint16 + subroutine loadtxt_iint32(filename, d, skiprows, max_rows) + !! 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 + integer(int32), allocatable, intent(out) :: d(:,:) + !! Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. + integer, intent(in), optional :: skiprows + !! 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. + integer, intent(in), optional :: max_rows + !! + !! Example + !! ------- + !! + !!```fortran + !! integer(int32), 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, skiprows_, max_rows_ + + skiprows_ = max(optval(skiprows, 0), 0) + max_rows_ = optval(max_rows, -1) + + s = open(filename) + + ! determine number or rows + nrow = number_of_rows(s) + skiprows_ = min(skiprows_, nrow) + if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_) ) max_rows_ = nrow - skiprows_ + + ! determine number of columns + ncol = 0 + if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_) + + allocate(d(max_rows_, ncol)) + + do i = 1, skiprows_ + read(s, *) + end do + + do i = 1, max_rows_ + read(s, *) d(i, :) + end do + close(s) + + end subroutine loadtxt_iint32 + subroutine loadtxt_iint64(filename, d, skiprows, max_rows) + !! 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 + integer(int64), allocatable, intent(out) :: d(:,:) + !! Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. + integer, intent(in), optional :: skiprows + !! 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. + integer, intent(in), optional :: max_rows + !! + !! Example + !! ------- + !! + !!```fortran + !! integer(int64), 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, skiprows_, max_rows_ + + skiprows_ = max(optval(skiprows, 0), 0) + max_rows_ = optval(max_rows, -1) + + s = open(filename) + + ! determine number or rows + nrow = number_of_rows(s) + skiprows_ = min(skiprows_, nrow) + if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_) ) max_rows_ = nrow - skiprows_ + + ! determine number of columns + ncol = 0 + if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_) + + allocate(d(max_rows_, ncol)) + + do i = 1, skiprows_ + read(s, *) + end do + + do i = 1, max_rows_ + read(s, *) d(i, :) + end do + close(s) + + end subroutine loadtxt_iint64 + subroutine loadtxt_csp(filename, d, skiprows, max_rows) + !! 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 + complex(sp), allocatable, intent(out) :: d(:,:) + !! Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. + integer, intent(in), optional :: skiprows + !! 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. + integer, intent(in), optional :: max_rows + !! + !! Example + !! ------- + !! + !!```fortran + !! complex(sp), 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, skiprows_, max_rows_ + + skiprows_ = max(optval(skiprows, 0), 0) + max_rows_ = optval(max_rows, -1) + + s = open(filename) + + ! determine number or rows + nrow = number_of_rows(s) + skiprows_ = min(skiprows_, nrow) + if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_) ) max_rows_ = nrow - skiprows_ + + ! determine number of columns + ncol = 0 + if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_) + ncol = ncol / 2 + + allocate(d(max_rows_, ncol)) + + do i = 1, skiprows_ + read(s, *) + end do + + do i = 1, max_rows_ + read(s, "(*"//FMT_COMPLEX_sp(1:len(FMT_COMPLEX_sp)-1)//",1x))") d(i, :) + end do + close(s) + + end subroutine loadtxt_csp + subroutine loadtxt_cdp(filename, d, skiprows, max_rows) + !! 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 + complex(dp), allocatable, intent(out) :: d(:,:) + !! Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. + integer, intent(in), optional :: skiprows + !! 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. + integer, intent(in), optional :: max_rows + !! + !! Example + !! ------- + !! + !!```fortran + !! complex(dp), 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, skiprows_, max_rows_ + + skiprows_ = max(optval(skiprows, 0), 0) + max_rows_ = optval(max_rows, -1) + + s = open(filename) + + ! determine number or rows + nrow = number_of_rows(s) + skiprows_ = min(skiprows_, nrow) + if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_) ) max_rows_ = nrow - skiprows_ + + ! determine number of columns + ncol = 0 + if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_) + ncol = ncol / 2 + + allocate(d(max_rows_, ncol)) + + do i = 1, skiprows_ + read(s, *) + end do + + do i = 1, max_rows_ + read(s, "(*"//FMT_COMPLEX_dp(1:len(FMT_COMPLEX_dp)-1)//",1x))") d(i, :) + end do + close(s) + + end subroutine loadtxt_cdp + + + subroutine savetxt_rsp(filename, d) + !! version: experimental + !! + !! Saves a 2D array into a text file. + !! + !! Arguments + !! --------- + !! + character(len=*), intent(in) :: filename ! File to save the array to + real(sp), intent(in) :: d(:,:) ! The 2D array to save + !! + !! Example + !! ------- + !! + !!```fortran + !! real(sp) :: data(3, 2) + !! call savetxt("log.txt", data) + !!``` + !! + + integer :: s, i + s = open(filename, "w") + do i = 1, size(d, 1) + write(s, "(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))") d(i, :) + end do + close(s) + end subroutine savetxt_rsp + subroutine savetxt_rdp(filename, d) + !! version: experimental + !! + !! Saves a 2D array into a text file. + !! + !! Arguments + !! --------- + !! + character(len=*), intent(in) :: filename ! File to save the array to + real(dp), intent(in) :: d(:,:) ! The 2D array to save + !! + !! Example + !! ------- + !! + !!```fortran + !! real(dp) :: data(3, 2) + !! call savetxt("log.txt", data) + !!``` + !! + + integer :: s, i + s = open(filename, "w") + do i = 1, size(d, 1) + write(s, "(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))") d(i, :) + end do + close(s) + end subroutine savetxt_rdp + subroutine savetxt_iint8(filename, d) + !! version: experimental + !! + !! Saves a 2D array into a text file. + !! + !! Arguments + !! --------- + !! + character(len=*), intent(in) :: filename ! File to save the array to + integer(int8), intent(in) :: d(:,:) ! The 2D array to save + !! + !! Example + !! ------- + !! + !!```fortran + !! integer(int8) :: data(3, 2) + !! call savetxt("log.txt", data) + !!``` + !! + + integer :: s, i + s = open(filename, "w") + do i = 1, size(d, 1) + write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",1x))") d(i, :) + end do + close(s) + end subroutine savetxt_iint8 + subroutine savetxt_iint16(filename, d) + !! version: experimental + !! + !! Saves a 2D array into a text file. + !! + !! Arguments + !! --------- + !! + character(len=*), intent(in) :: filename ! File to save the array to + integer(int16), intent(in) :: d(:,:) ! The 2D array to save + !! + !! Example + !! ------- + !! + !!```fortran + !! integer(int16) :: data(3, 2) + !! call savetxt("log.txt", data) + !!``` + !! + + integer :: s, i + s = open(filename, "w") + do i = 1, size(d, 1) + write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",1x))") d(i, :) + end do + close(s) + end subroutine savetxt_iint16 + subroutine savetxt_iint32(filename, d) + !! version: experimental + !! + !! Saves a 2D array into a text file. + !! + !! Arguments + !! --------- + !! + character(len=*), intent(in) :: filename ! File to save the array to + integer(int32), intent(in) :: d(:,:) ! The 2D array to save + !! + !! Example + !! ------- + !! + !!```fortran + !! integer(int32) :: data(3, 2) + !! call savetxt("log.txt", data) + !!``` + !! + + integer :: s, i + s = open(filename, "w") + do i = 1, size(d, 1) + write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",1x))") d(i, :) + end do + close(s) + end subroutine savetxt_iint32 + subroutine savetxt_iint64(filename, d) + !! version: experimental + !! + !! Saves a 2D array into a text file. + !! + !! Arguments + !! --------- + !! + character(len=*), intent(in) :: filename ! File to save the array to + integer(int64), intent(in) :: d(:,:) ! The 2D array to save + !! + !! Example + !! ------- + !! + !!```fortran + !! integer(int64) :: data(3, 2) + !! call savetxt("log.txt", data) + !!``` + !! + + integer :: s, i + s = open(filename, "w") + do i = 1, size(d, 1) + write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",1x))") d(i, :) + end do + close(s) + end subroutine savetxt_iint64 + subroutine savetxt_csp(filename, d) + !! version: experimental + !! + !! Saves a 2D array into a text file. + !! + !! Arguments + !! --------- + !! + character(len=*), intent(in) :: filename ! File to save the array to + complex(sp), intent(in) :: d(:,:) ! The 2D array to save + !! + !! Example + !! ------- + !! + !!```fortran + !! complex(sp) :: data(3, 2) + !! call savetxt("log.txt", data) + !!``` + !! + + integer :: s, i + s = open(filename, "w") + do i = 1, size(d, 1) + write(s, "(*"//FMT_COMPLEX_sp(1:len(FMT_COMPLEX_sp)-1)//",1x))") d(i, :) + end do + close(s) + end subroutine savetxt_csp + subroutine savetxt_cdp(filename, d) + !! version: experimental + !! + !! Saves a 2D array into a text file. + !! + !! Arguments + !! --------- + !! + character(len=*), intent(in) :: filename ! File to save the array to + complex(dp), intent(in) :: d(:,:) ! The 2D array to save + !! + !! Example + !! ------- + !! + !!```fortran + !! complex(dp) :: data(3, 2) + !! call savetxt("log.txt", data) + !!``` + !! + + integer :: s, i + s = open(filename, "w") + do i = 1, size(d, 1) + write(s, "(*"//FMT_COMPLEX_dp(1:len(FMT_COMPLEX_dp)-1)//",1x))") d(i, :) + end do + close(s) + end subroutine savetxt_cdp + + + integer function number_of_columns(s, skiprows) + !! version: experimental + !! + !! determine number of columns + integer,intent(in) :: s + integer, intent(in), optional :: skiprows + + integer :: ios, skiprows_, i + character :: c + logical :: lastblank + + skiprows_ = optval(skiprows, 0) + + rewind(s) + + do i = 1, skiprows_ + read(s, *) + end do + + 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(s) result(nrows) + !! version: experimental + !! + !! Determine the number or rows in a file + integer, intent(in)::s + integer :: ios + + rewind(s) + nrows = 0 + do + read(s, *, iostat=ios) + if (ios /= 0) exit + nrows = nrows + 1 + end do + + rewind(s) + + end function number_of_rows + + + 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 + + !> Version: experimental + !> + !> Read a whole line from a formatted unit into a deferred length character variable + subroutine getline_char(unit, line, iostat, iomsg) + !> Formatted IO unit + integer, intent(in) :: unit + !> Line to read + character(len=:), allocatable, intent(out) :: line + !> Status of operation + integer, intent(out), optional :: iostat + !> Error message + character(len=:), allocatable, optional :: iomsg + + integer, parameter :: bufsize = 4096 + character(len=bufsize) :: buffer, msg + integer :: chunk, stat + logical :: opened + + if (unit /= -1) then + inquire(unit=unit, opened=opened) + else + opened = .false. + end if + + if (opened) then + open(unit=unit, pad="yes", iostat=stat, iomsg=msg) + else + stat = 1 + msg = "Unit is not connected" + end if + + line = "" + do while (stat == 0) + read(unit, '(a)', advance='no', iostat=stat, iomsg=msg, size=chunk) buffer + if (stat > 0) exit + line = line // buffer(:chunk) + end do + if (is_iostat_eor(stat)) stat = 0 + + if (stat /= 0 .and. present(iomsg)) iomsg = trim(msg) + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop(trim(msg)) + end if + end subroutine getline_char + + !> Version: experimental + !> + !> Read a whole line from a formatted unit into a string variable + subroutine getline_string(unit, line, iostat, iomsg) + !> Formatted IO unit + integer, intent(in) :: unit + !> Line to read + type(string_type), intent(out) :: line + !> Status of operation + integer, intent(out), optional :: iostat + !> Error message + character(len=:), allocatable, optional :: iomsg + + character(len=:), allocatable :: buffer + + call getline(unit, buffer, iostat, iomsg) + line = string_type(buffer) + end subroutine getline_string + + !> Version: experimental + !> + !> Read a whole line from the standard input into a deferred length character variable + subroutine getline_input_char(line, iostat, iomsg) + !> Line to read + character(len=:), allocatable, intent(out) :: line + !> Status of operation + integer, intent(out), optional :: iostat + !> Error message + character(len=:), allocatable, optional :: iomsg + + call getline(input_unit, line, iostat, iomsg) + end subroutine getline_input_char + + !> Version: experimental + !> + !> Read a whole line from the standard input into a string variable + subroutine getline_input_string(line, iostat, iomsg) + !> Line to read + type(string_type), intent(out) :: line + !> Status of operation + integer, intent(out), optional :: iostat + !> Error message + character(len=:), allocatable, optional :: iomsg + + call getline(input_unit, line, iostat, iomsg) + end subroutine getline_input_string + +end module stdlib_io diff --git a/src/stdlib_io_npy.f90 b/src/stdlib_io_npy.f90 new file mode 100644 index 0000000..b742c55 --- /dev/null +++ b/src/stdlib_io_npy.f90 @@ -0,0 +1,487 @@ +! SPDX-Identifer: MIT + + +!> Description of the npy format taken from +!> https://numpy.org/doc/stable/reference/generated/numpy.lib.format.html +!> +!>## Format Version 1.0 +!> +!> The first 6 bytes are a magic string: exactly \x93NUMPY. +!> +!> The next 1 byte is an unsigned byte: +!> the major version number of the file format, e.g. \x01. +!> +!> The next 1 byte is an unsigned byte: +!> the minor version number of the file format, e.g. \x00. +!> Note: the version of the file format is not tied to the version of the numpy package. +!> +!> The next 2 bytes form a little-endian unsigned short int: +!> the length of the header data HEADER_LEN. +!> +!> The next HEADER_LEN bytes form the header data describing the array’s format. +!> It is an ASCII string which contains a Python literal expression of a dictionary. +!> It is terminated by a newline (\n) and padded with spaces (\x20) to make the total +!> of len(magic string) + 2 + len(length) + HEADER_LEN be evenly divisible by 64 for +!> alignment purposes. +!> +!> The dictionary contains three keys: +!> +!> - “descr”: dtype.descr +!> An object that can be passed as an argument to the numpy.dtype constructor +!> to create the array’s dtype. +!> +!> - “fortran_order”: bool +!> Whether the array data is Fortran-contiguous or not. Since Fortran-contiguous +!> arrays are a common form of non-C-contiguity, we allow them to be written directly +!> to disk for efficiency. +!> +!> - “shape”: tuple of int +!> The shape of the array. +!> +!> For repeatability and readability, the dictionary keys are sorted in alphabetic order. +!> This is for convenience only. A writer SHOULD implement this if possible. A reader MUST +!> NOT depend on this. +!> +!> Following the header comes the array data. If the dtype contains Python objects +!> (i.e. dtype.hasobject is True), then the data is a Python pickle of the array. +!> Otherwise the data is the contiguous (either C- or Fortran-, depending on fortran_order) +!> bytes of the array. Consumers can figure out the number of bytes by multiplying the +!> number of elements given by the shape (noting that shape=() means there is 1 element) +!> by dtype.itemsize. +!> +!>## Format Version 2.0 +!> +!> The version 1.0 format only allowed the array header to have a total size of 65535 bytes. +!> This can be exceeded by structured arrays with a large number of columns. +!> The version 2.0 format extends the header size to 4 GiB. numpy.save will automatically +!> save in 2.0 format if the data requires it, else it will always use the more compatible +!> 1.0 format. +!> +!> The description of the fourth element of the header therefore has become: +!> “The next 4 bytes form a little-endian unsigned int: the length of the header data +!> HEADER_LEN.” +!> +!>## Format Version 3.0 +!> +!> This version replaces the ASCII string (which in practice was latin1) with a +!> utf8-encoded string, so supports structured types with any unicode field names. +module stdlib_io_npy + use stdlib_kinds, only : int8, int16, int32, int64, sp, dp, xdp, qp + implicit none + private + + public :: save_npy, load_npy + + + !> Version: experimental + !> + !> Save multidimensional array in npy format + !> ([Specification](../page/specs/stdlib_io.html#save_npy)) + interface save_npy + module subroutine save_npy_rsp_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(sp), intent(in) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_rsp_1 + module subroutine save_npy_rsp_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(sp), intent(in) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_rsp_2 + module subroutine save_npy_rsp_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(sp), intent(in) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_rsp_3 + module subroutine save_npy_rsp_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(sp), intent(in) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_rsp_4 + module subroutine save_npy_rdp_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(dp), intent(in) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_rdp_1 + module subroutine save_npy_rdp_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(dp), intent(in) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_rdp_2 + module subroutine save_npy_rdp_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(dp), intent(in) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_rdp_3 + module subroutine save_npy_rdp_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(dp), intent(in) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_rdp_4 + module subroutine save_npy_iint8_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int8), intent(in) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint8_1 + module subroutine save_npy_iint8_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int8), intent(in) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint8_2 + module subroutine save_npy_iint8_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int8), intent(in) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint8_3 + module subroutine save_npy_iint8_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int8), intent(in) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint8_4 + module subroutine save_npy_iint16_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int16), intent(in) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint16_1 + module subroutine save_npy_iint16_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int16), intent(in) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint16_2 + module subroutine save_npy_iint16_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int16), intent(in) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint16_3 + module subroutine save_npy_iint16_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int16), intent(in) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint16_4 + module subroutine save_npy_iint32_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int32), intent(in) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint32_1 + module subroutine save_npy_iint32_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int32), intent(in) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint32_2 + module subroutine save_npy_iint32_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int32), intent(in) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint32_3 + module subroutine save_npy_iint32_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int32), intent(in) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint32_4 + module subroutine save_npy_iint64_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int64), intent(in) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint64_1 + module subroutine save_npy_iint64_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int64), intent(in) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint64_2 + module subroutine save_npy_iint64_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int64), intent(in) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint64_3 + module subroutine save_npy_iint64_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int64), intent(in) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_iint64_4 + module subroutine save_npy_csp_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(sp), intent(in) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_csp_1 + module subroutine save_npy_csp_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(sp), intent(in) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_csp_2 + module subroutine save_npy_csp_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(sp), intent(in) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_csp_3 + module subroutine save_npy_csp_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(sp), intent(in) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_csp_4 + module subroutine save_npy_cdp_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(dp), intent(in) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_cdp_1 + module subroutine save_npy_cdp_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(dp), intent(in) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_cdp_2 + module subroutine save_npy_cdp_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(dp), intent(in) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_cdp_3 + module subroutine save_npy_cdp_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(dp), intent(in) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine save_npy_cdp_4 + end interface save_npy + + !> Version: experimental + !> + !> Load multidimensional array in npy format + !> ([Specification](../page/specs/stdlib_io.html#load_npy)) + interface load_npy + module subroutine load_npy_rsp_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(sp), allocatable, intent(out) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_rsp_1 + module subroutine load_npy_rsp_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(sp), allocatable, intent(out) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_rsp_2 + module subroutine load_npy_rsp_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(sp), allocatable, intent(out) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_rsp_3 + module subroutine load_npy_rsp_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(sp), allocatable, intent(out) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_rsp_4 + module subroutine load_npy_rdp_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(dp), allocatable, intent(out) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_rdp_1 + module subroutine load_npy_rdp_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(dp), allocatable, intent(out) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_rdp_2 + module subroutine load_npy_rdp_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(dp), allocatable, intent(out) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_rdp_3 + module subroutine load_npy_rdp_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + real(dp), allocatable, intent(out) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_rdp_4 + module subroutine load_npy_iint8_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int8), allocatable, intent(out) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint8_1 + module subroutine load_npy_iint8_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int8), allocatable, intent(out) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint8_2 + module subroutine load_npy_iint8_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int8), allocatable, intent(out) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint8_3 + module subroutine load_npy_iint8_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int8), allocatable, intent(out) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint8_4 + module subroutine load_npy_iint16_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int16), allocatable, intent(out) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint16_1 + module subroutine load_npy_iint16_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int16), allocatable, intent(out) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint16_2 + module subroutine load_npy_iint16_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int16), allocatable, intent(out) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint16_3 + module subroutine load_npy_iint16_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int16), allocatable, intent(out) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint16_4 + module subroutine load_npy_iint32_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int32), allocatable, intent(out) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint32_1 + module subroutine load_npy_iint32_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int32), allocatable, intent(out) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint32_2 + module subroutine load_npy_iint32_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int32), allocatable, intent(out) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint32_3 + module subroutine load_npy_iint32_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int32), allocatable, intent(out) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint32_4 + module subroutine load_npy_iint64_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int64), allocatable, intent(out) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint64_1 + module subroutine load_npy_iint64_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int64), allocatable, intent(out) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint64_2 + module subroutine load_npy_iint64_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int64), allocatable, intent(out) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint64_3 + module subroutine load_npy_iint64_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + integer(int64), allocatable, intent(out) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_iint64_4 + module subroutine load_npy_csp_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(sp), allocatable, intent(out) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_csp_1 + module subroutine load_npy_csp_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(sp), allocatable, intent(out) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_csp_2 + module subroutine load_npy_csp_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(sp), allocatable, intent(out) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_csp_3 + module subroutine load_npy_csp_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(sp), allocatable, intent(out) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_csp_4 + module subroutine load_npy_cdp_1(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(dp), allocatable, intent(out) :: array(:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_cdp_1 + module subroutine load_npy_cdp_2(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(dp), allocatable, intent(out) :: array(:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_cdp_2 + module subroutine load_npy_cdp_3(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(dp), allocatable, intent(out) :: array(:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_cdp_3 + module subroutine load_npy_cdp_4(filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + complex(dp), allocatable, intent(out) :: array(:,:,:,:) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine load_npy_cdp_4 + end interface load_npy + + + character(len=*), parameter :: nl = achar(10) + + character(len=*), parameter :: & + type_iint8 = " Implementation of loading npy files into multidimensional arrays +submodule (stdlib_io_npy) stdlib_io_npy_load + use stdlib_error, only : error_stop + use stdlib_strings, only : to_string, starts_with + implicit none + +contains + + !> Load a 1-dimensional array from a npy file + module subroutine load_npy_rsp_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(sp), allocatable, intent(out) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rsp + integer, parameter :: rank = 1 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + real(sp), allocatable, intent(out) :: array(:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_rsp_1 + !> Load a 2-dimensional array from a npy file + module subroutine load_npy_rsp_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(sp), allocatable, intent(out) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rsp + integer, parameter :: rank = 2 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + real(sp), allocatable, intent(out) :: array(:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_rsp_2 + !> Load a 3-dimensional array from a npy file + module subroutine load_npy_rsp_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(sp), allocatable, intent(out) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rsp + integer, parameter :: rank = 3 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + real(sp), allocatable, intent(out) :: array(:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_rsp_3 + !> Load a 4-dimensional array from a npy file + module subroutine load_npy_rsp_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(sp), allocatable, intent(out) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rsp + integer, parameter :: rank = 4 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + real(sp), allocatable, intent(out) :: array(:,:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3), & + & vshape(4)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_rsp_4 + !> Load a 1-dimensional array from a npy file + module subroutine load_npy_rdp_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(dp), allocatable, intent(out) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rdp + integer, parameter :: rank = 1 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + real(dp), allocatable, intent(out) :: array(:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_rdp_1 + !> Load a 2-dimensional array from a npy file + module subroutine load_npy_rdp_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(dp), allocatable, intent(out) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rdp + integer, parameter :: rank = 2 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + real(dp), allocatable, intent(out) :: array(:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_rdp_2 + !> Load a 3-dimensional array from a npy file + module subroutine load_npy_rdp_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(dp), allocatable, intent(out) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rdp + integer, parameter :: rank = 3 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + real(dp), allocatable, intent(out) :: array(:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_rdp_3 + !> Load a 4-dimensional array from a npy file + module subroutine load_npy_rdp_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(dp), allocatable, intent(out) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rdp + integer, parameter :: rank = 4 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + real(dp), allocatable, intent(out) :: array(:,:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3), & + & vshape(4)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_rdp_4 + !> Load a 1-dimensional array from a npy file + module subroutine load_npy_iint8_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int8), allocatable, intent(out) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint8 + integer, parameter :: rank = 1 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int8), allocatable, intent(out) :: array(:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint8_1 + !> Load a 2-dimensional array from a npy file + module subroutine load_npy_iint8_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int8), allocatable, intent(out) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint8 + integer, parameter :: rank = 2 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int8), allocatable, intent(out) :: array(:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint8_2 + !> Load a 3-dimensional array from a npy file + module subroutine load_npy_iint8_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int8), allocatable, intent(out) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint8 + integer, parameter :: rank = 3 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int8), allocatable, intent(out) :: array(:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint8_3 + !> Load a 4-dimensional array from a npy file + module subroutine load_npy_iint8_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int8), allocatable, intent(out) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint8 + integer, parameter :: rank = 4 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int8), allocatable, intent(out) :: array(:,:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3), & + & vshape(4)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint8_4 + !> Load a 1-dimensional array from a npy file + module subroutine load_npy_iint16_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int16), allocatable, intent(out) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint16 + integer, parameter :: rank = 1 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int16), allocatable, intent(out) :: array(:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint16_1 + !> Load a 2-dimensional array from a npy file + module subroutine load_npy_iint16_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int16), allocatable, intent(out) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint16 + integer, parameter :: rank = 2 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int16), allocatable, intent(out) :: array(:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint16_2 + !> Load a 3-dimensional array from a npy file + module subroutine load_npy_iint16_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int16), allocatable, intent(out) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint16 + integer, parameter :: rank = 3 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int16), allocatable, intent(out) :: array(:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint16_3 + !> Load a 4-dimensional array from a npy file + module subroutine load_npy_iint16_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int16), allocatable, intent(out) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint16 + integer, parameter :: rank = 4 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int16), allocatable, intent(out) :: array(:,:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3), & + & vshape(4)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint16_4 + !> Load a 1-dimensional array from a npy file + module subroutine load_npy_iint32_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int32), allocatable, intent(out) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint32 + integer, parameter :: rank = 1 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int32), allocatable, intent(out) :: array(:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint32_1 + !> Load a 2-dimensional array from a npy file + module subroutine load_npy_iint32_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int32), allocatable, intent(out) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint32 + integer, parameter :: rank = 2 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int32), allocatable, intent(out) :: array(:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint32_2 + !> Load a 3-dimensional array from a npy file + module subroutine load_npy_iint32_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int32), allocatable, intent(out) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint32 + integer, parameter :: rank = 3 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int32), allocatable, intent(out) :: array(:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint32_3 + !> Load a 4-dimensional array from a npy file + module subroutine load_npy_iint32_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int32), allocatable, intent(out) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint32 + integer, parameter :: rank = 4 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int32), allocatable, intent(out) :: array(:,:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3), & + & vshape(4)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint32_4 + !> Load a 1-dimensional array from a npy file + module subroutine load_npy_iint64_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int64), allocatable, intent(out) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint64 + integer, parameter :: rank = 1 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int64), allocatable, intent(out) :: array(:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint64_1 + !> Load a 2-dimensional array from a npy file + module subroutine load_npy_iint64_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int64), allocatable, intent(out) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint64 + integer, parameter :: rank = 2 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int64), allocatable, intent(out) :: array(:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint64_2 + !> Load a 3-dimensional array from a npy file + module subroutine load_npy_iint64_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int64), allocatable, intent(out) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint64 + integer, parameter :: rank = 3 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int64), allocatable, intent(out) :: array(:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint64_3 + !> Load a 4-dimensional array from a npy file + module subroutine load_npy_iint64_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int64), allocatable, intent(out) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint64 + integer, parameter :: rank = 4 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + integer(int64), allocatable, intent(out) :: array(:,:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3), & + & vshape(4)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_iint64_4 + !> Load a 1-dimensional array from a npy file + module subroutine load_npy_csp_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(sp), allocatable, intent(out) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_csp + integer, parameter :: rank = 1 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + complex(sp), allocatable, intent(out) :: array(:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_csp_1 + !> Load a 2-dimensional array from a npy file + module subroutine load_npy_csp_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(sp), allocatable, intent(out) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_csp + integer, parameter :: rank = 2 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + complex(sp), allocatable, intent(out) :: array(:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_csp_2 + !> Load a 3-dimensional array from a npy file + module subroutine load_npy_csp_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(sp), allocatable, intent(out) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_csp + integer, parameter :: rank = 3 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + complex(sp), allocatable, intent(out) :: array(:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_csp_3 + !> Load a 4-dimensional array from a npy file + module subroutine load_npy_csp_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(sp), allocatable, intent(out) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_csp + integer, parameter :: rank = 4 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + complex(sp), allocatable, intent(out) :: array(:,:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3), & + & vshape(4)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_csp_4 + !> Load a 1-dimensional array from a npy file + module subroutine load_npy_cdp_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(dp), allocatable, intent(out) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_cdp + integer, parameter :: rank = 1 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + complex(dp), allocatable, intent(out) :: array(:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_cdp_1 + !> Load a 2-dimensional array from a npy file + module subroutine load_npy_cdp_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(dp), allocatable, intent(out) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_cdp + integer, parameter :: rank = 2 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + complex(dp), allocatable, intent(out) :: array(:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_cdp_2 + !> Load a 3-dimensional array from a npy file + module subroutine load_npy_cdp_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(dp), allocatable, intent(out) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_cdp + integer, parameter :: rank = 3 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + complex(dp), allocatable, intent(out) :: array(:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_cdp_3 + !> Load a 4-dimensional array from a npy file + module subroutine load_npy_cdp_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(dp), allocatable, intent(out) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_cdp + integer, parameter :: rank = 4 + + integer :: io, stat + character(len=:), allocatable :: msg + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + catch: block + character(len=:), allocatable :: this_type + integer, allocatable :: vshape(:) + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) exit catch + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + + call allocator(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//vtype//"' "//& + & "with total size of "//to_string(product(vshape)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read array from file '"//filename//"'"//nl//& + & msg) + else + call error_stop("Failed to read array from file '"//filename//"'") + end if + end if + + if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) + contains + + !> Wrapped intrinsic allocate to create an allocation from a shape array + subroutine allocator(array, vshape, stat) + !> Instance of the array to be allocated + complex(dp), allocatable, intent(out) :: array(:,:,:,:) + !> Dimensions to allocate for + integer, intent(in) :: vshape(:) + !> Status of allocate + integer, intent(out) :: stat + + allocate(array( & + & vshape(1), & + & vshape(2), & + & vshape(3), & + & vshape(4)), & + & stat=stat) + + end subroutine allocator + + end subroutine load_npy_cdp_4 + + + !> Read the npy header from a binary file and retrieve the descriptor string. + subroutine get_descriptor(io, filename, vtype, vshape, stat, msg) + !> Unformatted, stream accessed unit + integer, intent(in) :: io + !> Filename for error reporting + character(len=*), intent(in) :: filename + !> Type of data saved in npy file + character(len=:), allocatable, intent(out) :: vtype + !> Shape descriptor of the + integer, allocatable, intent(out) :: vshape(:) + !> Status of operation + integer, intent(out) :: stat + !> Associated error message in case of non-zero status + character(len=:), allocatable, intent(out) :: msg + + integer :: major, header_len, i + character(len=:), allocatable :: dict + character(len=8) :: header + character :: buf(4) + logical :: fortran_order + + read(io, iostat=stat) header + if (stat /= 0) return + + call parse_header(header, major, stat, msg) + if (stat /= 0) return + + read(io, iostat=stat) buf(1:merge(4, 2, major > 1)) + if (stat /= 0) return + + if (major > 1) then + header_len = ichar(buf(1)) & + & + ichar(buf(2)) * 256**1 & + & + ichar(buf(3)) * 256**2 & + & + ichar(buf(4)) * 256**3 + else + header_len = ichar(buf(1)) & + & + ichar(buf(2)) * 256**1 + end if + allocate(character(header_len) :: dict, stat=stat) + if (stat /= 0) return + + read(io, iostat=stat) dict + if (stat /= 0) return + + if (dict(header_len:header_len) /= nl) then + stat = 1 + msg = "Descriptor length does not match" + return + end if + + if (scan(dict, achar(0)) > 0) then + stat = 1 + msg = "Nul byte not allowed in descriptor string" + return + end if + + call parse_descriptor(trim(dict(:len(dict)-1)), filename, & + & vtype, fortran_order, vshape, stat, msg) + if (stat /= 0) return + + if (.not.fortran_order) then + vshape = [(vshape(i), i = size(vshape), 1, -1)] + end if + end subroutine get_descriptor + + + !> Parse the first eight bytes of the npy header to verify the data + subroutine parse_header(header, major, stat, msg) + !> Header of the binary file + character(len=*), intent(in) :: header + !> Major version of the npy format + integer, intent(out) :: major + !> Status of operation + integer, intent(out) :: stat + !> Associated error message in case of non-zero status + character(len=:), allocatable, intent(out) :: msg + + integer :: minor + + if (header(1:1) /= magic_number) then + stat = 1 + msg = "Expected z'93' but got z'"//to_string(ichar(header(1:1)))//"' "//& + & "as first byte" + return + end if + + if (header(2:6) /= magic_string) then + stat = 1 + msg = "Expected identifier '"//magic_string//"'" + return + end if + + major = ichar(header(7:7)) + if (.not.any(major == [1, 2, 3])) then + stat = 1 + msg = "Unsupported format major version number '"//to_string(major)//"'" + return + end if + + minor = ichar(header(8:8)) + if (minor /= 0) then + stat = 1 + msg = "Unsupported format version "// & + & "'"//to_string(major)//"."//to_string(minor)//"'" + return + end if + end subroutine parse_header + + !> Parse the descriptor in the npy header. This routine implements a minimal + !> non-recursive parser for serialized Python dictionaries. + subroutine parse_descriptor(input, filename, vtype, fortran_order, vshape, stat, msg) + !> Input string to parse as descriptor + character(len=*), intent(in) :: input + !> Filename for error reporting + character(len=*), intent(in) :: filename + !> Type of the data stored, retrieved from field `descr` + character(len=:), allocatable, intent(out) :: vtype + !> Whether the data is in left layout, retrieved from field `fortran_order` + logical, intent(out) :: fortran_order + !> Shape of the stored data, retrieved from field `shape` + integer, allocatable, intent(out) :: vshape(:) + !> Status of operation + integer, intent(out) :: stat + !> Associated error message in case of non-zero status + character(len=:), allocatable, intent(out) :: msg + + enum, bind(c) + enumerator :: invalid, string, lbrace, rbrace, comma, colon, & + lparen, rparen, bool, literal, space + end enum + + type :: token_type + integer :: first, last, kind + end type token_type + + integer :: pos + character(len=:), allocatable :: key + type(token_type) :: token, last + logical :: has_descr, has_shape, has_fortran_order + + has_descr = .false. + has_shape = .false. + has_fortran_order = .false. + pos = 0 + call next_token(input, pos, token, [lbrace], stat, msg) + if (stat /= 0) return + + last = token_type(pos, pos, comma) + do while (pos < len(input)) + call get_token(input, pos, token) + select case(token%kind) + case(space) + continue + case(comma) + if (token%kind == last%kind) then + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Comma cannot appear at this point") + return + end if + last = token + case(rbrace) + exit + case(string) + if (token%kind == last%kind) then + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "String cannot appear at this point") + return + end if + last = token + + key = input(token%first+1:token%last-1) + call next_token(input, pos, token, [colon], stat, msg) + if (stat /= 0) return + + if (key == "descr" .and. has_descr & + & .or. key == "fortran_order" .and. has_fortran_order & + & .or. key == "shape" .and. has_shape) then + stat = 1 + msg = make_message(filename, input, last%first, last%last, & + & "Duplicate entry for '"//key//"' found") + return + end if + + select case(key) + case("descr") + call next_token(input, pos, token, [string], stat, msg) + if (stat /= 0) return + + vtype = input(token%first+1:token%last-1) + has_descr = .true. + + case("fortran_order") + call next_token(input, pos, token, [bool], stat, msg) + if (stat /= 0) return + + fortran_order = input(token%first:token%last) == "True" + has_fortran_order = .true. + + case("shape") + call parse_tuple(input, pos, vshape, stat, msg) + + has_shape = .true. + + case default + stat = 1 + msg = make_message(filename, input, last%first, last%last, & + & "Invalid entry '"//key//"' in dictionary encountered") + return + end select + case default + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Invalid token encountered") + return + end select + end do + + if (.not.has_descr) then + stat = 1 + msg = make_message(filename, input, 1, pos, & + & "Dictionary does not contain required entry 'descr'") + end if + + if (.not.has_shape) then + stat = 1 + msg = make_message(filename, input, 1, pos, & + & "Dictionary does not contain required entry 'shape'") + end if + + if (.not.has_fortran_order) then + stat = 1 + msg = make_message(filename, input, 1, pos, & + & "Dictionary does not contain required entry 'fortran_order'") + end if + + contains + + function make_message(filename, input, first, last, message) result(str) + !> Filename for context + character(len=*), intent(in) :: filename + !> Input string to parse + character(len=*), intent(in) :: input + !> Offset in the input + integer, intent(in) :: first, last + !> Error message + character(len=*), intent(in) :: message + !> Final output message + character(len=:), allocatable :: str + + character(len=*), parameter :: nl = new_line('a') + + str = message // nl // & + & " --> " // filename // ":1:" // to_string(first) // "-" // to_string(last) // nl // & + & " |" // nl // & + & "1 | " // input // nl // & + & " |" // repeat(" ", first) // repeat("^", last - first + 1) // nl // & + & " |" + end function make_message + + !> Parse a tuple of integers into an array of integers + subroutine parse_tuple(input, pos, tuple, stat, msg) + !> Input string to parse + character(len=*), intent(in) :: input + !> Offset in the input, will be advanced after reading + integer, intent(inout) :: pos + !> Array representing tuple of integers + integer, allocatable, intent(out) :: tuple(:) + !> Status of operation + integer, intent(out) :: stat + !> Associated error message in case of non-zero status + character(len=:), allocatable, intent(out) :: msg + + type(token_type) :: token + integer :: last, itmp + + allocate(tuple(0), stat=stat) + if (stat /= 0) return + + call next_token(input, pos, token, [lparen], stat, msg) + if (stat /= 0) return + + last = comma + do while (pos < len(input)) + call get_token(input, pos, token) + select case(token%kind) + case(space) + continue + case(literal) + if (token%kind == last) then + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Invalid token encountered") + return + end if + last = token%kind + read(input(token%first:token%last), *, iostat=stat) itmp + if (stat /= 0) then + return + end if + tuple = [tuple, itmp] + case(comma) + if (token%kind == last) then + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Invalid token encountered") + return + end if + last = token%kind + case(rparen) + exit + case default + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Invalid token encountered") + return + end select + end do + end subroutine parse_tuple + + !> Get the next allowed token + subroutine next_token(input, pos, token, allowed_token, stat, msg) + !> Input string to parse + character(len=*), intent(in) :: input + !> Current offset in the input string + integer, intent(inout) :: pos + !> Last token parsed + type(token_type), intent(out) :: token + !> Tokens allowed in the current context + integer, intent(in) :: allowed_token(:) + !> Status of operation + integer, intent(out) :: stat + !> Associated error message in case of non-zero status + character(len=:), allocatable, intent(out) :: msg + + stat = pos + do while (pos < len(input)) + call get_token(input, pos, token) + if (token%kind == space) then + continue + else if (any(token%kind == allowed_token)) then + stat = 0 + exit + else + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Invalid token encountered") + exit + end if + end do + end subroutine next_token + + !> Tokenize input string + subroutine get_token(input, pos, token) + !> Input strin to tokenize + character(len=*), intent(in) :: input + !> Offset in input string, will be advanced + integer, intent(inout) :: pos + !> Returned token from the next position + type(token_type), intent(out) :: token + + character :: quote + + pos = pos + 1 + select case(input(pos:pos)) + case("""", "'") + quote = input(pos:pos) + token%first = pos + pos = pos + 1 + do while (pos <= len(input)) + if (input(pos:pos) == quote) then + token%last = pos + exit + else + pos = pos + 1 + end if + end do + token%kind = string + case("0", "1", "2", "3", "4", "5", "6", "7", "8", "9") + token%first = pos + do while (pos <= len(input)) + if (.not.any(input(pos:pos) == ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"])) then + pos = pos - 1 + token%last = pos + exit + else + pos = pos + 1 + end if + end do + token%kind = literal + case("T") + if (starts_with(input(pos:), "True")) then + token = token_type(pos, pos+3, bool) + pos = pos + 3 + else + token = token_type(pos, pos, invalid) + end if + case("F") + if (starts_with(input(pos:), "False")) then + token = token_type(pos, pos+4, bool) + pos = pos + 4 + else + token = token_type(pos, pos, invalid) + end if + case("{") + token = token_type(pos, pos, lbrace) + case("}") + token = token_type(pos, pos, rbrace) + case(",") + token = token_type(pos, pos, comma) + case(":") + token = token_type(pos, pos, colon) + case("(") + token = token_type(pos, pos, lparen) + case(")") + token = token_type(pos, pos, rparen) + case(" ", nl) + token = token_type(pos, pos, space) + case default + token = token_type(pos, pos, invalid) + end select + + end subroutine get_token + + end subroutine parse_descriptor + +end submodule stdlib_io_npy_load diff --git a/src/stdlib_io_npy_save.f90 b/src/stdlib_io_npy_save.f90 new file mode 100644 index 0000000..0315861 --- /dev/null +++ b/src/stdlib_io_npy_save.f90 @@ -0,0 +1,1217 @@ +! SPDX-Identifer: MIT + + +!> Implementation of saving multidimensional arrays to npy files +submodule (stdlib_io_npy) stdlib_io_npy_save + use stdlib_error, only : error_stop + use stdlib_strings, only : to_string + implicit none + +contains + + + !> Generate magic header string for npy format + pure function magic_header(major, minor) result(str) + !> Major version of npy format + integer, intent(in) :: major + !> Minor version of npy format + integer, intent(in) :: minor + !> Magic string for npy format + character(len=8) :: str + + str = magic_number // magic_string // achar(major) // achar(minor) + end function magic_header + + + !> Generate header for npy format + pure function npy_header(vtype, vshape) result(str) + !> Type of variable + character(len=*), intent(in) :: vtype + !> Shape of variable + integer, intent(in) :: vshape(:) + !> Header string for npy format + character(len=:), allocatable :: str + + integer, parameter :: len_v10 = 8 + 2, len_v20 = 8 + 4, block_size = 64 + + str = & + "{'descr': '"//vtype//& + "', 'fortran_order': True, 'shape': "//& + shape_str(vshape)//", }" + + if (len(str) + len_v10 >= 65535) then + str = str // & + & repeat(" ", block_size - mod(len(str) + len_v20 + 1, block_size)) // nl + str = magic_header(2, 0) // to_bytes_i4(int(len(str))) // str + else + str = str // & + & repeat(" ", block_size - mod(len(str) + len_v10 + 1, block_size)) // nl + str = magic_header(1, 0) // to_bytes_i2(int(len(str))) // str + end if + end function npy_header + + !> Write integer as byte string in little endian encoding + pure function to_bytes_i4(val) result(str) + !> Integer value to convert to bytes + integer, intent(in) :: val + !> String of bytes + character(len=4) :: str + + str = achar(mod(val, 256**1)) // & + & achar(mod(val, 256**2) / 256**1) // & + & achar(mod(val, 256**3) / 256**2) // & + & achar(val / 256**3) + end function to_bytes_i4 + + + !> Write integer as byte string in little endian encoding, 2-byte truncated version + pure function to_bytes_i2(val) result(str) + !> Integer value to convert to bytes + integer, intent(in) :: val + !> String of bytes + character(len=2) :: str + + str = achar(mod(val, 2**8)) // & + & achar(mod(val, 2**16) / 2**8) + end function to_bytes_i2 + + + !> Print array shape as tuple of int + pure function shape_str(vshape) result(str) + !> Shape of variable + integer, intent(in) :: vshape(:) + !> Shape string for npy format + character(len=:), allocatable :: str + + integer :: i + + str = "(" + do i = 1, size(vshape) + str = str//to_string(vshape(i))//", " + enddo + str = str//")" + end function shape_str + + + !> Save 1-dimensional array in npy format + module subroutine save_npy_rsp_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(sp), intent(in) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rsp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_rsp_1 + !> Save 2-dimensional array in npy format + module subroutine save_npy_rsp_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(sp), intent(in) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rsp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_rsp_2 + !> Save 3-dimensional array in npy format + module subroutine save_npy_rsp_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(sp), intent(in) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rsp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_rsp_3 + !> Save 4-dimensional array in npy format + module subroutine save_npy_rsp_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(sp), intent(in) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rsp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_rsp_4 + !> Save 1-dimensional array in npy format + module subroutine save_npy_rdp_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(dp), intent(in) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rdp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_rdp_1 + !> Save 2-dimensional array in npy format + module subroutine save_npy_rdp_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(dp), intent(in) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rdp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_rdp_2 + !> Save 3-dimensional array in npy format + module subroutine save_npy_rdp_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(dp), intent(in) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rdp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_rdp_3 + !> Save 4-dimensional array in npy format + module subroutine save_npy_rdp_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + real(dp), intent(in) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_rdp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_rdp_4 + !> Save 1-dimensional array in npy format + module subroutine save_npy_iint8_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int8), intent(in) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint8 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint8_1 + !> Save 2-dimensional array in npy format + module subroutine save_npy_iint8_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int8), intent(in) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint8 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint8_2 + !> Save 3-dimensional array in npy format + module subroutine save_npy_iint8_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int8), intent(in) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint8 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint8_3 + !> Save 4-dimensional array in npy format + module subroutine save_npy_iint8_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int8), intent(in) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint8 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint8_4 + !> Save 1-dimensional array in npy format + module subroutine save_npy_iint16_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int16), intent(in) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint16 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint16_1 + !> Save 2-dimensional array in npy format + module subroutine save_npy_iint16_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int16), intent(in) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint16 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint16_2 + !> Save 3-dimensional array in npy format + module subroutine save_npy_iint16_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int16), intent(in) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint16 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint16_3 + !> Save 4-dimensional array in npy format + module subroutine save_npy_iint16_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int16), intent(in) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint16 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint16_4 + !> Save 1-dimensional array in npy format + module subroutine save_npy_iint32_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int32), intent(in) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint32 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint32_1 + !> Save 2-dimensional array in npy format + module subroutine save_npy_iint32_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int32), intent(in) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint32 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint32_2 + !> Save 3-dimensional array in npy format + module subroutine save_npy_iint32_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int32), intent(in) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint32 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint32_3 + !> Save 4-dimensional array in npy format + module subroutine save_npy_iint32_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int32), intent(in) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint32 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint32_4 + !> Save 1-dimensional array in npy format + module subroutine save_npy_iint64_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int64), intent(in) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint64 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint64_1 + !> Save 2-dimensional array in npy format + module subroutine save_npy_iint64_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int64), intent(in) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint64 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint64_2 + !> Save 3-dimensional array in npy format + module subroutine save_npy_iint64_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int64), intent(in) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint64 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint64_3 + !> Save 4-dimensional array in npy format + module subroutine save_npy_iint64_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + integer(int64), intent(in) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_iint64 + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_iint64_4 + !> Save 1-dimensional array in npy format + module subroutine save_npy_csp_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(sp), intent(in) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_csp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_csp_1 + !> Save 2-dimensional array in npy format + module subroutine save_npy_csp_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(sp), intent(in) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_csp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_csp_2 + !> Save 3-dimensional array in npy format + module subroutine save_npy_csp_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(sp), intent(in) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_csp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_csp_3 + !> Save 4-dimensional array in npy format + module subroutine save_npy_csp_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(sp), intent(in) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_csp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_csp_4 + !> Save 1-dimensional array in npy format + module subroutine save_npy_cdp_1(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(dp), intent(in) :: array(:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_cdp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_cdp_1 + !> Save 2-dimensional array in npy format + module subroutine save_npy_cdp_2(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(dp), intent(in) :: array(:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_cdp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_cdp_2 + !> Save 3-dimensional array in npy format + module subroutine save_npy_cdp_3(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(dp), intent(in) :: array(:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_cdp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_cdp_3 + !> Save 4-dimensional array in npy format + module subroutine save_npy_cdp_4(filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + complex(dp), intent(in) :: array(:,:,:,:) + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_cdp + integer :: io, stat + + open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write(io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write(io, iostat=stat) array + end if + close(io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end subroutine save_npy_cdp_4 + +end submodule stdlib_io_npy_save