From 9301ba1b21660f3845c32072c1ac8aaeea4026a4 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Sat, 11 Oct 2025 15:54:09 +0200 Subject: [PATCH 01/50] draft implementation --- src/CMakeLists.txt | 3 + src/stdlib_io_mm.fypp | 111 +++++++++++++++ src/stdlib_io_mm_load.fypp | 275 +++++++++++++++++++++++++++++++++++++ src/stdlib_io_mm_save.fypp | 230 +++++++++++++++++++++++++++++++ 4 files changed, 619 insertions(+) create mode 100644 src/stdlib_io_mm.fypp create mode 100644 src/stdlib_io_mm_load.fypp create mode 100644 src/stdlib_io_mm_save.fypp diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9280d3397..8cf641de7 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -21,6 +21,9 @@ set(fppFiles stdlib_intrinsics_sum.fypp stdlib_intrinsics.fypp stdlib_io.fypp + stdlib_io_mm.fypp + stdlib_io_mm_load.fypp + stdlib_io_mm_save.fypp stdlib_io_npy.fypp stdlib_io_npy_load.fypp stdlib_io_npy_save.fypp diff --git a/src/stdlib_io_mm.fypp b/src/stdlib_io_mm.fypp new file mode 100644 index 000000000..a3e5d6000 --- /dev/null +++ b/src/stdlib_io_mm.fypp @@ -0,0 +1,111 @@ +! SPDX-Identifier: MIT + +#:include "common.fypp" +#:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) +#:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX)) +#:set RC_KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + +!> The Matrix Market (MM) format is a simple, human-readable, ASCII format for sparse +!> and dense matrices. The format was developed at NIST (National Institute of Standards +!> and Technology) for the Matrix Market, a repository of test matrices for use in +!> comparative studies of algorithms for numerical linear algebra. +!> +!> For more information, see: https://math.nist.gov/MatrixMarket/formats.html +module stdlib_io_mm + use stdlib_kinds, only : int8, int16, int32, int64, sp, dp, xdp, qp + use stdlib_sparse_kinds + implicit none + private + + type, public :: mm_header_type + integer :: object + integer :: format + integer :: qualifier + integer :: symmetry + character(len=1024), allocatable :: comments(:) + end type mm_header_type + + !> Version: experimental + !> + !> Load a matrix from a Matrix Market file + !> ([Specification](../page/specs/stdlib_io.html#load_mm)) + interface load_mm + #:for k, t, s in RC_KINDS_TYPES + module subroutine load_mm_dense_${s}$(filename, matrix, iostat, iomsg) + !> Name of the Matrix Market file to load from + character(len=*), intent(in) :: filename + !> Matrix to be loaded from the Matrix Market file + ${t}$, allocatable, intent(out) :: matrix(:,:) + !> 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 + end subroutine + #:endfor + #:for k, t, s in RC_KINDS_TYPES + module subroutine load_mm_coo_${s}$(filename, matrix, iostat, iomsg) + !> Name of the Matrix Market file to load from + character(len=*), intent(in) :: filename + !> Matrix to be loaded from the Matrix Market file + type(COO_${s}$_type), intent(out) :: matrix + !> 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 + end subroutine + #:endfor + end interface + public :: load_mm + + !> Version: experimental + !> + !> Save a matrix to a Matrix Market file + !> ([Specification](../page/specs/stdlib_io.html#save_mm)) + interface save_mm + #:for k, t, s in RC_KINDS_TYPES + module subroutine save_mm_dense_${s}$(filename, matrix, header_info, iostat, iomsg) + character(len=*), intent(in) :: filename + ${t}$, intent(in) :: matrix(:,:) + character(len=*), intent(in), optional :: header_info + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine + #:endfor + end interface save_mm + public :: save_mm + + ! Matrix Market format constants + character(len=*), parameter :: MM_BANNER = "%%MatrixMarket" + character(len=*), parameter :: MM_COMMENT_CHAR = "%" + + ! Matrix Market object types + character(len=*), parameter :: & + MM_MATRIX = "matrix", & + MM_VECTOR = "vector" + + ! Matrix Market format types + character(len=*), parameter :: & + MM_COORDINATE = "coordinate", & + MM_ARRAY = "array" + + ! Matrix Market data types + character(len=*), parameter :: & + MM_REAL = "real", & + MM_COMPLEX = "complex", & + MM_INTEGER = "integer", & + MM_PATTERN = "pattern" + + ! Matrix Market storage schemes + character(len=*), parameter :: & + MM_GENERAL = "general", & + MM_SYMMETRIC = "symmetric", & + MM_SKEW_SYMMETRIC = "skew-symmetric", & + MM_HERMITIAN = "hermitian" + + public :: MM_BANNER, MM_COMMENT_CHAR + public :: MM_MATRIX, MM_VECTOR + public :: MM_COORDINATE, MM_ARRAY + public :: MM_REAL, MM_COMPLEX, MM_INTEGER, MM_PATTERN + public :: MM_GENERAL, MM_SYMMETRIC, MM_SKEW_SYMMETRIC, MM_HERMITIAN + +end module stdlib_io_mm \ No newline at end of file diff --git a/src/stdlib_io_mm_load.fypp b/src/stdlib_io_mm_load.fypp new file mode 100644 index 000000000..fad4c88d2 --- /dev/null +++ b/src/stdlib_io_mm_load.fypp @@ -0,0 +1,275 @@ +! SPDX-Identifier: MIT + +#:include "common.fypp" +#:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) +#:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX)) +#:set RC_KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + +submodule (stdlib_io_mm) stdlib_io_mm_load + use stdlib_error, only : error_stop + use stdlib_strings, only : to_string, starts_with + use stdlib_str2num, only: to_num_from_stream + use stdlib_kinds + use stdlib_sparse_kinds + implicit none + + + enum, bind(c) + enumerator :: MF_array = 1 + enumerator :: MF_coordinate = 2 + end enum + enum, bind(c) + enumerator :: MQ_real = 1 + enumerator :: MQ_integer = 2 + enumerator :: MQ_complex = 3 + enumerator :: MQ_pattern = 4 + end enum + enum, bind(c) + enumerator :: MS_general = 1 + enumerator :: MS_symmetric = 2 + enumerator :: MS_skew_symmetric = 3 + enumerator :: MS_hermitian = 4 + end enum + + integer(int8), parameter :: LF = 10, CR = 13, PP=iachar('%') + +contains + + #:for k, t, s in RC_KINDS_TYPES + module subroutine load_mm_dense_${s}$(filename, matrix, iostat, iomsg) + !> Name of the Matrix Market file to load from + character(len=*), intent(in) :: filename + !> Matrix to be loaded from the Matrix Market file + ${t}$, allocatable, intent(out) :: matrix(:,:) + !> 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 + + ! Internal variables + type(mm_header_type) :: header + integer :: u , fsze, err, eol_position + integer :: nrows, ncols, i, j + integer(int8) :: stat + character(:), allocatable, target :: ff + character(len=:), pointer :: ffp + #:if t.startswith('complex') + real(${k}$) :: mold, val_r, val_i + #:else + ${t}$ :: mold + #:endif + !----------------------------------------------------------------------------- + ! Open file for regular reading + open( newunit = u , file=filename, status = 'old' , access='stream', action="read", iostat=err ) + if( err /= 0 ) return + err = 1 + + !----------------------------------------- + ! Load file in a single string + inquire(unit=u, size=fsze) + allocate(character(fsze) :: ff) + read(u) ff + ffp => ff(1:) + close(u) + + !----------------------------------------- + ! Read header + call read_mm_header(ffp, header, err) + if( err /= 0 ) return + if( header%format /= MF_array ) then + err = 2 + print *, "warning: a dense matrix is expected for the current file" + return + end if + + !----------------------------------------- + ! Skip comments + eol_position = shift_to_eol(ffp) + ffp => ffp(eol_position:) + do while( iachar(ffp(1:1))==PP ) + eol_position = shift_to_eol(ffp) + ffp => ffp(eol_position+1:) + end do + + !----------------------------------------- + ! Read matrix dimensions + nrows = to_num_from_stream(ffp, nrows, stat) + if( stat /= 0 ) return + ncols = to_num_from_stream(ffp, ncols, stat) + if( stat /= 0 ) return + + !----------------------------------------- + ! Read actual matrix data + allocate(matrix(nrows, ncols), stat=err) + if( err /= 0 ) return + do j = 1, ncols + do i = 1, nrows + #:if t.startswith('complex') + val_r = to_num_from_stream(ffp, mold, stat) + val_i = to_num_from_stream(ffp, mold, stat) + matrix(i,j) = complex( val_r, val_i ) + #:else + matrix(i,j) = to_num_from_stream(ffp, mold, stat) + #:endif + if( stat /= 0 ) return + end do + end do + end subroutine + #:endfor + + #:for k, t, s in RC_KINDS_TYPES + module subroutine load_mm_coo_${s}$(filename, matrix, iostat, iomsg) + !> Name of the Matrix Market file to load from + character(len=*), intent(in) :: filename + !> Matrix to be loaded from the Matrix Market file + type(COO_${s}$_type), intent(out) :: matrix + !> 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 + + ! Internal variables + type(mm_header_type) :: header + integer :: u , fsze, err, eol_position + integer :: i, j + integer(int8) :: stat + character(:), allocatable, target :: ff + character(len=:), pointer :: ffp + #:if t.startswith('complex') + real(${k}$) :: mold, val_r, val_i + #:else + ${t}$ :: mold + #:endif + !----------------------------------------------------------------------------- + ! Open file for regular reading + open( newunit = u , file=filename, status = 'old' , access='stream', action="read", iostat=err ) + if( err /= 0 ) return + err = 1 + + !----------------------------------------- + ! Load file in a single string + inquire(unit=u, size=fsze) + allocate(character(fsze) :: ff) + read(u) ff + ffp => ff(1:) + close(u) + + !----------------------------------------- + ! Read header + call read_mm_header(ffp, header, err) + if( err /= 0 ) return + if( header%format /= MF_coordinate ) then + err = 2 + print *, "warning: a coordinate matrix is expected for the current file" + return + end if + + !----------------------------------------- + ! Skip comments + eol_position = shift_to_eol(ffp) + ffp => ffp(eol_position:) + do while( iachar(ffp(1:1))==PP ) + eol_position = shift_to_eol(ffp) + ffp => ffp(eol_position+1:) + end do + + !----------------------------------------- + ! Read matrix dimensions + matrix%nrows = to_num_from_stream(ffp, matrix%nrows, stat) + if( stat /= 0 ) return + matrix%ncols = to_num_from_stream(ffp, matrix%ncols, stat) + if( stat /= 0 ) return + matrix%nnz = to_num_from_stream(ffp, matrix%nnz, stat) + if( stat /= 0 ) return + + !----------------------------------------- + ! Read actual matrix data + call matrix%malloc( matrix%nrows, matrix%ncols, matrix%nnz ) + do i = 1, matrix%nnz + matrix%index(1,i) = to_num_from_stream(ffp, matrix%index(1,i), stat) + matrix%index(2,i) = to_num_from_stream(ffp, matrix%index(2,i), stat) + #:if t.startswith('complex') + val_r = to_num_from_stream(ffp, mold, stat) + val_i = to_num_from_stream(ffp, mold, stat) + matrix%data(i) = complex( val_r, val_i ) + #:else + matrix%data(i) = to_num_from_stream(ffp, mold, stat) + #:endif + end do + end subroutine + #:endfor + + subroutine read_mm_header(ffp, header, err) + character(len=:), intent(inout), pointer :: ffp + type(mm_header_type), intent(out) :: header + integer, intent(out) :: err + !---------------------------------------------- + err = 0 + if( .not. starts_with(ffp, "%%MatrixMarket ") ) return + ffp => ffp(16:) + + ! Read object type: matrix + if( .not. starts_with(ffp, "matrix ") ) return + ffp => ffp(8:) + header%object = 1 ! matrix + + ! Read format type: coordinate or array + if( starts_with(ffp, "arr") ) then + ffp => ffp(7:) ! array + header%format = MF_array + else if( starts_with(ffp, "coo") ) then + ffp => ffp(12:) ! coordinate + header%format = MF_coordinate + else + return + end if + + ! Read first qualifier: real, complex, integer, pattern (sparse) + if( starts_with(ffp, "real") ) then + ffp => ffp(6:) ! real + header%qualifier = MQ_real + else if( starts_with(ffp, "complex") ) then + ffp => ffp(9:) ! complex + header%qualifier = MQ_complex + else if( starts_with(ffp, "integer") ) then + ffp => ffp(9:) ! integer + header%qualifier = MQ_integer + else if( starts_with(ffp, "pattern") ) then + ffp => ffp(9:) ! pattern + header%qualifier = MQ_pattern + else + return + end if + + ! Read second qualifier: general, symmetric, skew-symmetric, hermitian + if( starts_with(ffp, "general") ) then + ffp => ffp(9:) ! general + header%symmetry = MS_general + else if( starts_with(ffp, "symmetric") ) then + ffp => ffp(11:) ! symmetric + header%symmetry = MS_symmetric + else if( starts_with(ffp, "skew-symmetric") ) then + ffp => ffp(16:) ! skew-symmetric + header%symmetry = MS_skew_symmetric + else if( starts_with(ffp, "hermitian") ) then + ffp => ffp(11:) ! hermitian + header%symmetry = MS_hermitian + else + return + end if + end subroutine + + elemental function shift_to_eol(s) result(p) + !! move string to position of the next end-of-line character + character(*),intent(in) :: s !! character chain + integer :: p !! position + !---------------------------------------------- + p = 1 + do while( p Implementation of saving multidimensional arrays to Matrix Market files +submodule (stdlib_io_mm) stdlib_io_mm_save + use stdlib_error, only : error_stop + use stdlib_strings, only : to_string + use stdlib_io, only : open + implicit none + +contains + + #:for k, t, s in RC_KINDS_TYPES + module subroutine save_mm_dense_${s}$(filename, matrix, header_info, iostat, iomsg) + !> Name of the Matrix Market file to save to + character(len=*), intent(in) :: filename + !> Matrix to be saved to the Matrix Market file + ${t}$, intent(in) :: matrix(:,:) + !> Optional header information (comments, format preference) + character(len=*), intent(in), optional :: header_info + !> Error status of saving, 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 + + integer :: io, stat, i, j, nnz + character(len=:), allocatable :: msg + character(len=32) :: field_type, symmetry_type + logical :: save_as_coordinate + #:if t.startswith('complex') + real(${k}$) :: real_part, imag_part + #:endif + + io = open(filename, "w", iostat=stat) + if (stat /= 0) then + if (present(iostat)) then + iostat = stat + if (present(iomsg)) iomsg = "Could not create file: " // filename + return + else + call error_stop("Could not create file: " // filename) + end if + end if + + catch: block + ! Determine field type based on matrix type + #:if t.startswith('real') + field_type = MM_REAL + #:elif t.startswith('complex') + field_type = MM_COMPLEX + #:elif t.startswith('integer') + field_type = MM_INTEGER + #:endif + + ! For now, assume general symmetry (could be enhanced to detect symmetry) + symmetry_type = MM_GENERAL + + ! Count non-zero elements to decide format + nnz = 0 + do j = 1, size(matrix, 2) + do i = 1, size(matrix, 1) + #:if t.startswith('real') or t.startswith('integer') + if (matrix(i, j) /= 0) nnz = nnz + 1 + #:elif t.startswith('complex') + if (abs(matrix(i, j)) /= 0) nnz = nnz + 1 + #:endif + end do + end do + + ! Decide format based on sparsity (save as coordinate if < 50% non-zero) + save_as_coordinate = (real(nnz) / real(size(matrix)) < 0.5) + + ! Allow override via header_info (simple implementation) + if (present(header_info)) then + if (index(header_info, "array") > 0) save_as_coordinate = .false. + if (index(header_info, "coordinate") > 0) save_as_coordinate = .true. + end if + + ! Write header + if (save_as_coordinate) then + call write_mm_header(io, MM_COORDINATE, field_type, symmetry_type, & + size(matrix, 1), size(matrix, 2), nnz, header_info, stat, msg) + else + call write_mm_header(io, MM_ARRAY, field_type, symmetry_type, & + size(matrix, 1), size(matrix, 2), 0, header_info, stat, msg) + end if + if (stat /= 0) exit catch + + ! Write data + if (save_as_coordinate) then + ! Write coordinate format + do j = 1, size(matrix, 2) + do i = 1, size(matrix, 1) + #:if t.startswith('real') + if (matrix(i, j) /= 0) then + write(io, '(I0,1X,I0,1X,ES24.16E3)', iostat=stat) i, j, matrix(i, j) + if (stat /= 0) then + msg = "Error writing coordinate entry (" // & + to_string(i) // "," // to_string(j) // ")" + exit catch + end if + end if + #:elif t.startswith('complex') + if (abs(matrix(i, j)) /= 0) then + real_part = real(matrix(i, j), kind=${k}$) + imag_part = aimag(matrix(i, j)) + write(io, '(I0,1X,I0,1X,ES24.16E3,1X,ES24.16E3)', iostat=stat) & + i, j, real_part, imag_part + if (stat /= 0) then + msg = "Error writing coordinate entry (" // & + to_string(i) // "," // to_string(j) // ")" + exit catch + end if + end if + #:elif t.startswith('integer') + if (matrix(i, j) /= 0) then + write(io, '(I0,1X,I0,1X,I0)', iostat=stat) i, j, matrix(i, j) + if (stat /= 0) then + msg = "Error writing coordinate entry (" // & + to_string(i) // "," // to_string(j) // ")" + exit catch + end if + end if + #:endif + end do + end do + else + ! Write array format (column-major order) + do j = 1, size(matrix, 2) + do i = 1, size(matrix, 1) + #:if t.startswith('real') + write(io, '(ES24.16E3)', iostat=stat) matrix(i, j) + #:elif t.startswith('complex') + real_part = real(matrix(i, j), kind=${k}$) + imag_part = aimag(matrix(i, j)) + write(io, '(ES24.16E3,1X,ES24.16E3)', iostat=stat) real_part, imag_part + #:elif t.startswith('integer') + write(io, '(I0)', iostat=stat) matrix(i, j) + #:endif + if (stat /= 0) then + msg = "Error writing array element (" // & + to_string(i) // "," // to_string(j) // ")" + exit catch + end if + end do + end do + end if + 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 save Matrix Market file '" // filename // "': " // msg) + else + call error_stop("Failed to save Matrix Market file '" // filename // "'") + end if + end if + + if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) + end subroutine + #:endfor + + !> Write Matrix Market header + subroutine write_mm_header(io, format, field, symmetry, nrows, ncols, nnz, & + header_info, iostat, iomsg) + integer, intent(in) :: io + character(len=*), intent(in) :: format, field, symmetry + integer, intent(in) :: nrows, ncols, nnz + character(len=*), intent(in), optional :: header_info + integer, intent(out) :: iostat + character(len=:), allocatable, intent(out) :: iomsg + + integer :: stat + character(len=*), parameter :: iso_date_fmt = '(I4.4,"-",I2.2,"-",I2.2)' + integer :: date_values(8) + + iostat = 0 + + ! Write banner line + write(io, '(A)', iostat=stat) MM_BANNER // " " // MM_MATRIX // " " // & + format // " " // field // " " // symmetry + if (stat /= 0) then + iostat = stat + iomsg = "Error writing Matrix Market banner" + return + end if + + ! Write comments (including optional header_info and generation info) + call date_and_time(values=date_values) + write(io, '(A)', iostat=stat) "% Generated by Fortran stdlib on " // & + to_string(date_values(1)) // "-" // & + to_string(date_values(2)) // "-" // & + to_string(date_values(3)) + if (stat /= 0) then + iostat = stat + iomsg = "Error writing comment line" + return + end if + + if (present(header_info) .and. len_trim(header_info) > 0) then + write(io, '(A)', iostat=stat) "% " // trim(header_info) + if (stat /= 0) then + iostat = stat + iomsg = "Error writing header info" + return + end if + end if + + ! Write size line + if (format == MM_COORDINATE) then + write(io, '(I0,1X,I0,1X,I0)', iostat=stat) nrows, ncols, nnz + else + write(io, '(I0,1X,I0)', iostat=stat) nrows, ncols + end if + + if (stat /= 0) then + iostat = stat + iomsg = "Error writing matrix dimensions" + return + end if + end subroutine write_mm_header + +end submodule stdlib_io_mm_save \ No newline at end of file From e1fbad194459752326df3f224628bc6d2bf531ec Mon Sep 17 00:00:00 2001 From: jalvesz Date: Sat, 11 Oct 2025 17:53:35 +0200 Subject: [PATCH 02/50] manage symmetric storages --- src/stdlib_io_mm.fypp | 34 ---------------------------------- src/stdlib_io_mm_load.fypp | 32 +++++++++++++++++++++++++++++--- src/stdlib_io_mm_save.fypp | 28 ++++++++++++++++++++++++++++ 3 files changed, 57 insertions(+), 37 deletions(-) diff --git a/src/stdlib_io_mm.fypp b/src/stdlib_io_mm.fypp index a3e5d6000..2ab868f88 100644 --- a/src/stdlib_io_mm.fypp +++ b/src/stdlib_io_mm.fypp @@ -74,38 +74,4 @@ module stdlib_io_mm end interface save_mm public :: save_mm - ! Matrix Market format constants - character(len=*), parameter :: MM_BANNER = "%%MatrixMarket" - character(len=*), parameter :: MM_COMMENT_CHAR = "%" - - ! Matrix Market object types - character(len=*), parameter :: & - MM_MATRIX = "matrix", & - MM_VECTOR = "vector" - - ! Matrix Market format types - character(len=*), parameter :: & - MM_COORDINATE = "coordinate", & - MM_ARRAY = "array" - - ! Matrix Market data types - character(len=*), parameter :: & - MM_REAL = "real", & - MM_COMPLEX = "complex", & - MM_INTEGER = "integer", & - MM_PATTERN = "pattern" - - ! Matrix Market storage schemes - character(len=*), parameter :: & - MM_GENERAL = "general", & - MM_SYMMETRIC = "symmetric", & - MM_SKEW_SYMMETRIC = "skew-symmetric", & - MM_HERMITIAN = "hermitian" - - public :: MM_BANNER, MM_COMMENT_CHAR - public :: MM_MATRIX, MM_VECTOR - public :: MM_COORDINATE, MM_ARRAY - public :: MM_REAL, MM_COMPLEX, MM_INTEGER, MM_PATTERN - public :: MM_GENERAL, MM_SYMMETRIC, MM_SKEW_SYMMETRIC, MM_HERMITIAN - end module stdlib_io_mm \ No newline at end of file diff --git a/src/stdlib_io_mm_load.fypp b/src/stdlib_io_mm_load.fypp index fad4c88d2..e5028cde5 100644 --- a/src/stdlib_io_mm_load.fypp +++ b/src/stdlib_io_mm_load.fypp @@ -131,7 +131,7 @@ contains ! Internal variables type(mm_header_type) :: header integer :: u , fsze, err, eol_position - integer :: i, j + integer :: i, j, nnz, adr integer(int8) :: stat character(:), allocatable, target :: ff character(len=:), pointer :: ffp @@ -179,13 +179,22 @@ contains if( stat /= 0 ) return matrix%ncols = to_num_from_stream(ffp, matrix%ncols, stat) if( stat /= 0 ) return - matrix%nnz = to_num_from_stream(ffp, matrix%nnz, stat) + nnz = to_num_from_stream(ffp, nnz, stat) if( stat /= 0 ) return + !----------------------------------------- + ! check storage hypothesis + matrix%nnz = nnz + if(header%symmetry == MS_symmetric) then + matrix%nnz = 2*nnz - matrix%nrows + elseif(header%symmetry == MS_skew_symmetric) then + matrix%nnz = 2*nnz + end if + !----------------------------------------- ! Read actual matrix data call matrix%malloc( matrix%nrows, matrix%ncols, matrix%nnz ) - do i = 1, matrix%nnz + do i = 1, nnz ! read entries from file matrix%index(1,i) = to_num_from_stream(ffp, matrix%index(1,i), stat) matrix%index(2,i) = to_num_from_stream(ffp, matrix%index(2,i), stat) #:if t.startswith('complex') @@ -196,6 +205,23 @@ contains matrix%data(i) = to_num_from_stream(ffp, mold, stat) #:endif end do + + !----------------------------------------- + ! Fill in symmetric entries if needed + if(header%symmetry==MS_general) return + adr = 1 + do i = 1, nnz + if(matrix%index(1,i)==matrix%index(2,i)) cycle + matrix%index(1,nnz+adr) = matrix%index(2,i) + matrix%index(2,nnz+adr) = matrix%index(1,i) + matrix%data(nnz+adr) = matrix%data(i) + if(header%symmetry==MS_skew_symmetric) matrix%data(nnz+adr) = -matrix%data(i) + #:if t.startswith('complex') + if(header%symmetry==MS_hermitian) matrix%data(nnz+adr) = conjg(matrix%data(i)) + #:endif + adr = adr + 1 + end do + end subroutine #:endfor diff --git a/src/stdlib_io_mm_save.fypp b/src/stdlib_io_mm_save.fypp index 5208222a0..bfc98c9dd 100644 --- a/src/stdlib_io_mm_save.fypp +++ b/src/stdlib_io_mm_save.fypp @@ -12,6 +12,34 @@ submodule (stdlib_io_mm) stdlib_io_mm_save use stdlib_io, only : open implicit none + ! Matrix Market format constants + character(len=*), parameter :: MM_BANNER = "%%MatrixMarket" + character(len=*), parameter :: MM_COMMENT_CHAR = "%" + + ! Matrix Market object types + character(len=*), parameter :: & + MM_MATRIX = "matrix", & + MM_VECTOR = "vector" + + ! Matrix Market format types + character(len=*), parameter :: & + MM_COORDINATE = "coordinate", & + MM_ARRAY = "array" + + ! Matrix Market data types + character(len=*), parameter :: & + MM_REAL = "real", & + MM_COMPLEX = "complex", & + MM_INTEGER = "integer", & + MM_PATTERN = "pattern" + + ! Matrix Market storage schemes + character(len=*), parameter :: & + MM_GENERAL = "general", & + MM_SYMMETRIC = "symmetric", & + MM_SKEW_SYMMETRIC = "skew-symmetric", & + MM_HERMITIAN = "hermitian" + contains #:for k, t, s in RC_KINDS_TYPES From 32b1df167cbb337a9174b679977f12bebe36124f Mon Sep 17 00:00:00 2001 From: jalvesz Date: Wed, 31 Dec 2025 22:42:31 +0100 Subject: [PATCH 03/50] add examples and test --- doc/specs/stdlib_io.md | 67 ++++++++++++++++++++ example/io/CMakeLists.txt | 1 + example/io/example_matrix_market.f90 | 93 ++++++++++++++++++++++++++++ test/io/CMakeLists.txt | 1 + test/io/simple_test.mtx | 7 +++ test/io/test_complex.mtx | 7 +++ test/io/test_coord.mtx | 8 +++ test/io/test_integer.mtx | 9 +++ test/io/test_io_mm.f90 | 66 ++++++++++++++++++++ test/io/test_real.mtx | 12 ++++ test_simple.mtx | 7 +++ 11 files changed, 278 insertions(+) create mode 100644 example/io/example_matrix_market.f90 create mode 100644 test/io/simple_test.mtx create mode 100644 test/io/test_complex.mtx create mode 100644 test/io/test_coord.mtx create mode 100644 test/io/test_integer.mtx create mode 100644 test/io/test_io_mm.f90 create mode 100644 test/io/test_real.mtx create mode 100644 test_simple.mtx diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 46befe2ea..855eb90dd 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -305,3 +305,70 @@ Exceptions trigger an `error stop` unless the optional `err` argument is provide {!example/io/example_get_file.f90!} ``` +## Matrix Market Format I/O + +### Status + +Experimental + +### Description + +The Matrix Market I/O module provides support for reading and writing matrices in the Matrix Market format, a simple ASCII format for sparse and dense matrices developed at NIST. The format supports real, complex, and integer matrices with various symmetry properties. + +### `load_mm` - load a matrix from Matrix Market file + +#### Syntax + +`call ` [[stdlib_io_mm(module):load_mm(interface)]] `(filename, matrix [, iostat] [, iomsg])` + +#### Arguments + +`filename`: Shall be a character expression containing the Matrix Market file name to read from. + +`matrix`: Shall be an allocatable rank-2 array of type `real`, `complex`, or `integer` that will contain the loaded matrix. + +`iostat` (optional): Shall be a scalar of type `integer` that receives the error status. Zero indicates success. + +`iomsg` (optional): Shall be an allocatable character string that receives the error message if iostat is non-zero. + +#### Description + +Loads a 2D matrix from a Matrix Market format file. The routine automatically detects the data type, format (coordinate or array), and symmetry properties from the file header. For coordinate format files, symmetric matrices are expanded to full storage. + +### `save_mm` - save a matrix to Matrix Market file + +#### Syntax + +`call ` [[stdlib_io_mm(module):save_mm(interface)]] `(filename, matrix [, header_info] [, iostat] [, iomsg])` + +#### Arguments + +`filename`: Shall be a character expression containing the Matrix Market file name to write to. + +`matrix`: Shall be a rank-2 array of type `real`, `complex`, or `integer` to save. + +`header_info` (optional): Shall be a character expression containing additional comments for the file header. Can also specify format preference ('coordinate' or 'array'). + +`iostat` (optional): Shall be a scalar of type `integer` that receives the error status. Zero indicates success. + +`iomsg` (optional): Shall be an allocatable character string that receives the error message if iostat is non-zero. + +#### Description + +Saves a 2D matrix to Matrix Market format file. The routine automatically chooses coordinate format for sparse matrices (< 50% non-zero) and array format for dense matrices, unless overridden in `header_info`. + +### Matrix Market Format Details + +The Matrix Market format supports: + +- **Object types**: Currently only `matrix` is supported +- **Formats**: `coordinate` (sparse) and `array` (dense) +- **Data types**: `real`, `complex`, `integer` (pattern not yet supported) +- **Symmetry**: `general`, `symmetric`, `skew-symmetric`, `hermitian` + +### Example + +```fortran +{!example/io/example_matrix_market.f90!} +``` + diff --git a/example/io/CMakeLists.txt b/example/io/CMakeLists.txt index db663f537..fca9bb4f4 100644 --- a/example/io/CMakeLists.txt +++ b/example/io/CMakeLists.txt @@ -3,6 +3,7 @@ ADD_EXAMPLE(fmt_constants) ADD_EXAMPLE(get_file) ADD_EXAMPLE(loadnpy) ADD_EXAMPLE(loadtxt) +ADD_EXAMPLE(matrix_market) ADD_EXAMPLE(open) ADD_EXAMPLE(savenpy) ADD_EXAMPLE(savetxt) diff --git a/example/io/example_matrix_market.f90 b/example/io/example_matrix_market.f90 new file mode 100644 index 000000000..b13af3825 --- /dev/null +++ b/example/io/example_matrix_market.f90 @@ -0,0 +1,93 @@ +program example_matrix_market + use stdlib_io_mm, only : load_mm, save_mm, mm_header_type + use stdlib_kinds, only : dp + use stdlib_sparse_kinds, only : COO_dp_type + implicit none + + real(dp), allocatable :: matrix(:,:), matrix2(:,:) + type(COO_dp_type) :: sparse_matrix + character(len=*), parameter :: dense_filename = "test_dense.mtx" + character(len=*), parameter :: sparse_filename = "test_sparse.mtx" + integer :: iostat, i + character(len=:), allocatable :: iomsg + + ! Create a test dense matrix + allocate(matrix(3,3)) + matrix = reshape([1.0_dp, 2.0_dp, 3.0_dp, & + 4.0_dp, 5.0_dp, 6.0_dp, & + 7.0_dp, 8.0_dp, 9.0_dp], [3,3]) + + print *, "=== Dense Matrix Example ===" + print *, "Original dense matrix:" + call print_matrix(matrix) + + ! Save dense matrix to Matrix Market file + call save_mm(dense_filename, matrix, iostat=iostat, iomsg=iomsg) + if (iostat /= 0) then + print *, "Error saving dense matrix: ", iomsg + stop 1 + end if + + print *, "Dense matrix saved to ", dense_filename + + ! Load dense matrix from Matrix Market file + call load_mm(dense_filename, matrix2, iostat=iostat, iomsg=iomsg) + if (iostat /= 0) then + print *, "Error loading dense matrix: ", iomsg + stop 1 + end if + + print *, "Loaded dense matrix:" + call print_matrix(matrix2) + + ! Create a sparse test file manually for demonstration + call create_sparse_test_file(sparse_filename) + + print *, "=== Sparse Matrix Example ===" + print *, "Loading sparse matrix from ", sparse_filename + + ! Load sparse matrix from Matrix Market file + call load_mm(sparse_filename, sparse_matrix, iostat=iostat, iomsg=iomsg) + if (iostat /= 0) then + print *, "Error loading sparse matrix: ", iomsg + stop 1 + end if + + print *, "Loaded sparse matrix (COO format):" + print *, "Dimensions: ", sparse_matrix%nrows, "x", sparse_matrix%ncols + print *, "Non-zeros: ", sparse_matrix%nnz + print *, "Data (row, col, value):" + do i = 1, sparse_matrix%nnz + print *, sparse_matrix%index(1,i), sparse_matrix%index(2,i), sparse_matrix%data(i) + end do + +contains + + subroutine print_matrix(mat) + real(dp), intent(in) :: mat(:,:) + integer :: i + + do i = 1, size(mat, 1) + print *, mat(i, :) + end do + print * + end subroutine print_matrix + + subroutine create_sparse_test_file(filename) + character(len=*), intent(in) :: filename + integer :: u + + open(newunit=u, file=filename, status='replace') + write(u, '(A)') '%%MatrixMarket matrix coordinate real general' + write(u, '(A)') '% This is a test sparse matrix' + write(u, '(A)') '4 4 6' + write(u, '(A)') '1 1 10.0' + write(u, '(A)') '2 2 20.0' + write(u, '(A)') '3 3 30.0' + write(u, '(A)') '4 4 40.0' + write(u, '(A)') '1 4 5.0' + write(u, '(A)') '3 1 15.0' + close(u) + end subroutine create_sparse_test_file + +end program example_matrix_market \ No newline at end of file diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index 4e19b5fbe..f0c27a1b3 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -14,6 +14,7 @@ set_tests_properties(loadtxt_qp PROPERTIES LABELS quadruple_precision) set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision) ADDTEST(get_line) +ADDTEST(io_mm) ADDTEST(npy) ADDTEST(open) ADDTEST(parse_mode) diff --git a/test/io/simple_test.mtx b/test/io/simple_test.mtx new file mode 100644 index 000000000..82d36e26c --- /dev/null +++ b/test/io/simple_test.mtx @@ -0,0 +1,7 @@ +%%MatrixMarket matrix array real general +% Simple test matrix +2 2 +1.0 +0.0 +0.0 +2.0 diff --git a/test/io/test_complex.mtx b/test/io/test_complex.mtx new file mode 100644 index 000000000..761187794 --- /dev/null +++ b/test/io/test_complex.mtx @@ -0,0 +1,7 @@ +%%MatrixMarket matrix array complex general +% Generated by Fortran stdlib on 2025-10-3 +2 2 + 1.0000000000000000E+000 2.0000000000000000E+000 + 3.0000000000000000E+000 -1.0000000000000000E+000 + 0.0000000000000000E+000 0.0000000000000000E+000 + 0.0000000000000000E+000 4.0000000000000000E+000 diff --git a/test/io/test_coord.mtx b/test/io/test_coord.mtx new file mode 100644 index 000000000..8914a957b --- /dev/null +++ b/test/io/test_coord.mtx @@ -0,0 +1,8 @@ +%%MatrixMarket matrix coordinate real general +% Generated by Fortran stdlib on 2025-10-3 +% coordinate format +4 4 4 +1 1 1.0000000000000000E+000 +4 1 -3.0000000000000000E+000 +2 3 2.5000000000000000E+000 +4 4 4.5000000000000000E+000 diff --git a/test/io/test_integer.mtx b/test/io/test_integer.mtx new file mode 100644 index 000000000..452e11546 --- /dev/null +++ b/test/io/test_integer.mtx @@ -0,0 +1,9 @@ +%%MatrixMarket matrix array integer general +% Generated by Fortran stdlib on 2025-10-3 +2 3 +1 +0 +3 +0 +2 +0 diff --git a/test/io/test_io_mm.f90 b/test/io/test_io_mm.f90 new file mode 100644 index 000000000..143bc7503 --- /dev/null +++ b/test/io/test_io_mm.f90 @@ -0,0 +1,66 @@ +! Simple test for Matrix Market loading only +program test_matrix_market + use stdlib_io_mm + use stdlib_kinds, only: dp + implicit none + + call test_load_simple() + + write(*,*) 'Matrix Market load test passed!' + +contains + + subroutine test_load_simple() + real(dp), allocatable :: matrix(:,:) + integer :: iostat, io, i + character(len=:), allocatable :: iomsg + + write(*,*) 'Testing simple Matrix Market loading...' + + ! Create a simple test file + open(newunit=io, file='simple_test.mtx', action='write') + write(io, '(A)') '%%MatrixMarket matrix array real general' + write(io, '(A)') '% Simple test matrix' + write(io, '(A)') '2 2' + write(io, '(A)') '1.0' + write(io, '(A)') '0.0' + write(io, '(A)') '0.0' + write(io, '(A)') '2.0' + close(io) + + ! Try to load it + call load_mm('simple_test.mtx', matrix, iostat=iostat, iomsg=iomsg) + if (iostat /= 0) then + write(*,*) 'Error loading simple matrix: iostat=', iostat + if (allocated(iomsg)) write(*,*) 'Message: ', iomsg + stop 1 + end if + + ! Check results + if (.not. allocated(matrix)) then + write(*,*) 'Error: matrix not allocated' + stop 1 + end if + + if (size(matrix,1) /= 2 .or. size(matrix,2) /= 2) then + write(*,*) 'Error: wrong dimensions', size(matrix,1), size(matrix,2) + stop 1 + end if + + if (abs(matrix(1,1) - 1.0_dp) > 1e-12_dp .or. & + abs(matrix(2,1) - 0.0_dp) > 1e-12_dp .or. & + abs(matrix(1,2) - 0.0_dp) > 1e-12_dp .or. & + abs(matrix(2,2) - 2.0_dp) > 1e-12_dp) then + write(*,*) 'Error: wrong matrix values' + write(*,*) 'Expected: 1 0; 0 2' + write(*,*) 'Got:' + do i = 1, 2 + write(*,'(*(F8.3))') matrix(i,:) + end do + stop 1 + end if + + write(*,*) 'Simple load test passed' + end subroutine test_load_simple + +end program test_matrix_market \ No newline at end of file diff --git a/test/io/test_real.mtx b/test/io/test_real.mtx new file mode 100644 index 000000000..89e77280a --- /dev/null +++ b/test/io/test_real.mtx @@ -0,0 +1,12 @@ +%%MatrixMarket matrix array real general +% Generated by Fortran stdlib on 2025-10-5 +3 3 + 1.0000000000000000E+000 + 0.0000000000000000E+000 + 3.0000000000000000E+000 + 0.0000000000000000E+000 + 2.0000000000000000E+000 + 0.0000000000000000E+000 + 4.0000000000000000E+000 + 0.0000000000000000E+000 + 5.0000000000000000E+000 diff --git a/test_simple.mtx b/test_simple.mtx new file mode 100644 index 000000000..4c14cc1a7 --- /dev/null +++ b/test_simple.mtx @@ -0,0 +1,7 @@ +%%MatrixMarket matrix array real general +% Simple 2x2 test matrix +2 2 +1.0 +0.0 +0.0 +2.0 \ No newline at end of file From 6a21d2ac0c387c835c56a919507851e9578972f1 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Sat, 10 Jan 2026 13:18:55 +0100 Subject: [PATCH 04/50] split mm_save into dense and coo --- src/stdlib_io_mm.fypp | 24 +++- src/stdlib_io_mm_save.fypp | 248 ++++++++++++++++++++++++------------- 2 files changed, 180 insertions(+), 92 deletions(-) diff --git a/src/stdlib_io_mm.fypp b/src/stdlib_io_mm.fypp index 2ab868f88..edd930e1d 100644 --- a/src/stdlib_io_mm.fypp +++ b/src/stdlib_io_mm.fypp @@ -63,12 +63,24 @@ module stdlib_io_mm !> ([Specification](../page/specs/stdlib_io.html#save_mm)) interface save_mm #:for k, t, s in RC_KINDS_TYPES - module subroutine save_mm_dense_${s}$(filename, matrix, header_info, iostat, iomsg) - character(len=*), intent(in) :: filename - ${t}$, intent(in) :: matrix(:,:) - character(len=*), intent(in), optional :: header_info - integer, intent(out), optional :: iostat - character(len=:), allocatable, intent(out), optional :: iomsg + module subroutine save_mm_dense_${s}$(filename, matrix, comment, symmetry, iostat, iomsg) + character(len=*), intent(in) :: filename + ${t}$, intent(in) :: matrix(:,:) + character(len=*), intent(in), optional :: comment + character(len=*), intent(in), optional :: symmetry + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end subroutine + #:endfor + + #:for k, t, s in RC_KINDS_TYPES + module subroutine save_coo_${s}$(filename, matrix, comment, symmetry, iostat, iomsg) + character(len=*), intent(in) :: filename + type(COO_${s}$_type), intent(in) :: matrix + character(len=*), intent(in), optional :: comment + character(len=*), intent(in), optional :: symmetry + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg end subroutine #:endfor end interface save_mm diff --git a/src/stdlib_io_mm_save.fypp b/src/stdlib_io_mm_save.fypp index bfc98c9dd..4f55d6771 100644 --- a/src/stdlib_io_mm_save.fypp +++ b/src/stdlib_io_mm_save.fypp @@ -5,11 +5,13 @@ #:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX)) #:set RC_KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES -!> Implementation of saving multidimensional arrays to Matrix Market files +!> Implementation for saving multidimensional arrays to Matrix Market files submodule (stdlib_io_mm) stdlib_io_mm_save use stdlib_error, only : error_stop use stdlib_strings, only : to_string use stdlib_io, only : open + use stdlib_ascii, only : to_lower + use stdlib_constants, only : #{for k, t, s in RC_KINDS_TYPES[:-1]}#zero_${k}$, #{endfor}#zero_${RC_KINDS_TYPES[-1][0]}$ implicit none ! Matrix Market format constants @@ -43,13 +45,15 @@ submodule (stdlib_io_mm) stdlib_io_mm_save contains #:for k, t, s in RC_KINDS_TYPES - module subroutine save_mm_dense_${s}$(filename, matrix, header_info, iostat, iomsg) + module subroutine save_mm_dense_${s}$(filename, matrix, comment, symmetry, iostat, iomsg) !> Name of the Matrix Market file to save to character(len=*), intent(in) :: filename !> Matrix to be saved to the Matrix Market file ${t}$, intent(in) :: matrix(:,:) - !> Optional header information (comments, format preference) - character(len=*), intent(in), optional :: header_info + !> Optional comment information + character(len=*), intent(in), optional :: comment + !> Symmetry type of the matrix (general, symmetric, skew-symmetric, hermitian) + character(len=*), intent(in), optional :: symmetry !> Error status of saving, zero on success integer, intent(out), optional :: iostat !> Associated error message in case of non-zero status code @@ -57,8 +61,8 @@ contains integer :: io, stat, i, j, nnz character(len=:), allocatable :: msg - character(len=32) :: field_type, symmetry_type - logical :: save_as_coordinate + character(len=32) :: field_type + character(len=32) :: symmetry_ #:if t.startswith('complex') real(${k}$) :: real_part, imag_part #:endif @@ -74,92 +78,52 @@ contains end if end if - catch: block - ! Determine field type based on matrix type - #:if t.startswith('real') - field_type = MM_REAL - #:elif t.startswith('complex') - field_type = MM_COMPLEX - #:elif t.startswith('integer') - field_type = MM_INTEGER - #:endif - - ! For now, assume general symmetry (could be enhanced to detect symmetry) - symmetry_type = MM_GENERAL - - ! Count non-zero elements to decide format - nnz = 0 - do j = 1, size(matrix, 2) - do i = 1, size(matrix, 1) - #:if t.startswith('real') or t.startswith('integer') - if (matrix(i, j) /= 0) nnz = nnz + 1 - #:elif t.startswith('complex') - if (abs(matrix(i, j)) /= 0) nnz = nnz + 1 - #:endif - end do - end do + ! Determine symmetry type + symmetry_ = "general" + if (present(symmetry)) then + symmetry_ = to_lower(trim(symmetry)) + end if - ! Decide format based on sparsity (save as coordinate if < 50% non-zero) - save_as_coordinate = (real(nnz) / real(size(matrix)) < 0.5) - - ! Allow override via header_info (simple implementation) - if (present(header_info)) then - if (index(header_info, "array") > 0) save_as_coordinate = .false. - if (index(header_info, "coordinate") > 0) save_as_coordinate = .true. - end if + ! Determine field type based on matrix type + #:if t.startswith('real') + field_type = MM_REAL + #:elif t.startswith('complex') + field_type = MM_COMPLEX + #:elif t.startswith('integer') + field_type = MM_INTEGER + #:endif + catch: block ! Write header - if (save_as_coordinate) then - call write_mm_header(io, MM_COORDINATE, field_type, symmetry_type, & - size(matrix, 1), size(matrix, 2), nnz, header_info, stat, msg) - else - call write_mm_header(io, MM_ARRAY, field_type, symmetry_type, & - size(matrix, 1), size(matrix, 2), 0, header_info, stat, msg) - end if + call write_mm_header(io, MM_ARRAY, field_type, symmetry_, & + size(matrix, 1), size(matrix, 2), nnz, comment, stat, msg) if (stat /= 0) exit catch - ! Write data - if (save_as_coordinate) then - ! Write coordinate format + ! Write array format (column-major order) + if(symmetry_ == MM_GENERAL) then do j = 1, size(matrix, 2) do i = 1, size(matrix, 1) #:if t.startswith('real') - if (matrix(i, j) /= 0) then - write(io, '(I0,1X,I0,1X,ES24.16E3)', iostat=stat) i, j, matrix(i, j) - if (stat /= 0) then - msg = "Error writing coordinate entry (" // & - to_string(i) // "," // to_string(j) // ")" - exit catch - end if - end if + write(io, '(ES24.16E3)', iostat=stat) matrix(i, j) #:elif t.startswith('complex') - if (abs(matrix(i, j)) /= 0) then - real_part = real(matrix(i, j), kind=${k}$) - imag_part = aimag(matrix(i, j)) - write(io, '(I0,1X,I0,1X,ES24.16E3,1X,ES24.16E3)', iostat=stat) & - i, j, real_part, imag_part - if (stat /= 0) then - msg = "Error writing coordinate entry (" // & - to_string(i) // "," // to_string(j) // ")" - exit catch - end if - end if + real_part = real(matrix(i, j), kind=${k}$) + imag_part = aimag(matrix(i, j)) + write(io, '(ES24.16E3,1X,ES24.16E3)', iostat=stat) real_part, imag_part #:elif t.startswith('integer') - if (matrix(i, j) /= 0) then - write(io, '(I0,1X,I0,1X,I0)', iostat=stat) i, j, matrix(i, j) - if (stat /= 0) then - msg = "Error writing coordinate entry (" // & - to_string(i) // "," // to_string(j) // ")" - exit catch - end if - end if + write(io, '(I0)', iostat=stat) matrix(i, j) #:endif + if (stat /= 0) then + msg = "Error writing array element (" // & + to_string(i) // "," // to_string(j) // ")" + exit catch + end if end do end do else - ! Write array format (column-major order) + ! For symmetric, skew-symmetric, hermitian matrices, only write the + ! lower triangle (including diagonal) do j = 1, size(matrix, 2) - do i = 1, size(matrix, 1) + do i = j, size(matrix, 1) #:if t.startswith('real') write(io, '(ES24.16E3)', iostat=stat) matrix(i, j) #:elif t.startswith('complex') @@ -171,7 +135,7 @@ contains #:endif if (stat /= 0) then msg = "Error writing array element (" // & - to_string(i) // "," // to_string(j) // ")" + to_string(i) // "," // to_string(j) // ")" exit catch end if end do @@ -195,13 +159,123 @@ contains end subroutine #:endfor + #:for k, t, s in RC_KINDS_TYPES + module subroutine save_mm_coo_${s}$(filename, matrix, comment, symmetry, iostat, iomsg) + !> Name of the Matrix Market file to save to + character(len=*), intent(in) :: filename + !> Matrix to be saved to the Matrix Market file + type(COO_${s}$_type), intent(in) :: matrix + !> Optional comment information + character(len=*), intent(in), optional :: comment + !> Symmetry type of the matrix (general, symmetric, skew-symmetric, hermitian) + character(len=*), intent(in), optional :: symmetry + !> Error status of saving, 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 + + integer :: io, stat, i, j, nnz + character(len=:), allocatable :: msg + character(len=32) :: field_type + character(len=32) :: symmetry_ + #:if t.startswith('complex') + real(${k}$) :: real_part, imag_part + #:endif + + io = open(filename, "w", iostat=stat) + if (stat /= 0) then + if (present(iostat)) then + iostat = stat + if (present(iomsg)) iomsg = "Could not create file: " // filename + return + else + call error_stop("Could not create file: " // filename) + end if + end if + + ! Determine symmetry type + symmetry_ = "general" + if (present(symmetry)) then + symmetry_ = to_lower(trim(symmetry)) + end if + + ! Determine field type based on matrix type + #:if t.startswith('real') + field_type = MM_REAL + #:elif t.startswith('complex') + field_type = MM_COMPLEX + #:elif t.startswith('integer') + field_type = MM_INTEGER + #:endif + + catch: block + ! Write header + call write_mm_header(io, MM_COORDINATE, field_type, symmetry_, & + matrix%nrows, matrix%ncols, matrix%nnz, comment, stat, msg) + if (stat /= 0) exit catch + + ! Write array format (column-major order) + if(symmetry_ == MM_GENERAL) then + do i = 1, matrix%nnz + #:if t.startswith('real') + write(io, '(ES24.16E3)', iostat=stat) matrix%data(i) + #:elif t.startswith('complex') + real_part = real(matrix%data(i), kind=${k}$) + imag_part = aimag(matrix%data(i)) + write(io, '(ES24.16E3,1X,ES24.16E3)', iostat=stat) real_part, imag_part + #:elif t.startswith('integer') + write(io, '(I0)', iostat=stat) matrix%data(i) + #:endif + if (stat /= 0) then + msg = "Error writing array element (" // to_string(i) // ")" + exit catch + end if + end do + else + ! For symmetric, skew-symmetric, hermitian matrices, only write the + ! lower triangle (including diagonal) + do i = 1, matrix%nnz + if(matrix%index(1,i) > matrix%index(2,i)) cycle + #:if t.startswith('real') + write(io, '(ES24.16E3)', iostat=stat) matrix%data(i) + #:elif t.startswith('complex') + real_part = real(matrix%data(i), kind=${k}$) + imag_part = aimag(matrix%data(i)) + write(io, '(ES24.16E3,1X,ES24.16E3)', iostat=stat) real_part, imag_part + #:elif t.startswith('integer') + write(io, '(I0)', iostat=stat) matrix%data(i) + #:endif + if (stat /= 0) then + msg = "Error writing array element (" // to_string(i) // ")" + exit catch + end if + end do + end if + 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 save Matrix Market file '" // filename // "': " // msg) + else + call error_stop("Failed to save Matrix Market file '" // filename // "'") + end if + end if + + if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) + end subroutine + #:endfor + !> Write Matrix Market header subroutine write_mm_header(io, format, field, symmetry, nrows, ncols, nnz, & - header_info, iostat, iomsg) + comment, iostat, iomsg) integer, intent(in) :: io character(len=*), intent(in) :: format, field, symmetry integer, intent(in) :: nrows, ncols, nnz - character(len=*), intent(in), optional :: header_info + character(len=*), intent(in), optional :: comment integer, intent(out) :: iostat character(len=:), allocatable, intent(out) :: iomsg @@ -232,12 +306,14 @@ contains return end if - if (present(header_info) .and. len_trim(header_info) > 0) then - write(io, '(A)', iostat=stat) "% " // trim(header_info) - if (stat /= 0) then - iostat = stat - iomsg = "Error writing header info" - return + if (present(comment)) then + if(len_trim(comment) > 0) then + write(io, '(A)', iostat=stat) "% " // trim(comment) + if (stat /= 0) then + iostat = stat + iomsg = "Error writing header info" + return + end if end if end if From 2fb010f7c01986fde009f83230cc5df1494cdc5f Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Tue, 13 Jan 2026 20:33:58 +0530 Subject: [PATCH 05/50] added temporary arrays to read from mtx file for coordinate matrices and fixed nnz calculation --- src/stdlib_io_mm_load.fypp | 63 +++++++++++++++++++++++++++----------- 1 file changed, 45 insertions(+), 18 deletions(-) diff --git a/src/stdlib_io_mm_load.fypp b/src/stdlib_io_mm_load.fypp index e5028cde5..cb2f7f889 100644 --- a/src/stdlib_io_mm_load.fypp +++ b/src/stdlib_io_mm_load.fypp @@ -58,6 +58,9 @@ contains #:else ${t}$ :: mold #:endif + + if (present(iostat)) iostat = 0 + if (present(iomsg)) iomsg = '' !----------------------------------------------------------------------------- ! Open file for regular reading open( newunit = u , file=filename, status = 'old' , access='stream', action="read", iostat=err ) @@ -85,12 +88,12 @@ contains !----------------------------------------- ! Skip comments eol_position = shift_to_eol(ffp) - ffp => ffp(eol_position:) + ffp => ffp(eol_position+1:) do while( iachar(ffp(1:1))==PP ) eol_position = shift_to_eol(ffp) ffp => ffp(eol_position+1:) end do - + !----------------------------------------- ! Read matrix dimensions nrows = to_num_from_stream(ffp, nrows, stat) @@ -135,11 +138,17 @@ contains integer(int8) :: stat character(:), allocatable, target :: ff character(len=:), pointer :: ffp + integer, allocatable :: rows(:), cols(:) + ${t}$, allocatable :: vals(:) + integer :: n_diag #:if t.startswith('complex') real(${k}$) :: mold, val_r, val_i #:else ${t}$ :: mold #:endif + + if (present(iostat)) iostat = 0 + if (present(iomsg)) iomsg = '' !----------------------------------------------------------------------------- ! Open file for regular reading open( newunit = u , file=filename, status = 'old' , access='stream', action="read", iostat=err ) @@ -167,7 +176,7 @@ contains !----------------------------------------- ! Skip comments eol_position = shift_to_eol(ffp) - ffp => ffp(eol_position:) + ffp => ffp(eol_position+1:) do while( iachar(ffp(1:1))==PP ) eol_position = shift_to_eol(ffp) ffp => ffp(eol_position+1:) @@ -182,28 +191,42 @@ contains nnz = to_num_from_stream(ffp, nnz, stat) if( stat /= 0 ) return + allocate(rows(nnz)) + allocate(cols(nnz)) + allocate(vals(nnz)) + + !----------------------------------------- + ! Read actual matrix data and store inside temporary arrays + n_diag = 0 + do i = 1, nnz ! read entries from file + rows(i) = to_num_from_stream(ffp, rows(i), stat) + cols(i) = to_num_from_stream(ffp, cols(i), stat) + if(rows(i) == cols(i)) n_diag = n_diag + 1 + #:if t.startswith('complex') + val_r = to_num_from_stream(ffp, mold, stat) + val_i = to_num_from_stream(ffp, mold, stat) + vals(i) = complex( val_r, val_i) + #:else + vals(i) = to_num_from_stream(ffp, mold, stat) + #:endif + end do + !----------------------------------------- ! check storage hypothesis matrix%nnz = nnz - if(header%symmetry == MS_symmetric) then - matrix%nnz = 2*nnz - matrix%nrows + if(header%symmetry == MS_symmetric .or. header%symmetry == MS_hermitian) then + matrix%nnz = 2*nnz - n_diag elseif(header%symmetry == MS_skew_symmetric) then matrix%nnz = 2*nnz end if !----------------------------------------- - ! Read actual matrix data + ! Fill in matrix entries from temporary arrays call matrix%malloc( matrix%nrows, matrix%ncols, matrix%nnz ) - do i = 1, nnz ! read entries from file - matrix%index(1,i) = to_num_from_stream(ffp, matrix%index(1,i), stat) - matrix%index(2,i) = to_num_from_stream(ffp, matrix%index(2,i), stat) - #:if t.startswith('complex') - val_r = to_num_from_stream(ffp, mold, stat) - val_i = to_num_from_stream(ffp, mold, stat) - matrix%data(i) = complex( val_r, val_i ) - #:else - matrix%data(i) = to_num_from_stream(ffp, mold, stat) - #:endif + do i = 1, nnz + matrix%index(1,i) = rows(i) + matrix%index(2,i) = cols(i) + matrix%data(i) = vals(i) end do !----------------------------------------- @@ -294,8 +317,12 @@ contains do while( p Date: Thu, 15 Jan 2026 19:29:08 +0530 Subject: [PATCH 06/50] fixed subroutine name typo, coordinate write format and store lower triangle instead of upper --- src/stdlib_io_mm.fypp | 2 +- src/stdlib_io_mm_save.fypp | 22 ++++++++++++++-------- 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/src/stdlib_io_mm.fypp b/src/stdlib_io_mm.fypp index edd930e1d..6f2ebe6f0 100644 --- a/src/stdlib_io_mm.fypp +++ b/src/stdlib_io_mm.fypp @@ -74,7 +74,7 @@ module stdlib_io_mm #:endfor #:for k, t, s in RC_KINDS_TYPES - module subroutine save_coo_${s}$(filename, matrix, comment, symmetry, iostat, iomsg) + module subroutine save_mm_coo_${s}$(filename, matrix, comment, symmetry, iostat, iomsg) character(len=*), intent(in) :: filename type(COO_${s}$_type), intent(in) :: matrix character(len=*), intent(in), optional :: comment diff --git a/src/stdlib_io_mm_save.fypp b/src/stdlib_io_mm_save.fypp index 4f55d6771..9a4f5e7c0 100644 --- a/src/stdlib_io_mm_save.fypp +++ b/src/stdlib_io_mm_save.fypp @@ -214,17 +214,20 @@ contains matrix%nrows, matrix%ncols, matrix%nnz, comment, stat, msg) if (stat /= 0) exit catch - ! Write array format (column-major order) + ! Write coordinate format (row, column, value) if(symmetry_ == MM_GENERAL) then do i = 1, matrix%nnz #:if t.startswith('real') - write(io, '(ES24.16E3)', iostat=stat) matrix%data(i) + write(io, '(I0,1X,I0,1X,ES24.16E3)', iostat=stat) & + matrix%index(1,i), matrix%index(2,i), matrix%data(i) #:elif t.startswith('complex') real_part = real(matrix%data(i), kind=${k}$) imag_part = aimag(matrix%data(i)) - write(io, '(ES24.16E3,1X,ES24.16E3)', iostat=stat) real_part, imag_part + write(io, '(I0,1X,I0,1X,ES24.16E3,1X,ES24.16E3)', iostat=stat) & + matrix%index(1,i), matrix%index(2,i), real_part, imag_part #:elif t.startswith('integer') - write(io, '(I0)', iostat=stat) matrix%data(i) + write(io, '(I0,1X,I0,1X,I0)', iostat=stat) & + matrix%index(1,i), matrix%index(2,i), matrix%data(i) #:endif if (stat /= 0) then msg = "Error writing array element (" // to_string(i) // ")" @@ -235,15 +238,18 @@ contains ! For symmetric, skew-symmetric, hermitian matrices, only write the ! lower triangle (including diagonal) do i = 1, matrix%nnz - if(matrix%index(1,i) > matrix%index(2,i)) cycle + if(matrix%index(1,i) < matrix%index(2,i)) cycle #:if t.startswith('real') - write(io, '(ES24.16E3)', iostat=stat) matrix%data(i) + write(io, '(I0,1X,I0,1X,ES24.16E3)', iostat=stat) & + matrix%index(1,i), matrix%index(2,i), matrix%data(i) #:elif t.startswith('complex') real_part = real(matrix%data(i), kind=${k}$) imag_part = aimag(matrix%data(i)) - write(io, '(ES24.16E3,1X,ES24.16E3)', iostat=stat) real_part, imag_part + write(io, '(I0,1X,I0,1X,ES24.16E3,1X,ES24.16E3)', iostat=stat) & + matrix%index(1,i), matrix%index(2,i), real_part, imag_part #:elif t.startswith('integer') - write(io, '(I0)', iostat=stat) matrix%data(i) + write(io, '(I0,1X,I0,1X,I0)', iostat=stat) & + matrix%index(1,i), matrix%index(2,i), matrix%data(i) #:endif if (stat /= 0) then msg = "Error writing array element (" // to_string(i) // ")" From 7b78c6d11a4604d3ae73b144edda256e26c34c47 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Mon, 19 Jan 2026 12:45:07 +0530 Subject: [PATCH 07/50] added deallocation of temp arrays while reading mtx, calculation of nnz_to_write, expansion of matrix to other half in case of general and sparse_* --- src/stdlib_io_mm_load.fypp | 4 ++++ src/stdlib_io_mm_save.fypp | 45 +++++++++++++++++++++++++++++++++----- 2 files changed, 43 insertions(+), 6 deletions(-) diff --git a/src/stdlib_io_mm_load.fypp b/src/stdlib_io_mm_load.fypp index cb2f7f889..140589b63 100644 --- a/src/stdlib_io_mm_load.fypp +++ b/src/stdlib_io_mm_load.fypp @@ -229,6 +229,10 @@ contains matrix%data(i) = vals(i) end do + if(allocated(rows)) deallocate(rows) + if(allocated(cols)) deallocate(cols) + if(allocated(vals)) deallocate(vals) + !----------------------------------------- ! Fill in symmetric entries if needed if(header%symmetry==MS_general) return diff --git a/src/stdlib_io_mm_save.fypp b/src/stdlib_io_mm_save.fypp index 9a4f5e7c0..746bb7bd6 100644 --- a/src/stdlib_io_mm_save.fypp +++ b/src/stdlib_io_mm_save.fypp @@ -61,8 +61,8 @@ contains integer :: io, stat, i, j, nnz character(len=:), allocatable :: msg - character(len=32) :: field_type - character(len=32) :: symmetry_ + character(len=:), allocatable :: field_type + character(len=:), allocatable :: symmetry_ #:if t.startswith('complex') real(${k}$) :: real_part, imag_part #:endif @@ -174,13 +174,14 @@ contains !> Associated error message in case of non-zero status code character(len=:), allocatable, intent(out), optional :: iomsg - integer :: io, stat, i, j, nnz + integer :: io, stat, i, j, nnz_to_write character(len=:), allocatable :: msg - character(len=32) :: field_type - character(len=32) :: symmetry_ + character(len=:), allocatable :: field_type + character(len=:), allocatable :: symmetry_ #:if t.startswith('complex') real(${k}$) :: real_part, imag_part #:endif + logical :: expand = .false. io = open(filename, "w", iostat=stat) if (stat /= 0) then @@ -209,9 +210,24 @@ contains #:endif catch: block + ! Calculate the nnz to write inside mtx file + if (symmetry_ == MM_GENERAL) then + if (matrix%storage == sparse_lower .or. matrix%storage == sparse_upper) then + nnz_to_write = 2*matrix%nnz - count(matrix%index(1,:) == matrix%index(2,:)) + expand = .true. + else + nnz_to_write = matrix%nnz + end if + else + if (matrix%storage == sparse_full) then + nnz_to_write = count(matrix%index(1,:) >= matrix%index(2,:)) + else + nnz_to_write = matrix%nnz + end if + end if ! Write header call write_mm_header(io, MM_COORDINATE, field_type, symmetry_, & - matrix%nrows, matrix%ncols, matrix%nnz, comment, stat, msg) + matrix%nrows, matrix%ncols, nnz_to_write, comment, stat, msg) if (stat /= 0) exit catch ! Write coordinate format (row, column, value) @@ -229,6 +245,23 @@ contains write(io, '(I0,1X,I0,1X,I0)', iostat=stat) & matrix%index(1,i), matrix%index(2,i), matrix%data(i) #:endif + + ! For sparse_lower or sparse_upper matrices with general as symmetry argument, expand the other half assuming symmetry + if (expand) then + if(matrix%index(1,i) /= matrix%index(2,i)) then + #:if t.startswith('real') + write(io, '(I0,1X,I0,1X,ES24.16E3)', iostat=stat) & + matrix%index(2,i), matrix%index(1,i), matrix%data(i) + #:elif t.startswith('complex') + write(io, '(I0,1X,I0,1X,ES24.16E3,1X,ES24.16E3)', iostat=stat) & + matrix%index(2,i), matrix%index(1,i), & + real(matrix%data(i), kind=${k}$), aimag(matrix%data(i)) + #:elif t.startswith('integer') + write(io, '(I0,1X,I0,1X,I0)', iostat=stat) & + matrix%index(2,i), matrix%index(1,i), matrix%data(i) + #:endif + end if + end if if (stat /= 0) then msg = "Error writing array element (" // to_string(i) // ")" exit catch From 7189b922a892212547ba788fe4245f588a953541 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Tue, 20 Jan 2026 15:35:11 +0530 Subject: [PATCH 08/50] moved initialization of expand variable to a new line --- src/stdlib_io_mm_save.fypp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/stdlib_io_mm_save.fypp b/src/stdlib_io_mm_save.fypp index 746bb7bd6..e25bd3872 100644 --- a/src/stdlib_io_mm_save.fypp +++ b/src/stdlib_io_mm_save.fypp @@ -181,8 +181,9 @@ contains #:if t.startswith('complex') real(${k}$) :: real_part, imag_part #:endif - logical :: expand = .false. + logical :: expand + expand = .false. io = open(filename, "w", iostat=stat) if (stat /= 0) then if (present(iostat)) then From 694c0f30d28e2ba68a3597503c53bfdf15ffe061 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Thu, 22 Jan 2026 14:55:37 +0530 Subject: [PATCH 09/50] changed COMPLEX() to cmplx() inside load function --- src/stdlib_io_mm_load.fypp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_io_mm_load.fypp b/src/stdlib_io_mm_load.fypp index 140589b63..a7869025e 100644 --- a/src/stdlib_io_mm_load.fypp +++ b/src/stdlib_io_mm_load.fypp @@ -110,7 +110,7 @@ contains #:if t.startswith('complex') val_r = to_num_from_stream(ffp, mold, stat) val_i = to_num_from_stream(ffp, mold, stat) - matrix(i,j) = complex( val_r, val_i ) + matrix(i,j) = cmplx(val_r, val_i, kind = ${k}$) #:else matrix(i,j) = to_num_from_stream(ffp, mold, stat) #:endif @@ -205,7 +205,7 @@ contains #:if t.startswith('complex') val_r = to_num_from_stream(ffp, mold, stat) val_i = to_num_from_stream(ffp, mold, stat) - vals(i) = complex( val_r, val_i) + vals(i) = cmplx(val_r, val_i, kind = ${k}$) #:else vals(i) = to_num_from_stream(ffp, mold, stat) #:endif From 4aa2fad6820ecb8b9380821b25af160034af92fe Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Fri, 23 Jan 2026 18:30:38 +0100 Subject: [PATCH 10/50] move files according to new folder structure --- src/io/CMakeLists.txt | 5 ++++- src/{ => io}/stdlib_io_mm.fypp | 0 src/{ => io}/stdlib_io_mm_load.fypp | 0 src/{ => io}/stdlib_io_mm_save.fypp | 0 4 files changed, 4 insertions(+), 1 deletion(-) rename src/{ => io}/stdlib_io_mm.fypp (100%) rename src/{ => io}/stdlib_io_mm_load.fypp (100%) rename src/{ => io}/stdlib_io_mm_save.fypp (100%) diff --git a/src/io/CMakeLists.txt b/src/io/CMakeLists.txt index 0ea7bb165..f86863a70 100644 --- a/src/io/CMakeLists.txt +++ b/src/io/CMakeLists.txt @@ -3,6 +3,9 @@ set(io_fppFiles stdlib_io_npy.fypp stdlib_io_npy_load.fypp stdlib_io_npy_save.fypp + stdlib_io_mm.fypp + stdlib_io_mm_load.fypp + stdlib_io_mm_save.fypp ) set(io_cppFiles @@ -13,4 +16,4 @@ set(io_f90Files configure_stdlib_target(io io_f90Files io_fppFiles io_cppFiles) -target_link_libraries(io PUBLIC core strings) +target_link_libraries(io PUBLIC core strings sparse) diff --git a/src/stdlib_io_mm.fypp b/src/io/stdlib_io_mm.fypp similarity index 100% rename from src/stdlib_io_mm.fypp rename to src/io/stdlib_io_mm.fypp diff --git a/src/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp similarity index 100% rename from src/stdlib_io_mm_load.fypp rename to src/io/stdlib_io_mm_load.fypp diff --git a/src/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp similarity index 100% rename from src/stdlib_io_mm_save.fypp rename to src/io/stdlib_io_mm_save.fypp From a8d988a57da6801dfa0a310fa053522212edc8f2 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Mon, 26 Jan 2026 19:45:20 +0530 Subject: [PATCH 11/50] changed from COO sparse matrix to plain arrays --- example/io/example_matrix_market.f90 | 12 ++--- src/io/stdlib_io_mm.fypp | 14 ++--- src/io/stdlib_io_mm_load.fypp | 64 ++++++++++++---------- src/io/stdlib_io_mm_save.fypp | 79 ++++++++++------------------ 4 files changed, 78 insertions(+), 91 deletions(-) diff --git a/example/io/example_matrix_market.f90 b/example/io/example_matrix_market.f90 index b13af3825..ce0940122 100644 --- a/example/io/example_matrix_market.f90 +++ b/example/io/example_matrix_market.f90 @@ -1,11 +1,11 @@ program example_matrix_market use stdlib_io_mm, only : load_mm, save_mm, mm_header_type use stdlib_kinds, only : dp - use stdlib_sparse_kinds, only : COO_dp_type implicit none real(dp), allocatable :: matrix(:,:), matrix2(:,:) - type(COO_dp_type) :: sparse_matrix + integer, allocatable :: index(:,:) + real(dp), allocatable :: data(:) character(len=*), parameter :: dense_filename = "test_dense.mtx" character(len=*), parameter :: sparse_filename = "test_sparse.mtx" integer :: iostat, i @@ -47,18 +47,16 @@ program example_matrix_market print *, "Loading sparse matrix from ", sparse_filename ! Load sparse matrix from Matrix Market file - call load_mm(sparse_filename, sparse_matrix, iostat=iostat, iomsg=iomsg) + call load_mm(sparse_filename, index, data, iostat=iostat, iomsg=iomsg) if (iostat /= 0) then print *, "Error loading sparse matrix: ", iomsg stop 1 end if print *, "Loaded sparse matrix (COO format):" - print *, "Dimensions: ", sparse_matrix%nrows, "x", sparse_matrix%ncols - print *, "Non-zeros: ", sparse_matrix%nnz print *, "Data (row, col, value):" - do i = 1, sparse_matrix%nnz - print *, sparse_matrix%index(1,i), sparse_matrix%index(2,i), sparse_matrix%data(i) + do i = 1, size(data) + print *, index(1,i), index(2,i), data(i) end do contains diff --git a/src/io/stdlib_io_mm.fypp b/src/io/stdlib_io_mm.fypp index 6f2ebe6f0..68f951371 100644 --- a/src/io/stdlib_io_mm.fypp +++ b/src/io/stdlib_io_mm.fypp @@ -13,7 +13,6 @@ !> For more information, see: https://math.nist.gov/MatrixMarket/formats.html module stdlib_io_mm use stdlib_kinds, only : int8, int16, int32, int64, sp, dp, xdp, qp - use stdlib_sparse_kinds implicit none private @@ -43,11 +42,13 @@ module stdlib_io_mm end subroutine #:endfor #:for k, t, s in RC_KINDS_TYPES - module subroutine load_mm_coo_${s}$(filename, matrix, iostat, iomsg) + module subroutine load_mm_coo_${s}$(filename, index, data, iostat, iomsg) !> Name of the Matrix Market file to load from character(len=*), intent(in) :: filename - !> Matrix to be loaded from the Matrix Market file - type(COO_${s}$_type), intent(out) :: matrix + !> Matrix indices to be read to the Matrix Market file + integer, allocatable, intent(out) :: index(:,:) + !> Matrix data to be read to the Matrix Market file + ${t}$, allocatable, intent(out) :: data(:) !> Error status of loading, zero on success integer, intent(out), optional :: iostat !> Associated error message in case of non-zero status code @@ -74,9 +75,10 @@ module stdlib_io_mm #:endfor #:for k, t, s in RC_KINDS_TYPES - module subroutine save_mm_coo_${s}$(filename, matrix, comment, symmetry, iostat, iomsg) + module subroutine save_mm_coo_${s}$(filename, index, data, comment, symmetry, iostat, iomsg) character(len=*), intent(in) :: filename - type(COO_${s}$_type), intent(in) :: matrix + integer, intent(in) :: index(:,:) + ${t}$, intent(in) :: data(:) character(len=*), intent(in), optional :: comment character(len=*), intent(in), optional :: symmetry integer, intent(out), optional :: iostat diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index a7869025e..2c3e60fdc 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -121,11 +121,14 @@ contains #:endfor #:for k, t, s in RC_KINDS_TYPES - module subroutine load_mm_coo_${s}$(filename, matrix, iostat, iomsg) + module subroutine load_mm_coo_${s}$(filename, index, data, iostat, iomsg) !> Name of the Matrix Market file to load from character(len=*), intent(in) :: filename - !> Matrix to be loaded from the Matrix Market file - type(COO_${s}$_type), intent(out) :: matrix + !> Matrix indices in COO format read from the file: + !> index(1, :) = row indices, index(2, :) = column indices + integer, allocatable, intent(out) :: index(:, :) + !> Nonzero matrix values corresponding to each (row, column) index pair + ${t}$, allocatable, intent(out) :: data(:) !> Error status of loading, zero on success integer, intent(out), optional :: iostat !> Associated error message in case of non-zero status code @@ -134,13 +137,13 @@ contains ! Internal variables type(mm_header_type) :: header integer :: u , fsze, err, eol_position - integer :: i, j, nnz, adr + integer :: i, nnz, adr integer(int8) :: stat character(:), allocatable, target :: ff character(len=:), pointer :: ffp integer, allocatable :: rows(:), cols(:) ${t}$, allocatable :: vals(:) - integer :: n_diag + integer :: nrows, ncols, n_diag #:if t.startswith('complex') real(${k}$) :: mold, val_r, val_i #:else @@ -184,13 +187,15 @@ contains !----------------------------------------- ! Read matrix dimensions - matrix%nrows = to_num_from_stream(ffp, matrix%nrows, stat) + nrows = to_num_from_stream(ffp, nrows, stat) if( stat /= 0 ) return - matrix%ncols = to_num_from_stream(ffp, matrix%ncols, stat) + ncols = to_num_from_stream(ffp, ncols, stat) if( stat /= 0 ) return nnz = to_num_from_stream(ffp, nnz, stat) if( stat /= 0 ) return + !----------------------------------------- + ! Allocate temporary arrays to hold the file data allocate(rows(nnz)) allocate(cols(nnz)) allocate(vals(nnz)) @@ -213,20 +218,24 @@ contains !----------------------------------------- ! check storage hypothesis - matrix%nnz = nnz if(header%symmetry == MS_symmetric .or. header%symmetry == MS_hermitian) then - matrix%nnz = 2*nnz - n_diag - elseif(header%symmetry == MS_skew_symmetric) then - matrix%nnz = 2*nnz + allocate(index(2, 2*nnz-n_diag)) + allocate(data(2*nnz-n_diag)) + else if(header%symmetry == MS_skew_symmetric) then + allocate(index(2, 2*nnz)) + allocate(data(2*nnz)) + else + allocate(index(2, nnz)) + allocate(data(nnz)) end if + !----------------------------------------- ! Fill in matrix entries from temporary arrays - call matrix%malloc( matrix%nrows, matrix%ncols, matrix%nnz ) do i = 1, nnz - matrix%index(1,i) = rows(i) - matrix%index(2,i) = cols(i) - matrix%data(i) = vals(i) + index(1,i) = rows(i) + index(2,i) = cols(i) + data(i) = vals(i) end do if(allocated(rows)) deallocate(rows) @@ -236,19 +245,18 @@ contains !----------------------------------------- ! Fill in symmetric entries if needed if(header%symmetry==MS_general) return - adr = 1 - do i = 1, nnz - if(matrix%index(1,i)==matrix%index(2,i)) cycle - matrix%index(1,nnz+adr) = matrix%index(2,i) - matrix%index(2,nnz+adr) = matrix%index(1,i) - matrix%data(nnz+adr) = matrix%data(i) - if(header%symmetry==MS_skew_symmetric) matrix%data(nnz+adr) = -matrix%data(i) - #:if t.startswith('complex') - if(header%symmetry==MS_hermitian) matrix%data(nnz+adr) = conjg(matrix%data(i)) - #:endif - adr = adr + 1 - end do - + adr = 1 + do i = 1, nnz + if(index(1,i)==index(2,i)) cycle + index(1,nnz+adr) = index(2,i) + index(2,nnz+adr) = index(1,i) + data(nnz+adr) = data(i) + if(header%symmetry==MS_skew_symmetric) data(nnz+adr) = -data(i) + #:if t.startswith('complex') + if(header%symmetry==MS_hermitian) data(nnz+adr) = conjg(data(i)) + #:endif + adr = adr + 1 + end do end subroutine #:endfor diff --git a/src/io/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp index e25bd3872..8614e70ab 100644 --- a/src/io/stdlib_io_mm_save.fypp +++ b/src/io/stdlib_io_mm_save.fypp @@ -160,11 +160,14 @@ contains #:endfor #:for k, t, s in RC_KINDS_TYPES - module subroutine save_mm_coo_${s}$(filename, matrix, comment, symmetry, iostat, iomsg) + module subroutine save_mm_coo_${s}$(filename, index, data, comment, symmetry, iostat, iomsg) !> Name of the Matrix Market file to save to character(len=*), intent(in) :: filename - !> Matrix to be saved to the Matrix Market file - type(COO_${s}$_type), intent(in) :: matrix + !> Matrix indices in COO format to be written to the file: + !> index(1, :) = row indices, index(2, :) = column indices + integer, intent(in) :: index(:, :) + !> Nonzero matrix values corresponding to each (row, column) index pair + ${t}$, intent(in) :: data(:) !> Optional comment information character(len=*), intent(in), optional :: comment !> Symmetry type of the matrix (general, symmetric, skew-symmetric, hermitian) @@ -174,16 +177,13 @@ contains !> Associated error message in case of non-zero status code character(len=:), allocatable, intent(out), optional :: iomsg - integer :: io, stat, i, j, nnz_to_write + integer :: io, stat, i, nnz_to_write character(len=:), allocatable :: msg character(len=:), allocatable :: field_type character(len=:), allocatable :: symmetry_ #:if t.startswith('complex') real(${k}$) :: real_part, imag_part #:endif - logical :: expand - - expand = .false. io = open(filename, "w", iostat=stat) if (stat /= 0) then if (present(iostat)) then @@ -195,6 +195,8 @@ contains end if end if + if(size(index, dim=1)/=2) return + ! Determine symmetry type symmetry_ = "general" if (present(symmetry)) then @@ -213,56 +215,32 @@ contains catch: block ! Calculate the nnz to write inside mtx file if (symmetry_ == MM_GENERAL) then - if (matrix%storage == sparse_lower .or. matrix%storage == sparse_upper) then - nnz_to_write = 2*matrix%nnz - count(matrix%index(1,:) == matrix%index(2,:)) - expand = .true. - else - nnz_to_write = matrix%nnz - end if + nnz_to_write = size(index, dim=2) + else if(symmetry_ == MM_SKEW_SYMMETRIC) then + nnz_to_write = count(index(1,:) > index(2,:)) else - if (matrix%storage == sparse_full) then - nnz_to_write = count(matrix%index(1,:) >= matrix%index(2,:)) - else - nnz_to_write = matrix%nnz - end if + nnz_to_write = count(index(1,:) >= index(2,:)) end if ! Write header call write_mm_header(io, MM_COORDINATE, field_type, symmetry_, & - matrix%nrows, matrix%ncols, nnz_to_write, comment, stat, msg) + maxval(index(1,:)), maxval(index(2,:)), nnz_to_write, comment, stat, msg) if (stat /= 0) exit catch ! Write coordinate format (row, column, value) if(symmetry_ == MM_GENERAL) then - do i = 1, matrix%nnz + do i = 1, nnz_to_write #:if t.startswith('real') write(io, '(I0,1X,I0,1X,ES24.16E3)', iostat=stat) & - matrix%index(1,i), matrix%index(2,i), matrix%data(i) + index(1,i), index(2,i), data(i) #:elif t.startswith('complex') - real_part = real(matrix%data(i), kind=${k}$) - imag_part = aimag(matrix%data(i)) + real_part = real(data(i), kind=${k}$) + imag_part = aimag(data(i)) write(io, '(I0,1X,I0,1X,ES24.16E3,1X,ES24.16E3)', iostat=stat) & - matrix%index(1,i), matrix%index(2,i), real_part, imag_part + index(1,i), index(2,i), real_part, imag_part #:elif t.startswith('integer') write(io, '(I0,1X,I0,1X,I0)', iostat=stat) & - matrix%index(1,i), matrix%index(2,i), matrix%data(i) + index(1,i), index(2,i), data(i) #:endif - - ! For sparse_lower or sparse_upper matrices with general as symmetry argument, expand the other half assuming symmetry - if (expand) then - if(matrix%index(1,i) /= matrix%index(2,i)) then - #:if t.startswith('real') - write(io, '(I0,1X,I0,1X,ES24.16E3)', iostat=stat) & - matrix%index(2,i), matrix%index(1,i), matrix%data(i) - #:elif t.startswith('complex') - write(io, '(I0,1X,I0,1X,ES24.16E3,1X,ES24.16E3)', iostat=stat) & - matrix%index(2,i), matrix%index(1,i), & - real(matrix%data(i), kind=${k}$), aimag(matrix%data(i)) - #:elif t.startswith('integer') - write(io, '(I0,1X,I0,1X,I0)', iostat=stat) & - matrix%index(2,i), matrix%index(1,i), matrix%data(i) - #:endif - end if - end if if (stat /= 0) then msg = "Error writing array element (" // to_string(i) // ")" exit catch @@ -270,20 +248,21 @@ contains end do else ! For symmetric, skew-symmetric, hermitian matrices, only write the - ! lower triangle (including diagonal) - do i = 1, matrix%nnz - if(matrix%index(1,i) < matrix%index(2,i)) cycle + ! lower triangle + do i = 1, size(index, dim=2) + if(index(1,i) < index(2,i)) cycle + if(symmetry_ == MM_SKEW_SYMMETRIC .and. index(1,i) == index(2,i)) cycle #:if t.startswith('real') write(io, '(I0,1X,I0,1X,ES24.16E3)', iostat=stat) & - matrix%index(1,i), matrix%index(2,i), matrix%data(i) + index(1,i), index(2,i), data(i) #:elif t.startswith('complex') - real_part = real(matrix%data(i), kind=${k}$) - imag_part = aimag(matrix%data(i)) + real_part = real(data(i), kind=${k}$) + imag_part = aimag(data(i)) write(io, '(I0,1X,I0,1X,ES24.16E3,1X,ES24.16E3)', iostat=stat) & - matrix%index(1,i), matrix%index(2,i), real_part, imag_part + index(1,i), index(2,i), real_part, imag_part #:elif t.startswith('integer') write(io, '(I0,1X,I0,1X,I0)', iostat=stat) & - matrix%index(1,i), matrix%index(2,i), matrix%data(i) + index(1,i), index(2,i), data(i) #:endif if (stat /= 0) then msg = "Error writing array element (" // to_string(i) // ")" From c0351f3a2021d6eb6a607dfb122911239bb5c7ae Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Tue, 27 Jan 2026 00:19:26 +0530 Subject: [PATCH 12/50] add format specifier and integer subroutines for saving and loading --- src/io/stdlib_io_mm.fypp | 17 ++++---- src/io/stdlib_io_mm_load.fypp | 7 ++-- src/io/stdlib_io_mm_save.fypp | 74 ++++++++++++++++++++++++++--------- 3 files changed, 70 insertions(+), 28 deletions(-) diff --git a/src/io/stdlib_io_mm.fypp b/src/io/stdlib_io_mm.fypp index 68f951371..e6f83a7db 100644 --- a/src/io/stdlib_io_mm.fypp +++ b/src/io/stdlib_io_mm.fypp @@ -3,7 +3,8 @@ #:include "common.fypp" #:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) #:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX)) -#:set RC_KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES +#:set I_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES, INT_KINDS)) +#:set RCI_KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + I_KINDS_TYPES !> The Matrix Market (MM) format is a simple, human-readable, ASCII format for sparse !> and dense matrices. The format was developed at NIST (National Institute of Standards @@ -29,7 +30,7 @@ module stdlib_io_mm !> Load a matrix from a Matrix Market file !> ([Specification](../page/specs/stdlib_io.html#load_mm)) interface load_mm - #:for k, t, s in RC_KINDS_TYPES + #:for k, t, s in RCI_KINDS_TYPES module subroutine load_mm_dense_${s}$(filename, matrix, iostat, iomsg) !> Name of the Matrix Market file to load from character(len=*), intent(in) :: filename @@ -41,7 +42,7 @@ module stdlib_io_mm character(len=:), allocatable, intent(out), optional :: iomsg end subroutine #:endfor - #:for k, t, s in RC_KINDS_TYPES + #:for k, t, s in RCI_KINDS_TYPES module subroutine load_mm_coo_${s}$(filename, index, data, iostat, iomsg) !> Name of the Matrix Market file to load from character(len=*), intent(in) :: filename @@ -63,23 +64,25 @@ module stdlib_io_mm !> Save a matrix to a Matrix Market file !> ([Specification](../page/specs/stdlib_io.html#save_mm)) interface save_mm - #:for k, t, s in RC_KINDS_TYPES - module subroutine save_mm_dense_${s}$(filename, matrix, comment, symmetry, iostat, iomsg) + #:for k, t, s in RCI_KINDS_TYPES + module subroutine save_mm_dense_${s}$(filename, matrix, comment, format, symmetry, iostat, iomsg) character(len=*), intent(in) :: filename ${t}$, intent(in) :: matrix(:,:) character(len=*), intent(in), optional :: comment + character(len=*), intent(in), optional :: format character(len=*), intent(in), optional :: symmetry integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg end subroutine #:endfor - #:for k, t, s in RC_KINDS_TYPES - module subroutine save_mm_coo_${s}$(filename, index, data, comment, symmetry, iostat, iomsg) + #:for k, t, s in RCI_KINDS_TYPES + module subroutine save_mm_coo_${s}$(filename, index, data, comment, format, symmetry, iostat, iomsg) character(len=*), intent(in) :: filename integer, intent(in) :: index(:,:) ${t}$, intent(in) :: data(:) character(len=*), intent(in), optional :: comment + character(len=*), intent(in), optional :: format character(len=*), intent(in), optional :: symmetry integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index 2c3e60fdc..0e4eaaf36 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -3,7 +3,8 @@ #:include "common.fypp" #:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) #:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX)) -#:set RC_KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES +#:set I_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES, INT_KINDS)) +#:set RCI_KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + I_KINDS_TYPES submodule (stdlib_io_mm) stdlib_io_mm_load use stdlib_error, only : error_stop @@ -35,7 +36,7 @@ submodule (stdlib_io_mm) stdlib_io_mm_load contains - #:for k, t, s in RC_KINDS_TYPES + #:for k, t, s in RCI_KINDS_TYPES module subroutine load_mm_dense_${s}$(filename, matrix, iostat, iomsg) !> Name of the Matrix Market file to load from character(len=*), intent(in) :: filename @@ -120,7 +121,7 @@ contains end subroutine #:endfor - #:for k, t, s in RC_KINDS_TYPES + #:for k, t, s in RCI_KINDS_TYPES module subroutine load_mm_coo_${s}$(filename, index, data, iostat, iomsg) !> Name of the Matrix Market file to load from character(len=*), intent(in) :: filename diff --git a/src/io/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp index 8614e70ab..53ed84314 100644 --- a/src/io/stdlib_io_mm_save.fypp +++ b/src/io/stdlib_io_mm_save.fypp @@ -3,7 +3,8 @@ #:include "common.fypp" #:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) #:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX)) -#:set RC_KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES +#:set I_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES, INT_KINDS)) +#:set RCI_KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + I_KINDS_TYPES !> Implementation for saving multidimensional arrays to Matrix Market files submodule (stdlib_io_mm) stdlib_io_mm_save @@ -11,7 +12,7 @@ submodule (stdlib_io_mm) stdlib_io_mm_save use stdlib_strings, only : to_string use stdlib_io, only : open use stdlib_ascii, only : to_lower - use stdlib_constants, only : #{for k, t, s in RC_KINDS_TYPES[:-1]}#zero_${k}$, #{endfor}#zero_${RC_KINDS_TYPES[-1][0]}$ + use stdlib_constants, only : #{for k, t, s in RCI_KINDS_TYPES[:-1]}#zero_${k}$, #{endfor}#zero_${RCI_KINDS_TYPES[-1][0]}$ implicit none ! Matrix Market format constants @@ -44,14 +45,16 @@ submodule (stdlib_io_mm) stdlib_io_mm_save contains - #:for k, t, s in RC_KINDS_TYPES - module subroutine save_mm_dense_${s}$(filename, matrix, comment, symmetry, iostat, iomsg) + #:for k, t, s in RCI_KINDS_TYPES + module subroutine save_mm_dense_${s}$(filename, matrix, comment, format, symmetry, iostat, iomsg) !> Name of the Matrix Market file to save to character(len=*), intent(in) :: filename !> Matrix to be saved to the Matrix Market file ${t}$, intent(in) :: matrix(:,:) !> Optional comment information character(len=*), intent(in), optional :: comment + !> Format in which matrix data needs to be stored + character(len=*), intent(in), optional :: format !> Symmetry type of the matrix (general, symmetric, skew-symmetric, hermitian) character(len=*), intent(in), optional :: symmetry !> Error status of saving, zero on success @@ -62,11 +65,27 @@ contains integer :: io, stat, i, j, nnz character(len=:), allocatable :: msg character(len=:), allocatable :: field_type + character(len=:), allocatable :: fmt_ character(len=:), allocatable :: symmetry_ #:if t.startswith('complex') real(${k}$) :: real_part, imag_part #:endif + #:if t.startswith('integer') + fmt_ = "I0" + #:else + fmt_ = "ES24.16E3" + #:endif + if(present(format)) fmt_ = format + + #:if t.startswith('real') + fmt_ = '(' // fmt_ //')' + #:elif t.startswith('complex') + fmt_ = '(' // fmt_ //',1X,'// fmt_ //')' + #:elif t.startswith('integer') + fmt_ = '('// fmt_ //')' + #:endif + io = open(filename, "w", iostat=stat) if (stat /= 0) then if (present(iostat)) then @@ -104,13 +123,13 @@ contains do j = 1, size(matrix, 2) do i = 1, size(matrix, 1) #:if t.startswith('real') - write(io, '(ES24.16E3)', iostat=stat) matrix(i, j) + write(io, fmt=fmt_, iostat=stat) matrix(i, j) #:elif t.startswith('complex') real_part = real(matrix(i, j), kind=${k}$) imag_part = aimag(matrix(i, j)) - write(io, '(ES24.16E3,1X,ES24.16E3)', iostat=stat) real_part, imag_part + write(io, fmt=fmt_, iostat=stat) real_part, imag_part #:elif t.startswith('integer') - write(io, '(I0)', iostat=stat) matrix(i, j) + write(io, fmt=fmt_, iostat=stat) matrix(i, j) #:endif if (stat /= 0) then msg = "Error writing array element (" // & @@ -125,13 +144,13 @@ contains do j = 1, size(matrix, 2) do i = j, size(matrix, 1) #:if t.startswith('real') - write(io, '(ES24.16E3)', iostat=stat) matrix(i, j) + write(io, fmt=fmt_, iostat=stat) matrix(i, j) #:elif t.startswith('complex') real_part = real(matrix(i, j), kind=${k}$) imag_part = aimag(matrix(i, j)) - write(io, '(ES24.16E3,1X,ES24.16E3)', iostat=stat) real_part, imag_part + write(io, fmt=fmt_, iostat=stat) real_part, imag_part #:elif t.startswith('integer') - write(io, '(I0)', iostat=stat) matrix(i, j) + write(io, fmt=fmt_, iostat=stat) matrix(i, j) #:endif if (stat /= 0) then msg = "Error writing array element (" // & @@ -159,8 +178,8 @@ contains end subroutine #:endfor - #:for k, t, s in RC_KINDS_TYPES - module subroutine save_mm_coo_${s}$(filename, index, data, comment, symmetry, iostat, iomsg) + #:for k, t, s in RCI_KINDS_TYPES + module subroutine save_mm_coo_${s}$(filename, index, data, comment, format, symmetry, iostat, iomsg) !> Name of the Matrix Market file to save to character(len=*), intent(in) :: filename !> Matrix indices in COO format to be written to the file: @@ -170,6 +189,8 @@ contains ${t}$, intent(in) :: data(:) !> Optional comment information character(len=*), intent(in), optional :: comment + !> Format in which matrix data needs to be stored + character(len=*), intent(in), optional :: format !> Symmetry type of the matrix (general, symmetric, skew-symmetric, hermitian) character(len=*), intent(in), optional :: symmetry !> Error status of saving, zero on success @@ -180,10 +201,27 @@ contains integer :: io, stat, i, nnz_to_write character(len=:), allocatable :: msg character(len=:), allocatable :: field_type + character(len=:), allocatable :: fmt_ character(len=:), allocatable :: symmetry_ #:if t.startswith('complex') real(${k}$) :: real_part, imag_part #:endif + + #:if t.startswith('integer') + fmt_ = "I0" + #:else + fmt_ = "ES24.16E3" + #:endif + if(present(format)) fmt_ = format + + #:if t.startswith('real') + fmt_ = '(I0,1X,I0,1X,' // fmt_ //')' + #:elif t.startswith('complex') + fmt_ = '(I0,1X,I0,1X,' // fmt_//',1X,'//fmt_//')' + #:elif t.startswith('integer') + fmt_ = '(I0,1X,I0,1X,'// fmt_ //')' + #:endif + io = open(filename, "w", iostat=stat) if (stat /= 0) then if (present(iostat)) then @@ -230,15 +268,15 @@ contains if(symmetry_ == MM_GENERAL) then do i = 1, nnz_to_write #:if t.startswith('real') - write(io, '(I0,1X,I0,1X,ES24.16E3)', iostat=stat) & + write(io, fmt=fmt_, iostat=stat) & index(1,i), index(2,i), data(i) #:elif t.startswith('complex') real_part = real(data(i), kind=${k}$) imag_part = aimag(data(i)) - write(io, '(I0,1X,I0,1X,ES24.16E3,1X,ES24.16E3)', iostat=stat) & + write(io, fmt=fmt_, iostat=stat) & index(1,i), index(2,i), real_part, imag_part #:elif t.startswith('integer') - write(io, '(I0,1X,I0,1X,I0)', iostat=stat) & + write(io, fmt=fmt_, iostat=stat) & index(1,i), index(2,i), data(i) #:endif if (stat /= 0) then @@ -253,15 +291,15 @@ contains if(index(1,i) < index(2,i)) cycle if(symmetry_ == MM_SKEW_SYMMETRIC .and. index(1,i) == index(2,i)) cycle #:if t.startswith('real') - write(io, '(I0,1X,I0,1X,ES24.16E3)', iostat=stat) & + write(io, fmt=fmt_, iostat=stat) & index(1,i), index(2,i), data(i) #:elif t.startswith('complex') real_part = real(data(i), kind=${k}$) imag_part = aimag(data(i)) - write(io, '(I0,1X,I0,1X,ES24.16E3,1X,ES24.16E3)', iostat=stat) & + write(io, fmt=fmt_, iostat=stat) & index(1,i), index(2,i), real_part, imag_part #:elif t.startswith('integer') - write(io, '(I0,1X,I0,1X,I0)', iostat=stat) & + write(io, fmt=fmt_, iostat=stat) & index(1,i), index(2,i), data(i) #:endif if (stat /= 0) then From 014b6447bc8fa440f120d814c6022907250f2fb4 Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Tue, 27 Jan 2026 15:40:28 +0100 Subject: [PATCH 13/50] fix dependencies --- src/io/CMakeLists.txt | 2 +- src/io/stdlib_io_mm_load.fypp | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/io/CMakeLists.txt b/src/io/CMakeLists.txt index f86863a70..a48388fc9 100644 --- a/src/io/CMakeLists.txt +++ b/src/io/CMakeLists.txt @@ -16,4 +16,4 @@ set(io_f90Files configure_stdlib_target(io io_f90Files io_fppFiles io_cppFiles) -target_link_libraries(io PUBLIC core strings sparse) +target_link_libraries(io PUBLIC core constants strings) diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index 0e4eaaf36..7a7382eb2 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -11,7 +11,6 @@ submodule (stdlib_io_mm) stdlib_io_mm_load use stdlib_strings, only : to_string, starts_with use stdlib_str2num, only: to_num_from_stream use stdlib_kinds - use stdlib_sparse_kinds implicit none From 8a9ffb933e090f6376ba74d92ae0f99c7b61c746 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Alves?= <102541118+jalvesz@users.noreply.github.com> Date: Thu, 29 Jan 2026 21:16:17 +0100 Subject: [PATCH 14/50] Update src/io/stdlib_io_mm.fypp Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- src/io/stdlib_io_mm.fypp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/io/stdlib_io_mm.fypp b/src/io/stdlib_io_mm.fypp index e6f83a7db..6b2719ae2 100644 --- a/src/io/stdlib_io_mm.fypp +++ b/src/io/stdlib_io_mm.fypp @@ -46,9 +46,9 @@ module stdlib_io_mm module subroutine load_mm_coo_${s}$(filename, index, data, iostat, iomsg) !> Name of the Matrix Market file to load from character(len=*), intent(in) :: filename - !> Matrix indices to be read to the Matrix Market file + !> Matrix indices to be read from the Matrix Market file integer, allocatable, intent(out) :: index(:,:) - !> Matrix data to be read to the Matrix Market file + !> Matrix data to be read from the Matrix Market file ${t}$, allocatable, intent(out) :: data(:) !> Error status of loading, zero on success integer, intent(out), optional :: iostat From 0c332053e0fd07f79720fa869118004eaea8164c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Alves?= <102541118+jalvesz@users.noreply.github.com> Date: Thu, 29 Jan 2026 21:21:43 +0100 Subject: [PATCH 15/50] Update example/io/example_matrix_market.f90 Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- example/io/example_matrix_market.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example/io/example_matrix_market.f90 b/example/io/example_matrix_market.f90 index ce0940122..ae6de6839 100644 --- a/example/io/example_matrix_market.f90 +++ b/example/io/example_matrix_market.f90 @@ -1,5 +1,5 @@ program example_matrix_market - use stdlib_io_mm, only : load_mm, save_mm, mm_header_type + use stdlib_io_mm, only : load_mm, save_mm use stdlib_kinds, only : dp implicit none From 53d3ac3cf276d2ce0f5d659c8f43c4d20f9f7161 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Mon, 2 Feb 2026 22:40:35 +0530 Subject: [PATCH 16/50] fix: filling of upper triangular half incase of loading dense symmtry matrices, saving skew matrices with zero diag and hermitian with real diag elements --- src/io/stdlib_io_mm_load.fypp | 46 ++++++++++++++++++++++++++--------- src/io/stdlib_io_mm_save.fypp | 19 ++++++++++----- 2 files changed, 48 insertions(+), 17 deletions(-) diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index 7a7382eb2..f609dab47 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -104,19 +104,43 @@ contains !----------------------------------------- ! Read actual matrix data allocate(matrix(nrows, ncols), stat=err) + matrix = 0 if( err /= 0 ) return - do j = 1, ncols - do i = 1, nrows - #:if t.startswith('complex') - val_r = to_num_from_stream(ffp, mold, stat) - val_i = to_num_from_stream(ffp, mold, stat) - matrix(i,j) = cmplx(val_r, val_i, kind = ${k}$) - #:else - matrix(i,j) = to_num_from_stream(ffp, mold, stat) - #:endif - if( stat /= 0 ) return + if(header%symmetry==MS_general) then + do j = 1, ncols + do i = 1, nrows + #:if t.startswith('complex') + val_r = to_num_from_stream(ffp, mold, stat) + val_i = to_num_from_stream(ffp, mold, stat) + matrix(i,j) = cmplx(val_r, val_i, kind = ${k}$) + #:else + matrix(i,j) = to_num_from_stream(ffp, mold, stat) + #:endif + if( stat /= 0 ) return + end do end do - end do + else + do j = 1, ncols + do i = j, nrows + ! Keep diagonal elements as zero incase of skew-symmetric cases + if(header%symmetry==MS_skew_symmetric .and. i==j) cycle + #:if t.startswith('complex') + val_r = to_num_from_stream(ffp, mold, stat) + val_i = to_num_from_stream(ffp, mold, stat) + matrix(i,j) = cmplx(val_r, val_i, kind = ${k}$) + #:else + matrix(i,j) = to_num_from_stream(ffp, mold, stat) + #:endif + if( stat /= 0 ) return + ! Assign transpose of the current element + matrix(j, i) = matrix(i, j) + if(header%symmetry==MS_skew_symmetric) matrix(j, i) = -matrix(j, i) + #:if t.startswith('complex') + if(header%symmetry==MS_hermitian) matrix(j, i) = conjg(matrix(j, i)) + #:endif + end do + end do + end if end subroutine #:endfor diff --git a/src/io/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp index 53ed84314..43e4b3878 100644 --- a/src/io/stdlib_io_mm_save.fypp +++ b/src/io/stdlib_io_mm_save.fypp @@ -98,7 +98,7 @@ contains end if ! Determine symmetry type - symmetry_ = "general" + symmetry_ = MM_GENERAL if (present(symmetry)) then symmetry_ = to_lower(trim(symmetry)) end if @@ -139,15 +139,19 @@ contains end do end do else - ! For symmetric, skew-symmetric, hermitian matrices, only write the - ! lower triangle (including diagonal) + ! For symmetric and hermitian matrices, only the lower triangle + ! (including the diagonal) is written. + ! For skew-symmetric matrices, only the strictly lower triangle is written + ! (the diagonal is omitted and assumed zero). do j = 1, size(matrix, 2) do i = j, size(matrix, 1) + if(symmetry_ == MM_SKEW_SYMMETRIC .and. i == j) cycle #:if t.startswith('real') write(io, fmt=fmt_, iostat=stat) matrix(i, j) #:elif t.startswith('complex') real_part = real(matrix(i, j), kind=${k}$) imag_part = aimag(matrix(i, j)) + if(i==j .and. symmetry_ == MM_HERMITIAN) imag_part = 0 write(io, fmt=fmt_, iostat=stat) real_part, imag_part #:elif t.startswith('integer') write(io, fmt=fmt_, iostat=stat) matrix(i, j) @@ -236,7 +240,7 @@ contains if(size(index, dim=1)/=2) return ! Determine symmetry type - symmetry_ = "general" + symmetry_ = MM_GENERAL if (present(symmetry)) then symmetry_ = to_lower(trim(symmetry)) end if @@ -285,8 +289,10 @@ contains end if end do else - ! For symmetric, skew-symmetric, hermitian matrices, only write the - ! lower triangle + ! For symmetric and hermitian matrices, only the lower triangle + ! (including the diagonal) is written. + ! For skew-symmetric matrices, only the strictly lower triangle is written + ! (the diagonal is omitted and assumed zero). do i = 1, size(index, dim=2) if(index(1,i) < index(2,i)) cycle if(symmetry_ == MM_SKEW_SYMMETRIC .and. index(1,i) == index(2,i)) cycle @@ -296,6 +302,7 @@ contains #:elif t.startswith('complex') real_part = real(data(i), kind=${k}$) imag_part = aimag(data(i)) + if(index(1,i)==index(2,i) .and. symmetry_ == MM_HERMITIAN) imag_part = 0 write(io, fmt=fmt_, iostat=stat) & index(1,i), index(2,i), real_part, imag_part #:elif t.startswith('integer') From a1ba8acb465a0dad1f904ae7639911cb05db67fc Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Tue, 3 Feb 2026 00:24:05 +0530 Subject: [PATCH 17/50] add AUTO symmetry option for dense matrices --- src/io/stdlib_io_mm_save.fypp | 60 +++++++++++++++++++++++++++++++++-- 1 file changed, 58 insertions(+), 2 deletions(-) diff --git a/src/io/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp index 43e4b3878..253edd4cd 100644 --- a/src/io/stdlib_io_mm_save.fypp +++ b/src/io/stdlib_io_mm_save.fypp @@ -41,7 +41,8 @@ submodule (stdlib_io_mm) stdlib_io_mm_save MM_GENERAL = "general", & MM_SYMMETRIC = "symmetric", & MM_SKEW_SYMMETRIC = "skew-symmetric", & - MM_HERMITIAN = "hermitian" + MM_HERMITIAN = "hermitian", & + MM_AUTO = "auto" contains @@ -62,7 +63,7 @@ contains !> Associated error message in case of non-zero status code character(len=:), allocatable, intent(out), optional :: iomsg - integer :: io, stat, i, j, nnz + integer :: io, stat, i, j, nnz, nrows, ncols character(len=:), allocatable :: msg character(len=:), allocatable :: field_type character(len=:), allocatable :: fmt_ @@ -97,10 +98,65 @@ contains end if end if + nrows = size(matrix, 1) + ncols = size(matrix, 2) ! Determine symmetry type symmetry_ = MM_GENERAL if (present(symmetry)) then symmetry_ = to_lower(trim(symmetry)) + if (symmetry_ == MM_AUTO) then + + symmetry_block: block + ! Non-square matrices cannot be symmetric/skew/hermitian + if (nrows /= ncols) then + symmetry_ = MM_GENERAL + exit symmetry_block + end if + + ! Try symmetric + symmetry_ = MM_SYMMETRIC + do j = 1, ncols + do i = j+1, nrows + if (matrix(i,j) /= matrix(j,i)) then + symmetry_ = MM_GENERAL + exit + end if + end do + if (symmetry_ == MM_GENERAL) exit + end do + if (symmetry_ == MM_SYMMETRIC) exit symmetry_block + + ! Try skew-symmetric + symmetry_ = MM_SKEW_SYMMETRIC + do j = 1, ncols + do i = j, nrows + if (matrix(i,j) /= -matrix(j,i)) then + symmetry_ = MM_GENERAL + exit + end if + end do + if (symmetry_ == MM_GENERAL) exit + end do + if (symmetry_ == MM_SKEW_SYMMETRIC) exit symmetry_block + + #:if t.startswith('complex') + ! Try hermitian + symmetry_ = MM_HERMITIAN + do j = 1, ncols + do i = j, nrows + if (matrix(i,j) /= conjg(matrix(j,i))) then + symmetry_ = MM_GENERAL + exit + end if + end do + if (symmetry_ == MM_GENERAL) exit + end do + if (symmetry_ == MM_HERMITIAN) exit symmetry_block + #:endif + + symmetry_ = MM_GENERAL + end block symmetry_block + end if end if ! Determine field type based on matrix type From 7cf80fc4947c69493c40ca38333785a38576843e Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Fri, 20 Feb 2026 16:34:31 +0530 Subject: [PATCH 18/50] add: error handling --- example/io/example_matrix_market.f90 | 2 + src/io/stdlib_io_mm_load.fypp | 142 +++++++++++++++++++++------ src/io/stdlib_io_mm_save.fypp | 65 ++++++------ 3 files changed, 144 insertions(+), 65 deletions(-) diff --git a/example/io/example_matrix_market.f90 b/example/io/example_matrix_market.f90 index ae6de6839..38e38fbae 100644 --- a/example/io/example_matrix_market.f90 +++ b/example/io/example_matrix_market.f90 @@ -11,6 +11,8 @@ program example_matrix_market integer :: iostat, i character(len=:), allocatable :: iomsg + iostat = 0 + iomsg = '' ! Create a test dense matrix allocate(matrix(3,3)) matrix = reshape([1.0_dp, 2.0_dp, 3.0_dp, & diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index f609dab47..a48e70ba2 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -64,7 +64,11 @@ contains !----------------------------------------------------------------------------- ! Open file for regular reading open( newunit = u , file=filename, status = 'old' , access='stream', action="read", iostat=err ) - if( err /= 0 ) return + if( err /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = err,& + message = 'Error opening matrix market file') + return + end if err = 1 !----------------------------------------- @@ -78,11 +82,16 @@ contains !----------------------------------------- ! Read header call read_mm_header(ffp, header, err) - if( err /= 0 ) return + if( err /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = err,& + message = 'Error reading mm header') + return + end if if( header%format /= MF_array ) then - err = 2 - print *, "warning: a dense matrix is expected for the current file" - return + err = 2 + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = err, & + message = 'warning: a dense matrix is expected for the current file') + return end if !----------------------------------------- @@ -97,15 +106,27 @@ contains !----------------------------------------- ! Read matrix dimensions nrows = to_num_from_stream(ffp, nrows, stat) - if( stat /= 0 ) return + if( stat /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat),& + message = 'Error reading number of rows') + return + end if ncols = to_num_from_stream(ffp, ncols, stat) - if( stat /= 0 ) return + if( stat /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat),& + message = 'Error reading number of columns') + return + end if !----------------------------------------- ! Read actual matrix data allocate(matrix(nrows, ncols), stat=err) matrix = 0 - if( err /= 0 ) return + if( err /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = err,& + message = 'Error allocating matrix') + return + end if if(header%symmetry==MS_general) then do j = 1, ncols do i = 1, nrows @@ -116,7 +137,11 @@ contains #:else matrix(i,j) = to_num_from_stream(ffp, mold, stat) #:endif - if( stat /= 0 ) return + if( stat /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat),& + message = 'Error reading matrix value') + return + end if end do end do else @@ -131,7 +156,11 @@ contains #:else matrix(i,j) = to_num_from_stream(ffp, mold, stat) #:endif - if( stat /= 0 ) return + if( stat /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat),& + message = 'Error reading matrix value') + return + end if ! Assign transpose of the current element matrix(j, i) = matrix(i, j) if(header%symmetry==MS_skew_symmetric) matrix(j, i) = -matrix(j, i) @@ -179,7 +208,11 @@ contains !----------------------------------------------------------------------------- ! Open file for regular reading open( newunit = u , file=filename, status = 'old' , access='stream', action="read", iostat=err ) - if( err /= 0 ) return + if( err /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = err,& + message = 'Error opening matrix market file') + return + end if err = 1 !----------------------------------------- @@ -193,11 +226,16 @@ contains !----------------------------------------- ! Read header call read_mm_header(ffp, header, err) - if( err /= 0 ) return + if( err /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = err,& + message = 'Error reading mm header') + return + end if if( header%format /= MF_coordinate ) then - err = 2 - print *, "warning: a coordinate matrix is expected for the current file" - return + err = 2 + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = err, & + message = 'warning: a coordinate matrix is expected for the current file') + return end if !----------------------------------------- @@ -212,11 +250,23 @@ contains !----------------------------------------- ! Read matrix dimensions nrows = to_num_from_stream(ffp, nrows, stat) - if( stat /= 0 ) return + if( stat /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat),& + message = 'Error reading nrows') + return + end if ncols = to_num_from_stream(ffp, ncols, stat) - if( stat /= 0 ) return + if( stat /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat),& + message = 'Error reading ncols') + return + end if nnz = to_num_from_stream(ffp, nnz, stat) - if( stat /= 0 ) return + if( stat /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat),& + message = 'Error reading nnz') + return + end if !----------------------------------------- ! Allocate temporary arrays to hold the file data @@ -238,6 +288,11 @@ contains #:else vals(i) = to_num_from_stream(ffp, mold, stat) #:endif + if(stat /= 0) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat), & + message = 'Error reading the Matrix Market coordinate data') + return + end if end do !----------------------------------------- @@ -269,18 +324,18 @@ contains !----------------------------------------- ! Fill in symmetric entries if needed if(header%symmetry==MS_general) return - adr = 1 - do i = 1, nnz - if(index(1,i)==index(2,i)) cycle - index(1,nnz+adr) = index(2,i) - index(2,nnz+adr) = index(1,i) - data(nnz+adr) = data(i) - if(header%symmetry==MS_skew_symmetric) data(nnz+adr) = -data(i) - #:if t.startswith('complex') - if(header%symmetry==MS_hermitian) data(nnz+adr) = conjg(data(i)) - #:endif - adr = adr + 1 - end do + adr = 1 + do i = 1, nnz + if(index(1,i)==index(2,i)) cycle + index(1,nnz+adr) = index(2,i) + index(2,nnz+adr) = index(1,i) + data(nnz+adr) = data(i) + if(header%symmetry==MS_skew_symmetric) data(nnz+adr) = -data(i) + #:if t.startswith('complex') + if(header%symmetry==MS_hermitian) data(nnz+adr) = conjg(data(i)) + #:endif + adr = adr + 1 + end do end subroutine #:endfor @@ -290,11 +345,17 @@ contains integer, intent(out) :: err !---------------------------------------------- err = 0 - if( .not. starts_with(ffp, "%%MatrixMarket ") ) return + if( .not. starts_with(ffp, "%%MatrixMarket ") ) then + err = 1 + return + end if ffp => ffp(16:) ! Read object type: matrix - if( .not. starts_with(ffp, "matrix ") ) return + if( .not. starts_with(ffp, "matrix ") ) then + err = 1 + return + end if ffp => ffp(8:) header%object = 1 ! matrix @@ -306,6 +367,7 @@ contains ffp => ffp(12:) ! coordinate header%format = MF_coordinate else + err = 1 return end if @@ -323,6 +385,7 @@ contains ffp => ffp(9:) ! pattern header%qualifier = MQ_pattern else + err = 1 return end if @@ -340,6 +403,7 @@ contains ffp => ffp(11:) ! hermitian header%symmetry = MS_hermitian else + err = 1 return end if end subroutine @@ -361,4 +425,18 @@ contains end if end function + subroutine mm_fail_process(iostat, iomsg, code, message) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + integer, intent(in) :: code + character(*), intent(in) :: message + + if (present(iostat)) iostat = code + if (present(iomsg)) then + iomsg = message + else + call error_stop(message) + end if + end subroutine + end submodule stdlib_io_mm_load \ No newline at end of file diff --git a/src/io/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp index 253edd4cd..185be18ef 100644 --- a/src/io/stdlib_io_mm_save.fypp +++ b/src/io/stdlib_io_mm_save.fypp @@ -89,13 +89,9 @@ contains io = open(filename, "w", iostat=stat) if (stat /= 0) then - if (present(iostat)) then - iostat = stat - if (present(iomsg)) iomsg = "Could not create file: " // filename - return - else - call error_stop("Could not create file: " // filename) - end if + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = stat,& + message = "Could not create file: " // filename) + return end if nrows = size(matrix, 1) @@ -223,15 +219,10 @@ contains 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 save Matrix Market file '" // filename // "': " // msg) - else - call error_stop("Failed to save Matrix Market file '" // filename // "'") - end if + if(stat/=0) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = stat,& + message = "Failed to save Matrix Market file '" // filename // "': " // msg) + return end if if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) @@ -284,16 +275,14 @@ contains io = open(filename, "w", iostat=stat) if (stat /= 0) then - if (present(iostat)) then - iostat = stat - if (present(iomsg)) iomsg = "Could not create file: " // filename - return - else - call error_stop("Could not create file: " // filename) - end if + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = stat,& + message = "Could not create file: " // filename) end if - if(size(index, dim=1)/=2) return + if(size(index, dim=1)/=2) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = stat,& + message = "Invalid index dimensions: first dimension must be 2") + end if ! Determine symmetry type symmetry_ = MM_GENERAL @@ -375,14 +364,9 @@ contains close(io) - if (present(iostat)) then - iostat = stat - else if (stat /= 0) then - if (allocated(msg)) then - call error_stop("Failed to save Matrix Market file '" // filename // "': " // msg) - else - call error_stop("Failed to save Matrix Market file '" // filename // "'") - end if + if(stat/=0) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = stat,& + message = "Failed to save Matrix Market file '" // filename // "': " // msg) end if if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) @@ -394,7 +378,8 @@ contains comment, iostat, iomsg) integer, intent(in) :: io character(len=*), intent(in) :: format, field, symmetry - integer, intent(in) :: nrows, ncols, nnz + integer, intent(in) :: nrows, ncols + integer, intent(in), optional :: nnz character(len=*), intent(in), optional :: comment integer, intent(out) :: iostat character(len=:), allocatable, intent(out) :: iomsg @@ -451,4 +436,18 @@ contains end if end subroutine write_mm_header + subroutine mm_fail_process(iostat, iomsg, code, message) + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + integer, intent(in) :: code + character(*), intent(in) :: message + + if (present(iostat)) iostat = code + if (present(iomsg)) then + iomsg = message + else + call error_stop(message) + end if + end subroutine + end submodule stdlib_io_mm_save \ No newline at end of file From 2d027667aa956c8155240a3a6119b5c3a2faef02 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Fri, 20 Feb 2026 23:20:22 +0530 Subject: [PATCH 19/50] add: basic test_io_mm --- test/io/CMakeLists.txt | 1 + test/io/test_io_mm.f90 | 66 ---------------------------- test/io/test_io_mm.fypp | 97 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 98 insertions(+), 66 deletions(-) delete mode 100644 test/io/test_io_mm.f90 create mode 100644 test/io/test_io_mm.fypp diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index f0c27a1b3..f6f78ca82 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -2,6 +2,7 @@ set( fppFiles "test_loadtxt_qp.fypp" "test_savetxt_qp.fypp" + "test_io_mm.fypp" ) fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) diff --git a/test/io/test_io_mm.f90 b/test/io/test_io_mm.f90 deleted file mode 100644 index 143bc7503..000000000 --- a/test/io/test_io_mm.f90 +++ /dev/null @@ -1,66 +0,0 @@ -! Simple test for Matrix Market loading only -program test_matrix_market - use stdlib_io_mm - use stdlib_kinds, only: dp - implicit none - - call test_load_simple() - - write(*,*) 'Matrix Market load test passed!' - -contains - - subroutine test_load_simple() - real(dp), allocatable :: matrix(:,:) - integer :: iostat, io, i - character(len=:), allocatable :: iomsg - - write(*,*) 'Testing simple Matrix Market loading...' - - ! Create a simple test file - open(newunit=io, file='simple_test.mtx', action='write') - write(io, '(A)') '%%MatrixMarket matrix array real general' - write(io, '(A)') '% Simple test matrix' - write(io, '(A)') '2 2' - write(io, '(A)') '1.0' - write(io, '(A)') '0.0' - write(io, '(A)') '0.0' - write(io, '(A)') '2.0' - close(io) - - ! Try to load it - call load_mm('simple_test.mtx', matrix, iostat=iostat, iomsg=iomsg) - if (iostat /= 0) then - write(*,*) 'Error loading simple matrix: iostat=', iostat - if (allocated(iomsg)) write(*,*) 'Message: ', iomsg - stop 1 - end if - - ! Check results - if (.not. allocated(matrix)) then - write(*,*) 'Error: matrix not allocated' - stop 1 - end if - - if (size(matrix,1) /= 2 .or. size(matrix,2) /= 2) then - write(*,*) 'Error: wrong dimensions', size(matrix,1), size(matrix,2) - stop 1 - end if - - if (abs(matrix(1,1) - 1.0_dp) > 1e-12_dp .or. & - abs(matrix(2,1) - 0.0_dp) > 1e-12_dp .or. & - abs(matrix(1,2) - 0.0_dp) > 1e-12_dp .or. & - abs(matrix(2,2) - 2.0_dp) > 1e-12_dp) then - write(*,*) 'Error: wrong matrix values' - write(*,*) 'Expected: 1 0; 0 2' - write(*,*) 'Got:' - do i = 1, 2 - write(*,'(*(F8.3))') matrix(i,:) - end do - stop 1 - end if - - write(*,*) 'Simple load test passed' - end subroutine test_load_simple - -end program test_matrix_market \ No newline at end of file diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp new file mode 100644 index 000000000..2f8ef762c --- /dev/null +++ b/test/io/test_io_mm.fypp @@ -0,0 +1,97 @@ +#:include "common.fypp" +#:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) +! #:set C_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) +! #:set I_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES, INT_KINDS)) +! #:set KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + I_KINDS_TYPES +#:set KINDS_TYPES = R_KINDS_TYPES +module test_io_mm + use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test + use stdlib_kinds + use stdlib_math, only: all_close + use stdlib_io_mm + implicit none + +contains + + + !> Collect all exported unit tests + subroutine collect_suite(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest('io_mm_array', test_io_mm_array), & + new_unittest('io_mm_coordinate', test_io_mm_coordinate) & + ] + end subroutine + + subroutine test_io_mm_array(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + #:for k, t, s in (KINDS_TYPES) + block + integer, parameter :: wp = ${k}$ + integer, parameter :: n = 5 + ${t}$, allocatable :: matrix_save(:, :), matrix_load(:, :) + integer :: i,j + allocate(matrix_save(n,n), source=0.0_wp) + call random_number(matrix_save) + call save_mm("test_mmio_dense.mtx", matrix_save) + call load_mm("test_mmio_dense.mtx", matrix_load) + do i = 1,n; do j = 1,n + if(matrix_save(i,j) /= matrix_load(i,j)) then + print*, "save: ", matrix_save(i,j), " load: ", matrix_load(i,j) + end if + end do; end do + call check(error, all_close(matrix_save, matrix_load), .true.) + if(allocated(error)) return + end block + #:endfor + end subroutine + + subroutine test_io_mm_coordinate(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + #:for k, t, s in (KINDS_TYPES) + block + integer, parameter :: n = 5 + ${t}$, allocatable :: index_save(:), index_load(:) + integer, allocatable :: data_save(:, :), data_load(:,:) + ! allocate(matrix_save(n,n)) + ! call random_number(matrix_save) + ! call save_mm("test_mmio_dense.mtx", matrix_save) + ! call load_mm("test_mmio_dense.mtx", matrix_load) + ! call check(error, all_close(matrix_save, matrix_load), .true.) + ! if(allocated(error)) return + end block + #:endfor + end subroutine + +end module + + +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_io_mm, only : collect_suite + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("io_mm", collect_suite) & + ] + + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if +end program From 28db8938269716644d11e64766c8c938e7e3dd2a Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sat, 21 Feb 2026 23:02:58 +0530 Subject: [PATCH 20/50] add: test array general --- test/io/test_io_mm.fypp | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index 2f8ef762c..ee5436d7b 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -30,19 +30,13 @@ contains type(error_type), allocatable, intent(out) :: error #:for k, t, s in (KINDS_TYPES) block - integer, parameter :: wp = ${k}$ integer, parameter :: n = 5 ${t}$, allocatable :: matrix_save(:, :), matrix_load(:, :) integer :: i,j - allocate(matrix_save(n,n), source=0.0_wp) + allocate(matrix_save(n,n)) call random_number(matrix_save) - call save_mm("test_mmio_dense.mtx", matrix_save) + call save_mm("test_mmio_dense.mtx", matrix_save, format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - do i = 1,n; do j = 1,n - if(matrix_save(i,j) /= matrix_load(i,j)) then - print*, "save: ", matrix_save(i,j), " load: ", matrix_load(i,j) - end if - end do; end do call check(error, all_close(matrix_save, matrix_load), .true.) if(allocated(error)) return end block From be4c4982e200319115b7b5be4951af92c9d1ee8c Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sun, 22 Feb 2026 00:20:23 +0530 Subject: [PATCH 21/50] test_io_mm_array implemented --- test/io/test_io_mm.fypp | 105 +++++++++++++++++++++++++++++++++++----- 1 file changed, 92 insertions(+), 13 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index ee5436d7b..e3be577d1 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -1,9 +1,8 @@ #:include "common.fypp" #:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) -! #:set C_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) -! #:set I_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES, INT_KINDS)) -! #:set KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + I_KINDS_TYPES -#:set KINDS_TYPES = R_KINDS_TYPES +#:set C_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) +#:set KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + module test_io_mm use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test use stdlib_kinds @@ -31,14 +30,100 @@ contains #:for k, t, s in (KINDS_TYPES) block integer, parameter :: n = 5 - ${t}$, allocatable :: matrix_save(:, :), matrix_load(:, :) - integer :: i,j + ${t}$, allocatable :: matrix_save(:, :), matrix_load(:, :), R(:, :), A(:, :) + #:if t.startswith('complex') + ${t}$, allocatable :: I(:,:) + #:endif allocate(matrix_save(n,n)) + allocate(R(n,n)) + allocate(A(n,n)) + #:if t.startswith('complex') + allocate(I(n,n)) + #:endif + + ! General matrix + #:if t.startswith('complex') + call random_number(R) + call random_number(I) + matrix_save = cmplx(R, I, kind=${k}$) + #:else call random_number(matrix_save) + #:endif call save_mm("test_mmio_dense.mtx", matrix_save, format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - call check(error, all_close(matrix_save, matrix_load), .true.) + call check(error, all_close(matrix_save, matrix_load), .true.,& + "MM array test failed: matrix=general, symmetry_arg=unspecified") + if(allocated(error)) return + ! Check if symmetry = auto + call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") + call load_mm("test_mmio_dense.mtx", matrix_load) + call check(error, all_close(matrix_save, matrix_load), .true.,& + "MM array test failed: matrix=general, symmetry_arg=auto") + if(allocated(error)) return + + ! Symmetric matrix + #:if t.startswith('complex') + call random_number(R) + call random_number(I) + A = cmplx(R, I, kind=${k}$) + #:else + call random_number(A) + #:endif + ! Construct symmetric matrix using (A + A.T) + matrix_save = A + transpose(A) + call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "symmetric", format = "G0") + call load_mm("test_mmio_dense.mtx", matrix_load) + call check(error, all_close(matrix_save, matrix_load), .true.,& + "MM array test failed: matrix=symmetric, symmetry_arg=symmetric") + if(allocated(error)) return + ! Check if symmetry = auto + call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") + call load_mm("test_mmio_dense.mtx", matrix_load) + call check(error, all_close(matrix_save, matrix_load), .true.,& + "MM array test failed: matrix=symmetric, symmetry_arg=auto") + if(allocated(error)) return + + ! Skew-symmetric matrix + #:if t.startswith('complex') + call random_number(R) + call random_number(I) + A = cmplx(R, I, kind=${k}$) + #:else + call random_number(A) + #:endif + ! Construct symmetric matrix using (A - A.T) + matrix_save = A - transpose(A) + call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "skew-symmetric", format = "G0") + call load_mm("test_mmio_dense.mtx", matrix_load) + call check(error, all_close(matrix_save, matrix_load), .true.,& + "MM array test failed: matrix=skew-symmetric, symmetry_arg=skew-symmetric") + if(allocated(error)) return + ! Check if symmetry = auto + call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") + call load_mm("test_mmio_dense.mtx", matrix_load) + call check(error, all_close(matrix_save, matrix_load), .true.,& + "MM array test failed: matrix=skew-symmetric, symmetry_arg=auto") + if(allocated(error)) return + + ! Hermitian matrix + #:if t.startswith('complex') + call random_number(R) + call random_number(I) + A = cmplx(R, I, kind=${k}$) + ! Construct symmetric matrix using (A + A.H) + matrix_save = A + transpose(conjg(A)) + call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "hermitian", format = "G0") + call load_mm("test_mmio_dense.mtx", matrix_load) + call check(error, all_close(matrix_save, matrix_load), .true.,& + "MM array test failed: matrix=hermitian, symmetry_arg=hermitian") + if(allocated(error)) return + ! Check if symmetry = auto + call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") + call load_mm("test_mmio_dense.mtx", matrix_load) + call check(error, all_close(matrix_save, matrix_load), .true.,& + "MM array test failed: matrix=hermitian, symmetry_arg=auto") if(allocated(error)) return + #:endif end block #:endfor end subroutine @@ -51,12 +136,6 @@ contains integer, parameter :: n = 5 ${t}$, allocatable :: index_save(:), index_load(:) integer, allocatable :: data_save(:, :), data_load(:,:) - ! allocate(matrix_save(n,n)) - ! call random_number(matrix_save) - ! call save_mm("test_mmio_dense.mtx", matrix_save) - ! call load_mm("test_mmio_dense.mtx", matrix_load) - ! call check(error, all_close(matrix_save, matrix_load), .true.) - ! if(allocated(error)) return end block #:endfor end subroutine From 67a90c2a6576da8804383940063f1f78ac68dded Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sun, 22 Feb 2026 00:21:02 +0530 Subject: [PATCH 22/50] minor change --- test/io/test_io_mm.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index e3be577d1..4732ca134 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -105,8 +105,8 @@ contains "MM array test failed: matrix=skew-symmetric, symmetry_arg=auto") if(allocated(error)) return - ! Hermitian matrix #:if t.startswith('complex') + ! Hermitian matrix call random_number(R) call random_number(I) A = cmplx(R, I, kind=${k}$) From c736d416ffb91d081e7751a4a78844856420f056 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sun, 22 Feb 2026 12:47:47 +0530 Subject: [PATCH 23/50] add initialization of err variables to zero --- src/io/stdlib_io_mm_load.fypp | 4 ++++ src/io/stdlib_io_mm_save.fypp | 6 ++++++ 2 files changed, 10 insertions(+) diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index a48e70ba2..c38402c12 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -61,6 +61,8 @@ contains if (present(iostat)) iostat = 0 if (present(iomsg)) iomsg = '' + stat = 0 + err = 0 !----------------------------------------------------------------------------- ! Open file for regular reading open( newunit = u , file=filename, status = 'old' , access='stream', action="read", iostat=err ) @@ -205,6 +207,8 @@ contains if (present(iostat)) iostat = 0 if (present(iomsg)) iomsg = '' + stat = 0 + err = 0 !----------------------------------------------------------------------------- ! Open file for regular reading open( newunit = u , file=filename, status = 'old' , access='stream', action="read", iostat=err ) diff --git a/src/io/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp index 185be18ef..21904c495 100644 --- a/src/io/stdlib_io_mm_save.fypp +++ b/src/io/stdlib_io_mm_save.fypp @@ -71,6 +71,9 @@ contains #:if t.startswith('complex') real(${k}$) :: real_part, imag_part #:endif + if(present(iostat)) iostat = 0 + if(present(iomsg)) iomsg = '' + stat = 0 #:if t.startswith('integer') fmt_ = "I0" @@ -257,6 +260,9 @@ contains #:if t.startswith('complex') real(${k}$) :: real_part, imag_part #:endif + if(present(iostat)) iostat = 0 + if(present(iomsg)) iomsg = '' + stat = 0 #:if t.startswith('integer') fmt_ = "I0" From 8d505bbe034982fb57c687ba7ff61b8132301bda Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sun, 22 Feb 2026 13:42:35 +0530 Subject: [PATCH 24/50] modify test --- test/io/test_io_mm.fypp | 125 +++++++++++++++++++++++++--------------- 1 file changed, 79 insertions(+), 46 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index 4732ca134..190535bc9 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -1,8 +1,8 @@ #:include "common.fypp" #:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) -#:set C_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) -#:set KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES - +#:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX)) +#:set I_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES, INT_KINDS)) +#:set KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + I_KINDS_TYPES module test_io_mm use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test use stdlib_kinds @@ -25,103 +25,136 @@ contains end subroutine subroutine test_io_mm_array(error) + #:def generate_random_for_real(A) + #:if t.startswith('real') + call random_number(${A}$) + #:endif + #:enddef + #:def generate_random_for_complex(A, R, I) + #:if t.startswith('complex') + call random_number(${R}$) + call random_number(${I}$) + ${A}$ = cmplx(${R}$, ${I}$, kind=${k}$) + #:endif + #:enddef + #:def generate_random_for_int(A, i, j, n, rnd) + #:if t.startswith('integer') + do ${j}$ = 1, ${n}$ + do ${i}$ = 1,${n}$ + call random_number(${rnd}$) + ${A}$(${i}$,${j}$) = int(${rnd}$ * 100, kind=${k}$) + end do + end do + #:endif + #:enddef + #:def compare(result ,A, B) + #:if t.startswith('integer') + ${result}$ = all(${A}$==${B}$) + #:else + ${result}$ = all_close(${A}$, ${B}$) + #:endif + #:enddef !> Error handling type(error_type), allocatable, intent(out) :: error #:for k, t, s in (KINDS_TYPES) block integer, parameter :: n = 5 - ${t}$, allocatable :: matrix_save(:, :), matrix_load(:, :), R(:, :), A(:, :) + ${t}$, allocatable :: matrix_save(:, :), matrix_load(:, :), A(:, :) #:if t.startswith('complex') - ${t}$, allocatable :: I(:,:) + real(${k}$), allocatable :: R(:, :) + real(${k}$), allocatable :: I(:,:) + #:endif + #:if t.startswith('integer') + real :: rnd + integer :: i, j #:endif + logical :: result allocate(matrix_save(n,n)) - allocate(R(n,n)) allocate(A(n,n)) #:if t.startswith('complex') + allocate(R(n,n)) allocate(I(n,n)) #:endif ! General matrix - #:if t.startswith('complex') - call random_number(R) - call random_number(I) - matrix_save = cmplx(R, I, kind=${k}$) - #:else - call random_number(matrix_save) - #:endif + @:generate_random_for_real(matrix_save) + @:generate_random_for_complex(matrix_save, R, I) + @:generate_random_for_int(matrix_save, i, j, n, rnd) call save_mm("test_mmio_dense.mtx", matrix_save, format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - call check(error, all_close(matrix_save, matrix_load), .true.,& - "MM array test failed: matrix=general, symmetry_arg=unspecified") + @:compare(result, matrix_save, matrix_load) + if(.not. result) then + print*, matrix_save + print*, matrix_load + end if + call check(error, result, .true.,& + "MM array test failed: matrix=general, symmetry_arg=unspecified, type=${t}$") if(allocated(error)) return ! Check if symmetry = auto call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - call check(error, all_close(matrix_save, matrix_load), .true.,& - "MM array test failed: matrix=general, symmetry_arg=auto") + @:compare(result, matrix_save, matrix_load) + call check(error, result, .true.,& + "MM array test failed: matrix=general, symmetry_arg=auto, type=${t}$") if(allocated(error)) return ! Symmetric matrix - #:if t.startswith('complex') - call random_number(R) - call random_number(I) - A = cmplx(R, I, kind=${k}$) - #:else - call random_number(A) - #:endif + @:generate_random_for_real(A) + @:generate_random_for_complex(A, R, I) + @:generate_random_for_int(A, i, j, n, rnd) ! Construct symmetric matrix using (A + A.T) matrix_save = A + transpose(A) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "symmetric", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - call check(error, all_close(matrix_save, matrix_load), .true.,& - "MM array test failed: matrix=symmetric, symmetry_arg=symmetric") + @:compare(result, matrix_save, matrix_load) + call check(error, result, .true.,& + "MM array test failed: matrix=symmetric, symmetry_arg=symmetric, type=${t}$") if(allocated(error)) return ! Check if symmetry = auto call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - call check(error, all_close(matrix_save, matrix_load), .true.,& - "MM array test failed: matrix=symmetric, symmetry_arg=auto") + @:compare(result, matrix_save, matrix_load) + call check(error, result, .true.,& + "MM array test failed: matrix=symmetric, symmetry_arg=auto, type=${t}$") if(allocated(error)) return ! Skew-symmetric matrix - #:if t.startswith('complex') - call random_number(R) - call random_number(I) - A = cmplx(R, I, kind=${k}$) - #:else - call random_number(A) - #:endif + @:generate_random_for_real(A) + @:generate_random_for_complex(A, R, I) + @:generate_random_for_int(A, i, j, n, rnd) ! Construct symmetric matrix using (A - A.T) matrix_save = A - transpose(A) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "skew-symmetric", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - call check(error, all_close(matrix_save, matrix_load), .true.,& - "MM array test failed: matrix=skew-symmetric, symmetry_arg=skew-symmetric") + @:compare(result, matrix_save, matrix_load) + call check(error, result, .true.,& + "MM array test failed: matrix=skew-symmetric, symmetry_arg=skew-symmetric, type=${t}$") if(allocated(error)) return ! Check if symmetry = auto call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - call check(error, all_close(matrix_save, matrix_load), .true.,& - "MM array test failed: matrix=skew-symmetric, symmetry_arg=auto") + @:compare(result, matrix_save, matrix_load) + call check(error, result, .true.,& + "MM array test failed: matrix=skew-symmetric, symmetry_arg=auto, type=${t}$") if(allocated(error)) return #:if t.startswith('complex') ! Hermitian matrix - call random_number(R) - call random_number(I) - A = cmplx(R, I, kind=${k}$) + @:generate_random_for_complex(A, R, I) ! Construct symmetric matrix using (A + A.H) matrix_save = A + transpose(conjg(A)) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "hermitian", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - call check(error, all_close(matrix_save, matrix_load), .true.,& - "MM array test failed: matrix=hermitian, symmetry_arg=hermitian") + @:compare(result, matrix_save, matrix_load) + call check(error, result, .true.,& + "MM array test failed: matrix=hermitian, symmetry_arg=hermitian, type=${t}$") if(allocated(error)) return ! Check if symmetry = auto call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - call check(error, all_close(matrix_save, matrix_load), .true.,& - "MM array test failed: matrix=hermitian, symmetry_arg=auto") + @:compare(result, matrix_save, matrix_load) + call check(error, result, .true.,& + "MM array test failed: matrix=hermitian, symmetry_arg=auto, type=${t}$") if(allocated(error)) return #:endif end block From 63634bee43c0134f235c272260d5831eb9727a69 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Tue, 24 Feb 2026 23:11:45 +0530 Subject: [PATCH 25/50] minor changes --- src/io/stdlib_io_mm_load.fypp | 2 +- test/io/test_io_mm.fypp | 6 +----- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index c38402c12..22a8916c0 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -292,7 +292,7 @@ contains #:else vals(i) = to_num_from_stream(ffp, mold, stat) #:endif - if(stat /= 0) then + if(stat /= 0 ) then call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat), & message = 'Error reading the Matrix Market coordinate data') return diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index 190535bc9..4e71023fd 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -2,7 +2,7 @@ #:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) #:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX)) #:set I_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES, INT_KINDS)) -#:set KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + I_KINDS_TYPES +#:set KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES module test_io_mm use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test use stdlib_kinds @@ -83,10 +83,6 @@ contains call save_mm("test_mmio_dense.mtx", matrix_save, format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) @:compare(result, matrix_save, matrix_load) - if(.not. result) then - print*, matrix_save - print*, matrix_load - end if call check(error, result, .true.,& "MM array test failed: matrix=general, symmetry_arg=unspecified, type=${t}$") if(allocated(error)) return From 0bf717087b909b281415c39f94696e0e599c3f6f Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Tue, 24 Feb 2026 23:22:11 +0530 Subject: [PATCH 26/50] remove: unused constants dependency --- src/io/CMakeLists.txt | 2 +- src/io/stdlib_io_mm_save.fypp | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/io/CMakeLists.txt b/src/io/CMakeLists.txt index 8f91fd7fd..4587bc698 100644 --- a/src/io/CMakeLists.txt +++ b/src/io/CMakeLists.txt @@ -16,4 +16,4 @@ set(io_f90Files configure_stdlib_target(${PROJECT_NAME}_io io_f90Files io_fppFiles io_cppFiles) -target_link_libraries(${PROJECT_NAME}_io PUBLIC ${PROJECT_NAME}_core ${PROJECT_NAME}_constants ${PROJECT_NAME}_strings) +target_link_libraries(${PROJECT_NAME}_io PUBLIC ${PROJECT_NAME}_core ${PROJECT_NAME}_strings) diff --git a/src/io/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp index 21904c495..24a4f399f 100644 --- a/src/io/stdlib_io_mm_save.fypp +++ b/src/io/stdlib_io_mm_save.fypp @@ -12,7 +12,6 @@ submodule (stdlib_io_mm) stdlib_io_mm_save use stdlib_strings, only : to_string use stdlib_io, only : open use stdlib_ascii, only : to_lower - use stdlib_constants, only : #{for k, t, s in RCI_KINDS_TYPES[:-1]}#zero_${k}$, #{endfor}#zero_${RCI_KINDS_TYPES[-1][0]}$ implicit none ! Matrix Market format constants From 5abdabdf5a3e0460dd3d08852b8e80558b47a76c Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Wed, 4 Mar 2026 23:45:12 +0530 Subject: [PATCH 27/50] minor changes to write mm header call --- src/io/stdlib_io_mm_save.fypp | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/io/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp index 24a4f399f..3898377c2 100644 --- a/src/io/stdlib_io_mm_save.fypp +++ b/src/io/stdlib_io_mm_save.fypp @@ -169,13 +169,13 @@ contains catch: block ! Write header call write_mm_header(io, MM_ARRAY, field_type, symmetry_, & - size(matrix, 1), size(matrix, 2), nnz, comment, stat, msg) + nrows, ncols, comment=comment, iostat=stat, iomsg=msg) if (stat /= 0) exit catch ! Write array format (column-major order) if(symmetry_ == MM_GENERAL) then - do j = 1, size(matrix, 2) - do i = 1, size(matrix, 1) + do j = 1, ncols + do i = 1, nrows #:if t.startswith('real') write(io, fmt=fmt_, iostat=stat) matrix(i, j) #:elif t.startswith('complex') @@ -197,8 +197,8 @@ contains ! (including the diagonal) is written. ! For skew-symmetric matrices, only the strictly lower triangle is written ! (the diagonal is omitted and assumed zero). - do j = 1, size(matrix, 2) - do i = j, size(matrix, 1) + do j = 1, ncols + do i = j, nrows if(symmetry_ == MM_SKEW_SYMMETRIC .and. i == j) cycle #:if t.startswith('real') write(io, fmt=fmt_, iostat=stat) matrix(i, j) @@ -315,7 +315,8 @@ contains end if ! Write header call write_mm_header(io, MM_COORDINATE, field_type, symmetry_, & - maxval(index(1,:)), maxval(index(2,:)), nnz_to_write, comment, stat, msg) + maxval(index(1,:)), maxval(index(2,:)),& + nnz=nnz_to_write, comment=comment, iostat=stat, iomsg=msg) if (stat /= 0) exit catch ! Write coordinate format (row, column, value) From 3113f13308727e5cac12c25b68377ffa9b2cc863 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Thu, 5 Mar 2026 00:18:26 +0530 Subject: [PATCH 28/50] add stat error check after each time reading an input value --- src/io/stdlib_io_mm_load.fypp | 124 ++++++++++++++++++---------------- 1 file changed, 67 insertions(+), 57 deletions(-) diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index 22a8916c0..56d90dfcc 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -129,48 +129,51 @@ contains message = 'Error allocating matrix') return end if - if(header%symmetry==MS_general) then - do j = 1, ncols - do i = 1, nrows - #:if t.startswith('complex') - val_r = to_num_from_stream(ffp, mold, stat) - val_i = to_num_from_stream(ffp, mold, stat) - matrix(i,j) = cmplx(val_r, val_i, kind = ${k}$) - #:else - matrix(i,j) = to_num_from_stream(ffp, mold, stat) - #:endif - if( stat /= 0 ) then - call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat),& - message = 'Error reading matrix value') - return - end if + read_vals: block + if(header%symmetry==MS_general) then + do j = 1, ncols + do i = 1, nrows + #:if t.startswith('complex') + val_r = to_num_from_stream(ffp, mold, stat) + if(stat/=0) exit read_vals + val_i = to_num_from_stream(ffp, mold, stat) + if(stat/=0) exit read_vals + matrix(i,j) = cmplx(val_r, val_i, kind = ${k}$) + #:else + matrix(i,j) = to_num_from_stream(ffp, mold, stat) + if(stat/=0) exit read_vals + #:endif + end do end do - end do - else - do j = 1, ncols - do i = j, nrows - ! Keep diagonal elements as zero incase of skew-symmetric cases - if(header%symmetry==MS_skew_symmetric .and. i==j) cycle - #:if t.startswith('complex') - val_r = to_num_from_stream(ffp, mold, stat) - val_i = to_num_from_stream(ffp, mold, stat) - matrix(i,j) = cmplx(val_r, val_i, kind = ${k}$) - #:else - matrix(i,j) = to_num_from_stream(ffp, mold, stat) - #:endif - if( stat /= 0 ) then - call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat),& - message = 'Error reading matrix value') - return - end if - ! Assign transpose of the current element - matrix(j, i) = matrix(i, j) - if(header%symmetry==MS_skew_symmetric) matrix(j, i) = -matrix(j, i) - #:if t.startswith('complex') - if(header%symmetry==MS_hermitian) matrix(j, i) = conjg(matrix(j, i)) - #:endif + else + do j = 1, ncols + do i = j, nrows + ! Keep diagonal elements as zero incase of skew-symmetric cases + if(header%symmetry==MS_skew_symmetric .and. i==j) cycle + #:if t.startswith('complex') + val_r = to_num_from_stream(ffp, mold, stat) + if(stat/=0) exit read_vals + val_i = to_num_from_stream(ffp, mold, stat) + if(stat/=0) exit read_vals + matrix(i,j) = cmplx(val_r, val_i, kind = ${k}$) + #:else + matrix(i,j) = to_num_from_stream(ffp, mold, stat) + if(stat/=0) exit read_vals + #:endif + ! Assign transpose of the current element + matrix(j, i) = matrix(i, j) + if(header%symmetry==MS_skew_symmetric) matrix(j, i) = -matrix(j, i) + #:if t.startswith('complex') + if(header%symmetry==MS_hermitian) matrix(j, i) = conjg(matrix(j, i)) + #:endif + end do end do - end do + end if + end block read_vals + if( stat /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat),& + message = 'Error reading matrix value') + return end if end subroutine #:endfor @@ -281,23 +284,30 @@ contains !----------------------------------------- ! Read actual matrix data and store inside temporary arrays n_diag = 0 - do i = 1, nnz ! read entries from file - rows(i) = to_num_from_stream(ffp, rows(i), stat) - cols(i) = to_num_from_stream(ffp, cols(i), stat) - if(rows(i) == cols(i)) n_diag = n_diag + 1 - #:if t.startswith('complex') - val_r = to_num_from_stream(ffp, mold, stat) - val_i = to_num_from_stream(ffp, mold, stat) - vals(i) = cmplx(val_r, val_i, kind = ${k}$) - #:else - vals(i) = to_num_from_stream(ffp, mold, stat) - #:endif - if(stat /= 0 ) then - call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat), & - message = 'Error reading the Matrix Market coordinate data') - return - end if - end do + read_vals: block + do i = 1, nnz ! read entries from file + rows(i) = to_num_from_stream(ffp, rows(i), stat) + if(stat/=0) exit read_vals + cols(i) = to_num_from_stream(ffp, cols(i), stat) + if(stat/=0) exit read_vals + if(rows(i) == cols(i)) n_diag = n_diag + 1 + #:if t.startswith('complex') + val_r = to_num_from_stream(ffp, mold, stat) + if(stat/=0) exit read_vals + val_i = to_num_from_stream(ffp, mold, stat) + if(stat/=0) exit read_vals + vals(i) = cmplx(val_r, val_i, kind = ${k}$) + #:else + vals(i) = to_num_from_stream(ffp, mold, stat) + if(stat/=0) exit read_vals + #:endif + end do + end block read_vals + if(stat /= 0 ) then + call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat), & + message = 'Error reading the Matrix Market coordinate data') + return + end if !----------------------------------------- ! check storage hypothesis From 91fbededed97116b2a116e8ddc6da05a1b668b35 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Thu, 5 Mar 2026 23:15:39 +0530 Subject: [PATCH 29/50] add zero length array save condition for COO type --- src/io/stdlib_io_mm_save.fypp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/io/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp index 3898377c2..79010b37a 100644 --- a/src/io/stdlib_io_mm_save.fypp +++ b/src/io/stdlib_io_mm_save.fypp @@ -314,6 +314,12 @@ contains nnz_to_write = count(index(1,:) >= index(2,:)) end if ! Write header + if(nnz_to_write == 0) then + call write_mm_header(io, MM_COORDINATE, field_type, symmetry_, & + 0, 0,& + nnz=nnz_to_write, comment=comment, iostat=stat, iomsg=msg) + exit catch + end if call write_mm_header(io, MM_COORDINATE, field_type, symmetry_, & maxval(index(1,:)), maxval(index(2,:)),& nnz=nnz_to_write, comment=comment, iostat=stat, iomsg=msg) From 107ffda729959524000591ad634d8bdf85542bd6 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Fri, 6 Mar 2026 15:20:50 +0530 Subject: [PATCH 30/50] added coo tests --- test/io/test_io_mm.fypp | 215 ++++++++++++++++++++++++++++++++++++---- 1 file changed, 197 insertions(+), 18 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index 4e71023fd..d2c94e65f 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -2,7 +2,7 @@ #:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX)) #:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX)) #:set I_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES, INT_KINDS)) -#:set KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES +#:set KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + I_KINDS_TYPES module test_io_mm use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test use stdlib_kinds @@ -25,24 +25,24 @@ contains end subroutine subroutine test_io_mm_array(error) - #:def generate_random_for_real(A) + #:def generate_random_for_real_dense(A) #:if t.startswith('real') call random_number(${A}$) #:endif #:enddef - #:def generate_random_for_complex(A, R, I) + #:def generate_random_for_complex_dense(A, R, I) #:if t.startswith('complex') call random_number(${R}$) call random_number(${I}$) ${A}$ = cmplx(${R}$, ${I}$, kind=${k}$) #:endif #:enddef - #:def generate_random_for_int(A, i, j, n, rnd) + #:def generate_random_for_int_dense(A, i, j, n, rnd) #:if t.startswith('integer') do ${j}$ = 1, ${n}$ do ${i}$ = 1,${n}$ call random_number(${rnd}$) - ${A}$(${i}$,${j}$) = int(${rnd}$ * 100, kind=${k}$) + ${A}$(${i}$,${j}$) = int(${rnd}$ * 100 - 50, kind=${k}$) end do end do #:endif @@ -77,9 +77,9 @@ contains #:endif ! General matrix - @:generate_random_for_real(matrix_save) - @:generate_random_for_complex(matrix_save, R, I) - @:generate_random_for_int(matrix_save, i, j, n, rnd) + @:generate_random_for_real_dense(matrix_save) + @:generate_random_for_complex_dense(matrix_save, R, I) + @:generate_random_for_int_dense(matrix_save, i, j, n, rnd) call save_mm("test_mmio_dense.mtx", matrix_save, format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) @:compare(result, matrix_save, matrix_load) @@ -95,9 +95,9 @@ contains if(allocated(error)) return ! Symmetric matrix - @:generate_random_for_real(A) - @:generate_random_for_complex(A, R, I) - @:generate_random_for_int(A, i, j, n, rnd) + @:generate_random_for_real_dense(A) + @:generate_random_for_complex_dense(A, R, I) + @:generate_random_for_int_dense(A, i, j, n, rnd) ! Construct symmetric matrix using (A + A.T) matrix_save = A + transpose(A) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "symmetric", format = "G0") @@ -115,9 +115,9 @@ contains if(allocated(error)) return ! Skew-symmetric matrix - @:generate_random_for_real(A) - @:generate_random_for_complex(A, R, I) - @:generate_random_for_int(A, i, j, n, rnd) + @:generate_random_for_real_dense(A) + @:generate_random_for_complex_dense(A, R, I) + @:generate_random_for_int_dense(A, i, j, n, rnd) ! Construct symmetric matrix using (A - A.T) matrix_save = A - transpose(A) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "skew-symmetric", format = "G0") @@ -136,7 +136,7 @@ contains #:if t.startswith('complex') ! Hermitian matrix - @:generate_random_for_complex(A, R, I) + @:generate_random_for_complex_dense(A, R, I) ! Construct symmetric matrix using (A + A.H) matrix_save = A + transpose(conjg(A)) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "hermitian", format = "G0") @@ -158,13 +158,192 @@ contains end subroutine subroutine test_io_mm_coordinate(error) + #:def generate_random_for_real_coo(A, R, nnz_to_write) + #:if t.startswith('real') + call random_number(${R}$) + ${A}$(1:${nnz_to_write}$) = ${R}$(1:${nnz_to_write}$) + #:endif + #:enddef + #:def generate_random_for_complex_coo(A, R, I, nnz_to_write) + #:if t.startswith('complex') + call random_number(${R}$) + call random_number(${I}$) + ${A}$(1:${nnz_to_write}$) = cmplx(${R}$(1:${nnz_to_write}$), ${I}$(1:${nnz_to_write}$), kind=${k}$) + #:endif + #:enddef + #:def generate_random_for_int_coo(A, i, nnz_to_write, rnd) + #:if t.startswith('integer') + do ${i}$ = 1, ${nnz_to_write}$ + call random_number(${rnd}$) + ${A}$(${i}$) = int(${rnd}$ * 100 - 50, kind=${k}$) + end do + #:endif + #:enddef + #:def generate_random_positions(pos, i, j, t_entries, rnd, temp) + do ${i}$ = 1, ${t_entries}$ + ${pos}$(${i}$) = ${i}$ + end do + call random_seed() + do ${i}$ = ${t_entries}$, 1, -1 + call random_number(${rnd}$) + ${j}$ = ceiling(${t_entries}$*${rnd}$) + ${temp}$ = ${pos}$(${i}$) + ${pos}$(${i}$) = ${pos}$(${j}$) + ${pos}$(${j}$) = ${temp}$ + end do + #:enddef + #:def fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j, op) + ${j}$ = 1 + do ${i}$ = 1, ${nnz}$ + ${row}$ = mod(${pos}$(${i}$) - 1,${nrows}$) + 1 + ${col}$ = (${pos}$(${i}$) - 1)/${ncols}$ + 1 + if(${row}$ <${op}$ ${col}$) cycle + ${index_save}$(1,${j}$) = ${row}$ + ${index_save}$(2,${j}$) = ${col}$ + ${j}$ = ${j}$ + 1 + end do + #:enddef + ! Generates t_entries - half_nnz elements + #:def fill_other_half(index_save, data_save, i, j, half_nnz, op) + do ${i}$ = 1, ${half_nnz}$ + if(${index_save}$(1,${i}$) == ${index_save}$(2,${i}$)) cycle + ${index_save}$(1,${j}$) = ${index_save}$(2,${i}$) + ${index_save}$(2,${j}$) = ${index_save}$(1,${i}$) + ${data_save}$(${j}$) = ${op}$(${data_save}$(${i}$)) + ${j}$=${j}$+1 + end do + #:enddef + #:def compare(result , index_save, index_load, data_save, data_load) + #:if t.startswith('integer') + ${result}$ = all(${index_save}$ == ${index_load}$) .and. all(${data_save}$ == ${data_load}$) + #:else + ${result}$ = all(${index_save}$ == ${index_load}$) .and. all_close(${data_save}$, ${data_load}$) + #:endif + #:enddef !> Error handling type(error_type), allocatable, intent(out) :: error #:for k, t, s in (KINDS_TYPES) block - integer, parameter :: n = 5 - ${t}$, allocatable :: index_save(:), index_load(:) - integer, allocatable :: data_save(:, :), data_load(:,:) + integer :: nrows, ncols + ${t}$, allocatable :: data_save(:), data_load(:) + integer, allocatable :: index_save(:, :), index_load(:,:) + #:if t.startswith('int') + ${t}$, allocatable :: R(:) + #:else + real(${k}$), allocatable :: R(:) + #:endif + #:if t.startswith('complex') + real(${k}$), allocatable :: Img(:) + #:endif + + integer :: row, col, t_entries, nnz, nnz_lower, nnz_diag + integer, allocatable :: pos(:) + integer :: i, j, temp, adr + #:if t.startswith('int') + real(dp) :: rnd, density + #:else + real(${k}$) :: rnd, density + #:endif + logical :: result + + nrows = 5 + ncols = 5 + t_entries = nrows * ncols + allocate(R(t_entries)) + #:if t.startswith('complex') + allocate(Img(t_entries)) + #:endif + allocate(pos(t_entries)) + + ! General matrix + @:generate_random_positions(pos, i, j, t_entries, rnd, temp) + call random_number(density) + nnz = ceiling(density*t_entries) + allocate(index_save(2, nnz)) + allocate(data_save(nnz)) + do i = 1, nnz + index_save(1,i) = mod(pos(i) - 1,ncols) + 1 + index_save(2,i) = (pos(i) - 1)/nrows + 1 + end do + @:generate_random_for_real_coo(data_save, R, nnz) + @:generate_random_for_complex_coo(data_save, R, Img, nnz) + @:generate_random_for_int_coo(data_save, i, nnz, rnd) + call save_mm("test_mmio_sparse.mtx", index_save, data_save, format = "G0") + call load_mm("test_mmio_sparse.mtx", index_load, data_load) + @:compare(result, index_save, index_load, data_save, data_load) + call check(error, result, .true.,& + "MM coordinate test failed: symmetry_arg=unspecified, type=${t}$") + if(allocated(error)) return + if(allocated(index_save)) deallocate(index_save) + if(allocated(data_save)) deallocate(data_save) + + ! Symmetric matrix + @:generate_random_positions(pos, i, j, t_entries, rnd, temp) + call random_number(density) + nnz = ceiling(density*t_entries) + nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part + nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/ncols) !! diagonal + allocate(index_save(2, 2*nnz_lower + nnz_diag)) + allocate(data_save(2*nnz_lower + nnz_diag)) + @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,) + @:generate_random_for_real_coo(data_save, R, nnz_diag + nnz_lower) + @:generate_random_for_complex_coo(data_save, R, Img, nnz_diag + nnz_lower) + @:generate_random_for_int_coo(data_save, i, nnz_diag + nnz_lower, rnd) + @:fill_other_half(index_save, data_save, i, j, nnz_lower+nnz_diag,) + call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "symmetric", format = "G0") + call load_mm("test_mmio_sparse.mtx", index_load, data_load) + @:compare(result, index_save, index_load, data_save, data_load) + call check(error, result, .true.,& + "MM coordinate test failed: symmetry_arg=symmetric, type=${t}$") + if(allocated(error)) return + if(allocated(index_save)) deallocate(index_save) + if(allocated(data_save)) deallocate(data_save) + + ! Skew-symmetric matrix + @:generate_random_positions(pos, i, j, t_entries, rnd, temp) + call random_number(density) + nnz = ceiling(density*t_entries) + nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part + allocate(index_save(2, 2*nnz_lower)) + allocate(data_save(2*nnz_lower)) + @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,=) + @:generate_random_for_real_coo(data_save, R, nnz_lower) + @:generate_random_for_complex_coo(data_save, R, Img, nnz_lower) + @:generate_random_for_int_coo(data_save, i, nnz_lower, rnd) + @:fill_other_half(index_save, data_save, i, j, nnz_lower, -) + call save_mm("test_mmio_sparse_skew.mtx", index_save, data_save, symmetry = "skew-symmetric", format = "G0") + call load_mm("test_mmio_sparse_skew.mtx", index_load, data_load) + @:compare(result, index_save, index_load, data_save, data_load) + call check(error, result, .true.,& + "MM coordinate test failed: symmetry_arg=skew-symmetric, type=${t}$") + if(allocated(error)) return + if(allocated(index_save)) deallocate(index_save) + if(allocated(data_save)) deallocate(data_save) + + #:if t.startswith('complex') + ! Hermitian matrix + @:generate_random_positions(pos, i, j, t_entries, rnd, temp) + call random_number(density) + nnz = ceiling(density*t_entries) + nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part + nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/ncols) !! diagonal + allocate(index_save(2, 2*nnz_lower + nnz_diag)) + allocate(data_save(2*nnz_lower + nnz_diag)) + @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,) + @:generate_random_for_complex_coo(data_save, R, Img, nnz_diag + nnz_lower) + do i = 1, nnz_lower + nnz_diag + if(index_save(1, i) == index_save(2,i)) data_save(i) = real(data_save(i)) + end do + @:fill_other_half(index_save, data_save, i, j, nnz_lower+nnz_diag, conjg) + call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "hermitian", format = "G0") + call load_mm("test_mmio_sparse.mtx", index_load, data_load) + @:compare(result, index_save, index_load, data_save, data_load) + call check(error, result, .true.,& + "MM coordinate test failed: symmetry_arg=hermitian, type=${t}$") + if(allocated(error)) return + if(allocated(index_save)) deallocate(index_save) + if(allocated(data_save)) deallocate(data_save) + #:endif end block #:endfor end subroutine From 213bc2a82618c45c1a35ed9e32fc096cf3f44433 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Fri, 6 Mar 2026 15:43:01 +0530 Subject: [PATCH 31/50] remove I and made R one more dimensional --- test/io/test_io_mm.fypp | 72 ++++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 41 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index d2c94e65f..4ec9bbdef 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -30,11 +30,11 @@ contains call random_number(${A}$) #:endif #:enddef - #:def generate_random_for_complex_dense(A, R, I) + #:def generate_random_for_complex_dense(A, R) #:if t.startswith('complex') - call random_number(${R}$) - call random_number(${I}$) - ${A}$ = cmplx(${R}$, ${I}$, kind=${k}$) + call random_number(${R}$(:,:,1)) + call random_number(${R}$(:,:,2)) + ${A}$ = cmplx(${R}$(:,:,1), ${R}$(:,:,2), kind=${k}$) #:endif #:enddef #:def generate_random_for_int_dense(A, i, j, n, rnd) @@ -61,8 +61,7 @@ contains integer, parameter :: n = 5 ${t}$, allocatable :: matrix_save(:, :), matrix_load(:, :), A(:, :) #:if t.startswith('complex') - real(${k}$), allocatable :: R(:, :) - real(${k}$), allocatable :: I(:,:) + real(${k}$), allocatable :: R(:, :, :) #:endif #:if t.startswith('integer') real :: rnd @@ -72,13 +71,12 @@ contains allocate(matrix_save(n,n)) allocate(A(n,n)) #:if t.startswith('complex') - allocate(R(n,n)) - allocate(I(n,n)) + allocate(R(n,n,2)) #:endif ! General matrix @:generate_random_for_real_dense(matrix_save) - @:generate_random_for_complex_dense(matrix_save, R, I) + @:generate_random_for_complex_dense(matrix_save, R) @:generate_random_for_int_dense(matrix_save, i, j, n, rnd) call save_mm("test_mmio_dense.mtx", matrix_save, format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) @@ -96,7 +94,7 @@ contains ! Symmetric matrix @:generate_random_for_real_dense(A) - @:generate_random_for_complex_dense(A, R, I) + @:generate_random_for_complex_dense(A, R) @:generate_random_for_int_dense(A, i, j, n, rnd) ! Construct symmetric matrix using (A + A.T) matrix_save = A + transpose(A) @@ -116,7 +114,7 @@ contains ! Skew-symmetric matrix @:generate_random_for_real_dense(A) - @:generate_random_for_complex_dense(A, R, I) + @:generate_random_for_complex_dense(A, R) @:generate_random_for_int_dense(A, i, j, n, rnd) ! Construct symmetric matrix using (A - A.T) matrix_save = A - transpose(A) @@ -136,7 +134,7 @@ contains #:if t.startswith('complex') ! Hermitian matrix - @:generate_random_for_complex_dense(A, R, I) + @:generate_random_for_complex_dense(A, R) ! Construct symmetric matrix using (A + A.H) matrix_save = A + transpose(conjg(A)) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "hermitian", format = "G0") @@ -158,20 +156,19 @@ contains end subroutine subroutine test_io_mm_coordinate(error) - #:def generate_random_for_real_coo(A, R, nnz_to_write) + #:def generate_random_data_for_real_coo(A, nnz_to_write) #:if t.startswith('real') - call random_number(${R}$) - ${A}$(1:${nnz_to_write}$) = ${R}$(1:${nnz_to_write}$) + call random_number(${A}$(1:${nnz_to_write}$)) #:endif #:enddef - #:def generate_random_for_complex_coo(A, R, I, nnz_to_write) + #:def generate_random_data_for_complex_coo(A, R, nnz_to_write) #:if t.startswith('complex') - call random_number(${R}$) - call random_number(${I}$) - ${A}$(1:${nnz_to_write}$) = cmplx(${R}$(1:${nnz_to_write}$), ${I}$(1:${nnz_to_write}$), kind=${k}$) + call random_number(${R}$(:,1)) + call random_number(${R}$(:,2)) + ${A}$(1:${nnz_to_write}$) = cmplx(${R}$(1:${nnz_to_write}$, 1), ${R}$(1:${nnz_to_write}$, 2), kind=${k}$) #:endif #:enddef - #:def generate_random_for_int_coo(A, i, nnz_to_write, rnd) + #:def generate_random_data_for_int_coo(A, i, nnz_to_write, rnd) #:if t.startswith('integer') do ${i}$ = 1, ${nnz_to_write}$ call random_number(${rnd}$) @@ -203,7 +200,6 @@ contains ${j}$ = ${j}$ + 1 end do #:enddef - ! Generates t_entries - half_nnz elements #:def fill_other_half(index_save, data_save, i, j, half_nnz, op) do ${i}$ = 1, ${half_nnz}$ if(${index_save}$(1,${i}$) == ${index_save}$(2,${i}$)) cycle @@ -227,13 +223,8 @@ contains integer :: nrows, ncols ${t}$, allocatable :: data_save(:), data_load(:) integer, allocatable :: index_save(:, :), index_load(:,:) - #:if t.startswith('int') - ${t}$, allocatable :: R(:) - #:else - real(${k}$), allocatable :: R(:) - #:endif #:if t.startswith('complex') - real(${k}$), allocatable :: Img(:) + real(${k}$), allocatable :: R(:, :) #:endif integer :: row, col, t_entries, nnz, nnz_lower, nnz_diag @@ -249,9 +240,8 @@ contains nrows = 5 ncols = 5 t_entries = nrows * ncols - allocate(R(t_entries)) #:if t.startswith('complex') - allocate(Img(t_entries)) + allocate(R(t_entries, 2)) #:endif allocate(pos(t_entries)) @@ -265,9 +255,9 @@ contains index_save(1,i) = mod(pos(i) - 1,ncols) + 1 index_save(2,i) = (pos(i) - 1)/nrows + 1 end do - @:generate_random_for_real_coo(data_save, R, nnz) - @:generate_random_for_complex_coo(data_save, R, Img, nnz) - @:generate_random_for_int_coo(data_save, i, nnz, rnd) + @:generate_random_data_for_real_coo(data_save, nnz) + @:generate_random_data_for_complex_coo(data_save, R, nnz) + @:generate_random_data_for_int_coo(data_save, i, nnz, rnd) call save_mm("test_mmio_sparse.mtx", index_save, data_save, format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) @:compare(result, index_save, index_load, data_save, data_load) @@ -286,9 +276,9 @@ contains allocate(index_save(2, 2*nnz_lower + nnz_diag)) allocate(data_save(2*nnz_lower + nnz_diag)) @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,) - @:generate_random_for_real_coo(data_save, R, nnz_diag + nnz_lower) - @:generate_random_for_complex_coo(data_save, R, Img, nnz_diag + nnz_lower) - @:generate_random_for_int_coo(data_save, i, nnz_diag + nnz_lower, rnd) + @:generate_random_data_for_real_coo(data_save, nnz_diag + nnz_lower) + @:generate_random_data_for_complex_coo(data_save, R, nnz_diag + nnz_lower) + @:generate_random_data_for_int_coo(data_save, i, nnz_diag + nnz_lower, rnd) @:fill_other_half(index_save, data_save, i, j, nnz_lower+nnz_diag,) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "symmetric", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) @@ -307,12 +297,12 @@ contains allocate(index_save(2, 2*nnz_lower)) allocate(data_save(2*nnz_lower)) @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,=) - @:generate_random_for_real_coo(data_save, R, nnz_lower) - @:generate_random_for_complex_coo(data_save, R, Img, nnz_lower) - @:generate_random_for_int_coo(data_save, i, nnz_lower, rnd) + @:generate_random_data_for_real_coo(data_save, nnz_lower) + @:generate_random_data_for_complex_coo(data_save, R, nnz_lower) + @:generate_random_data_for_int_coo(data_save, i, nnz_lower, rnd) @:fill_other_half(index_save, data_save, i, j, nnz_lower, -) - call save_mm("test_mmio_sparse_skew.mtx", index_save, data_save, symmetry = "skew-symmetric", format = "G0") - call load_mm("test_mmio_sparse_skew.mtx", index_load, data_load) + call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "skew-symmetric", format = "G0") + call load_mm("test_mmio_sparse.mtx", index_load, data_load) @:compare(result, index_save, index_load, data_save, data_load) call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=skew-symmetric, type=${t}$") @@ -330,7 +320,7 @@ contains allocate(index_save(2, 2*nnz_lower + nnz_diag)) allocate(data_save(2*nnz_lower + nnz_diag)) @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,) - @:generate_random_for_complex_coo(data_save, R, Img, nnz_diag + nnz_lower) + @:generate_random_data_for_complex_coo(data_save, R, nnz_diag + nnz_lower) do i = 1, nnz_lower + nnz_diag if(index_save(1, i) == index_save(2,i)) data_save(i) = real(data_save(i)) end do From c1a8c65004b020f2c38e7e6399104c3217204095 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sat, 7 Mar 2026 14:11:12 +0530 Subject: [PATCH 32/50] change fypp to subroutine: dense done --- test/io/test_io_mm.fypp | 248 ++++++++++++++++++++++------------------ 1 file changed, 136 insertions(+), 112 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index 4ec9bbdef..a9c962261 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -24,129 +24,130 @@ contains ] end subroutine - subroutine test_io_mm_array(error) - #:def generate_random_for_real_dense(A) - #:if t.startswith('real') - call random_number(${A}$) - #:endif - #:enddef - #:def generate_random_for_complex_dense(A, R) - #:if t.startswith('complex') - call random_number(${R}$(:,:,1)) - call random_number(${R}$(:,:,2)) - ${A}$ = cmplx(${R}$(:,:,1), ${R}$(:,:,2), kind=${k}$) - #:endif - #:enddef - #:def generate_random_for_int_dense(A, i, j, n, rnd) - #:if t.startswith('integer') - do ${j}$ = 1, ${n}$ - do ${i}$ = 1,${n}$ - call random_number(${rnd}$) - ${A}$(${i}$,${j}$) = int(${rnd}$ * 100 - 50, kind=${k}$) - end do + #:for k, t, s in KINDS_TYPES + subroutine generate_random_for_${s}$_dense(A) + ${t}$, intent(out) :: A(:, :) + + ! Internal variables + #:if t.startswith('complex') + real(${k}$), allocatable :: R(:, :, :) + #:endif + #:if t.startswith('integer') + real :: rnd + integer :: i, j + #:endif + integer :: n + + n = size(A,dim=1) + + #:if t.startswith('real') + call random_number(A) + #:endif + #:if t.startswith('complex') + allocate(R(n,n,2)) + call random_number(R(:,:,1)) + call random_number(R(:,:,2)) + A = cmplx(R(:,:,1), R(:,:,2), kind=${k}$) + #:endif + #:if t.startswith('integer') + do j = 1, n + do i = 1,n + call random_number(rnd) + A(i,j) = int(rnd * 100 - 50, kind=${k}$) end do - #:endif - #:enddef - #:def compare(result ,A, B) + end do + #:endif + end subroutine + pure function compare_dense_${s}$(A, B) result(result) + ${t}$, intent(in) :: A(:, :), B(:, :) + logical :: result + #:if t.startswith('integer') - ${result}$ = all(${A}$==${B}$) + result = all(A==B) #:else - ${result}$ = all_close(${A}$, ${B}$) + result = all_close(A, B) #:endif - #:enddef + end function + #:endfor + + subroutine test_io_mm_array(error) !> Error handling type(error_type), allocatable, intent(out) :: error #:for k, t, s in (KINDS_TYPES) block integer, parameter :: n = 5 ${t}$, allocatable :: matrix_save(:, :), matrix_load(:, :), A(:, :) - #:if t.startswith('complex') - real(${k}$), allocatable :: R(:, :, :) - #:endif - #:if t.startswith('integer') - real :: rnd - integer :: i, j - #:endif logical :: result allocate(matrix_save(n,n)) allocate(A(n,n)) - #:if t.startswith('complex') - allocate(R(n,n,2)) - #:endif ! General matrix - @:generate_random_for_real_dense(matrix_save) - @:generate_random_for_complex_dense(matrix_save, R) - @:generate_random_for_int_dense(matrix_save, i, j, n, rnd) + call generate_random_for_${s}$_dense(matrix_save) call save_mm("test_mmio_dense.mtx", matrix_save, format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - @:compare(result, matrix_save, matrix_load) + result = compare_dense_${s}$(matrix_save, matrix_load) call check(error, result, .true.,& "MM array test failed: matrix=general, symmetry_arg=unspecified, type=${t}$") if(allocated(error)) return ! Check if symmetry = auto call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - @:compare(result, matrix_save, matrix_load) + result = compare_dense_${s}$(matrix_save, matrix_load) call check(error, result, .true.,& "MM array test failed: matrix=general, symmetry_arg=auto, type=${t}$") if(allocated(error)) return ! Symmetric matrix - @:generate_random_for_real_dense(A) - @:generate_random_for_complex_dense(A, R) - @:generate_random_for_int_dense(A, i, j, n, rnd) + call generate_random_for_${s}$_dense(A) ! Construct symmetric matrix using (A + A.T) matrix_save = A + transpose(A) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "symmetric", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - @:compare(result, matrix_save, matrix_load) + result = compare_dense_${s}$(matrix_save, matrix_load) call check(error, result, .true.,& "MM array test failed: matrix=symmetric, symmetry_arg=symmetric, type=${t}$") if(allocated(error)) return ! Check if symmetry = auto call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - @:compare(result, matrix_save, matrix_load) + result = compare_dense_${s}$(matrix_save, matrix_load) call check(error, result, .true.,& "MM array test failed: matrix=symmetric, symmetry_arg=auto, type=${t}$") if(allocated(error)) return ! Skew-symmetric matrix - @:generate_random_for_real_dense(A) - @:generate_random_for_complex_dense(A, R) - @:generate_random_for_int_dense(A, i, j, n, rnd) + call generate_random_for_${s}$_dense(A) ! Construct symmetric matrix using (A - A.T) matrix_save = A - transpose(A) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "skew-symmetric", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - @:compare(result, matrix_save, matrix_load) + result = compare_dense_${s}$(matrix_save, matrix_load) call check(error, result, .true.,& "MM array test failed: matrix=skew-symmetric, symmetry_arg=skew-symmetric, type=${t}$") if(allocated(error)) return ! Check if symmetry = auto call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - @:compare(result, matrix_save, matrix_load) + result = compare_dense_${s}$(matrix_save, matrix_load) call check(error, result, .true.,& "MM array test failed: matrix=skew-symmetric, symmetry_arg=auto, type=${t}$") if(allocated(error)) return #:if t.startswith('complex') ! Hermitian matrix - @:generate_random_for_complex_dense(A, R) + call generate_random_for_${s}$_dense(A) ! Construct symmetric matrix using (A + A.H) matrix_save = A + transpose(conjg(A)) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "hermitian", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - @:compare(result, matrix_save, matrix_load) + result = compare_dense_${s}$(matrix_save, matrix_load) call check(error, result, .true.,& "MM array test failed: matrix=hermitian, symmetry_arg=hermitian, type=${t}$") if(allocated(error)) return ! Check if symmetry = auto call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "auto", format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) - @:compare(result, matrix_save, matrix_load) + result = compare_dense_${s}$(matrix_save, matrix_load) call check(error, result, .true.,& "MM array test failed: matrix=hermitian, symmetry_arg=auto, type=${t}$") if(allocated(error)) return @@ -155,40 +156,76 @@ contains #:endfor end subroutine + #:for k, t, s in KINDS_TYPES + subroutine generate_random_for_${s}$_coo(A, nnz_to_write) + ${t}$, intent(out) :: A(:) + integer, intent(in) :: nnz_to_write + + ! Internal variables + #:if t.startswith('complex') + real(${k}$), allocatable :: R(:, :) + #:endif + #:if t.startswith('integer') + real :: rnd + integer :: i + #:endif + + #:if t.startswith('real') + call random_number(A(1:nnz_to_write)) + #:endif + #:if t.startswith('complex') + allocate(R(nnz_to_write, 2)) + call random_number(R(:,1)) + call random_number(R(:,2)) + A(1:nnz_to_write) = cmplx(R(1:nnz_to_write, 1), R(1:nnz_to_write, 2), kind=${k}$) + #:endif + #:if t.startswith('integer') + do i = 1, nnz_to_write + call random_number(rnd) + A(i) = int(rnd * 100 - 50, kind=${k}$) + end do + #:endif + end subroutine + + pure function compare_coo_${s}$(index_save, index_load, data_save, data_load) result(result) + ${t}$, intent(in) :: data_save(:), data_load(:) + integer, intent(in) :: index_save(:, :), index_load(:,:) + logical :: result + + #:if t.startswith('integer') + result = all(index_save == index_load) .and. all(data_save == data_load) + #:else + result = all(index_save == index_load) .and. all_close(data_save, data_load) + #:endif + end function + + subroutine generate_random_positions_${s}$(pos, t_entries) + integer, intent(inout) :: pos(:) + integer, intent(in) :: t_entries + + ! Internal variables + integer :: i, j, temp + #:if t.startswith('int') + real(dp) :: rnd + #:else + real(${k}$) :: rnd + #:endif + + do i = 1, t_entries + pos(i) = i + end do + call random_seed() + do i = t_entries, 1, -1 + call random_number(rnd) + j = ceiling(t_entries*rnd) + temp = pos(i) + pos(i) = pos(j) + pos(j) = temp + end do + end subroutine + #:endfor + subroutine test_io_mm_coordinate(error) - #:def generate_random_data_for_real_coo(A, nnz_to_write) - #:if t.startswith('real') - call random_number(${A}$(1:${nnz_to_write}$)) - #:endif - #:enddef - #:def generate_random_data_for_complex_coo(A, R, nnz_to_write) - #:if t.startswith('complex') - call random_number(${R}$(:,1)) - call random_number(${R}$(:,2)) - ${A}$(1:${nnz_to_write}$) = cmplx(${R}$(1:${nnz_to_write}$, 1), ${R}$(1:${nnz_to_write}$, 2), kind=${k}$) - #:endif - #:enddef - #:def generate_random_data_for_int_coo(A, i, nnz_to_write, rnd) - #:if t.startswith('integer') - do ${i}$ = 1, ${nnz_to_write}$ - call random_number(${rnd}$) - ${A}$(${i}$) = int(${rnd}$ * 100 - 50, kind=${k}$) - end do - #:endif - #:enddef - #:def generate_random_positions(pos, i, j, t_entries, rnd, temp) - do ${i}$ = 1, ${t_entries}$ - ${pos}$(${i}$) = ${i}$ - end do - call random_seed() - do ${i}$ = ${t_entries}$, 1, -1 - call random_number(${rnd}$) - ${j}$ = ceiling(${t_entries}$*${rnd}$) - ${temp}$ = ${pos}$(${i}$) - ${pos}$(${i}$) = ${pos}$(${j}$) - ${pos}$(${j}$) = ${temp}$ - end do - #:enddef #:def fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j, op) ${j}$ = 1 do ${i}$ = 1, ${nnz}$ @@ -209,13 +246,6 @@ contains ${j}$=${j}$+1 end do #:enddef - #:def compare(result , index_save, index_load, data_save, data_load) - #:if t.startswith('integer') - ${result}$ = all(${index_save}$ == ${index_load}$) .and. all(${data_save}$ == ${data_load}$) - #:else - ${result}$ = all(${index_save}$ == ${index_load}$) .and. all_close(${data_save}$, ${data_load}$) - #:endif - #:enddef !> Error handling type(error_type), allocatable, intent(out) :: error #:for k, t, s in (KINDS_TYPES) @@ -246,7 +276,7 @@ contains allocate(pos(t_entries)) ! General matrix - @:generate_random_positions(pos, i, j, t_entries, rnd, temp) + call generate_random_positions_${s}$(pos, t_entries) call random_number(density) nnz = ceiling(density*t_entries) allocate(index_save(2, nnz)) @@ -255,12 +285,10 @@ contains index_save(1,i) = mod(pos(i) - 1,ncols) + 1 index_save(2,i) = (pos(i) - 1)/nrows + 1 end do - @:generate_random_data_for_real_coo(data_save, nnz) - @:generate_random_data_for_complex_coo(data_save, R, nnz) - @:generate_random_data_for_int_coo(data_save, i, nnz, rnd) + call generate_random_for_${s}$_coo(data_save, nnz) call save_mm("test_mmio_sparse.mtx", index_save, data_save, format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) - @:compare(result, index_save, index_load, data_save, data_load) + result = compare_coo_${s}$(index_save, index_load, data_save, data_load) call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=unspecified, type=${t}$") if(allocated(error)) return @@ -268,7 +296,7 @@ contains if(allocated(data_save)) deallocate(data_save) ! Symmetric matrix - @:generate_random_positions(pos, i, j, t_entries, rnd, temp) + call generate_random_positions_${s}$(pos, t_entries) call random_number(density) nnz = ceiling(density*t_entries) nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part @@ -276,13 +304,11 @@ contains allocate(index_save(2, 2*nnz_lower + nnz_diag)) allocate(data_save(2*nnz_lower + nnz_diag)) @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,) - @:generate_random_data_for_real_coo(data_save, nnz_diag + nnz_lower) - @:generate_random_data_for_complex_coo(data_save, R, nnz_diag + nnz_lower) - @:generate_random_data_for_int_coo(data_save, i, nnz_diag + nnz_lower, rnd) + call generate_random_for_${s}$_coo(data_save, nnz_lower + nnz_diag) @:fill_other_half(index_save, data_save, i, j, nnz_lower+nnz_diag,) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "symmetric", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) - @:compare(result, index_save, index_load, data_save, data_load) + result = compare_coo_${s}$(index_save, index_load, data_save, data_load) call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=symmetric, type=${t}$") if(allocated(error)) return @@ -290,20 +316,18 @@ contains if(allocated(data_save)) deallocate(data_save) ! Skew-symmetric matrix - @:generate_random_positions(pos, i, j, t_entries, rnd, temp) + call generate_random_positions_${s}$(pos, t_entries) call random_number(density) nnz = ceiling(density*t_entries) nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part allocate(index_save(2, 2*nnz_lower)) allocate(data_save(2*nnz_lower)) @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,=) - @:generate_random_data_for_real_coo(data_save, nnz_lower) - @:generate_random_data_for_complex_coo(data_save, R, nnz_lower) - @:generate_random_data_for_int_coo(data_save, i, nnz_lower, rnd) + call generate_random_for_${s}$_coo(data_save, nnz_lower) @:fill_other_half(index_save, data_save, i, j, nnz_lower, -) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "skew-symmetric", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) - @:compare(result, index_save, index_load, data_save, data_load) + result = compare_coo_${s}$(index_save, index_load, data_save, data_load) call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=skew-symmetric, type=${t}$") if(allocated(error)) return @@ -312,7 +336,7 @@ contains #:if t.startswith('complex') ! Hermitian matrix - @:generate_random_positions(pos, i, j, t_entries, rnd, temp) + call generate_random_positions_${s}$(pos, t_entries) call random_number(density) nnz = ceiling(density*t_entries) nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part @@ -320,14 +344,14 @@ contains allocate(index_save(2, 2*nnz_lower + nnz_diag)) allocate(data_save(2*nnz_lower + nnz_diag)) @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,) - @:generate_random_data_for_complex_coo(data_save, R, nnz_diag + nnz_lower) + call generate_random_for_${s}$_coo(data_save, nnz_lower+nnz_diag) do i = 1, nnz_lower + nnz_diag if(index_save(1, i) == index_save(2,i)) data_save(i) = real(data_save(i)) end do @:fill_other_half(index_save, data_save, i, j, nnz_lower+nnz_diag, conjg) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "hermitian", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) - @:compare(result, index_save, index_load, data_save, data_load) + result = compare_coo_${s}$(index_save, index_load, data_save, data_load) call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=hermitian, type=${t}$") if(allocated(error)) return From a4cb00ef671423e6603f979987fddb4305d482fb Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sat, 7 Mar 2026 16:54:58 +0530 Subject: [PATCH 33/50] change fypp to subroutine: complete --- test/io/test_io_mm.fypp | 106 ++++++++++++++++++++++++++++++---------- 1 file changed, 80 insertions(+), 26 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index a9c962261..b4949ca6d 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -10,6 +10,11 @@ module test_io_mm use stdlib_io_mm implicit none + integer, parameter :: MS_general = 1 + integer, parameter :: MS_symmetric = 2 + integer, parameter :: MS_skew_symmetric = 3 + integer, parameter :: MS_hermitian = 4 + contains @@ -223,29 +228,78 @@ contains pos(j) = temp end do end subroutine - #:endfor - subroutine test_io_mm_coordinate(error) - #:def fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j, op) - ${j}$ = 1 - do ${i}$ = 1, ${nnz}$ - ${row}$ = mod(${pos}$(${i}$) - 1,${nrows}$) + 1 - ${col}$ = (${pos}$(${i}$) - 1)/${ncols}$ + 1 - if(${row}$ <${op}$ ${col}$) cycle - ${index_save}$(1,${j}$) = ${row}$ - ${index_save}$(2,${j}$) = ${col}$ - ${j}$ = ${j}$ + 1 + subroutine fill_first_half_indices_${s}$(index_save, pos, nnz, nrows, ncols, symmetry, j) + integer, intent(out) :: index_save(:, :) + integer, intent(in) :: pos(:), nnz, nrows, ncols, symmetry + integer, intent(inout) :: j + + ! Internal variables + integer :: i, row, col + + if(symmetry == MS_symmetric .or. symmetry == MS_hermitian) then + j = 1 + do i = 1, nnz + row = mod(pos(i) - 1,nrows) + 1 + col = (pos(i) - 1)/ncols + 1 + if(row < col) cycle + index_save(1,j) = row + index_save(2,j) = col + j = j + 1 + end do + else + j = 1 + do i = 1, nnz + row = mod(pos(i) - 1,nrows) + 1 + col = (pos(i) - 1)/ncols + 1 + if(row <= col) cycle + index_save(1,j) = row + index_save(2,j) = col + j = j + 1 + end do + end if + end subroutine + + subroutine fill_other_half_${s}$(index_save, data_save, j, half_nnz, symmetry) + integer, intent(out) :: index_save(:, :) + ${t}$, intent(out) :: data_save(:) + integer, intent(in) :: half_nnz, symmetry + integer, intent(inout) :: j + + ! Internal variables. + integer :: i + + if(symmetry == MS_symmetric) then + do i = 1, half_nnz + if(index_save(1,i) == index_save(2,i)) cycle + index_save(1,j) = index_save(2,i) + index_save(2,j) = index_save(1,i) + data_save(j) = data_save(i) + j=j+1 end do - #:enddef - #:def fill_other_half(index_save, data_save, i, j, half_nnz, op) - do ${i}$ = 1, ${half_nnz}$ - if(${index_save}$(1,${i}$) == ${index_save}$(2,${i}$)) cycle - ${index_save}$(1,${j}$) = ${index_save}$(2,${i}$) - ${index_save}$(2,${j}$) = ${index_save}$(1,${i}$) - ${data_save}$(${j}$) = ${op}$(${data_save}$(${i}$)) - ${j}$=${j}$+1 + #:if t.startswith('complex') + else if(symmetry == MS_hermitian) then + do i = 1, half_nnz + if(index_save(1,i) == index_save(2,i)) cycle + index_save(1,j) = index_save(2,i) + index_save(2,j) = index_save(1,i) + data_save(j) = conjg(data_save(i)) + j=j+1 end do - #:enddef + #:endif + else + do i = 1, half_nnz + if(index_save(1,i) == index_save(2,i)) cycle + index_save(1,j) = index_save(2,i) + index_save(2,j) = index_save(1,i) + data_save(j) = -data_save(i) + j=j+1 + end do + end if + end subroutine + #:endfor + + subroutine test_io_mm_coordinate(error) !> Error handling type(error_type), allocatable, intent(out) :: error #:for k, t, s in (KINDS_TYPES) @@ -303,9 +357,9 @@ contains nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/ncols) !! diagonal allocate(index_save(2, 2*nnz_lower + nnz_diag)) allocate(data_save(2*nnz_lower + nnz_diag)) - @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,) + call fill_first_half_indices_${s}$(index_save, pos, nnz, nrows, ncols, MS_symmetric, j) call generate_random_for_${s}$_coo(data_save, nnz_lower + nnz_diag) - @:fill_other_half(index_save, data_save, i, j, nnz_lower+nnz_diag,) + call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_symmetric) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "symmetric", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) result = compare_coo_${s}$(index_save, index_load, data_save, data_load) @@ -322,9 +376,9 @@ contains nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part allocate(index_save(2, 2*nnz_lower)) allocate(data_save(2*nnz_lower)) - @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,=) + call fill_first_half_indices_${s}$(index_save, pos, nnz, nrows, ncols, MS_skew_symmetric, j) call generate_random_for_${s}$_coo(data_save, nnz_lower) - @:fill_other_half(index_save, data_save, i, j, nnz_lower, -) + call fill_other_half_${s}$(index_save, data_save, j, nnz_lower, MS_skew_symmetric) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "skew-symmetric", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) result = compare_coo_${s}$(index_save, index_load, data_save, data_load) @@ -343,12 +397,12 @@ contains nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/ncols) !! diagonal allocate(index_save(2, 2*nnz_lower + nnz_diag)) allocate(data_save(2*nnz_lower + nnz_diag)) - @:fill_first_half_indices(index_save, pos, row, col, nnz, nrows, ncols, i, j,) + call fill_first_half_indices_${s}$(index_save, pos, nnz, nrows, ncols, MS_hermitian, j) call generate_random_for_${s}$_coo(data_save, nnz_lower+nnz_diag) do i = 1, nnz_lower + nnz_diag if(index_save(1, i) == index_save(2,i)) data_save(i) = real(data_save(i)) end do - @:fill_other_half(index_save, data_save, i, j, nnz_lower+nnz_diag, conjg) + call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_hermitian) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "hermitian", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) result = compare_coo_${s}$(index_save, index_load, data_save, data_load) From 4d220ccfb0f71288c113f19d08160056e271f907 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sat, 7 Mar 2026 17:42:42 +0530 Subject: [PATCH 34/50] modularized --- test/io/test_io_mm.fypp | 229 ++++++++++++++++++++-------------------- 1 file changed, 114 insertions(+), 115 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index b4949ca6d..90c1fe2b7 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -30,7 +30,7 @@ contains end subroutine #:for k, t, s in KINDS_TYPES - subroutine generate_random_for_${s}$_dense(A) + subroutine generate_random_${s}$_dense_matrix(A) ${t}$, intent(out) :: A(:, :) ! Internal variables @@ -87,7 +87,7 @@ contains allocate(A(n,n)) ! General matrix - call generate_random_for_${s}$_dense(matrix_save) + call generate_random_${s}$_dense_matrix(matrix_save) call save_mm("test_mmio_dense.mtx", matrix_save, format = "G0") call load_mm("test_mmio_dense.mtx", matrix_load) result = compare_dense_${s}$(matrix_save, matrix_load) @@ -103,7 +103,7 @@ contains if(allocated(error)) return ! Symmetric matrix - call generate_random_for_${s}$_dense(A) + call generate_random_${s}$_dense_matrix(A) ! Construct symmetric matrix using (A + A.T) matrix_save = A + transpose(A) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "symmetric", format = "G0") @@ -121,7 +121,7 @@ contains if(allocated(error)) return ! Skew-symmetric matrix - call generate_random_for_${s}$_dense(A) + call generate_random_${s}$_dense_matrix(A) ! Construct symmetric matrix using (A - A.T) matrix_save = A - transpose(A) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "skew-symmetric", format = "G0") @@ -140,7 +140,7 @@ contains #:if t.startswith('complex') ! Hermitian matrix - call generate_random_for_${s}$_dense(A) + call generate_random_${s}$_dense_matrix(A) ! Construct symmetric matrix using (A + A.H) matrix_save = A + transpose(conjg(A)) call save_mm("test_mmio_dense.mtx", matrix_save, symmetry = "hermitian", format = "G0") @@ -161,65 +161,17 @@ contains #:endfor end subroutine - #:for k, t, s in KINDS_TYPES - subroutine generate_random_for_${s}$_coo(A, nnz_to_write) - ${t}$, intent(out) :: A(:) - integer, intent(in) :: nnz_to_write - - ! Internal variables - #:if t.startswith('complex') - real(${k}$), allocatable :: R(:, :) - #:endif - #:if t.startswith('integer') - real :: rnd - integer :: i - #:endif - - #:if t.startswith('real') - call random_number(A(1:nnz_to_write)) - #:endif - #:if t.startswith('complex') - allocate(R(nnz_to_write, 2)) - call random_number(R(:,1)) - call random_number(R(:,2)) - A(1:nnz_to_write) = cmplx(R(1:nnz_to_write, 1), R(1:nnz_to_write, 2), kind=${k}$) - #:endif - #:if t.startswith('integer') - do i = 1, nnz_to_write - call random_number(rnd) - A(i) = int(rnd * 100 - 50, kind=${k}$) - end do - #:endif - end subroutine - - pure function compare_coo_${s}$(index_save, index_load, data_save, data_load) result(result) - ${t}$, intent(in) :: data_save(:), data_load(:) - integer, intent(in) :: index_save(:, :), index_load(:,:) - logical :: result - - #:if t.startswith('integer') - result = all(index_save == index_load) .and. all(data_save == data_load) - #:else - result = all(index_save == index_load) .and. all_close(data_save, data_load) - #:endif - end function - - subroutine generate_random_positions_${s}$(pos, t_entries) + subroutine generate_random_positions(pos, t_entries) integer, intent(inout) :: pos(:) integer, intent(in) :: t_entries ! Internal variables integer :: i, j, temp - #:if t.startswith('int') real(dp) :: rnd - #:else - real(${k}$) :: rnd - #:endif do i = 1, t_entries pos(i) = i end do - call random_seed() do i = t_entries, 1, -1 call random_number(rnd) j = ceiling(t_entries*rnd) @@ -229,10 +181,10 @@ contains end do end subroutine - subroutine fill_first_half_indices_${s}$(index_save, pos, nnz, nrows, ncols, symmetry, j) + subroutine fill_first_half_indices(index_save, pos, nnz, nrows, ncols, symmetry, j) integer, intent(out) :: index_save(:, :) integer, intent(in) :: pos(:), nnz, nrows, ncols, symmetry - integer, intent(inout) :: j + integer, intent(out) :: j ! Internal variables integer :: i, row, col @@ -260,6 +212,49 @@ contains end if end subroutine + #:for k, t, s in KINDS_TYPES + subroutine generate_random_data_for_${s}$_coo(A, nnz_to_write) + ${t}$, intent(out) :: A(:) + integer, intent(in) :: nnz_to_write + + ! Internal variables + #:if t.startswith('complex') + real(${k}$), allocatable :: R(:, :) + #:endif + #:if t.startswith('integer') + real :: rnd + integer :: i + #:endif + + #:if t.startswith('real') + call random_number(A(1:nnz_to_write)) + #:endif + #:if t.startswith('complex') + allocate(R(nnz_to_write, 2)) + call random_number(R(:,1)) + call random_number(R(:,2)) + A(1:nnz_to_write) = cmplx(R(1:nnz_to_write, 1), R(1:nnz_to_write, 2), kind=${k}$) + #:endif + #:if t.startswith('integer') + do i = 1, nnz_to_write + call random_number(rnd) + A(i) = int(rnd * 100 - 50, kind=${k}$) + end do + #:endif + end subroutine + + pure function compare_coo_${s}$(index_save, index_load, data_save, data_load) result(result) + ${t}$, intent(in) :: data_save(:), data_load(:) + integer, intent(in) :: index_save(:, :), index_load(:,:) + logical :: result + + #:if t.startswith('integer') + result = all(index_save == index_load) .and. all(data_save == data_load) + #:else + result = all(index_save == index_load) .and. all_close(data_save, data_load) + #:endif + end function + subroutine fill_other_half_${s}$(index_save, data_save, j, half_nnz, symmetry) integer, intent(out) :: index_save(:, :) ${t}$, intent(out) :: data_save(:) @@ -297,6 +292,64 @@ contains end do end if end subroutine + + subroutine generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, symmetry) + ${t}$, allocatable, intent(out) :: data_save(:) + integer, allocatable, intent(out) :: index_save(:, :) + integer, intent(in) :: nrows, ncols, symmetry + + ! Internal variables + integer, allocatable :: pos(:) + integer :: nnz, nnz_lower, nnz_diag, i, j + #:if t.startswith('integer') + real(dp) :: density + #:else + real(${k}$) :: density + #:endif + + allocate(pos(nrows * ncols)) + call generate_random_positions(pos, nrows * ncols) + call random_number(density) + nnz = ceiling(density*nrows*ncols) + + if(symmetry == MS_general) then + allocate(index_save(2, nnz)) + allocate(data_save(nnz)) + do i = 1, nnz + index_save(1,i) = mod(pos(i) - 1,ncols) + 1 + index_save(2,i) = (pos(i) - 1)/nrows + 1 + end do + call generate_random_data_for_${s}$_coo(data_save, nnz) + else if(symmetry == MS_symmetric) then + nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part + nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/ncols) !! diagonal + allocate(index_save(2, 2*nnz_lower + nnz_diag)) + allocate(data_save(2*nnz_lower + nnz_diag)) + call fill_first_half_indices(index_save, pos, nnz, nrows, ncols, MS_symmetric, j) + call generate_random_data_for_${s}$_coo(data_save, nnz_lower + nnz_diag) + call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_symmetric) + #:if t.startswith('complex') + else if(symmetry == MS_hermitian) then + nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part + nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/ncols) !! diagonal + allocate(index_save(2, 2*nnz_lower + nnz_diag)) + allocate(data_save(2*nnz_lower + nnz_diag)) + call fill_first_half_indices(index_save, pos, nnz, nrows, ncols, MS_hermitian, j) + call generate_random_data_for_${s}$_coo(data_save, nnz_lower+nnz_diag) + do i = 1, nnz_lower + nnz_diag + if(index_save(1, i) == index_save(2,i)) data_save(i) = real(data_save(i)) + end do + call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_hermitian) + #:endif + else + nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part + allocate(index_save(2, 2*nnz_lower)) + allocate(data_save(2*nnz_lower)) + call fill_first_half_indices(index_save, pos, nnz, nrows, ncols, MS_skew_symmetric, j) + call generate_random_data_for_${s}$_coo(data_save, nnz_lower) + call fill_other_half_${s}$(index_save, data_save, j, nnz_lower, MS_skew_symmetric) + end if + end subroutine #:endfor subroutine test_io_mm_coordinate(error) @@ -307,39 +360,14 @@ contains integer :: nrows, ncols ${t}$, allocatable :: data_save(:), data_load(:) integer, allocatable :: index_save(:, :), index_load(:,:) - #:if t.startswith('complex') - real(${k}$), allocatable :: R(:, :) - #:endif - - integer :: row, col, t_entries, nnz, nnz_lower, nnz_diag - integer, allocatable :: pos(:) - integer :: i, j, temp, adr - #:if t.startswith('int') - real(dp) :: rnd, density - #:else - real(${k}$) :: rnd, density - #:endif logical :: result nrows = 5 ncols = 5 - t_entries = nrows * ncols - #:if t.startswith('complex') - allocate(R(t_entries, 2)) - #:endif - allocate(pos(t_entries)) + call random_seed() ! General matrix - call generate_random_positions_${s}$(pos, t_entries) - call random_number(density) - nnz = ceiling(density*t_entries) - allocate(index_save(2, nnz)) - allocate(data_save(nnz)) - do i = 1, nnz - index_save(1,i) = mod(pos(i) - 1,ncols) + 1 - index_save(2,i) = (pos(i) - 1)/nrows + 1 - end do - call generate_random_for_${s}$_coo(data_save, nnz) + call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_general) call save_mm("test_mmio_sparse.mtx", index_save, data_save, format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) result = compare_coo_${s}$(index_save, index_load, data_save, data_load) @@ -350,16 +378,7 @@ contains if(allocated(data_save)) deallocate(data_save) ! Symmetric matrix - call generate_random_positions_${s}$(pos, t_entries) - call random_number(density) - nnz = ceiling(density*t_entries) - nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part - nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/ncols) !! diagonal - allocate(index_save(2, 2*nnz_lower + nnz_diag)) - allocate(data_save(2*nnz_lower + nnz_diag)) - call fill_first_half_indices_${s}$(index_save, pos, nnz, nrows, ncols, MS_symmetric, j) - call generate_random_for_${s}$_coo(data_save, nnz_lower + nnz_diag) - call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_symmetric) + call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_symmetric) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "symmetric", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) result = compare_coo_${s}$(index_save, index_load, data_save, data_load) @@ -370,15 +389,7 @@ contains if(allocated(data_save)) deallocate(data_save) ! Skew-symmetric matrix - call generate_random_positions_${s}$(pos, t_entries) - call random_number(density) - nnz = ceiling(density*t_entries) - nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part - allocate(index_save(2, 2*nnz_lower)) - allocate(data_save(2*nnz_lower)) - call fill_first_half_indices_${s}$(index_save, pos, nnz, nrows, ncols, MS_skew_symmetric, j) - call generate_random_for_${s}$_coo(data_save, nnz_lower) - call fill_other_half_${s}$(index_save, data_save, j, nnz_lower, MS_skew_symmetric) + call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_skew_symmetric) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "skew-symmetric", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) result = compare_coo_${s}$(index_save, index_load, data_save, data_load) @@ -390,19 +401,7 @@ contains #:if t.startswith('complex') ! Hermitian matrix - call generate_random_positions_${s}$(pos, t_entries) - call random_number(density) - nnz = ceiling(density*t_entries) - nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part - nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/ncols) !! diagonal - allocate(index_save(2, 2*nnz_lower + nnz_diag)) - allocate(data_save(2*nnz_lower + nnz_diag)) - call fill_first_half_indices_${s}$(index_save, pos, nnz, nrows, ncols, MS_hermitian, j) - call generate_random_for_${s}$_coo(data_save, nnz_lower+nnz_diag) - do i = 1, nnz_lower + nnz_diag - if(index_save(1, i) == index_save(2,i)) data_save(i) = real(data_save(i)) - end do - call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_hermitian) + call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_hermitian) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "hermitian", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) result = compare_coo_${s}$(index_save, index_load, data_save, data_load) From 4b27f8c501b86786044ab6ed87e9344d116513cd Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sat, 7 Mar 2026 17:53:15 +0530 Subject: [PATCH 35/50] minor changes --- test/io/test_io_mm.fypp | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index 90c1fe2b7..8f114d9c4 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -193,7 +193,7 @@ contains j = 1 do i = 1, nnz row = mod(pos(i) - 1,nrows) + 1 - col = (pos(i) - 1)/ncols + 1 + col = (pos(i) - 1)/nrows + 1 if(row < col) cycle index_save(1,j) = row index_save(2,j) = col @@ -203,7 +203,7 @@ contains j = 1 do i = 1, nnz row = mod(pos(i) - 1,nrows) + 1 - col = (pos(i) - 1)/ncols + 1 + col = (pos(i) - 1)/nrows + 1 if(row <= col) cycle index_save(1,j) = row index_save(2,j) = col @@ -256,8 +256,8 @@ contains end function subroutine fill_other_half_${s}$(index_save, data_save, j, half_nnz, symmetry) - integer, intent(out) :: index_save(:, :) - ${t}$, intent(out) :: data_save(:) + integer, intent(inout) :: index_save(:, :) + ${t}$, intent(inout) :: data_save(:) integer, intent(in) :: half_nnz, symmetry integer, intent(inout) :: j @@ -316,13 +316,13 @@ contains allocate(index_save(2, nnz)) allocate(data_save(nnz)) do i = 1, nnz - index_save(1,i) = mod(pos(i) - 1,ncols) + 1 + index_save(1,i) = mod(pos(i) - 1,nrows) + 1 index_save(2,i) = (pos(i) - 1)/nrows + 1 end do call generate_random_data_for_${s}$_coo(data_save, nnz) else if(symmetry == MS_symmetric) then - nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part - nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/ncols) !! diagonal + nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/nrows) !! lower triangular part + nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/nrows) !! diagonal allocate(index_save(2, 2*nnz_lower + nnz_diag)) allocate(data_save(2*nnz_lower + nnz_diag)) call fill_first_half_indices(index_save, pos, nnz, nrows, ncols, MS_symmetric, j) @@ -330,8 +330,8 @@ contains call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_symmetric) #:if t.startswith('complex') else if(symmetry == MS_hermitian) then - nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part - nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/ncols) !! diagonal + nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/nrows) !! lower triangular part + nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/nrows) !! diagonal allocate(index_save(2, 2*nnz_lower + nnz_diag)) allocate(data_save(2*nnz_lower + nnz_diag)) call fill_first_half_indices(index_save, pos, nnz, nrows, ncols, MS_hermitian, j) @@ -342,7 +342,7 @@ contains call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_hermitian) #:endif else - nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/ncols) !! lower triangular part + nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/nrows) !! lower triangular part allocate(index_save(2, 2*nnz_lower)) allocate(data_save(2*nnz_lower)) call fill_first_half_indices(index_save, pos, nnz, nrows, ncols, MS_skew_symmetric, j) From ad0225480981cd08d7ec41ff2c70f6aa68159ff5 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sat, 7 Mar 2026 18:12:41 +0530 Subject: [PATCH 36/50] minor improvements and updated fisher algorithm --- test/io/test_io_mm.fypp | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index 8f114d9c4..e3bd94d57 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -44,7 +44,7 @@ contains integer :: n n = size(A,dim=1) - + #:if t.startswith('real') call random_number(A) #:endif @@ -86,6 +86,7 @@ contains allocate(matrix_save(n,n)) allocate(A(n,n)) + call random_seed() ! General matrix call generate_random_${s}$_dense_matrix(matrix_save) call save_mm("test_mmio_dense.mtx", matrix_save, format = "G0") @@ -162,19 +163,17 @@ contains end subroutine subroutine generate_random_positions(pos, t_entries) - integer, intent(inout) :: pos(:) + integer, intent(out) :: pos(:) integer, intent(in) :: t_entries ! Internal variables integer :: i, j, temp real(dp) :: rnd - do i = 1, t_entries - pos(i) = i - end do - do i = t_entries, 1, -1 + pos = [(i,i=1,t_entries)] + do i = t_entries, 2, -1 call random_number(rnd) - j = ceiling(t_entries*rnd) + j = int(i*rnd) + 1 temp = pos(i) pos(i) = pos(j) pos(j) = temp @@ -247,7 +246,7 @@ contains ${t}$, intent(in) :: data_save(:), data_load(:) integer, intent(in) :: index_save(:, :), index_load(:,:) logical :: result - + #:if t.startswith('integer') result = all(index_save == index_load) .and. all(data_save == data_load) #:else @@ -292,7 +291,7 @@ contains end do end if end subroutine - + subroutine generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, symmetry) ${t}$, allocatable, intent(out) :: data_save(:) integer, allocatable, intent(out) :: index_save(:, :) @@ -311,7 +310,7 @@ contains call generate_random_positions(pos, nrows * ncols) call random_number(density) nnz = ceiling(density*nrows*ncols) - + if(symmetry == MS_general) then allocate(index_save(2, nnz)) allocate(data_save(nnz)) @@ -349,6 +348,7 @@ contains call generate_random_data_for_${s}$_coo(data_save, nnz_lower) call fill_other_half_${s}$(index_save, data_save, j, nnz_lower, MS_skew_symmetric) end if + if(allocated(pos)) deallocate(pos) end subroutine #:endfor @@ -398,7 +398,7 @@ contains if(allocated(error)) return if(allocated(index_save)) deallocate(index_save) if(allocated(data_save)) deallocate(data_save) - + #:if t.startswith('complex') ! Hermitian matrix call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_hermitian) From 749b798ced25ba86ce70ebfdc7727ca89179cb36 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sat, 7 Mar 2026 18:14:41 +0530 Subject: [PATCH 37/50] trim trailing whitespaces --- src/io/stdlib_io_mm.fypp | 10 +++---- src/io/stdlib_io_mm_load.fypp | 50 +++++++++++++++++------------------ src/io/stdlib_io_mm_save.fypp | 26 +++++++++--------- 3 files changed, 43 insertions(+), 43 deletions(-) diff --git a/src/io/stdlib_io_mm.fypp b/src/io/stdlib_io_mm.fypp index 6b2719ae2..fe2ae1799 100644 --- a/src/io/stdlib_io_mm.fypp +++ b/src/io/stdlib_io_mm.fypp @@ -6,9 +6,9 @@ #:set I_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES, INT_KINDS)) #:set RCI_KINDS_TYPES = R_KINDS_TYPES + C_KINDS_TYPES + I_KINDS_TYPES -!> The Matrix Market (MM) format is a simple, human-readable, ASCII format for sparse -!> and dense matrices. The format was developed at NIST (National Institute of Standards -!> and Technology) for the Matrix Market, a repository of test matrices for use in +!> The Matrix Market (MM) format is a simple, human-readable, ASCII format for sparse +!> and dense matrices. The format was developed at NIST (National Institute of Standards +!> and Technology) for the Matrix Market, a repository of test matrices for use in !> comparative studies of algorithms for numerical linear algebra. !> !> For more information, see: https://math.nist.gov/MatrixMarket/formats.html @@ -73,7 +73,7 @@ module stdlib_io_mm character(len=*), intent(in), optional :: symmetry integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg - end subroutine + end subroutine #:endfor #:for k, t, s in RCI_KINDS_TYPES @@ -86,7 +86,7 @@ module stdlib_io_mm character(len=*), intent(in), optional :: symmetry integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg - end subroutine + end subroutine #:endfor end interface save_mm public :: save_mm diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index 56d90dfcc..23003b425 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -13,17 +13,17 @@ submodule (stdlib_io_mm) stdlib_io_mm_load use stdlib_kinds implicit none - + enum, bind(c) enumerator :: MF_array = 1 enumerator :: MF_coordinate = 2 - end enum + end enum enum, bind(c) enumerator :: MQ_real = 1 enumerator :: MQ_integer = 2 enumerator :: MQ_complex = 3 enumerator :: MQ_pattern = 4 - end enum + end enum enum, bind(c) enumerator :: MS_general = 1 enumerator :: MS_symmetric = 2 @@ -53,9 +53,9 @@ contains integer(int8) :: stat character(:), allocatable, target :: ff character(len=:), pointer :: ffp - #:if t.startswith('complex') + #:if t.startswith('complex') real(${k}$) :: mold, val_r, val_i - #:else + #:else ${t}$ :: mold #:endif @@ -73,7 +73,7 @@ contains end if err = 1 - !----------------------------------------- + !----------------------------------------- ! Load file in a single string inquire(unit=u, size=fsze) allocate(character(fsze) :: ff) @@ -81,7 +81,7 @@ contains ffp => ff(1:) close(u) - !----------------------------------------- + !----------------------------------------- ! Read header call read_mm_header(ffp, header, err) if( err /= 0 ) then @@ -96,7 +96,7 @@ contains return end if - !----------------------------------------- + !----------------------------------------- ! Skip comments eol_position = shift_to_eol(ffp) ffp => ffp(eol_position+1:) @@ -105,7 +105,7 @@ contains ffp => ffp(eol_position+1:) end do - !----------------------------------------- + !----------------------------------------- ! Read matrix dimensions nrows = to_num_from_stream(ffp, nrows, stat) if( stat /= 0 ) then @@ -120,7 +120,7 @@ contains return end if - !----------------------------------------- + !----------------------------------------- ! Read actual matrix data allocate(matrix(nrows, ncols), stat=err) matrix = 0 @@ -202,9 +202,9 @@ contains integer, allocatable :: rows(:), cols(:) ${t}$, allocatable :: vals(:) integer :: nrows, ncols, n_diag - #:if t.startswith('complex') + #:if t.startswith('complex') real(${k}$) :: mold, val_r, val_i - #:else + #:else ${t}$ :: mold #:endif @@ -222,7 +222,7 @@ contains end if err = 1 - !----------------------------------------- + !----------------------------------------- ! Load file in a single string inquire(unit=u, size=fsze) allocate(character(fsze) :: ff) @@ -230,7 +230,7 @@ contains ffp => ff(1:) close(u) - !----------------------------------------- + !----------------------------------------- ! Read header call read_mm_header(ffp, header, err) if( err /= 0 ) then @@ -245,7 +245,7 @@ contains return end if - !----------------------------------------- + !----------------------------------------- ! Skip comments eol_position = shift_to_eol(ffp) ffp => ffp(eol_position+1:) @@ -253,8 +253,8 @@ contains eol_position = shift_to_eol(ffp) ffp => ffp(eol_position+1:) end do - - !----------------------------------------- + + !----------------------------------------- ! Read matrix dimensions nrows = to_num_from_stream(ffp, nrows, stat) if( stat /= 0 ) then @@ -274,7 +274,7 @@ contains message = 'Error reading nnz') return end if - + !----------------------------------------- ! Allocate temporary arrays to hold the file data allocate(rows(nnz)) @@ -309,7 +309,7 @@ contains return end if - !----------------------------------------- + !----------------------------------------- ! check storage hypothesis if(header%symmetry == MS_symmetric .or. header%symmetry == MS_hermitian) then allocate(index(2, 2*nnz-n_diag)) @@ -323,7 +323,7 @@ contains end if - !----------------------------------------- + !----------------------------------------- ! Fill in matrix entries from temporary arrays do i = 1, nnz index(1,i) = rows(i) @@ -335,7 +335,7 @@ contains if(allocated(cols)) deallocate(cols) if(allocated(vals)) deallocate(vals) - !----------------------------------------- + !----------------------------------------- ! Fill in symmetric entries if needed if(header%symmetry==MS_general) return adr = 1 @@ -364,7 +364,7 @@ contains return end if ffp => ffp(16:) - + ! Read object type: matrix if( .not. starts_with(ffp, "matrix ") ) then err = 1 @@ -372,9 +372,9 @@ contains end if ffp => ffp(8:) header%object = 1 ! matrix - + ! Read format type: coordinate or array - if( starts_with(ffp, "arr") ) then + if( starts_with(ffp, "arr") ) then ffp => ffp(7:) ! array header%format = MF_array else if( starts_with(ffp, "coo") ) then @@ -428,7 +428,7 @@ contains integer :: p !! position !---------------------------------------------- p = 1 - do while( p Write Matrix Market header @@ -440,7 +440,7 @@ contains else write(io, '(I0,1X,I0)', iostat=stat) nrows, ncols end if - + if (stat /= 0) then iostat = stat iomsg = "Error writing matrix dimensions" From 4a650547aceacda439699ff0d22a7b07f032a792 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Mon, 9 Mar 2026 17:06:41 +0530 Subject: [PATCH 38/50] add: pattern support and tests --- src/io/stdlib_io_mm_load.fypp | 67 +++++++++----- src/io/stdlib_io_mm_save.fypp | 165 ++++++++++++++++++++++------------ test/io/test_io_mm.fypp | 33 ++++++- 3 files changed, 185 insertions(+), 80 deletions(-) diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index 23003b425..91e8c600c 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -279,12 +279,22 @@ contains ! Allocate temporary arrays to hold the file data allocate(rows(nnz)) allocate(cols(nnz)) - allocate(vals(nnz)) + if(header%qualifier/=MQ_pattern) allocate(vals(nnz)) !----------------------------------------- ! Read actual matrix data and store inside temporary arrays n_diag = 0 read_vals: block + if(header%qualifier==MQ_pattern) then + do i = 1, nnz ! read entries from file + rows(i) = to_num_from_stream(ffp, rows(i), stat) + if(stat/=0) exit read_vals + cols(i) = to_num_from_stream(ffp, cols(i), stat) + if(stat/=0) exit read_vals + if(rows(i) == cols(i)) n_diag = n_diag + 1 + if(stat/=0) exit read_vals + end do + else do i = 1, nnz ! read entries from file rows(i) = to_num_from_stream(ffp, rows(i), stat) if(stat/=0) exit read_vals @@ -302,6 +312,7 @@ contains if(stat/=0) exit read_vals #:endif end do + end if end block read_vals if(stat /= 0 ) then call mm_fail_process(iostat = iostat, iomsg = iomsg, code = int(stat), & @@ -313,23 +324,30 @@ contains ! check storage hypothesis if(header%symmetry == MS_symmetric .or. header%symmetry == MS_hermitian) then allocate(index(2, 2*nnz-n_diag)) - allocate(data(2*nnz-n_diag)) + if(header%qualifier/=MQ_pattern) allocate(data(2*nnz-n_diag)) else if(header%symmetry == MS_skew_symmetric) then allocate(index(2, 2*nnz)) - allocate(data(2*nnz)) + if(header%qualifier/=MQ_pattern) allocate(data(2*nnz)) else allocate(index(2, nnz)) - allocate(data(nnz)) + if(header%qualifier/=MQ_pattern) allocate(data(nnz)) end if !----------------------------------------- ! Fill in matrix entries from temporary arrays - do i = 1, nnz - index(1,i) = rows(i) - index(2,i) = cols(i) - data(i) = vals(i) - end do + if(header%qualifier==MQ_pattern) then + do i = 1, nnz + index(1,i) = rows(i) + index(2,i) = cols(i) + end do + else + do i = 1, nnz + index(1,i) = rows(i) + index(2,i) = cols(i) + data(i) = vals(i) + end do + end if if(allocated(rows)) deallocate(rows) if(allocated(cols)) deallocate(cols) @@ -339,17 +357,26 @@ contains ! Fill in symmetric entries if needed if(header%symmetry==MS_general) return adr = 1 - do i = 1, nnz - if(index(1,i)==index(2,i)) cycle - index(1,nnz+adr) = index(2,i) - index(2,nnz+adr) = index(1,i) - data(nnz+adr) = data(i) - if(header%symmetry==MS_skew_symmetric) data(nnz+adr) = -data(i) - #:if t.startswith('complex') - if(header%symmetry==MS_hermitian) data(nnz+adr) = conjg(data(i)) - #:endif - adr = adr + 1 - end do + if(header%qualifier==MQ_pattern) then + do i = 1, nnz + if(index(1,i)==index(2,i)) cycle + index(1,nnz+adr) = index(2,i) + index(2,nnz+adr) = index(1,i) + adr = adr + 1 + end do + else + do i = 1, nnz + if(index(1,i)==index(2,i)) cycle + index(1,nnz+adr) = index(2,i) + index(2,nnz+adr) = index(1,i) + data(nnz+adr) = data(i) + if(header%symmetry==MS_skew_symmetric) data(nnz+adr) = -data(i) + #:if t.startswith('complex') + if(header%symmetry==MS_hermitian) data(nnz+adr) = conjg(data(i)) + #:endif + adr = adr + 1 + end do + end if end subroutine #:endfor diff --git a/src/io/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp index 22a40cd2c..021ff89ef 100644 --- a/src/io/stdlib_io_mm_save.fypp +++ b/src/io/stdlib_io_mm_save.fypp @@ -256,6 +256,7 @@ contains character(len=:), allocatable :: field_type character(len=:), allocatable :: fmt_ character(len=:), allocatable :: symmetry_ + logical :: is_pattern #:if t.startswith('complex') real(${k}$) :: real_part, imag_part #:endif @@ -263,30 +264,47 @@ contains if(present(iomsg)) iomsg = '' stat = 0 - #:if t.startswith('integer') - fmt_ = "I0" - #:else - fmt_ = "ES24.16E3" - #:endif - if(present(format)) fmt_ = format + if(size(data)==1 .and. size(data)/=size(index,dim=2)) then + is_pattern = .true. + else + is_pattern = .false. + end if - #:if t.startswith('real') - fmt_ = '(I0,1X,I0,1X,' // fmt_ //')' - #:elif t.startswith('complex') - fmt_ = '(I0,1X,I0,1X,' // fmt_//',1X,'//fmt_//')' - #:elif t.startswith('integer') - fmt_ = '(I0,1X,I0,1X,'// fmt_ //')' - #:endif + if(is_pattern) then + fmt_ = '(I0,1X,I0)' + else + #:if t.startswith('integer') + fmt_ = "I0" + #:else + fmt_ = "ES24.16E3" + #:endif + if(present(format)) fmt_ = format + #:if t.startswith('real') + fmt_ = '(I0,1X,I0,1X,' // fmt_ //')' + #:elif t.startswith('complex') + fmt_ = '(I0,1X,I0,1X,' // fmt_//',1X,'//fmt_//')' + #:elif t.startswith('integer') + fmt_ = '(I0,1X,I0,1X,'// fmt_ //')' + #:endif + end if io = open(filename, "w", iostat=stat) if (stat /= 0) then call mm_fail_process(iostat = iostat, iomsg = iomsg, code = stat,& message = "Could not create file: " // filename) + return + end if + + if (.not. is_pattern .and. size(data) /= size(index,dim=2)) then + call mm_fail_process(iostat=iostat, iomsg=iomsg, code=1, & + message="Invalid COO data size") + return end if if(size(index, dim=1)/=2) then call mm_fail_process(iostat = iostat, iomsg = iomsg, code = stat,& message = "Invalid index dimensions: first dimension must be 2") + return end if ! Determine symmetry type @@ -296,13 +314,17 @@ contains end if ! Determine field type based on matrix type - #:if t.startswith('real') - field_type = MM_REAL - #:elif t.startswith('complex') - field_type = MM_COMPLEX - #:elif t.startswith('integer') - field_type = MM_INTEGER - #:endif + if(is_pattern) then + field_type = MM_PATTERN + else + #:if t.startswith('real') + field_type = MM_REAL + #:elif t.startswith('complex') + field_type = MM_COMPLEX + #:elif t.startswith('integer') + field_type = MM_INTEGER + #:endif + end if catch: block ! Calculate the nnz to write inside mtx file @@ -327,50 +349,74 @@ contains ! Write coordinate format (row, column, value) if(symmetry_ == MM_GENERAL) then - do i = 1, nnz_to_write - #:if t.startswith('real') - write(io, fmt=fmt_, iostat=stat) & - index(1,i), index(2,i), data(i) - #:elif t.startswith('complex') - real_part = real(data(i), kind=${k}$) - imag_part = aimag(data(i)) - write(io, fmt=fmt_, iostat=stat) & - index(1,i), index(2,i), real_part, imag_part - #:elif t.startswith('integer') - write(io, fmt=fmt_, iostat=stat) & - index(1,i), index(2,i), data(i) - #:endif - if (stat /= 0) then - msg = "Error writing array element (" // to_string(i) // ")" - exit catch - end if - end do + if(is_pattern) then + do i = 1, nnz_to_write + write(io, fmt=fmt_, iostat=stat) & + index(1,i), index(2,i) + if (stat /= 0) then + msg = "Error writing array element (" // to_string(i) // ")" + exit catch + end if + end do + else + do i = 1, nnz_to_write + #:if t.startswith('real') + write(io, fmt=fmt_, iostat=stat) & + index(1,i), index(2,i), data(i) + #:elif t.startswith('complex') + real_part = real(data(i), kind=${k}$) + imag_part = aimag(data(i)) + write(io, fmt=fmt_, iostat=stat) & + index(1,i), index(2,i), real_part, imag_part + #:elif t.startswith('integer') + write(io, fmt=fmt_, iostat=stat) & + index(1,i), index(2,i), data(i) + #:endif + if (stat /= 0) then + msg = "Error writing array element (" // to_string(i) // ")" + exit catch + end if + end do + end if else ! For symmetric and hermitian matrices, only the lower triangle ! (including the diagonal) is written. ! For skew-symmetric matrices, only the strictly lower triangle is written ! (the diagonal is omitted and assumed zero). - do i = 1, size(index, dim=2) - if(index(1,i) < index(2,i)) cycle - if(symmetry_ == MM_SKEW_SYMMETRIC .and. index(1,i) == index(2,i)) cycle - #:if t.startswith('real') - write(io, fmt=fmt_, iostat=stat) & - index(1,i), index(2,i), data(i) - #:elif t.startswith('complex') - real_part = real(data(i), kind=${k}$) - imag_part = aimag(data(i)) - if(index(1,i)==index(2,i) .and. symmetry_ == MM_HERMITIAN) imag_part = 0 - write(io, fmt=fmt_, iostat=stat) & - index(1,i), index(2,i), real_part, imag_part - #:elif t.startswith('integer') - write(io, fmt=fmt_, iostat=stat) & - index(1,i), index(2,i), data(i) - #:endif - if (stat /= 0) then - msg = "Error writing array element (" // to_string(i) // ")" - exit catch - end if - end do + if(is_pattern) then + do i = 1, size(index, dim=2) + if(index(1,i) < index(2,i)) cycle + if(symmetry_ == MM_SKEW_SYMMETRIC .and. index(1,i) == index(2,i)) cycle + write(io, fmt=fmt_, iostat=stat) & + index(1,i), index(2,i) + if (stat /= 0) then + msg = "Error writing array element (" // to_string(i) // ")" + exit catch + end if + end do + else + do i = 1, size(index, dim=2) + if(index(1,i) < index(2,i)) cycle + if(symmetry_ == MM_SKEW_SYMMETRIC .and. index(1,i) == index(2,i)) cycle + #:if t.startswith('real') + write(io, fmt=fmt_, iostat=stat) & + index(1,i), index(2,i), data(i) + #:elif t.startswith('complex') + real_part = real(data(i), kind=${k}$) + imag_part = aimag(data(i)) + if(index(1,i)==index(2,i) .and. symmetry_ == MM_HERMITIAN) imag_part = 0 + write(io, fmt=fmt_, iostat=stat) & + index(1,i), index(2,i), real_part, imag_part + #:elif t.startswith('integer') + write(io, fmt=fmt_, iostat=stat) & + index(1,i), index(2,i), data(i) + #:endif + if (stat /= 0) then + msg = "Error writing array element (" // to_string(i) // ")" + exit catch + end if + end do + end if end if end block catch @@ -379,6 +425,7 @@ contains if(stat/=0) then call mm_fail_process(iostat = iostat, iomsg = iomsg, code = stat,& message = "Failed to save Matrix Market file '" // filename // "': " // msg) + return end if if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index e3bd94d57..516bd8202 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -352,10 +352,17 @@ contains end subroutine #:endfor + pure function compare_coo_pattern(index_save, index_load) result(result) + integer, intent(in) :: index_save(:, :), index_load(:,:) + logical :: result + + result = all(index_save == index_load) + end function + subroutine test_io_mm_coordinate(error) !> Error handling type(error_type), allocatable, intent(out) :: error - #:for k, t, s in (KINDS_TYPES) + #:for k, t, s in KINDS_TYPES block integer :: nrows, ncols ${t}$, allocatable :: data_save(:), data_load(:) @@ -374,6 +381,12 @@ contains call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=unspecified, type=${t}$") if(allocated(error)) return + call save_mm("test_mmio_sparse.mtx", index_save, [0], format = "G0") + call load_mm("test_mmio_sparse.mtx", index_load, data_load) + result = compare_coo_pattern(index_save, index_load) + call check(error, result, .true.,& + "MM coordinate test failed: symmetry_arg=unspecified, type=pattern") + if(allocated(error)) return if(allocated(index_save)) deallocate(index_save) if(allocated(data_save)) deallocate(data_save) @@ -385,6 +398,12 @@ contains call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=symmetric, type=${t}$") if(allocated(error)) return + call save_mm("test_mmio_sparse.mtx", index_save, [0], symmetry = "symmetric", format = "G0") + call load_mm("test_mmio_sparse.mtx", index_load, data_load) + result = compare_coo_pattern(index_save, index_load) + call check(error, result, .true.,& + "MM coordinate test failed: symmetry_arg=symmetric, type=pattern") + if(allocated(error)) return if(allocated(index_save)) deallocate(index_save) if(allocated(data_save)) deallocate(data_save) @@ -396,6 +415,12 @@ contains call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=skew-symmetric, type=${t}$") if(allocated(error)) return + call save_mm("test_mmio_sparse.mtx", index_save, [0], symmetry = "skew-symmetric", format = "G0") + call load_mm("test_mmio_sparse.mtx", index_load, data_load) + result = compare_coo_pattern(index_save, index_load) + call check(error, result, .true.,& + "MM coordinate test failed: symmetry_arg=skew-symmetric, type=pattern") + if(allocated(error)) return if(allocated(index_save)) deallocate(index_save) if(allocated(data_save)) deallocate(data_save) @@ -408,6 +433,12 @@ contains call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=hermitian, type=${t}$") if(allocated(error)) return + call save_mm("test_mmio_sparse.mtx", index_save, [0], symmetry = "hermitian", format = "G0") + call load_mm("test_mmio_sparse.mtx", index_load, data_load) + result = compare_coo_pattern(index_save, index_load) + call check(error, result, .true.,& + "MM coordinate test failed: symmetry_arg=hermitian, type=pattern") + if(allocated(error)) return if(allocated(index_save)) deallocate(index_save) if(allocated(data_save)) deallocate(data_save) #:endif From 3183c37bf5d1f26bd34b22b4917282782a6c0ec5 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Fri, 13 Mar 2026 21:33:18 +0100 Subject: [PATCH 39/50] delet file --- test_simple.mtx | 7 ------- 1 file changed, 7 deletions(-) delete mode 100644 test_simple.mtx diff --git a/test_simple.mtx b/test_simple.mtx deleted file mode 100644 index 4c14cc1a7..000000000 --- a/test_simple.mtx +++ /dev/null @@ -1,7 +0,0 @@ -%%MatrixMarket matrix array real general -% Simple 2x2 test matrix -2 2 -1.0 -0.0 -0.0 -2.0 \ No newline at end of file From 874bad2710a6e1258de28cff2b49a789b2d3480d Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sat, 14 Mar 2026 13:06:28 +0530 Subject: [PATCH 40/50] modify: remove pattern test duplication --- test/io/test_io_mm.fypp | 193 ++++++++++++++++++++++++++-------------- 1 file changed, 126 insertions(+), 67 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index 516bd8202..fe04c14a1 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -254,48 +254,77 @@ contains #:endif end function - subroutine fill_other_half_${s}$(index_save, data_save, j, half_nnz, symmetry) + subroutine fill_other_half_${s}$(index_save, data_save, j, half_nnz, symmetry, is_pattern) integer, intent(inout) :: index_save(:, :) ${t}$, intent(inout) :: data_save(:) integer, intent(in) :: half_nnz, symmetry integer, intent(inout) :: j + logical, intent(in) :: is_pattern ! Internal variables. integer :: i - if(symmetry == MS_symmetric) then - do i = 1, half_nnz - if(index_save(1,i) == index_save(2,i)) cycle - index_save(1,j) = index_save(2,i) - index_save(2,j) = index_save(1,i) - data_save(j) = data_save(i) - j=j+1 - end do - #:if t.startswith('complex') - else if(symmetry == MS_hermitian) then - do i = 1, half_nnz - if(index_save(1,i) == index_save(2,i)) cycle - index_save(1,j) = index_save(2,i) - index_save(2,j) = index_save(1,i) - data_save(j) = conjg(data_save(i)) - j=j+1 - end do - #:endif + if(.not. is_pattern) then + if(symmetry == MS_symmetric) then + do i = 1, half_nnz + if(index_save(1,i) == index_save(2,i)) cycle + index_save(1,j) = index_save(2,i) + index_save(2,j) = index_save(1,i) + data_save(j) = data_save(i) + j=j+1 + end do + #:if t.startswith('complex') + else if(symmetry == MS_hermitian) then + do i = 1, half_nnz + if(index_save(1,i) == index_save(2,i)) cycle + index_save(1,j) = index_save(2,i) + index_save(2,j) = index_save(1,i) + data_save(j) = conjg(data_save(i)) + j=j+1 + end do + #:endif + else + do i = 1, half_nnz + if(index_save(1,i) == index_save(2,i)) cycle + index_save(1,j) = index_save(2,i) + index_save(2,j) = index_save(1,i) + data_save(j) = -data_save(i) + j=j+1 + end do + end if else - do i = 1, half_nnz - if(index_save(1,i) == index_save(2,i)) cycle - index_save(1,j) = index_save(2,i) - index_save(2,j) = index_save(1,i) - data_save(j) = -data_save(i) - j=j+1 - end do + if(symmetry == MS_symmetric) then + do i = 1, half_nnz + if(index_save(1,i) == index_save(2,i)) cycle + index_save(1,j) = index_save(2,i) + index_save(2,j) = index_save(1,i) + j=j+1 + end do + #:if t.startswith('complex') + else if(symmetry == MS_hermitian) then + do i = 1, half_nnz + if(index_save(1,i) == index_save(2,i)) cycle + index_save(1,j) = index_save(2,i) + index_save(2,j) = index_save(1,i) + j=j+1 + end do + #:endif + else + do i = 1, half_nnz + if(index_save(1,i) == index_save(2,i)) cycle + index_save(1,j) = index_save(2,i) + index_save(2,j) = index_save(1,i) + j=j+1 + end do + end if end if end subroutine - subroutine generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, symmetry) + subroutine generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, symmetry, is_pattern) ${t}$, allocatable, intent(out) :: data_save(:) integer, allocatable, intent(out) :: index_save(:, :) integer, intent(in) :: nrows, ncols, symmetry + logical, intent(in) :: is_pattern ! Internal variables integer, allocatable :: pos(:) @@ -313,40 +342,42 @@ contains if(symmetry == MS_general) then allocate(index_save(2, nnz)) - allocate(data_save(nnz)) + if(.not. is_pattern) allocate(data_save(nnz)) do i = 1, nnz index_save(1,i) = mod(pos(i) - 1,nrows) + 1 index_save(2,i) = (pos(i) - 1)/nrows + 1 end do - call generate_random_data_for_${s}$_coo(data_save, nnz) + if(.not. is_pattern) call generate_random_data_for_${s}$_coo(data_save, nnz) else if(symmetry == MS_symmetric) then nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/nrows) !! lower triangular part nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/nrows) !! diagonal allocate(index_save(2, 2*nnz_lower + nnz_diag)) - allocate(data_save(2*nnz_lower + nnz_diag)) + if(.not. is_pattern) allocate(data_save(2*nnz_lower + nnz_diag)) call fill_first_half_indices(index_save, pos, nnz, nrows, ncols, MS_symmetric, j) - call generate_random_data_for_${s}$_coo(data_save, nnz_lower + nnz_diag) - call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_symmetric) + if(.not. is_pattern) call generate_random_data_for_${s}$_coo(data_save, nnz_lower + nnz_diag) + call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_symmetric, is_pattern) #:if t.startswith('complex') else if(symmetry == MS_hermitian) then nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/nrows) !! lower triangular part nnz_diag = count(mod(pos(1:nnz) - 1,nrows) == (pos(1:nnz) - 1)/nrows) !! diagonal allocate(index_save(2, 2*nnz_lower + nnz_diag)) - allocate(data_save(2*nnz_lower + nnz_diag)) + if(.not. is_pattern) allocate(data_save(2*nnz_lower + nnz_diag)) call fill_first_half_indices(index_save, pos, nnz, nrows, ncols, MS_hermitian, j) - call generate_random_data_for_${s}$_coo(data_save, nnz_lower+nnz_diag) - do i = 1, nnz_lower + nnz_diag - if(index_save(1, i) == index_save(2,i)) data_save(i) = real(data_save(i)) - end do - call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_hermitian) + if(.not. is_pattern) call generate_random_data_for_${s}$_coo(data_save, nnz_lower+nnz_diag) + if(.not. is_pattern) then + do i = 1, nnz_lower + nnz_diag + if(index_save(1, i) == index_save(2,i)) data_save(i) = real(data_save(i)) + end do + end if + call fill_other_half_${s}$(index_save, data_save, j, nnz_lower+nnz_diag, MS_hermitian, is_pattern) #:endif else nnz_lower = count(mod(pos(1:nnz) - 1,nrows) > (pos(1:nnz) - 1)/nrows) !! lower triangular part allocate(index_save(2, 2*nnz_lower)) - allocate(data_save(2*nnz_lower)) + if(.not. is_pattern) allocate(data_save(2*nnz_lower)) call fill_first_half_indices(index_save, pos, nnz, nrows, ncols, MS_skew_symmetric, j) - call generate_random_data_for_${s}$_coo(data_save, nnz_lower) - call fill_other_half_${s}$(index_save, data_save, j, nnz_lower, MS_skew_symmetric) + if(.not. is_pattern) call generate_random_data_for_${s}$_coo(data_save, nnz_lower) + call fill_other_half_${s}$(index_save, data_save, j, nnz_lower, MS_skew_symmetric, is_pattern) end if if(allocated(pos)) deallocate(pos) end subroutine @@ -374,76 +405,104 @@ contains call random_seed() ! General matrix - call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_general) + call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_general, .false.) call save_mm("test_mmio_sparse.mtx", index_save, data_save, format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) result = compare_coo_${s}$(index_save, index_load, data_save, data_load) call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=unspecified, type=${t}$") if(allocated(error)) return - call save_mm("test_mmio_sparse.mtx", index_save, [0], format = "G0") - call load_mm("test_mmio_sparse.mtx", index_load, data_load) - result = compare_coo_pattern(index_save, index_load) - call check(error, result, .true.,& - "MM coordinate test failed: symmetry_arg=unspecified, type=pattern") - if(allocated(error)) return if(allocated(index_save)) deallocate(index_save) if(allocated(data_save)) deallocate(data_save) ! Symmetric matrix - call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_symmetric) + call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_symmetric, .false.) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "symmetric", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) result = compare_coo_${s}$(index_save, index_load, data_save, data_load) call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=symmetric, type=${t}$") if(allocated(error)) return - call save_mm("test_mmio_sparse.mtx", index_save, [0], symmetry = "symmetric", format = "G0") - call load_mm("test_mmio_sparse.mtx", index_load, data_load) - result = compare_coo_pattern(index_save, index_load) - call check(error, result, .true.,& - "MM coordinate test failed: symmetry_arg=symmetric, type=pattern") - if(allocated(error)) return if(allocated(index_save)) deallocate(index_save) if(allocated(data_save)) deallocate(data_save) ! Skew-symmetric matrix - call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_skew_symmetric) + call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_skew_symmetric, .false.) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "skew-symmetric", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) result = compare_coo_${s}$(index_save, index_load, data_save, data_load) call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=skew-symmetric, type=${t}$") if(allocated(error)) return - call save_mm("test_mmio_sparse.mtx", index_save, [0], symmetry = "skew-symmetric", format = "G0") - call load_mm("test_mmio_sparse.mtx", index_load, data_load) - result = compare_coo_pattern(index_save, index_load) - call check(error, result, .true.,& - "MM coordinate test failed: symmetry_arg=skew-symmetric, type=pattern") - if(allocated(error)) return if(allocated(index_save)) deallocate(index_save) if(allocated(data_save)) deallocate(data_save) #:if t.startswith('complex') ! Hermitian matrix - call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_hermitian) + call generate_random_${s}$_coo_matrix(index_save, data_save, nrows, ncols, MS_hermitian, .false.) call save_mm("test_mmio_sparse.mtx", index_save, data_save, symmetry = "hermitian", format = "G0") call load_mm("test_mmio_sparse.mtx", index_load, data_load) result = compare_coo_${s}$(index_save, index_load, data_save, data_load) call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=hermitian, type=${t}$") if(allocated(error)) return + if(allocated(index_save)) deallocate(index_save) + if(allocated(data_save)) deallocate(data_save) + #:endif + end block + #:endfor + + ! Pattern tests + block + integer :: nrows, ncols + real(sp), allocatable :: dummy(:) ! Dummy data matrix + integer, allocatable :: index_save(:, :), index_load(:,:) + logical :: result + + nrows = 5 + ncols = 5 + + call random_seed() + ! General matrix + call generate_random_sp_coo_matrix(index_save, dummy, nrows, ncols, MS_general, .true.) + call save_mm("test_mmio_sparse.mtx", index_save, [0], format = "G0") + call load_mm("test_mmio_sparse.mtx", index_load, dummy) + result = compare_coo_pattern(index_save, index_load) + call check(error, result, .true.,& + "MM coordinate test failed: symmetry_arg=unspecified, type=pattern") + if(allocated(error)) return + if(allocated(index_save)) deallocate(index_save) + + ! Symmetric matrix + call generate_random_sp_coo_matrix(index_save, dummy, nrows, ncols, MS_symmetric, .true.) + call save_mm("test_mmio_sparse.mtx", index_save, [0], symmetry = "symmetric", format = "G0") + call load_mm("test_mmio_sparse.mtx", index_load, dummy) + result = compare_coo_pattern(index_save, index_load) + call check(error, result, .true.,& + "MM coordinate test failed: symmetry_arg=symmetric, type=pattern") + if(allocated(error)) return + if(allocated(index_save)) deallocate(index_save) + + ! Skew-symmetric matrix + call generate_random_sp_coo_matrix(index_save, dummy, nrows, ncols, MS_skew_symmetric, .true.) + call save_mm("test_mmio_sparse.mtx", index_save, [0], symmetry = "skew-symmetric", format = "G0") + call load_mm("test_mmio_sparse.mtx", index_load, dummy) + result = compare_coo_pattern(index_save, index_load) + call check(error, result, .true.,& + "MM coordinate test failed: symmetry_arg=skew-symmetric, type=pattern") + if(allocated(error)) return + if(allocated(index_save)) deallocate(index_save) + + ! Hermitian matrix + call generate_random_sp_coo_matrix(index_save, dummy, nrows, ncols, MS_hermitian, .true.) call save_mm("test_mmio_sparse.mtx", index_save, [0], symmetry = "hermitian", format = "G0") - call load_mm("test_mmio_sparse.mtx", index_load, data_load) + call load_mm("test_mmio_sparse.mtx", index_load, dummy) result = compare_coo_pattern(index_save, index_load) call check(error, result, .true.,& "MM coordinate test failed: symmetry_arg=hermitian, type=pattern") if(allocated(error)) return if(allocated(index_save)) deallocate(index_save) - if(allocated(data_save)) deallocate(data_save) - #:endif end block - #:endfor end subroutine end module From e00ee73feb4ad788640a19a23028407f696d6fbc Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Sat, 14 Mar 2026 13:11:30 +0530 Subject: [PATCH 41/50] move optional arguments to last inside mm_fail_process declaration --- src/io/stdlib_io_mm_load.fypp | 2 +- src/io/stdlib_io_mm_save.fypp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index 91e8c600c..c81b13b51 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -466,7 +466,7 @@ contains end if end function - subroutine mm_fail_process(iostat, iomsg, code, message) + subroutine mm_fail_process(code, message, iostat, iomsg) integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg integer, intent(in) :: code diff --git a/src/io/stdlib_io_mm_save.fypp b/src/io/stdlib_io_mm_save.fypp index 021ff89ef..f8c556567 100644 --- a/src/io/stdlib_io_mm_save.fypp +++ b/src/io/stdlib_io_mm_save.fypp @@ -495,7 +495,7 @@ contains end if end subroutine write_mm_header - subroutine mm_fail_process(iostat, iomsg, code, message) + subroutine mm_fail_process(code, message, iostat, iomsg) integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg integer, intent(in) :: code From bfd3bccb39fc797e797e8ce9ec6d70b42cc97056 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Fri, 3 Apr 2026 15:29:19 +0530 Subject: [PATCH 42/50] fix: while loop in comments part --- src/io/stdlib_io_mm_load.fypp | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index c81b13b51..f495fa3e3 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -247,8 +247,6 @@ contains !----------------------------------------- ! Skip comments - eol_position = shift_to_eol(ffp) - ffp => ffp(eol_position+1:) do while( iachar(ffp(1:1))==PP ) eol_position = shift_to_eol(ffp) ffp => ffp(eol_position+1:) From 37196b4cab71f2d36b34a43bb656122212dd9660 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Tue, 21 Apr 2026 00:42:24 +0530 Subject: [PATCH 43/50] revert cmake and add fypp _FILE_ variable --- test/data/matrix_market/fidap005.mtx | 281 ++++++++++++++++++ test/data/matrix_market/fidap005.mtx_data.npy | Bin 0 -> 2360 bytes .../matrix_market/fidap005.mtx_indices.npy | Bin 0 -> 2360 bytes test/io/test_io_mm.fypp | 46 +++ 4 files changed, 327 insertions(+) create mode 100644 test/data/matrix_market/fidap005.mtx create mode 100644 test/data/matrix_market/fidap005.mtx_data.npy create mode 100644 test/data/matrix_market/fidap005.mtx_indices.npy diff --git a/test/data/matrix_market/fidap005.mtx b/test/data/matrix_market/fidap005.mtx new file mode 100644 index 000000000..b07b69beb --- /dev/null +++ b/test/data/matrix_market/fidap005.mtx @@ -0,0 +1,281 @@ +%%MatrixMarket matrix coordinate real general +27 27 279 +1 1 1.0370389925925e+06 +2 1 2.5925905925925e+05 +10 1 -1.1851862518518e+06 +11 1 -2.9629665185183e+05 +19 1 1.4814814814813e+05 +20 1 3.7037148148145e+04 +1 2 2.5925905925925e+05 +2 2 2.9629754074078e+05 +3 2 2.5925905925929e+05 +4 2 -1.8518551851871e+04 +10 2 -2.9629665185185e+05 +11 2 -1.4814854814816e+05 +12 2 -2.9629665185189e+05 +13 2 -7.4073962962971e+04 +19 2 3.7037148148146e+04 +20 2 -1.4814821481483e+05 +21 2 3.7037148148160e+04 +22 2 9.2592570370393e+04 +2 3 2.5925905925929e+05 +3 3 1.0370389925926e+06 +4 3 2.5925905925926e+05 +11 3 -2.9629665185187e+05 +12 3 -1.1851862518518e+06 +13 3 -2.9629665185184e+05 +20 3 3.7037148148138e+04 +21 3 1.4814814814814e+05 +22 3 3.7037148148151e+04 +2 4 -1.8518551851871e+04 +3 4 2.5925905925926e+05 +4 4 2.9629754074078e+05 +5 4 2.5925905925929e+05 +6 4 -1.8518551851853e+04 +11 4 -7.4073962962959e+04 +12 4 -2.9629665185181e+05 +13 4 -1.4814854814814e+05 +14 4 -2.9629665185187e+05 +15 4 -7.4073962962958e+04 +20 4 9.2592570370383e+04 +21 4 3.7037148148130e+04 +22 4 -1.4814821481485e+05 +23 4 3.7037148148128e+04 +24 4 9.2592570370382e+04 +4 5 2.5925905925929e+05 +5 5 1.0370389925926e+06 +6 5 2.5925905925929e+05 +13 5 -2.9629665185187e+05 +14 5 -1.1851862518519e+06 +15 5 -2.9629665185185e+05 +22 5 3.7037148148052e+04 +23 5 1.4814814814786e+05 +24 5 3.7037148148072e+04 +4 6 -1.8518551851853e+04 +5 6 2.5925905925929e+05 +6 6 2.9629754074080e+05 +7 6 2.5925905925917e+05 +8 6 -1.8518551851932e+04 +13 6 -7.4073962962968e+04 +14 6 -2.9629665185186e+05 +15 6 -1.4814854814816e+05 +16 6 -2.9629665185186e+05 +17 6 -7.4073962962958e+04 +22 6 9.2592570370359e+04 +23 6 3.7037148148071e+04 +24 6 -1.4814821481487e+05 +25 6 3.7037148148270e+04 +26 6 9.2592570370455e+04 +6 7 2.5925905925917e+05 +7 7 1.0370389925923e+06 +8 7 2.5925905925921e+05 +15 7 -2.9629665185186e+05 +16 7 -1.1851862518519e+06 +17 7 -2.9629665185184e+05 +24 7 3.7037148148208e+04 +25 7 1.4814814814847e+05 +26 7 3.7037148148278e+04 +6 8 -1.8518551851932e+04 +7 8 2.5925905925921e+05 +8 8 2.9629754074058e+05 +9 8 2.5925905925904e+05 +15 8 -7.4073962962964e+04 +16 8 -2.9629665185184e+05 +17 8 -1.4814854814815e+05 +18 8 -2.9629665185188e+05 +24 8 9.2592570370439e+04 +25 8 3.7037148148223e+04 +26 8 -1.4814821481463e+05 +27 8 3.7037148148387e+04 +8 9 2.5925905925904e+05 +9 9 1.0370389925921e+06 +17 9 -2.9629665185188e+05 +18 9 -1.1851862518519e+06 +26 9 3.7037148148464e+04 +27 9 1.4814814814901e+05 +1 10 -1.1851862518518e+06 +2 10 -2.9629665185185e+05 +10 10 2.3703760592592e+06 +11 10 5.9259152592589e+05 +19 10 -1.1851862518518e+06 +20 10 -2.9629665185183e+05 +1 11 -2.9629665185183e+05 +2 11 -1.4814854814816e+05 +3 11 -2.9629665185187e+05 +4 11 -7.4073962962959e+04 +10 11 5.9259152592589e+05 +11 11 2.9630020740741e+05 +12 11 5.9259152592596e+05 +13 11 1.4814814814815e+05 +19 11 -2.9629665185184e+05 +20 11 -1.4814854814815e+05 +21 11 -2.9629665185187e+05 +22 11 -7.4073962962967e+04 +2 12 -2.9629665185189e+05 +3 12 -1.1851862518518e+06 +4 12 -2.9629665185181e+05 +11 12 5.9259152592596e+05 +12 12 2.3703760592593e+06 +13 12 5.9259152592591e+05 +20 12 -2.9629665185185e+05 +21 12 -1.1851862518519e+06 +22 12 -2.9629665185186e+05 +2 13 -7.4073962962971e+04 +3 13 -2.9629665185184e+05 +4 13 -1.4814854814814e+05 +5 13 -2.9629665185187e+05 +6 13 -7.4073962962968e+04 +11 13 1.4814814814815e+05 +12 13 5.9259152592591e+05 +13 13 2.9630020740741e+05 +14 13 5.9259152592596e+05 +15 13 1.4814814814815e+05 +20 13 -7.4073962962958e+04 +21 13 -2.9629665185185e+05 +22 13 -1.4814854814815e+05 +23 13 -2.9629665185187e+05 +24 13 -7.4073962962969e+04 +4 14 -2.9629665185187e+05 +5 14 -1.1851862518519e+06 +6 14 -2.9629665185186e+05 +13 14 5.9259152592596e+05 +14 14 2.3703760592594e+06 +15 14 5.9259152592593e+05 +22 14 -2.9629665185185e+05 +23 14 -1.1851862518519e+06 +24 14 -2.9629665185186e+05 +4 15 -7.4073962962958e+04 +5 15 -2.9629665185185e+05 +6 15 -1.4814854814816e+05 +7 15 -2.9629665185186e+05 +8 15 -7.4073962962964e+04 +13 15 1.4814814814815e+05 +14 15 5.9259152592593e+05 +15 15 2.9630020740741e+05 +16 15 5.9259152592595e+05 +17 15 1.4814814814815e+05 +22 15 -7.4073962962968e+04 +23 15 -2.9629665185185e+05 +24 15 -1.4814854814814e+05 +25 15 -2.9629665185186e+05 +26 15 -7.4073962962966e+04 +6 16 -2.9629665185186e+05 +7 16 -1.1851862518519e+06 +8 16 -2.9629665185184e+05 +15 16 5.9259152592595e+05 +16 16 2.3703760592593e+06 +17 16 5.9259152592590e+05 +24 16 -2.9629665185184e+05 +25 16 -1.1851862518518e+06 +26 16 -2.9629665185186e+05 +6 17 -7.4073962962958e+04 +7 17 -2.9629665185184e+05 +8 17 -1.4814854814815e+05 +9 17 -2.9629665185188e+05 +15 17 1.4814814814815e+05 +16 17 5.9259152592590e+05 +17 17 2.9630020740741e+05 +18 17 5.9259152592598e+05 +24 17 -7.4073962962960e+04 +25 17 -2.9629665185183e+05 +26 17 -1.4814854814815e+05 +27 17 -2.9629665185188e+05 +8 18 -2.9629665185188e+05 +9 18 -1.1851862518519e+06 +17 18 5.9259152592598e+05 +18 18 2.3703760592593e+06 +26 18 -2.9629665185185e+05 +27 18 -1.1851862518519e+06 +1 19 1.4814814814813e+05 +2 19 3.7037148148146e+04 +10 19 -1.1851862518518e+06 +11 19 -2.9629665185184e+05 +19 19 1.0370389925926e+06 +20 19 2.5925905925926e+05 +1 20 3.7037148148145e+04 +2 20 -1.4814821481483e+05 +3 20 3.7037148148138e+04 +4 20 9.2592570370383e+04 +10 20 -2.9629665185183e+05 +11 20 -1.4814854814815e+05 +12 20 -2.9629665185185e+05 +13 20 -7.4073962962958e+04 +19 20 2.5925905925926e+05 +20 20 2.9629754074076e+05 +21 20 2.5925905925926e+05 +22 20 -1.8518551851868e+04 +2 21 3.7037148148160e+04 +3 21 1.4814814814814e+05 +4 21 3.7037148148130e+04 +11 21 -2.9629665185187e+05 +12 21 -1.1851862518519e+06 +13 21 -2.9629665185185e+05 +20 21 2.5925905925926e+05 +21 21 1.0370389925926e+06 +22 21 2.5925905925927e+05 +2 22 9.2592570370393e+04 +3 22 3.7037148148151e+04 +4 22 -1.4814821481485e+05 +5 22 3.7037148148052e+04 +6 22 9.2592570370359e+04 +11 22 -7.4073962962967e+04 +12 22 -2.9629665185186e+05 +13 22 -1.4814854814815e+05 +14 22 -2.9629665185185e+05 +15 22 -7.4073962962968e+04 +20 22 -1.8518551851868e+04 +21 22 2.5925905925927e+05 +22 22 2.9629754074078e+05 +23 22 2.5925905925935e+05 +24 22 -1.8518551851840e+04 +4 23 3.7037148148128e+04 +5 23 1.4814814814786e+05 +6 23 3.7037148148071e+04 +13 23 -2.9629665185187e+05 +14 23 -1.1851862518519e+06 +15 23 -2.9629665185185e+05 +22 23 2.5925905925935e+05 +23 23 1.0370389925929e+06 +24 23 2.5925905925934e+05 +4 24 9.2592570370382e+04 +5 24 3.7037148148072e+04 +6 24 -1.4814821481487e+05 +7 24 3.7037148148208e+04 +8 24 9.2592570370439e+04 +13 24 -7.4073962962969e+04 +14 24 -2.9629665185186e+05 +15 24 -1.4814854814814e+05 +16 24 -2.9629665185184e+05 +17 24 -7.4073962962960e+04 +22 24 -1.8518551851840e+04 +23 24 2.5925905925934e+05 +24 24 2.9629754074080e+05 +25 24 2.5925905925917e+05 +26 24 -1.8518551851921e+04 +6 25 3.7037148148270e+04 +7 25 1.4814814814847e+05 +8 25 3.7037148148223e+04 +15 25 -2.9629665185186e+05 +16 25 -1.1851862518518e+06 +17 25 -2.9629665185183e+05 +24 25 2.5925905925917e+05 +25 25 1.0370389925923e+06 +26 25 2.5925905925918e+05 +6 26 9.2592570370455e+04 +7 26 3.7037148148278e+04 +8 26 -1.4814821481463e+05 +9 26 3.7037148148464e+04 +15 26 -7.4073962962966e+04 +16 26 -2.9629665185186e+05 +17 26 -1.4814854814815e+05 +18 26 -2.9629665185185e+05 +24 26 -1.8518551851921e+04 +25 26 2.5925905925918e+05 +26 26 2.9629754074054e+05 +27 26 2.5925905925895e+05 +8 27 3.7037148148387e+04 +9 27 1.4814814814901e+05 +17 27 -2.9629665185188e+05 +18 27 -1.1851862518519e+06 +26 27 2.5925905925895e+05 +27 27 1.0370389925918e+06 diff --git a/test/data/matrix_market/fidap005.mtx_data.npy b/test/data/matrix_market/fidap005.mtx_data.npy new file mode 100644 index 0000000000000000000000000000000000000000..465ef322c0d5997209fe8d94fb821955d1dd0620 GIT binary patch literal 2360 zcmbW3TS!z<7=_K~<`skk5rKnbC9cXt9{XCGJ*PC=o@TR`mV1tQijE#E_msH){GMM_R_O};Ug<8XaE0oW%++hs z9BH;%+kgK>HCS0c23j+mBOeQ^`jF@@E+EmmfrJG#!-VkHC)Z*pfeTanK8^yWu? zYbclJs=l^4u2~7r4PVsPaHf9eRja3CX{`EMPx*@dR%D;@4>pw~VWSn&1tBFxP;ZXn6&Egzgp&B0gP2TKs@y-s4 zt13!*uzsG%A58e^q^dN$7)04&Tohv=~ z=}UEHf53&_Ox*Z|{Wur+?}quQO&<6M!~FgK z;5YYU-n<_^fge5iy~f;mU-+2^dc$GgQNz#t&}06=us>Mmyy%CYb>@X1;YJ7UbIWwD z8^ig7-^_k=;G_>e-jj9mnw*6fJ~LOzb@G@zCGSiw_T#41o9cQee!g)1peML`^C#f|tY{KK9P2}B57lC2Z? zO7G1{ZwTqR-=o{%_^wxc6rXO=bPuh&D&6(-g{w;UIBnnC`t^R=P8#wz^-I?%-#yiD zjpDPx;IcZe%C9netQ8tPu__4qVoxy0&xv{A=hyYVA-ry1?*}5(@*S_^TQSXo@{1zW zZYtgq;hICmM}j^0HPrW7YR5E7$}fvhyRCRfglmo!p9uEi*RTh#rFKlSqI{^^RUB$h z6;mG_HJPUldB*I_XJ`H&?)mR+|NG?br+^1p;19XrD;D@eF8GQCUXcR65(A%(fzPIZ ze_P Error handling type(error_type), allocatable, intent(out) :: error + integer :: u, stat #:for k, t, s in (KINDS_TYPES) block integer, parameter :: n = 5 @@ -160,6 +162,12 @@ contains #:endif end block #:endfor + + stat = 0 + open(newunit=u, file="test_mmio_dense.mtx", status="old", iostat=stat) + if (stat == 0) then + close(u, status="delete") + end if end subroutine subroutine generate_random_positions(pos, t_entries) @@ -393,6 +401,7 @@ contains subroutine test_io_mm_coordinate(error) !> Error handling type(error_type), allocatable, intent(out) :: error + integer :: u, stat #:for k, t, s in KINDS_TYPES block integer :: nrows, ncols @@ -503,6 +512,43 @@ contains if(allocated(error)) return if(allocated(index_save)) deallocate(index_save) end block + + ! Validate given matrices inside https://math.nist.gov/MatrixMarket/data/SPARSKIT/ + block + real(dp), allocatable :: data_f_load(:), data_s_load(:) + integer, allocatable :: index_f_load(:,:), index_s_load(:) + integer :: nrows, nnz, stat, i + character(len=:), allocatable :: path, str + + str = "${_FILE_}$" + i = len_trim(str) + do while(i > 0) + if(str(i:i) == '/' .or. str(i:i) == '\') exit + i = i - 1 + end do + if(i > 0) then + path = str(:i) // "../data/" + else + path = "data/" + end if + path = path // "matrix_market/" + call load_mm(path // "fidap005.mtx", index_f_load, data_f_load, iostat=stat) + nnz = size(index_f_load, dim=2) + call load_npy(path // "fidap005.mtx_indices.npy", index_s_load, iostat=stat) + index_s_load = index_s_load + 1 + call load_npy(path // "fidap005.mtx_data.npy", data_s_load, iostat=stat) + call check(error, all(index_f_load(1,:)==index_s_load(1:nnz)), .true.,& + "MM coordinate test failed: fidap005.mtx rows not matched") + call check(error, all(index_f_load(2,:)==index_s_load(nnz+1:2*nnz)), .true.,& + "MM coordinate test failed: fidap005.mtx cols not matched") + call check(error, all_close(data_f_load, data_s_load), .true.,& + "MM coordinate test failed: fidap005.mtx data not matched") + end block + stat = 0 + open(newunit=u, file="test_mmio_sparse.mtx", status="old", iostat=stat) + if (stat == 0) then + close(u, status="delete") + end if end subroutine end module From af21a8ddb9252dc63ef64d1c5e3aa6fb87b8b624 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Tue, 21 Apr 2026 16:19:30 +0530 Subject: [PATCH 44/50] add windows support, more mtx files --- test/data/matrix_market/ash85.mtx | 318 ++++ test/data/matrix_market/ash85.mtx_data.npy | Bin 0 -> 4312 bytes test/data/matrix_market/ash85.mtx_indices.npy | Bin 0 -> 4312 bytes test/data/matrix_market/bcsstk01.mtx | 238 +++ test/data/matrix_market/bcsstk01.mtx_data.npy | Bin 0 -> 3328 bytes .../matrix_market/bcsstk01.mtx_indices.npy | Bin 0 -> 3328 bytes test/data/matrix_market/fidap005.mtx | 281 ---- test/data/matrix_market/fidap005.mtx_data.npy | Bin 2360 -> 0 bytes .../matrix_market/fidap005.mtx_indices.npy | Bin 2360 -> 0 bytes test/data/matrix_market/lhr01_b.mtx | 1484 +++++++++++++++++ test/data/matrix_market/lhr01_b.mtx_data.npy | Bin 0 -> 11944 bytes test/io/simple_test.mtx | 7 - test/io/test_complex.mtx | 7 - test/io/test_coord.mtx | 8 - test/io/test_integer.mtx | 9 - test/io/test_io_mm.fypp | 60 +- test/io/test_real.mtx | 12 - 17 files changed, 2086 insertions(+), 338 deletions(-) create mode 100644 test/data/matrix_market/ash85.mtx create mode 100644 test/data/matrix_market/ash85.mtx_data.npy create mode 100644 test/data/matrix_market/ash85.mtx_indices.npy create mode 100644 test/data/matrix_market/bcsstk01.mtx create mode 100644 test/data/matrix_market/bcsstk01.mtx_data.npy create mode 100644 test/data/matrix_market/bcsstk01.mtx_indices.npy delete mode 100644 test/data/matrix_market/fidap005.mtx delete mode 100644 test/data/matrix_market/fidap005.mtx_data.npy delete mode 100644 test/data/matrix_market/fidap005.mtx_indices.npy create mode 100644 test/data/matrix_market/lhr01_b.mtx create mode 100644 test/data/matrix_market/lhr01_b.mtx_data.npy delete mode 100644 test/io/simple_test.mtx delete mode 100644 test/io/test_complex.mtx delete mode 100644 test/io/test_coord.mtx delete mode 100644 test/io/test_integer.mtx delete mode 100644 test/io/test_real.mtx diff --git a/test/data/matrix_market/ash85.mtx b/test/data/matrix_market/ash85.mtx new file mode 100644 index 000000000..293634394 --- /dev/null +++ b/test/data/matrix_market/ash85.mtx @@ -0,0 +1,318 @@ +%%MatrixMarket matrix coordinate pattern symmetric +%------------------------------------------------------------------------------- +% UF Sparse Matrix Collection, Tim Davis +% http://www.cise.ufl.edu/research/sparse/matrices/HB/ash85 +% name: HB/ash85 +% [SYMMETRIC PATTERN OF NORMAL MATRIX OF HOLLAND SURVEY. ASHKENAZI, 1974] +% id: 11 +% date: 1974 +% author: V. Askenazi +% ed: A. Curtis, I. Duff, J. Reid +% fields: title A name id date author ed kind +% kind: least squares problem +%------------------------------------------------------------------------------- +85 85 304 +1 1 +2 1 +6 1 +7 1 +8 1 +2 2 +3 2 +8 2 +9 2 +10 2 +3 3 +4 3 +10 3 +4 4 +5 4 +10 4 +11 4 +12 4 +5 5 +12 5 +23 5 +6 6 +7 6 +13 6 +14 6 +45 6 +7 7 +8 7 +14 7 +15 7 +16 7 +8 8 +9 8 +16 8 +18 8 +9 9 +10 9 +11 9 +18 9 +19 9 +20 9 +10 10 +11 10 +11 11 +12 11 +20 11 +21 11 +22 11 +12 12 +22 12 +23 12 +13 13 +44 13 +45 13 +14 14 +15 14 +45 14 +46 14 +47 14 +15 15 +16 15 +17 15 +31 15 +47 15 +48 15 +16 16 +17 16 +18 16 +17 17 +18 17 +29 17 +30 17 +31 17 +18 18 +19 18 +28 18 +29 18 +19 19 +20 19 +27 19 +28 19 +20 20 +21 20 +27 20 +21 21 +22 21 +24 21 +25 21 +26 21 +27 21 +22 22 +23 22 +24 22 +23 23 +24 23 +32 23 +24 24 +25 24 +32 24 +33 24 +34 24 +25 25 +26 25 +34 25 +26 26 +27 26 +34 26 +36 26 +37 26 +27 27 +28 27 +37 27 +39 27 +28 28 +29 28 +39 28 +29 29 +30 29 +39 29 +40 29 +30 30 +31 30 +40 30 +42 30 +43 30 +31 31 +43 31 +48 31 +49 31 +32 32 +33 32 +64 32 +33 33 +34 33 +63 33 +64 33 +34 34 +35 34 +36 34 +64 34 +65 34 +35 35 +36 35 +38 35 +65 35 +66 35 +36 36 +37 36 +38 36 +37 37 +38 37 +39 37 +38 38 +39 38 +66 38 +67 38 +69 38 +39 39 +40 39 +41 39 +69 39 +70 39 +40 40 +41 40 +42 40 +71 40 +41 41 +70 41 +71 41 +42 42 +43 42 +50 42 +71 42 +72 42 +43 43 +49 43 +50 43 +51 43 +44 44 +45 44 +52 44 +53 44 +54 44 +45 45 +46 45 +52 45 +57 45 +46 46 +47 46 +57 46 +58 46 +47 47 +48 47 +58 47 +48 48 +49 48 +58 48 +59 48 +49 49 +51 49 +59 49 +60 49 +50 50 +51 50 +72 50 +73 50 +51 51 +60 51 +61 51 +73 51 +52 52 +54 52 +57 52 +81 52 +53 53 +54 53 +55 53 +85 53 +54 54 +55 54 +56 54 +81 54 +55 55 +56 55 +83 55 +84 55 +85 55 +56 56 +81 56 +82 56 +83 56 +57 57 +58 57 +80 57 +81 57 +58 58 +59 58 +80 58 +59 59 +60 59 +61 59 +79 59 +80 59 +60 60 +61 60 +61 61 +62 61 +73 61 +76 61 +78 61 +79 61 +62 62 +73 62 +74 62 +76 62 +78 62 +63 63 +64 63 +64 64 +65 64 +65 65 +66 65 +66 66 +67 66 +67 67 +68 67 +69 67 +68 68 +69 68 +69 69 +70 69 +70 70 +71 70 +71 71 +72 71 +72 72 +73 72 +73 73 +74 73 +74 74 +75 74 +76 74 +75 75 +76 75 +76 76 +77 76 +78 76 +77 77 +78 77 +78 78 +79 78 +79 79 +80 79 +80 80 +81 80 +81 81 +82 81 +82 82 +83 82 +83 83 +84 83 +84 84 +85 84 +85 85 diff --git a/test/data/matrix_market/ash85.mtx_data.npy b/test/data/matrix_market/ash85.mtx_data.npy new file mode 100644 index 0000000000000000000000000000000000000000..606f90430771e962e9f770f2cce9008241323e7d GIT binary patch literal 4312 zcmbR27wQ`j$;eQ~P_3SlTAW;@Zl$1ZlV+i=qoAIaUsO_*m=~X4l#&V(cT3DEP6dh= zXCxM+0{I%IM#egtItsN4WCJb+F!*3UN`pdRG#p0L!Du=d%?G39z-T!zS`Lhs1Eb}@ YXgM%i4vdxqqvgP8IWSrdkWvl+0GrZ=r~m)} literal 0 HcmV?d00001 diff --git a/test/data/matrix_market/ash85.mtx_indices.npy b/test/data/matrix_market/ash85.mtx_indices.npy new file mode 100644 index 0000000000000000000000000000000000000000..2251eb6d5ad0d9b3a4421afbb32070fdbc1ac935 GIT binary patch literal 4312 zcmbW1TW?iW6h?cYl$KITK?QFd5I8NA-bF=}(+j=#^o9>Skw$7XF=ATdi}6?Zhy6yf zMzXSVeDNeB^P6*@z2@3$?{EIo{bB#`O@H5?eSfvzon8ER-hSR{zxZXjJ=1Fc^#1&h z^V8qnzCV9=Mt$S-*Nd~%FMdA#{Ve&^!u;~HndzC<->v`q8|}-lKMaM-VYuW2MPErA z3FL!C6E79b0#{2;{4luISoF0p6I`2oJX{a-Vtw?DqUpt&qV^fZ1N{aN6D?&Xtc>h9~~Xlm|<+ z_DZ~4BL73T!oA>qXzxdV5gr8lq8|nKg?8WQcJLX{)8TR8nTS05e6aV+=vJWD_kkRJ zKhT@J6U-l$d?nGnQDa|3_F&{ct6{y=+0RtTUnQEe$BlB0I@*0NlzcOh{j+y!i^2E4 z6ulh248D76UkASf^f!TTf-^vS7U<`JwOJSaZLkl$w*uFwzbH99=*ilL!96^SejT`m z{wi=?eH?uf_>b3)qN%&jgJ|w?Z{+Ta{@p;${ZRWZu+QDFANY^8?W*p3_T6@Jjd$hy z;+?Gp-kTB4yYc<-jyM<3hQ9QGoxmQ9=)J(6jPB3p@OgP=&cgHXtUNEytoiFtp=KaC z3^urw9EKWPPF^#dT&_en8A)xl!PVq2R=Ac}GoHN3_0(XZ!HwiH87()X;Z_frHNcz! zW=+lQZ^7I88*fYPX?!hsxkev%QeO$H z1wE@*H&fpVO@HpDrXRb}dhjUvIGluDzy1`P;5TXdj$H5c@*jSz{ioK0#-MHKVGZ>jz5$}6HdNSa7*F)DnXKlVi)?_Ur-`#9r zy@`PT$mdGVx}a~lP9J?u4?Is!FEsPSnc-}pH#NZ1%n`kfhxs3o`-%7#ud*%?PqGIh zGlSR;?1wlV9v9d<9%%)>AJ+4GVm7e0-xZn}&eY230$Lg6sXbbAW)+h+V#67*SGY;JNtoaP4r1NZF& Q?uEU;x~}b>+^2j07a1nNSpWb4 literal 0 HcmV?d00001 diff --git a/test/data/matrix_market/bcsstk01.mtx b/test/data/matrix_market/bcsstk01.mtx new file mode 100644 index 000000000..728073cb1 --- /dev/null +++ b/test/data/matrix_market/bcsstk01.mtx @@ -0,0 +1,238 @@ +%%MatrixMarket matrix coordinate real symmetric +%------------------------------------------------------------------------------- +% UF Sparse Matrix Collection, Tim Davis +% http://www.cise.ufl.edu/research/sparse/matrices/HB/bcsstk01 +% name: HB/bcsstk01 +% [SYMMETRIC STIFFNESS MATRIX SMALL GENERALIZED EIGENVALUE PROBLEM] +% id: 23 +% date: 1982 +% author: J. Lewis +% ed: I. Duff, R. Grimes, J. Lewis +% fields: title A name id date author ed kind +% kind: structural problem +%------------------------------------------------------------------------------- +48 48 224 +1 1 2832268.51852 +5 1 1e6 +6 1 2083333.33333 +7 1 -3333.33333333 +11 1 1e6 +19 1 -2.8e6 +25 1 -28935.1851852 +30 1 2083333.33333 +2 2 1635447.53086 +4 2 -2e6 +6 2 5555555.55555 +8 2 -6666.66666667 +10 2 -2e6 +20 2 -30864.1975309 +24 2 5555555.55555 +26 2 -1597916.66667 +3 3 1724367.28395 +4 3 -2083333.33333 +5 3 -2777777.77778 +9 3 -1.68e6 +21 3 -15432.0987654 +23 3 -2777777.77778 +27 3 -28935.1851852 +28 3 -2083333.33333 +4 4 1003333333.33 +8 4 2e6 +10 4 4e8 +22 4 -3333333.33333 +27 4 2083333.33333 +28 4 1e8 +5 5 1.0675e9 +7 5 -1e6 +11 5 2e8 +21 5 2777777.77778 +23 5 333333333.333 +29 5 -833333.333333 +6 6 1535333333.33 +12 6 -2e6 +20 6 -5555555.55555 +24 6 666666666.667 +25 6 -2083333.33333 +30 6 1e8 +7 7 2832268.51852 +11 7 -1e6 +12 7 2083333.33333 +13 7 -2.8e6 +31 7 -28935.1851852 +36 7 2083333.33333 +8 8 1635447.53086 +10 8 2e6 +12 8 5555555.55555 +14 8 -30864.1975309 +18 8 5555555.55555 +32 8 -1597916.66667 +9 9 1724367.28395 +10 9 -2083333.33333 +11 9 -2777777.77778 +15 9 -15432.0987654 +17 9 -2777777.77778 +33 9 -28935.1851852 +34 9 -2083333.33333 +10 10 1003333333.33 +16 10 -3333333.33333 +33 10 2083333.33333 +34 10 1e8 +11 11 1.0675e9 +15 11 2777777.77778 +17 11 333333333.333 +35 11 -833333.333333 +12 12 1535333333.33 +14 12 -5555555.55555 +18 12 666666666.667 +31 12 -2083333.33333 +36 12 1e8 +13 13 2836099.4695 +17 13 -2149285.29451 +18 13 2359161.80402 +19 13 -3333.33333333 +23 13 -1e6 +37 13 -28935.1851852 +42 13 2083333.33333 +43 13 -3830.95098171 +47 13 -1149285.29451 +48 13 275828.470683 +14 14 1767410.74446 +15 14 517922.131816 +16 14 4298570.58902 +18 14 -5555555.55555 +20 14 -6666.66666667 +22 14 2e6 +38 14 -1597916.66667 +44 14 -131963.213599 +45 14 -517922.131816 +46 14 2298570.58902 +15 15 3890038.06848 +16 15 -2634990.2747 +17 15 2777777.77778 +21 15 -1.68e6 +39 15 -28935.1851852 +40 15 -2083333.33333 +44 15 -517922.131816 +45 15 -2165670.78453 +46 15 -551656.941367 +16 16 1975720635.31 +20 16 -2e6 +22 16 4e8 +39 16 2083333.33333 +40 16 1e8 +44 16 -2298570.58902 +45 16 551656.941366 +46 16 486193650.99 +17 17 1527346515.47 +18 17 -109779731.332 +19 17 1e6 +23 17 2e8 +41 17 -833333.333333 +43 17 1149285.29451 +47 17 229724661.236 +48 17 -55717351.0779 +18 18 1564111437.11 +24 18 -2e6 +37 18 -2083333.33333 +42 18 1e8 +43 18 -275828.470683 +47 18 -55717351.0779 +48 18 10941196.0038 +19 19 2832268.51852 +23 19 1e6 +24 19 2083333.33333 +43 19 -28935.1851852 +48 19 2083333.33333 +20 20 1635447.53086 +22 20 -2e6 +24 20 -5555555.55555 +44 20 -1597916.66667 +21 21 1724367.28395 +22 21 -2083333.33333 +23 21 2777777.77778 +45 21 -28935.1851852 +46 21 -2083333.33333 +22 22 1003333333.33 +45 22 2083333.33333 +46 22 1e8 +23 23 1.0675e9 +47 23 -833333.333333 +24 24 1535333333.33 +43 24 -2083333.33333 +48 24 1e8 +25 25 60879.6296296 +29 25 1.25e6 +30 25 416666.666667 +31 25 -4166.66666667 +35 25 1.25e6 +26 26 3372916.66667 +28 26 -2.5e6 +32 26 -8333.33333333 +34 26 -2.5e6 +27 27 2411712.96296 +28 27 -416666.666667 +33 27 -2.355e6 +28 28 1.5e9 +32 28 2.5e6 +34 28 5e8 +29 29 501833333.333 +31 29 -1.25e6 +35 29 2.5e8 +30 30 5.025e8 +36 30 -2.5e6 +31 31 3985879.62963 +35 31 -1.25e6 +36 31 416666.666667 +37 31 -3.925e6 +32 32 3411496.91358 +34 32 2.5e6 +36 32 6944444.44444 +38 32 -38580.2469136 +42 32 6944444.44445 +33 33 2431003.08642 +34 33 -416666.666667 +35 33 -3472222.22222 +39 33 -19290.1234568 +41 33 -3472222.22222 +34 34 1504166666.67 +40 34 -4166666.66667 +35 35 1335166666.67 +39 35 3472222.22222 +41 35 416666666.667 +36 36 2169166666.67 +38 36 -6944444.44444 +42 36 833333333.333 +37 37 3985879.62963 +41 37 -1.25e6 +42 37 416666.666667 +43 37 -4166.66666667 +47 37 -1.25e6 +38 38 3411496.91358 +40 38 2.5e6 +42 38 -6944444.44445 +44 38 -8333.33333333 +46 38 2.5e6 +39 39 2431003.08642 +40 39 -416666.666667 +41 39 3472222.22222 +45 39 -2.355e6 +40 40 1504166666.67 +44 40 -2.5e6 +46 40 5e8 +41 41 1335166666.67 +43 41 1.25e6 +47 41 2.5e8 +42 42 2169166666.67 +48 42 -2.5e6 +43 43 64710.5806113 +47 43 2399285.29451 +48 43 140838.195984 +44 44 3504879.88027 +45 44 517922.131816 +46 44 -4798570.58902 +45 45 4577383.74749 +46 45 134990.2747 +46 46 2472387301.98 +47 47 961679848.804 +48 47 -109779731.332 +48 48 531278103.775 diff --git a/test/data/matrix_market/bcsstk01.mtx_data.npy b/test/data/matrix_market/bcsstk01.mtx_data.npy new file mode 100644 index 0000000000000000000000000000000000000000..587b025e4b0e684390e8a51bc8f49def016ab017 GIT binary patch literal 3328 zcmb_ee@xV67(X^Cp_)zIO!~pO%Ig|22>$?<%5&F|qMY{QyD1TIb$1gqfkVY47S)wT z&COxal1USq^IN1d8la%xS2xxyf&lN96NcxyhGh~`ESA;xeZTMX1z!4gMBYE|zR&yo z_&m@1JkRH+?lEw};9zU0X^$ zs=RcQtJtG{KeQ|z-!R=R&{)P<=w?8nT;C)R< zmM^+e$txqrR&}jQ$GBwA8fxz#EbgH+QjtdOzEMyv#3v=o<-*=@C&p)|KiCXSD*nQ) zs|n(y{`|ojdOw`s-Np42i6%b`+&@&TlqCDW=TKfp?X9HcKIzxK!2s9S^CPx=s&`h$ zjsAstPKiH*`T^GGzt(G}b&6D%NOj=&4D;V!eODXQJK&ef;~)2UGROh*m2lf%AokO= zK3WvN;D_+lMkN&GS>t&-nH05-U;6g^osjnP{!=4k=`g2b{H;B;@!aovtP>IX4D`No zmwxfx-6q2Ah~^hy@cP-gCmXZjV4n5=6zwx*{A2T!*-xz5fZ-erM1J68nCIDSyPiJpQ_>fS0I)9p< z!+QVmdcdE3JFnEg@Cn3J)uk5gt0K!|pQx^N2KD&7&zT<@m)DP={v%7`D_sL_5c*Tc zE94CZb4~R6{`1^|;76ZNqd64kOw6PD_n#gdZM~X7>(V_x1!4%D%f;G$$vmc@d~Jy& zojAFg)uVg9oxEPJ?w?GB-`mM=4qJJ?*M|12PPJn|Pvy28ZN61IX7A~2r+Z*~-cURD zm%{WtosIPSqpIsDw-act>Hcw(Q`bX$6xW=QZ1QT-@V14wX7PJF>})Ez=V(O^9NgF( z-W>=jg#+66YhCl+x#Qgle41Vs(e!#0{9biQJ~Lbp0Ge;~xphSSJ`Ugaa=%&dh9W=Q zcfLjKGpXQN>mbG>r|PKuOEALA=4hgx({OW~VqL)iH_MmS7xB`1(08FHtuNx%;2iG#_K8bVMVA;I7zSif>>+M){L_W>p&W86WzDmE&2Q%h7>~G{V=4S>x z$Kx@)5%`Vn5msk^(3sZ*{D%8n(@TuVV~8&je~I}=;w>Y-GUBO7{B*N;>1OfK|K%Zk zM|#q}5cjMR|IC(mFdn|67T1_>H2sPHl>$HT`P1h}=NI&k?=09&=|{?U$RlWnxaj$B zyrJDs=ZhGPXV@HZo}l}S;idbF`(^i>7xew6#v|OG=}{iwad00`+y593_q@3Gao_WM vea~y(Ir@G_To_;6>xjc>p9?q`{z>`seD(a<{p9?`Jw16&=zhk%jQ#gFzv4_~ literal 0 HcmV?d00001 diff --git a/test/data/matrix_market/bcsstk01.mtx_indices.npy b/test/data/matrix_market/bcsstk01.mtx_indices.npy new file mode 100644 index 0000000000000000000000000000000000000000..f7f8268ff7adf623fa77f889f16b03bc034046fa GIT binary patch literal 3328 zcmbW3$!b(l6h$kI>0{rw&$be+m<$|$BWPl&%6 zf16DbpM4qsn54h=^5|%^KWhFo|NYw<Y7T2SziYgGp1tJPv#>w!)OAkpz&LX_yL%Di9Gr`@b63wz-!^gXUDx2fct^BD z?WiX@K?}SK^;R2A+BMER=P;l5wNIOSxCVV{O8uL_y6i=rr~`fKSz~n$YmryqkM)>C zjQjIW)}37L?He&x>&+Z$SnFTk(wZ?(t&l(Ox0Jy?mNVAJO2*o(Ce{Y8wOLE7&3a;O zHWKS%GjZ8UTej1#?4-Yl-Q+9+AI$>~^?`r-z&l;wn+l#0{8GUy`Uj5y{;1#$!54Z1 zU*L!8CAyep}b}yR>agefw48eyh%HFVec>i}ddJJk2}Sr+edl+Be>%e`D1Hw)KJE z>IK_+LSOJVL~nHY1Fz^0zxt$lrTRtB_%}%3ba@9KH67p~&_~rvU4Ft_)latdlwZA7 z{iVmM&#Kq-+bDY+1bhdF0o|i<^o;&^3u?yQ@d{&T8m;m!)R;Ol##}Vb+wcz7(|q2@ znCqKMjnTGix+iBKj-IJEwPJ5#XczrZb7JJ8RrJ;b>WwySJ4WrD>zd4AE$++NslWBJ zHq2)|@;E2=;a#jJwPc*NxEF84yVP;#b&b{ic|+dJy{U88nbbSEydP&Gmp%1_@9dW~ z%~#vhfx6WHpJ+FM`cg}CcmwsznHVEREvOlN#PVj)&TPzF M?rB}T6LX0F0|iiIS^xk5 literal 0 HcmV?d00001 diff --git a/test/data/matrix_market/fidap005.mtx b/test/data/matrix_market/fidap005.mtx deleted file mode 100644 index b07b69beb..000000000 --- a/test/data/matrix_market/fidap005.mtx +++ /dev/null @@ -1,281 +0,0 @@ -%%MatrixMarket matrix coordinate real general -27 27 279 -1 1 1.0370389925925e+06 -2 1 2.5925905925925e+05 -10 1 -1.1851862518518e+06 -11 1 -2.9629665185183e+05 -19 1 1.4814814814813e+05 -20 1 3.7037148148145e+04 -1 2 2.5925905925925e+05 -2 2 2.9629754074078e+05 -3 2 2.5925905925929e+05 -4 2 -1.8518551851871e+04 -10 2 -2.9629665185185e+05 -11 2 -1.4814854814816e+05 -12 2 -2.9629665185189e+05 -13 2 -7.4073962962971e+04 -19 2 3.7037148148146e+04 -20 2 -1.4814821481483e+05 -21 2 3.7037148148160e+04 -22 2 9.2592570370393e+04 -2 3 2.5925905925929e+05 -3 3 1.0370389925926e+06 -4 3 2.5925905925926e+05 -11 3 -2.9629665185187e+05 -12 3 -1.1851862518518e+06 -13 3 -2.9629665185184e+05 -20 3 3.7037148148138e+04 -21 3 1.4814814814814e+05 -22 3 3.7037148148151e+04 -2 4 -1.8518551851871e+04 -3 4 2.5925905925926e+05 -4 4 2.9629754074078e+05 -5 4 2.5925905925929e+05 -6 4 -1.8518551851853e+04 -11 4 -7.4073962962959e+04 -12 4 -2.9629665185181e+05 -13 4 -1.4814854814814e+05 -14 4 -2.9629665185187e+05 -15 4 -7.4073962962958e+04 -20 4 9.2592570370383e+04 -21 4 3.7037148148130e+04 -22 4 -1.4814821481485e+05 -23 4 3.7037148148128e+04 -24 4 9.2592570370382e+04 -4 5 2.5925905925929e+05 -5 5 1.0370389925926e+06 -6 5 2.5925905925929e+05 -13 5 -2.9629665185187e+05 -14 5 -1.1851862518519e+06 -15 5 -2.9629665185185e+05 -22 5 3.7037148148052e+04 -23 5 1.4814814814786e+05 -24 5 3.7037148148072e+04 -4 6 -1.8518551851853e+04 -5 6 2.5925905925929e+05 -6 6 2.9629754074080e+05 -7 6 2.5925905925917e+05 -8 6 -1.8518551851932e+04 -13 6 -7.4073962962968e+04 -14 6 -2.9629665185186e+05 -15 6 -1.4814854814816e+05 -16 6 -2.9629665185186e+05 -17 6 -7.4073962962958e+04 -22 6 9.2592570370359e+04 -23 6 3.7037148148071e+04 -24 6 -1.4814821481487e+05 -25 6 3.7037148148270e+04 -26 6 9.2592570370455e+04 -6 7 2.5925905925917e+05 -7 7 1.0370389925923e+06 -8 7 2.5925905925921e+05 -15 7 -2.9629665185186e+05 -16 7 -1.1851862518519e+06 -17 7 -2.9629665185184e+05 -24 7 3.7037148148208e+04 -25 7 1.4814814814847e+05 -26 7 3.7037148148278e+04 -6 8 -1.8518551851932e+04 -7 8 2.5925905925921e+05 -8 8 2.9629754074058e+05 -9 8 2.5925905925904e+05 -15 8 -7.4073962962964e+04 -16 8 -2.9629665185184e+05 -17 8 -1.4814854814815e+05 -18 8 -2.9629665185188e+05 -24 8 9.2592570370439e+04 -25 8 3.7037148148223e+04 -26 8 -1.4814821481463e+05 -27 8 3.7037148148387e+04 -8 9 2.5925905925904e+05 -9 9 1.0370389925921e+06 -17 9 -2.9629665185188e+05 -18 9 -1.1851862518519e+06 -26 9 3.7037148148464e+04 -27 9 1.4814814814901e+05 -1 10 -1.1851862518518e+06 -2 10 -2.9629665185185e+05 -10 10 2.3703760592592e+06 -11 10 5.9259152592589e+05 -19 10 -1.1851862518518e+06 -20 10 -2.9629665185183e+05 -1 11 -2.9629665185183e+05 -2 11 -1.4814854814816e+05 -3 11 -2.9629665185187e+05 -4 11 -7.4073962962959e+04 -10 11 5.9259152592589e+05 -11 11 2.9630020740741e+05 -12 11 5.9259152592596e+05 -13 11 1.4814814814815e+05 -19 11 -2.9629665185184e+05 -20 11 -1.4814854814815e+05 -21 11 -2.9629665185187e+05 -22 11 -7.4073962962967e+04 -2 12 -2.9629665185189e+05 -3 12 -1.1851862518518e+06 -4 12 -2.9629665185181e+05 -11 12 5.9259152592596e+05 -12 12 2.3703760592593e+06 -13 12 5.9259152592591e+05 -20 12 -2.9629665185185e+05 -21 12 -1.1851862518519e+06 -22 12 -2.9629665185186e+05 -2 13 -7.4073962962971e+04 -3 13 -2.9629665185184e+05 -4 13 -1.4814854814814e+05 -5 13 -2.9629665185187e+05 -6 13 -7.4073962962968e+04 -11 13 1.4814814814815e+05 -12 13 5.9259152592591e+05 -13 13 2.9630020740741e+05 -14 13 5.9259152592596e+05 -15 13 1.4814814814815e+05 -20 13 -7.4073962962958e+04 -21 13 -2.9629665185185e+05 -22 13 -1.4814854814815e+05 -23 13 -2.9629665185187e+05 -24 13 -7.4073962962969e+04 -4 14 -2.9629665185187e+05 -5 14 -1.1851862518519e+06 -6 14 -2.9629665185186e+05 -13 14 5.9259152592596e+05 -14 14 2.3703760592594e+06 -15 14 5.9259152592593e+05 -22 14 -2.9629665185185e+05 -23 14 -1.1851862518519e+06 -24 14 -2.9629665185186e+05 -4 15 -7.4073962962958e+04 -5 15 -2.9629665185185e+05 -6 15 -1.4814854814816e+05 -7 15 -2.9629665185186e+05 -8 15 -7.4073962962964e+04 -13 15 1.4814814814815e+05 -14 15 5.9259152592593e+05 -15 15 2.9630020740741e+05 -16 15 5.9259152592595e+05 -17 15 1.4814814814815e+05 -22 15 -7.4073962962968e+04 -23 15 -2.9629665185185e+05 -24 15 -1.4814854814814e+05 -25 15 -2.9629665185186e+05 -26 15 -7.4073962962966e+04 -6 16 -2.9629665185186e+05 -7 16 -1.1851862518519e+06 -8 16 -2.9629665185184e+05 -15 16 5.9259152592595e+05 -16 16 2.3703760592593e+06 -17 16 5.9259152592590e+05 -24 16 -2.9629665185184e+05 -25 16 -1.1851862518518e+06 -26 16 -2.9629665185186e+05 -6 17 -7.4073962962958e+04 -7 17 -2.9629665185184e+05 -8 17 -1.4814854814815e+05 -9 17 -2.9629665185188e+05 -15 17 1.4814814814815e+05 -16 17 5.9259152592590e+05 -17 17 2.9630020740741e+05 -18 17 5.9259152592598e+05 -24 17 -7.4073962962960e+04 -25 17 -2.9629665185183e+05 -26 17 -1.4814854814815e+05 -27 17 -2.9629665185188e+05 -8 18 -2.9629665185188e+05 -9 18 -1.1851862518519e+06 -17 18 5.9259152592598e+05 -18 18 2.3703760592593e+06 -26 18 -2.9629665185185e+05 -27 18 -1.1851862518519e+06 -1 19 1.4814814814813e+05 -2 19 3.7037148148146e+04 -10 19 -1.1851862518518e+06 -11 19 -2.9629665185184e+05 -19 19 1.0370389925926e+06 -20 19 2.5925905925926e+05 -1 20 3.7037148148145e+04 -2 20 -1.4814821481483e+05 -3 20 3.7037148148138e+04 -4 20 9.2592570370383e+04 -10 20 -2.9629665185183e+05 -11 20 -1.4814854814815e+05 -12 20 -2.9629665185185e+05 -13 20 -7.4073962962958e+04 -19 20 2.5925905925926e+05 -20 20 2.9629754074076e+05 -21 20 2.5925905925926e+05 -22 20 -1.8518551851868e+04 -2 21 3.7037148148160e+04 -3 21 1.4814814814814e+05 -4 21 3.7037148148130e+04 -11 21 -2.9629665185187e+05 -12 21 -1.1851862518519e+06 -13 21 -2.9629665185185e+05 -20 21 2.5925905925926e+05 -21 21 1.0370389925926e+06 -22 21 2.5925905925927e+05 -2 22 9.2592570370393e+04 -3 22 3.7037148148151e+04 -4 22 -1.4814821481485e+05 -5 22 3.7037148148052e+04 -6 22 9.2592570370359e+04 -11 22 -7.4073962962967e+04 -12 22 -2.9629665185186e+05 -13 22 -1.4814854814815e+05 -14 22 -2.9629665185185e+05 -15 22 -7.4073962962968e+04 -20 22 -1.8518551851868e+04 -21 22 2.5925905925927e+05 -22 22 2.9629754074078e+05 -23 22 2.5925905925935e+05 -24 22 -1.8518551851840e+04 -4 23 3.7037148148128e+04 -5 23 1.4814814814786e+05 -6 23 3.7037148148071e+04 -13 23 -2.9629665185187e+05 -14 23 -1.1851862518519e+06 -15 23 -2.9629665185185e+05 -22 23 2.5925905925935e+05 -23 23 1.0370389925929e+06 -24 23 2.5925905925934e+05 -4 24 9.2592570370382e+04 -5 24 3.7037148148072e+04 -6 24 -1.4814821481487e+05 -7 24 3.7037148148208e+04 -8 24 9.2592570370439e+04 -13 24 -7.4073962962969e+04 -14 24 -2.9629665185186e+05 -15 24 -1.4814854814814e+05 -16 24 -2.9629665185184e+05 -17 24 -7.4073962962960e+04 -22 24 -1.8518551851840e+04 -23 24 2.5925905925934e+05 -24 24 2.9629754074080e+05 -25 24 2.5925905925917e+05 -26 24 -1.8518551851921e+04 -6 25 3.7037148148270e+04 -7 25 1.4814814814847e+05 -8 25 3.7037148148223e+04 -15 25 -2.9629665185186e+05 -16 25 -1.1851862518518e+06 -17 25 -2.9629665185183e+05 -24 25 2.5925905925917e+05 -25 25 1.0370389925923e+06 -26 25 2.5925905925918e+05 -6 26 9.2592570370455e+04 -7 26 3.7037148148278e+04 -8 26 -1.4814821481463e+05 -9 26 3.7037148148464e+04 -15 26 -7.4073962962966e+04 -16 26 -2.9629665185186e+05 -17 26 -1.4814854814815e+05 -18 26 -2.9629665185185e+05 -24 26 -1.8518551851921e+04 -25 26 2.5925905925918e+05 -26 26 2.9629754074054e+05 -27 26 2.5925905925895e+05 -8 27 3.7037148148387e+04 -9 27 1.4814814814901e+05 -17 27 -2.9629665185188e+05 -18 27 -1.1851862518519e+06 -26 27 2.5925905925895e+05 -27 27 1.0370389925918e+06 diff --git a/test/data/matrix_market/fidap005.mtx_data.npy b/test/data/matrix_market/fidap005.mtx_data.npy deleted file mode 100644 index 465ef322c0d5997209fe8d94fb821955d1dd0620..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 2360 zcmbW3TS!z<7=_K~<`skk5rKnbC9cXt9{XCGJ*PC=o@TR`mV1tQijE#E_msH){GMM_R_O};Ug<8XaE0oW%++hs z9BH;%+kgK>HCS0c23j+mBOeQ^`jF@@E+EmmfrJG#!-VkHC)Z*pfeTanK8^yWu? zYbclJs=l^4u2~7r4PVsPaHf9eRja3CX{`EMPx*@dR%D;@4>pw~VWSn&1tBFxP;ZXn6&Egzgp&B0gP2TKs@y-s4 zt13!*uzsG%A58e^q^dN$7)04&Tohv=~ z=}UEHf53&_Ox*Z|{Wur+?}quQO&<6M!~FgK z;5YYU-n<_^fge5iy~f;mU-+2^dc$GgQNz#t&}06=us>Mmyy%CYb>@X1;YJ7UbIWwD z8^ig7-^_k=;G_>e-jj9mnw*6fJ~LOzb@G@zCGSiw_T#41o9cQee!g)1peML`^C#f|tY{KK9P2}B57lC2Z? zO7G1{ZwTqR-=o{%_^wxc6rXO=bPuh&D&6(-g{w;UIBnnC`t^R=P8#wz^-I?%-#yiD zjpDPx;IcZe%C9netQ8tPu__4qVoxy0&xv{A=hyYVA-ry1?*}5(@*S_^TQSXo@{1zW zZYtgq;hICmM}j^0HPrW7YR5E7$}fvhyRCRfglmo!p9uEi*RTh#rFKlSqI{^^RUB$h z6;mG_HJPUldB*I_XJ`H&?)mR+|NG?br+^1p;19XrD;D@eF8GQCUXcR65(A%(fzPIZ ze_PgD3#2~oQTL+Nax(Qp)|=@qyfp$ETlBunxqF&D$OJmDpQ&``!+-= zr3?|tRLT?~GM;ar=Xvjap11Wr>s#Nu*0s;5h_qn51t+ujR z%ZCME2h=uu___P4EmTxnn0v*KZl4LZ=h5^sJ026X`7!MK$;1tri#-6|A2gikGMKOQ3|!XMDjRT zo<4}@^iULM+bBNr6H4|3V%cO2W9LsH?wG@NUUlNi@HyP?6NydJFf4a$Dj_2X@0&7$ z-xG%VS>uV1dY%=j4~hu-vH$8al=gm4_m`*RgO;mU>O;tE{X7s%z6|6S!@jZfg~ zyROT{0spc6|GUmNuV3D+Pm5gz-ypmCm3j5z>!4jzi^<-T%g+jX8L)Zfe^>ddJ>jb` z>_{V*nEgXk>Cj4lwqv*vMR|sTx1ZtrIIK)O9)vQ2O-RxMst6%8+u(3dvCzECg~%P# z2l^AB{-+c$5QB1}J}`v$)gM~`y5RgofaTzX8isXyCO4hV zk+lS`M<}W`-vV?%Kasjm5tz$in9UDWU`;5!B2-T(5M zJO`VRClG_)cdNkkV5cx6F0XQz{k9}-kuTDl2KQFA37kOs;s*o**T_vAF;ZN;9y_Z5b?CH+OL|sj7Wcyhkwo9uvMSWZXjz2Y4=y^-742E_T|F6f4@{lllf;gJE8aL+U=}p zr=kGFgfH=U{0|bvR5uaPOtyt)80%DD)dPfg72O&1zn!Khm z!wK;PA-OGXYxNQPR%oQ2s_sV|lF%_}xUvs%@Jr!Ub9YxFHn~!|)JnG;v5GI~4fvRj zm^Y9ATXNDcv=2&~w!;6>^{XB1ngi|0v=sD-V{5FI`LcRoo=Szf5pmg2D(=T`c2bn# zun}md?NwMDa1tsg7g+;fk?@LQsVx8@d<_(5wg@n#`(vhs#@~|*?f#i45u66)s5o(i z-cc>7#=p_=b50i73G-q~uY){6zYnQ-Ns%z>IuXVTcYIVAKQl5sPJN!hd2|TSHDl5+Bt3& z($Cg2Skt+Xg*Z#`dW}KwNyHtJvfbO=7*;p-B_rM(Li#5{CRstp4kC_@u#kIu(uXDW z0nR_=g6!?Bu>Gi1gD%lw5j;i_6TldqH`({%B<;VVyKn^+I3uCmWE$ZLAPOmDP;_o8wc=tn90ax%XUO1D_@(Kl!g zuXD(U^I*MIB*|^R-=FI3hV1XUXYO#byendI3bZdiU*gI<`ILc=GHh4a3|CnnR8Pio z6(=Q-qr1fCY*ck1qF{e@#*dP2FprBU(*P9(@5f?(Y7tYQy|OOP1Y77l&~O5n^ZQ27 z4EL9TT-ZV;-FioHf-A{C`d^>Z_=2MLYNnGVtUS)~r%y=+36!+Q2p!fpI4>y+~D%`w-T$jKipJX*oEym%e4^Yi@+_K%)N+^_fgpxCug#G(c6b(1dO zh`;Eka=SglEA(fAc;&x+2GxLCd1w8`U6qjeowgJDn3lYlqwU!}>a zmlDID^SQk8Sas{t?vrEae)$^7o&=Jyi<>@6+fGL@b|I&4B6V;2MKn*`OO8*9jDr!! zoRiIdGsxIMmXn-gY4A<-Jjw9mi^G(n5zCDa%Wk(hi8$|qQ|2RQd&G*?4Prj88UMIy zZC86!n;Ozz3tOYzHa3jLo26!L*4kK%xUcH7?{kug4`GH0;W^PqSiJFjKTy!m^k(eZ zTz)jH-9jJfgJYZOLUu|Z?lJGIvCPor?pI2orj0Bi9>BQ9?%hG+o$M}y7Hgsm`j4Oh zelRp1=4E=OV4Dg3BsOkIzvq-88QOS`Qm8W^{_qo2jwOtTuAU7f8^+yT_It>%4vH$3 zOT+oQD2_n9J89fXarauPlI69gxjs$i_zmcnC~mIFeP|a;B}?#@-`nlYncP}TeL3ZW ziwZz{j95oL&Weg2_`&R>grg4UNe{-Mb>@wqC-cYqTpoxhLh~A6H=Ow%n~cUCGMsJu z`si7t*PQGjSkS|)Ymh>jk96n*R6pLU=JYVdP=fkDd>Ku%ZGOkD5oP%bMn9Z zazX-P=ZFCR(V2|@*tjbE?8SR}NPqgE=E<_4-7H@Jznw}I!Lq)ib-(RZRk*k$4Ka8t zmR*^@1+jL_3!k0yR1n7(IW)eUAA;Ij{=BEBt(1v_Rn4J0qZf-Iz0B>;;sd+C61?Zf z-O7H=vghNbz6qpUESC^3;5u~6Sd#8DF|68ikX*n2@EFTRkuZku`MG`*pq^w)b^X*N zdKXku+%LVjX%+Mjf>Pi@=R3+ps1Hwp{)0*fq-i5uZrjD=T77n+#(Ou`^Uqq;r6-c) z`@MHLdJ`KLnFwK*CI*h=Y@_4jG)ogz_Nzzz9)7Guv(X{L`W>tdL?)GF=7(c2?sC+1 z@QV$nbb7^^_q$5uzwy%@L#H!{*Tn@at$xASg>z2xxO0;kyI9#EW8-{17PS|h za>+|1?kM70{b7DdF9y&$B)X-<&wQ{6>Gwrp8;?HBKoh)ZRUP4S&bl-H4+E%M|vrX0UkUpS@KezH*}oVh!n*@a&g` zV1p2b?UT|44xVo)MF$_UxZG*oQ0FSbOo?xJZiNCNXaxO6y9{uxD5I#t9&((}bBbeD zkH3ZMR&PH@Ugg$MmK&OIb-2z0c5iUg>Kl|HM-e~abNBi-XD@Ekx4=i!n_3p7PRG){ z#`Wjyh5i8(nQxLo=grT`o;)o`OgP!h;f`;&SgLVi5BI`BajXE;gGIMbuuB!nfoSPu zjk>*oXk6}!n*?SgFn*agKAx;|QqWkL`w)#&!gqbc65X?C9^dRPc&gBsh}x?-yIoAM zkclIy_S1LyXk0@2Z41*rIFB%SvE^l*BkZojNKZ=J+el_I`Gfb)6yqQ3)*!tke}R>F zBZtN7U!i=%3fJom1dn(28FaSTnIpYi{ znXvz;4C2|L>8m3QH=_2u)oYJ6Njo6s=bItYqS%evzm~Y~x^_b|;uYbaHr|Ze16mwl z591|3{9Se}$2$=3f_dh{`^I3;#^w@k$ztLk@qRN%J^rzd>-g#rioDH`+hczoy)o=j+#cUG^Je@=}{mEW>B2 zUg-X_t6#)pl}x@MyK~7K>1)is{AQeYq{b~J)L$Q4%Zr!3Yoq>}2w8?dxSfIKcf^yg zV&s-K;_3YwLjjySIlOsLmfE(WoNb2Mn;^NYvCGO3u~TAZl4)}x!K*)l2V^gO%$$FY zk9seCGQ=57rv1H=KG>dRPf>|W@G-dWooFHf-0udDDHKQ$P0dhWH9(3!em};6`w^a9 zJfzQep3Vh#iqa`+h@W^#pBu#tk$$V`9ZnDF{S1o7ow%JS?15b?X#(RBHuQzu^5|eS zD_ERRq4(|eapX!3oTApZkZ+cTQ&d(p`SxS>C|3^yUG(`?LJ$6>_|fPW!82%{MxmW? z%61cugBg4I!U$>VhV0qaw)P?V1@zEik#%yCSdkg0@ujj$4UVhn$r|A}w5gU|0% zAiluwWYns0gdg-%L5sBh*yo!o5hE~evQKFcTj4&aE5MGhXo6O2GXrGN`>b9uLI-|7 z3)(o9D1rH~E59Cb9JXVKnG%uEzDq6C2qBnPa~-CDZxXP6au==(&o^TG)d?&mtgXS| z2wI1qy7LaoS>~bfz}o+GJzAJK?`e-%F0YW^d5f9z$8pHcw2~%HA_Vf$I*)I?dP{C& z4q{8UoXnE-4^jQwf=VX>`ItE7I6YRQee+&a-y+!Kp3QdVJ<8g}zgGDL6DJeDrVr## zi$L|grP5|M8Z!A$*sBxD&p$AE?BV)(m*hE~sD80VY|%rp^@u-MJafp(wn5A}ArU#D zjq#6Kvehcz=P~|tTiN4l2fP^07*m&Pc;QE*h836SKa2+2v;U9lLSJ+R^q3w{xCD+mC0}+F`GA%#J11`*?gTh6C z3qL%k%FrV^;QiWb*~G$bsQ=K5Csji`iJ1km==Wo02cANImz_L@FTVksJ0}NnpxIH0 zU&%V!9^!}a!)$0@(y~N0w3|{GkE_y-`n?He?4T;r_U-x&Og!hUKTrDVKe5WYD3Z(L zo}!ervRfm_t_DW)q{c!^(Y!3K=?Wg~u0iZ^87~P?dym*DO8eNhxD>=!7Z(iAJI?q& z&}_{a6ugY|8Xwb}8tyT1vQgsfD}n3Gc@9_1$W3q-6Bo5E`iZ4utGT@X%Io`&-)TA@ zvD&I*s+-PFNA2GY4C-X*sUVg**{!f#oZ<79QZo~rESUQ*l)tjrV21e44q-m^tB#19 zr>(ZEO=O-w-dZ!+&dQQo5ED&t6t@yd{`V-Csa9nBsc=f`mL8CTd6LhRiGZKp??z4} z7Q*jhL49+GNmC&|84p_M_$4U|3TQtkD@}}}_fP4Dfd3Qp16pgqQ|RBi=P46;FrUIy zWx!W@;NrrBG~6et1sMZT=x4b=hKPanT})NLB6Xg94AX zysSqY+MT~^38!@GnFH!9mQ z&;OvKwr}Hl#%?S-RrU^7_;ZWkd(M7t3)1?hxmc_Y!IN*V8=z_ z9Ci;5JcD6A^Pa4Q>xr!u0NwQeXda= z>R?jss8V~22pad{p{x9jy3s7&JpL+;Cfpa;tTH2)S1v(#o@v<1Z^|2g>?advQinIbf0V)O!;e07H+$K^?3Ws~j%Nl0`=I-OsKl+^`|%9o z6~~mg&QeTV5%o7=2ff~d^rBDA0ynxcdG*&iw+-r-cOkub^66)xO`eDyUOf7(>@BlD zn)sTG)#$KCdU@e{GCivU5t|NC8CLDgc}vvNaV5F(en>xNA6{-Vf$7f`%aHt#r8`&& zFdxLCYzX?8O;u2jbbgLgyY7qs<9uxz9#7{N);(k%T@Q1@EoeJf_-<$BdBpV#zTQ0WoH<{qD_*2A%%9BVJ;c)VVSeg|Q;56Y z#*MT1J+l1P?8=SblV5$@1<;|go4V{-EHu!vWa&j?am;4(z@uTqpNZ)-eAxX}YX+LzG z_D<^gZlteoyp}Nf-HX*gpLf{mqInbf4*mW83UU?vKF+p$N2<{KhtX~_RTWC{4sw{D zAWIRVhW2=V)ghz16mC$}}OB2^#4rEO2%VY8WulJ75cd06qVmS;; ztA38da6@qmqw!*g2Zwz>bIDq9RjvMm2k_kIHCy-aRxx}0v(z}BjToss0W z^Yh=k4V=SWI`iZ*!_MOhlrr|)nVWdv77_mo7gEW@PnBC@=A0)}uS<4CYiFVJfyLv5 zB7MZre-UJNLf;$^o_K literal 0 HcmV?d00001 diff --git a/test/io/simple_test.mtx b/test/io/simple_test.mtx deleted file mode 100644 index 82d36e26c..000000000 --- a/test/io/simple_test.mtx +++ /dev/null @@ -1,7 +0,0 @@ -%%MatrixMarket matrix array real general -% Simple test matrix -2 2 -1.0 -0.0 -0.0 -2.0 diff --git a/test/io/test_complex.mtx b/test/io/test_complex.mtx deleted file mode 100644 index 761187794..000000000 --- a/test/io/test_complex.mtx +++ /dev/null @@ -1,7 +0,0 @@ -%%MatrixMarket matrix array complex general -% Generated by Fortran stdlib on 2025-10-3 -2 2 - 1.0000000000000000E+000 2.0000000000000000E+000 - 3.0000000000000000E+000 -1.0000000000000000E+000 - 0.0000000000000000E+000 0.0000000000000000E+000 - 0.0000000000000000E+000 4.0000000000000000E+000 diff --git a/test/io/test_coord.mtx b/test/io/test_coord.mtx deleted file mode 100644 index 8914a957b..000000000 --- a/test/io/test_coord.mtx +++ /dev/null @@ -1,8 +0,0 @@ -%%MatrixMarket matrix coordinate real general -% Generated by Fortran stdlib on 2025-10-3 -% coordinate format -4 4 4 -1 1 1.0000000000000000E+000 -4 1 -3.0000000000000000E+000 -2 3 2.5000000000000000E+000 -4 4 4.5000000000000000E+000 diff --git a/test/io/test_integer.mtx b/test/io/test_integer.mtx deleted file mode 100644 index 452e11546..000000000 --- a/test/io/test_integer.mtx +++ /dev/null @@ -1,9 +0,0 @@ -%%MatrixMarket matrix array integer general -% Generated by Fortran stdlib on 2025-10-3 -2 3 -1 -0 -3 -0 -2 -0 diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index b8054fc59..7dfd2da1d 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -9,6 +9,7 @@ module test_io_mm use stdlib_math, only: all_close use stdlib_io_npy, only: load_npy use stdlib_io_mm + use stdlib_system, only: OS_NAME, get_runtime_os implicit none integer, parameter :: MS_general = 1 @@ -513,12 +514,12 @@ contains if(allocated(index_save)) deallocate(index_save) end block - ! Validate given matrices inside https://math.nist.gov/MatrixMarket/data/SPARSKIT/ + ! Validate given matrices inside https://sparse.tamu.edu/ block - real(dp), allocatable :: data_f_load(:), data_s_load(:) + real(dp), allocatable :: data_f_load_1(:), data_s_load_1(:), data_f_load_2(:,:), data_s_load_2(:,:) integer, allocatable :: index_f_load(:,:), index_s_load(:) integer :: nrows, nnz, stat, i - character(len=:), allocatable :: path, str + character(len=:), allocatable :: path, str, filename str = "${_FILE_}$" i = len_trim(str) @@ -526,23 +527,54 @@ contains if(str(i:i) == '/' .or. str(i:i) == '\') exit i = i - 1 end do - if(i > 0) then - path = str(:i) // "../data/" + if(OS_NAME(get_runtime_os())=="Windows") then + if(i > 0) then + path = str(:i) // "..\data\" + else + path = "data\" + end if + path = path // "matrix_market\" else - path = "data/" - end if + if(i > 0) then + path = str(:i) // "../data/" + else + path = "data/" + end if + end if path = path // "matrix_market/" - call load_mm(path // "fidap005.mtx", index_f_load, data_f_load, iostat=stat) + + ! coordinate real symmetric + filename = "bcsstk01" + call load_mm(path // filename // ".mtx", index_f_load, data_f_load_1, iostat=stat) + nnz = size(index_f_load, dim=2) + call load_npy(path // filename // ".mtx_indices.npy", index_s_load, iostat=stat) + index_s_load = index_s_load + 1 + call load_npy(path // filename //".mtx_data.npy", data_s_load_1, iostat=stat) + call check(error, all(index_f_load(1,:)==index_s_load(1:nnz)), .true.,& + "MM coordinate test failed: bcsstk01.mtx rows not matched") + call check(error, all(index_f_load(2,:)==index_s_load(nnz+1:2*nnz)), .true.,& + "MM coordinate test failed: bcsstk01.mtx cols not matched") + call check(error, all_close(data_f_load_1, data_s_load_1), .true.,& + "MM coordinate test failed: bcsstk01.mtx data not matched") + + ! coordinate pattern symmetric + filename = "ash85" + call load_mm(path // filename // ".mtx", index_f_load, data_f_load_1, iostat=stat) nnz = size(index_f_load, dim=2) - call load_npy(path // "fidap005.mtx_indices.npy", index_s_load, iostat=stat) + call load_npy(path // filename // ".mtx_indices.npy", index_s_load, iostat=stat) index_s_load = index_s_load + 1 - call load_npy(path // "fidap005.mtx_data.npy", data_s_load, iostat=stat) + call load_npy(path // filename //".mtx_data.npy", data_s_load_1, iostat=stat) call check(error, all(index_f_load(1,:)==index_s_load(1:nnz)), .true.,& - "MM coordinate test failed: fidap005.mtx rows not matched") + "MM coordinate test failed: bcsstk01.mtx rows not matched") call check(error, all(index_f_load(2,:)==index_s_load(nnz+1:2*nnz)), .true.,& - "MM coordinate test failed: fidap005.mtx cols not matched") - call check(error, all_close(data_f_load, data_s_load), .true.,& - "MM coordinate test failed: fidap005.mtx data not matched") + "MM coordinate test failed: bcsstk01.mtx cols not matched") + + ! array real general + filename = "lhr01_b" + call load_mm(path // filename // ".mtx", data_f_load_2, iostat=stat) + call load_npy(path // filename // ".mtx_data.npy", data_s_load_2, iostat=stat) + call check(error, all_close(data_f_load_2, transpose(data_s_load_2)), .true.,& + "MM coordinate test failed: bcsstk01.mtx data not matched") end block stat = 0 open(newunit=u, file="test_mmio_sparse.mtx", status="old", iostat=stat) diff --git a/test/io/test_real.mtx b/test/io/test_real.mtx deleted file mode 100644 index 89e77280a..000000000 --- a/test/io/test_real.mtx +++ /dev/null @@ -1,12 +0,0 @@ -%%MatrixMarket matrix array real general -% Generated by Fortran stdlib on 2025-10-5 -3 3 - 1.0000000000000000E+000 - 0.0000000000000000E+000 - 3.0000000000000000E+000 - 0.0000000000000000E+000 - 2.0000000000000000E+000 - 0.0000000000000000E+000 - 4.0000000000000000E+000 - 0.0000000000000000E+000 - 5.0000000000000000E+000 From 516815eb5dc363eb4c555d2d940fba84b3ec732b Mon Sep 17 00:00:00 2001 From: Mahmood Sinan Date: Wed, 22 Apr 2026 12:27:53 +0530 Subject: [PATCH 45/50] fix windows bug --- example/io/example_matrix_market.f90 | 4 ++-- src/io/stdlib_io_mm_load.fypp | 2 ++ test/io/test_io_mm.fypp | 2 +- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/example/io/example_matrix_market.f90 b/example/io/example_matrix_market.f90 index 38e38fbae..791c5bc28 100644 --- a/example/io/example_matrix_market.f90 +++ b/example/io/example_matrix_market.f90 @@ -6,8 +6,8 @@ program example_matrix_market real(dp), allocatable :: matrix(:,:), matrix2(:,:) integer, allocatable :: index(:,:) real(dp), allocatable :: data(:) - character(len=*), parameter :: dense_filename = "test_dense.mtx" - character(len=*), parameter :: sparse_filename = "test_sparse.mtx" + character(len=*), parameter :: dense_filename = "example_dense.mtx" + character(len=*), parameter :: sparse_filename = "example_sparse.mtx" integer :: iostat, i character(len=:), allocatable :: iomsg diff --git a/src/io/stdlib_io_mm_load.fypp b/src/io/stdlib_io_mm_load.fypp index f495fa3e3..c81b13b51 100644 --- a/src/io/stdlib_io_mm_load.fypp +++ b/src/io/stdlib_io_mm_load.fypp @@ -247,6 +247,8 @@ contains !----------------------------------------- ! Skip comments + eol_position = shift_to_eol(ffp) + ffp => ffp(eol_position+1:) do while( iachar(ffp(1:1))==PP ) eol_position = shift_to_eol(ffp) ffp => ffp(eol_position+1:) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index 7dfd2da1d..b428d3bf9 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -540,8 +540,8 @@ contains else path = "data/" end if + path = path // "matrix_market/" end if - path = path // "matrix_market/" ! coordinate real symmetric filename = "bcsstk01" From 0617db44d38b7ac3ac6bdd782ad70b1d07c4a357 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Wed, 22 Apr 2026 15:42:59 +0530 Subject: [PATCH 46/50] small change --- test/io/test_io_mm.fypp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index b428d3bf9..c06feae37 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -9,7 +9,7 @@ module test_io_mm use stdlib_math, only: all_close use stdlib_io_npy, only: load_npy use stdlib_io_mm - use stdlib_system, only: OS_NAME, get_runtime_os + use stdlib_system, only: OS_TYPE, OS_WINDOWS implicit none integer, parameter :: MS_general = 1 @@ -527,7 +527,7 @@ contains if(str(i:i) == '/' .or. str(i:i) == '\') exit i = i - 1 end do - if(OS_NAME(get_runtime_os())=="Windows") then + if(OS_TYPE() == OS_WINDOWS) then if(i > 0) then path = str(:i) // "..\data\" else From 0901da104ade9f90ca96c1e4798ec2b4397ba7a2 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Wed, 22 Apr 2026 22:45:38 +0530 Subject: [PATCH 47/50] remove: os check --- test/io/test_io_mm.fypp | 17 +---------------- 1 file changed, 1 insertion(+), 16 deletions(-) diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index c06feae37..bdd7eabb6 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -9,7 +9,6 @@ module test_io_mm use stdlib_math, only: all_close use stdlib_io_npy, only: load_npy use stdlib_io_mm - use stdlib_system, only: OS_TYPE, OS_WINDOWS implicit none integer, parameter :: MS_general = 1 @@ -527,21 +526,7 @@ contains if(str(i:i) == '/' .or. str(i:i) == '\') exit i = i - 1 end do - if(OS_TYPE() == OS_WINDOWS) then - if(i > 0) then - path = str(:i) // "..\data\" - else - path = "data\" - end if - path = path // "matrix_market\" - else - if(i > 0) then - path = str(:i) // "../data/" - else - path = "data/" - end if - path = path // "matrix_market/" - end if + path = str(:i) // "../data/matrix_market/" ! coordinate real symmetric filename = "bcsstk01" From 1fbd0bb842e5260e0923803094287a51dbef4e24 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Thu, 23 Apr 2026 17:54:16 +0530 Subject: [PATCH 48/50] add README.md for data/matrix_market, remove the data file for ash85 pattern matrix --- test/data/matrix_market/README.md | 76 +++++++++++++++++++++ test/data/matrix_market/ash85.mtx_data.npy | Bin 4312 -> 0 bytes test/io/test_io_mm.fypp | 1 - 3 files changed, 76 insertions(+), 1 deletion(-) create mode 100644 test/data/matrix_market/README.md delete mode 100644 test/data/matrix_market/ash85.mtx_data.npy diff --git a/test/data/matrix_market/README.md b/test/data/matrix_market/README.md new file mode 100644 index 000000000..511d9e309 --- /dev/null +++ b/test/data/matrix_market/README.md @@ -0,0 +1,76 @@ +# Test Data: Matrix Market + +This directory contains matrices used for testing purposes. These matrices are obtained from the SuiteSparse Matrix Collection (formerly the University of Florida Sparse Matrix Collection): + +https://sparse.tamu.edu + +## License + +The matrices in this directory are distributed under the CC-BY 4.0 license: + +https://creativecommons.org/licenses/by/4.0/ + +## Attribution + +- Kolodziej et al., (2019). The SuiteSparse Matrix Collection Website Interface. Journal of Open Source Software, 4(35), 1244. DOI: https://doi.org/10.21105/joss.01244 + +- Timothy A. Davis and Yifan Hu. 2011. The University of Florida Sparse Matrix Collection. ACM Transactions on Mathematical Software 38, 1, Article 1 (December 2011), 25 pages. DOI: https://doi.org/10.1145/2049662.2049663 + +## Matrix Market Metadata + +The matrices stored in the Matrix Market (`.mtx`) files include metadata in their headers, which may contain additional citations specific to individual matrices. + +These headers have been preserved and must not be removed. + +## Matrix Sources + +The matrix market files used are listed below: +- https://sparse.tamu.edu/HB/ash85 +- https://sparse.tamu.edu/HB/bcsstk01 +- https://sparse.tamu.edu/Mallya/lhr01 + +## About .npy files + +The `.npy` files in this directory are derived from the corresponding Matrix Market (`.mtx`) files using SciPy and NumPy. + +### Storage format + +For coordinate (COO) matrices: + +- Non-pattern matrices: + - `*_data.npy` contains the nonzero values + - `*_indices.npy` contains the indices in a flattened format: + [row_1, row_2, ..., row_n, col_1, col_2, ..., col_n] + +- Pattern matrices: + - `*_indices.npy` contains the indices in the same flattened format + +For array-type matrices: +- `*_data.npy` contains the matrix entries + +### Generation of .npy files + +The following Python snippet was used to generate the `.npy` files: + +```python +import numpy as np +from scipy.io import mmread + +FILE_NAME = "mm_file_name.mtx" + +loaded = mmread(FILE_NAME) +indices = np.concatenate((loaded.row, loaded.col)) # not applicable for array-type matrices + +np.save(FILE_NAME + "_indices.npy", indices) # not applicable for array-type matrices +np.save(FILE_NAME + "_data.npy", loaded.data) # not applicable for pattern matrices +``` + +## Notes + +- The matrices included are solely for testing purposes. +- The matrices in the Matrix Market (`.mtx`) files are included without modification from their original source. +- The stdlib project itself remains licensed under the MIT License. +- The CC-BY 4.0 license applies only to the Matrix Market (`.mtx`) files in this directory. +- No warranties are provided by the original authors. + +© The original authors of the Matrix Market (`.mtx`) files, as listed in the SuiteSparse Matrix Collection. \ No newline at end of file diff --git a/test/data/matrix_market/ash85.mtx_data.npy b/test/data/matrix_market/ash85.mtx_data.npy deleted file mode 100644 index 606f90430771e962e9f770f2cce9008241323e7d..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4312 zcmbR27wQ`j$;eQ~P_3SlTAW;@Zl$1ZlV+i=qoAIaUsO_*m=~X4l#&V(cT3DEP6dh= zXCxM+0{I%IM#egtItsN4WCJb+F!*3UN`pdRG#p0L!Du=d%?G39z-T!zS`Lhs1Eb}@ YXgM%i4vdxqqvgP8IWSrdkWvl+0GrZ=r~m)} diff --git a/test/io/test_io_mm.fypp b/test/io/test_io_mm.fypp index bdd7eabb6..c111f9388 100644 --- a/test/io/test_io_mm.fypp +++ b/test/io/test_io_mm.fypp @@ -548,7 +548,6 @@ contains nnz = size(index_f_load, dim=2) call load_npy(path // filename // ".mtx_indices.npy", index_s_load, iostat=stat) index_s_load = index_s_load + 1 - call load_npy(path // filename //".mtx_data.npy", data_s_load_1, iostat=stat) call check(error, all(index_f_load(1,:)==index_s_load(1:nnz)), .true.,& "MM coordinate test failed: bcsstk01.mtx rows not matched") call check(error, all(index_f_load(2,:)==index_s_load(nnz+1:2*nnz)), .true.,& From 22ed21ca984a60059c7b4b21b2efb807bb7cc648 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Fri, 24 Apr 2026 11:23:03 +0530 Subject: [PATCH 49/50] example modified --- example/io/example_matrix_market.f90 | 45 +++++++++++++--------------- 1 file changed, 20 insertions(+), 25 deletions(-) diff --git a/example/io/example_matrix_market.f90 b/example/io/example_matrix_market.f90 index 791c5bc28..c19dd2c96 100644 --- a/example/io/example_matrix_market.f90 +++ b/example/io/example_matrix_market.f90 @@ -5,14 +5,12 @@ program example_matrix_market real(dp), allocatable :: matrix(:,:), matrix2(:,:) integer, allocatable :: index(:,:) - real(dp), allocatable :: data(:) + complex(dp), allocatable :: data(:) character(len=*), parameter :: dense_filename = "example_dense.mtx" character(len=*), parameter :: sparse_filename = "example_sparse.mtx" integer :: iostat, i character(len=:), allocatable :: iomsg - iostat = 0 - iomsg = '' ! Create a test dense matrix allocate(matrix(3,3)) matrix = reshape([1.0_dp, 2.0_dp, 3.0_dp, & @@ -24,7 +22,7 @@ program example_matrix_market call print_matrix(matrix) ! Save dense matrix to Matrix Market file - call save_mm(dense_filename, matrix, iostat=iostat, iomsg=iomsg) + call save_mm(dense_filename, matrix, format="ES24.15E2", symmetry="general", iostat=iostat, iomsg=iomsg) if (iostat /= 0) then print *, "Error saving dense matrix: ", iomsg stop 1 @@ -42,11 +40,25 @@ program example_matrix_market print *, "Loaded dense matrix:" call print_matrix(matrix2) - ! Create a sparse test file manually for demonstration - call create_sparse_test_file(sparse_filename) - print *, "=== Sparse Matrix Example ===" - print *, "Loading sparse matrix from ", sparse_filename + ! Create a test sparse matrix + allocate(index(2,6)) + allocate(data(6)) + index(:,1) = [1,1]; data(1) = (10.0_dp, -1.5_dp) + index(:,2) = [2,2]; data(2) = (20.0_dp, 2.0_dp) + index(:,3) = [3,3]; data(3) = (30.0_dp, 3.0_dp) + index(:,4) = [4,4]; data(4) = (40.0_dp, -4.0_dp) + index(:,5) = [1,4]; data(5) = ( 5.0_dp, -7.5_dp) + index(:,6) = [3,1]; data(6) = (15.0_dp, 25.0_dp) + + ! Save sparse matrix to Matrix Market file + call save_mm(sparse_filename, index, data, format="ES24.15E2", symmetry="general", iostat=iostat, iomsg=iomsg) + if (iostat /= 0) then + print *, "Error saving sparse matrix: ", iomsg + stop 1 + end if + + print *, "Sparse matrix saved to ", sparse_filename ! Load sparse matrix from Matrix Market file call load_mm(sparse_filename, index, data, iostat=iostat, iomsg=iomsg) @@ -73,21 +85,4 @@ subroutine print_matrix(mat) print * end subroutine print_matrix - subroutine create_sparse_test_file(filename) - character(len=*), intent(in) :: filename - integer :: u - - open(newunit=u, file=filename, status='replace') - write(u, '(A)') '%%MatrixMarket matrix coordinate real general' - write(u, '(A)') '% This is a test sparse matrix' - write(u, '(A)') '4 4 6' - write(u, '(A)') '1 1 10.0' - write(u, '(A)') '2 2 20.0' - write(u, '(A)') '3 3 30.0' - write(u, '(A)') '4 4 40.0' - write(u, '(A)') '1 4 5.0' - write(u, '(A)') '3 1 15.0' - close(u) - end subroutine create_sparse_test_file - end program example_matrix_market \ No newline at end of file From d6a4403b3b6a9125a93364d0f0da14d5f2edb445 Mon Sep 17 00:00:00 2001 From: Mahmood-Sinan Date: Fri, 24 Apr 2026 22:57:05 +0530 Subject: [PATCH 50/50] modified docs --- doc/specs/stdlib_io.md | 104 +++++++++++++++++++++++++++++++++-------- 1 file changed, 85 insertions(+), 19 deletions(-) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 6cd022166..307baa89a 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -333,45 +333,112 @@ The Matrix Market I/O module provides support for reading and writing matrices i ### `load_mm` - load a matrix from Matrix Market file +Loads a 2D matrix from a Matrix Market format file. Symmetric matrices are expanded to full storage. + #### Syntax -`call ` [[stdlib_io_mm(module):load_mm(interface)]] `(filename, matrix [, iostat] [, iomsg])` +- To load a matrix of `array` format: + +`call ` [[stdlib_io_mm(module):load_mm(interface)]] `(filename, matrix [, iostat, iomsg])` + +- To load a matrix of `coordinate` format: + +`call ` [[stdlib_io_mm(module):load_mm(interface)]] `(filename, index, data [, iostat, iomsg])` #### Arguments -`filename`: Shall be a character expression containing the Matrix Market file name to read from. +**`Array` format** + +`call ` [[stdlib_io_mm(module):load_mm(interface)]] `(filename, matrix [, iostat, iomsg])` + +- `filename`: Shall be a character expression containing the Matrix Market file name to read from. + +- `matrix`: Shall be an allocatable rank-2 array of type `real`, `complex`, or `integer` that will contain the loaded matrix. + +- `iostat` (optional): Shall be a scalar of type `integer` that receives the error status. Zero indicates success. -`matrix`: Shall be an allocatable rank-2 array of type `real`, `complex`, or `integer` that will contain the loaded matrix. +- `iomsg` (optional): Shall be an allocatable character string that receives the error message if iostat is non-zero. -`iostat` (optional): Shall be a scalar of type `integer` that receives the error status. Zero indicates success. +**`Coordinate` format** -`iomsg` (optional): Shall be an allocatable character string that receives the error message if iostat is non-zero. +`call ` [[stdlib_io_mm(module):load_mm(interface)]] `(filename, index, data [, iostat, iomsg])` -#### Description +- `filename`: Shall be a character expression containing the Matrix Market file name to read from. -Loads a 2D matrix from a Matrix Market format file. The routine automatically detects the data type, format (coordinate or array), and symmetry properties from the file header. For coordinate format files, symmetric matrices are expanded to full storage. +- `index`: Shall be an allocatable rank-2 array of type `integer` that will contain the indices of the loaded matrix. + +- `data`: Shall be an allocatable rank-1 array of type `real`, `complex`, or `integer` that will contain the values of the loaded matrix. + +- `iostat` (optional): Shall be a scalar of type `integer` that receives the error status. Zero indicates success. + +- `iomsg` (optional): Shall be an allocatable character string that receives the error message if iostat is non-zero. ### `save_mm` - save a matrix to Matrix Market file +Saves a 2D matrix to Matrix Market format file. + #### Syntax -`call ` [[stdlib_io_mm(module):save_mm(interface)]] `(filename, matrix [, header_info] [, iostat] [, iomsg])` +- To save a matrix of `array` format: + +`call ` [[stdlib_io_mm(module):save_mm(interface)]] `(filename, matrix [, comment, format, symmetry, iostat, iomsg])` + +- To save a matrix of `coordinate` format: + +`call ` [[stdlib_io_mm(module):save_mm(interface)]] `(filename, index, data [, comment, format, symmetry, iostat, iomsg])` #### Arguments -`filename`: Shall be a character expression containing the Matrix Market file name to write to. +**`Array` format** -`matrix`: Shall be a rank-2 array of type `real`, `complex`, or `integer` to save. +`call ` [[stdlib_io_mm(module):save_mm(interface)]] `(filename, matrix [, comment, format, symmetry, iostat, iomsg])` -`header_info` (optional): Shall be a character expression containing additional comments for the file header. Can also specify format preference ('coordinate' or 'array'). +- `filename`: Shall be a character expression containing the Matrix Market file name to write to. -`iostat` (optional): Shall be a scalar of type `integer` that receives the error status. Zero indicates success. +- `matrix`: Shall be a rank-2 array of type `real`, `complex`, or `integer` to save. -`iomsg` (optional): Shall be an allocatable character string that receives the error message if iostat is non-zero. +- `comment` (optional): Shall be a character expression containing additional comments for the file header. -#### Description +- `format` (optional): Shall be a character expression specifying how entries are written. -Saves a 2D matrix to Matrix Market format file. The routine automatically chooses coordinate format for sparse matrices (< 50% non-zero) and array format for dense matrices, unless overridden in `header_info`. +- `symmetry` (optional): Shall be a character expression defining the symmetry of the matrix. Allowed values: `auto`, `general`, `symmetric`, `skew-symmetric`, `hermitian`. + - `auto`: Detects the symmetry automatically, falls back to `general` if no symmetry is found. + - `general`: all entries are stored + - `symmetric` / `hermitian`: only the lower triangle (including diagonal) is stored + - `skew-symmetric`: only the strictly lower triangle (excluding diagonal) is stored + + Default: `general` + +- `iostat` (optional): Shall be a scalar of type `integer` that receives the error status. Zero indicates success. + +- `iomsg` (optional): Shall be an allocatable character string that receives the error message if iostat is non-zero. + +**`Coordinate` format** + +`call ` [[stdlib_io_mm(module):save_mm(interface)]] `(filename, index, data [, comment, format, symmetry, iostat, iomsg])` + +- `filename`: Shall be a character expression containing the Matrix Market file name to write to. + +- `index`: Shall be a rank-2 `integer` array of shape `(2, n)` specifying the indices of the entries. + - index(1,:) shall contain row indices + - index(2,:) shall contain column indices + +- `data`: Shall be a rank-1 array of type `real`, `complex`, or `integer` to save. + - If `size(data) == n`, the values for each index are written. + - If `size(data) == 1`, a `pattern` matrix is written (no explicit values) + +- `comment` (optional): Shall be a character expression containing additional comments for the file header. + +- `format` (optional): Shall be a character expression specifying how entries are written. + +- `symmetry` (optional): Shall be a character expression defining the symmetry of the matrix. Allowed values: `general`, `symmetric`, `skew-symmetric`, `hermitian`. + - `general`: all entries are stored + - `symmetric` / `hermitian`: only the lower triangle (including diagonal) is stored + - `skew-symmetric`: only the strictly lower triangle (excluding diagonal) is stored + +- `iostat` (optional): Shall be a scalar of type `integer` that receives the error status. Zero indicates success. + +- `iomsg` (optional): Shall be an allocatable character string that receives the error message if iostat is non-zero. ### Matrix Market Format Details @@ -379,12 +446,11 @@ The Matrix Market format supports: - **Object types**: Currently only `matrix` is supported - **Formats**: `coordinate` (sparse) and `array` (dense) -- **Data types**: `real`, `complex`, `integer` (pattern not yet supported) -- **Symmetry**: `general`, `symmetric`, `skew-symmetric`, `hermitian` +- **Data types**: `real`, `complex`, `integer`, `pattern` +- **Symmetry**: `general`, `symmetric`, `skew-symmetric`, `hermitian`, `auto` (Currently only supported for `array` format) ### Example ```fortran {!example/io/example_matrix_market.f90!} -``` - +``` \ No newline at end of file