From 5d0ff52cb0a4ae44145c0ffed711aa1bf09ada57 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Wed, 10 Jan 2024 00:47:51 +0100
Subject: [PATCH 01/78] sparse API 1st commit
---
src/stdlib_sparse.f90 | 6 +
src/stdlib_sparse_conversion.fypp | 141 ++++++++++++++++
src/stdlib_sparse_kinds.fypp | 244 ++++++++++++++++++++++++++++
src/stdlib_sparse_matvec.fypp | 193 ++++++++++++++++++++++
test/linalg/test_sparse_matvec.fypp | 88 ++++++++++
5 files changed, 672 insertions(+)
create mode 100644 src/stdlib_sparse.f90
create mode 100644 src/stdlib_sparse_conversion.fypp
create mode 100644 src/stdlib_sparse_kinds.fypp
create mode 100644 src/stdlib_sparse_matvec.fypp
create mode 100644 test/linalg/test_sparse_matvec.fypp
diff --git a/src/stdlib_sparse.f90 b/src/stdlib_sparse.f90
new file mode 100644
index 000000000..c9d866151
--- /dev/null
+++ b/src/stdlib_sparse.f90
@@ -0,0 +1,6 @@
+!! public API
+module stdlib_sparse
+ use stdlib_sparse_kinds
+ use stdlib_sparse_matvec
+ use sparse_stdlib_conversion
+end module stdlib_sparse
\ No newline at end of file
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
new file mode 100644
index 000000000..3f3a9eb49
--- /dev/null
+++ b/src/stdlib_sparse_conversion.fypp
@@ -0,0 +1,141 @@
+#:include "common.fypp"
+#:set KINDS_TYPES = REAL_KINDS_TYPES
+!> The `stdlib_sparse_conversion` module provides sparse to sparse matrix conversion utilities.
+!>
+!> This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
+module sparse_stdlib_conversion
+ use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
+ use stdlib_sparse_kinds
+ implicit none
+ private
+
+ public :: dense2coo, coo2dense, coo2csr, csr2coo
+ interface dense2coo
+ #:for k1, t1 in (KINDS_TYPES)
+ module procedure dense2coo_${k1}$
+ #:endfor
+ end interface
+
+ interface coo2dense
+ #:for k1, t1 in (KINDS_TYPES)
+ module procedure coo2dense_${k1}$
+ #:endfor
+ end interface
+
+ interface coo2csr
+ #:for k1, t1 in (KINDS_TYPES)
+ module procedure coo2csr_${k1}$
+ #:endfor
+ end interface
+
+ interface csr2coo
+ #:for k1, t1 in (KINDS_TYPES)
+ module procedure csr2coo_${k1}$
+ #:endfor
+ end interface
+
+contains
+
+ #:for k1, t1 in (KINDS_TYPES)
+ subroutine dense2coo_${k1}$(dense,COO)
+ ${t1}$, intent(in) :: dense(:,:)
+ type(COO_${k1}$), intent(inout) :: COO
+ integer :: num_rows, num_cols, nnz
+ integer :: i, j, idx
+
+ num_rows = size(dense,dim=1)
+ num_cols = size(dense,dim=2)
+ nnz = count( abs(dense) > tiny(1._${k1}$) )
+
+ call COO%malloc(num_rows,num_cols,nnz)
+
+ idx = 1
+ do i = 1, num_rows
+ do j = 1, num_cols
+ if(abs(dense(i,j)) < tiny(1._${k1}$)) cycle
+ COO%index(1,idx) = i
+ COO%index(2,idx) = j
+ COO%data(idx) = dense(i,j)
+ idx = idx + 1
+ end do
+ end do
+ COO%isOrdered = .true.
+ end subroutine
+
+ #:endfor
+
+ #:for k1, t1 in (KINDS_TYPES)
+ subroutine coo2dense_${k1}$(COO,dense)
+ type(COO_${k1}$), intent(in) :: COO
+ ${t1}$, allocatable, intent(inout) :: dense(:,:)
+ integer :: idx
+
+ if(.not.allocated(dense)) allocate(dense(COO%nrows,COO%nrows),source=0._${k1}$)
+ do concurrent(idx = 1:COO%nnz)
+ dense( COO%index(1,idx) , COO%index(2,idx) ) = COO%data(idx)
+ end do
+ end subroutine
+
+ #:endfor
+
+ #:for k1, t1 in (KINDS_TYPES)
+ subroutine coo2csr_${k1}$(COO,CSR)
+ !! coo2csr: This function enables transfering data from a COO matrix to a CSR matrix
+ !! under the hypothesis that the COO is already ordered.
+ type(COO_${k1}$), intent(in) :: COO
+ type(CSR_${k1}$), intent(inout) :: CSR
+ integer :: i
+
+ CSR%nnz = COO%nnz; CSR%nrows = COO%nrows; CSR%ncols = COO%ncols
+ CSR%base = COO%base; CSR%sym = COO%sym
+
+ if( allocated(CSR%col) ) then
+ CSR%col(1:COO%nnz) = COO%index(2,1:COO%nnz)
+ CSR%rowptr(1:CSR%nrows) = 0
+ CSR%data(1:CSR%nnz) = COO%data(1:COO%nnz)
+ else
+ allocate( CSR%col(CSR%nnz) , source = COO%index(2,1:COO%nnz) )
+ allocate( CSR%rowptr(CSR%nrows+1) , source = 0 )
+ allocate( CSR%data(CSR%nnz) , source = COO%data(1:COO%nnz) )
+ end if
+
+ CSR%rowptr(1) = 1
+ do i = 1, COO%nnz
+ CSR%rowptr( COO%index(1,i)+1 ) = CSR%rowptr( COO%index(1,i)+1 ) + 1
+ end do
+ do i = 1, CSR%nrows
+ CSR%rowptr( i+1 ) = CSR%rowptr( i+1 ) + CSR%rowptr( i )
+ end do
+ end subroutine
+
+ #:endfor
+
+ #:for k1, t1 in (KINDS_TYPES)
+ subroutine csr2coo_${k1}$(CSR,COO)
+ !! csr2coo: This function enables transfering data from a CSR matrix to a COO matrix
+ !! under the hypothesis that the CSR is already ordered.
+ type(CSR_${k1}$), intent(in) :: CSR
+ type(COO_${k1}$), intent(inout) :: COO
+ integer :: i, j
+
+ COO%nnz = CSR%nnz; COO%nrows = CSR%nrows; COO%ncols = CSR%ncols
+ COO%base = CSR%base; COO%sym = CSR%sym
+
+ if( .not.allocated(COO%data) ) then
+ allocate( COO%data(CSR%nnz) , source = CSR%data(1:CSR%nnz) )
+ else
+ COO%data(1:CSR%nnz) = CSR%data(1:CSR%nnz)
+ end if
+
+ if( .not.allocated(COO%index) ) allocate( COO%index(2,CSR%nnz) )
+
+ do i = 1, CSR%nrows
+ do j = CSR%rowptr(i), CSR%rowptr(i+1)-1
+ COO%index(1:2,j) = [i,CSR%col(j)]
+ end do
+ end do
+ end subroutine
+
+ #:endfor
+
+end module sparse_stdlib_conversion
\ No newline at end of file
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
new file mode 100644
index 000000000..238ff5993
--- /dev/null
+++ b/src/stdlib_sparse_kinds.fypp
@@ -0,0 +1,244 @@
+#:include "common.fypp"
+#:set KINDS_TYPES = REAL_KINDS_TYPES
+!> The `stdlib_sparse_kinds` module provides derived type definitions for different sparse matrices
+!>
+!> This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
+module stdlib_sparse_kinds
+ use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
+ implicit none
+
+ private
+
+ ! -- Global parameters
+ enum, bind(C)
+ enumerator :: k_NOSYMMETRY !! Full Sparse matrix (no symmetry considerations)
+ enumerator :: k_SYMTRIINF !! Symmetric Sparse matrix with triangular inferior storage
+ enumerator :: k_SYMTRISUP !! Symmetric Sparse matrix with triangular supperior storage
+ end enum
+ public :: k_NOSYMMETRY, k_SYMTRIINF, k_SYMTRISUP
+ ! -- Classes
+ type, public, abstract :: sparse_t
+ integer :: nrows = 0 !! number of rows
+ integer :: ncols = 0 !! number of columns
+ integer :: nnz = 0 !! number of non-zero values
+ integer :: sym = k_NOSYMMETRY !! assumed storage symmetry
+ integer :: base = 1 !! index base = 0 for (C) or 1 (Fortran)
+ end type
+
+ !! COO: COOrdinates compresed format
+ type, public, extends(sparse_t) :: COO_t
+ logical :: isOrdered = .false. !! wether the matrix is ordered or not
+ integer, allocatable :: index(:,:) !! Matrix coordinates index(2,nnz)
+ contains
+ procedure :: malloc => malloc_coo
+ end type
+
+ #:for k1, t1 in (KINDS_TYPES)
+ type, public, extends(COO_t) :: COO_${k1}$
+ ${t1}$, allocatable :: data(:) !! single precision values
+ end type
+ #:endfor
+
+ !! CSR: Compressed sparse row or Yale format
+ type, extends(sparse_t) :: CSR_t
+ integer, allocatable :: col(:) !! matrix column pointer
+ integer, allocatable :: rowptr(:) !! matrix row pointer
+ contains
+ procedure :: malloc => malloc_csr
+ end type
+
+ #:for k1, t1 in (KINDS_TYPES)
+ type, public, extends(CSR_t) :: CSR_${k1}$
+ ${t1}$, allocatable :: data(:) !! single precision values
+ end type
+ #:endfor
+
+ !! CSC: Compressed sparse column
+ type, extends(sparse_t) :: CSC_t
+ integer, allocatable :: colptr(:) !! matrix column pointer
+ integer, allocatable :: row(:) !! matrix row pointer
+ contains
+ procedure :: malloc => malloc_csc
+ end type
+
+ #:for k1, t1 in (KINDS_TYPES)
+ type, public, extends(CSC_t) :: CSC_${k1}$
+ ${t1}$, allocatable :: data(:) !! single precision values
+ end type
+ #:endfor
+
+ !! Compressed ELLPACK
+ type, extends(sparse_t) :: ELL_t
+ integer :: K = 0 !! maximum number of nonzeros per row
+ integer, allocatable :: index(:,:) !! column indices
+ contains
+ procedure :: malloc => malloc_ell
+ end type
+
+ #:for k1, t1 in (KINDS_TYPES)
+ type, public, extends(ELL_t) :: ELL_${k1}$
+ ${t1}$, allocatable :: data(:,:) !! single precision values
+ end type
+ #:endfor
+
+contains
+
+ subroutine malloc_coo(self,num_rows,num_cols,nnz)
+ class(COO_t) :: self
+ integer, intent(in) :: num_rows
+ integer, intent(in) :: num_cols
+ integer, intent(in) :: nnz
+
+ integer, allocatable :: temp_idx(:,:)
+ !-----------------------------------------------------
+
+ self%nrows = num_rows
+ self%ncols = num_cols
+ self%nnz = nnz
+
+ if(.not.allocated(self%index)) then
+ allocate(temp_idx(2,nnz) , source = 0 )
+ else
+ allocate(temp_idx(2,nnz) , source = self%index )
+ end if
+ call move_alloc(from=temp_idx,to=self%index)
+
+ select type(self)
+ #:for k1, t1 in (KINDS_TYPES)
+ type is(COO_${k1}$)
+ block
+ ${t1}$, allocatable :: temp_data_${k1}$(:)
+ if(.not.allocated(self%data)) then
+ allocate(temp_data_${k1}$(nnz) , source = 0._${k1}$ )
+ else
+ allocate(temp_data_${k1}$(nnz) , source = self%data )
+ end if
+ call move_alloc(from=temp_data_${k1}$,to=self%data)
+ end block
+ #:endfor
+ end select
+ end subroutine
+
+ subroutine malloc_csr(self,num_rows,num_cols,nnz)
+ class(CSR_t) :: self
+ integer, intent(in) :: num_rows
+ integer, intent(in) :: num_cols
+ integer, intent(in) :: nnz
+
+ integer, allocatable :: temp_idx(:)
+ !-----------------------------------------------------
+
+ self%nrows = num_rows
+ self%ncols = num_cols
+ self%nnz = nnz
+
+ if(.not.allocated(self%col)) then
+ allocate(temp_idx(nnz) , source = 0 )
+ else
+ allocate(temp_idx(nnz) , source = self%col )
+ end if
+ call move_alloc(from=temp_idx,to=self%col)
+
+ if(.not.allocated(self%rowptr)) then
+ allocate(temp_idx(num_rows+1) , source = 0 )
+ else
+ allocate(temp_idx(num_rows+1) , source = self%rowptr )
+ end if
+ call move_alloc(from=temp_idx,to=self%rowptr)
+
+ select type(self)
+ #:for k1, t1 in (KINDS_TYPES)
+ type is(CSR_${k1}$)
+ block
+ ${t1}$, allocatable :: temp_data_${k1}$(:)
+ if(.not.allocated(self%data)) then
+ allocate(temp_data_${k1}$(nnz) , source = 0._${k1}$ )
+ else
+ allocate(temp_data_${k1}$(nnz) , source = self%data )
+ end if
+ call move_alloc(from=temp_data_${k1}$,to=self%data)
+ end block
+ #:endfor
+ end select
+ end subroutine
+
+ subroutine malloc_csc(self,num_rows,num_cols,nnz)
+ class(CSC_t) :: self
+ integer, intent(in) :: num_rows
+ integer, intent(in) :: num_cols
+ integer, intent(in) :: nnz
+
+ integer, allocatable :: temp_idx(:)
+ !-----------------------------------------------------
+
+ self%nrows = num_rows
+ self%ncols = num_cols
+ self%nnz = nnz
+
+ if(.not.allocated(self%row)) then
+ allocate(temp_idx(nnz) , source = 0 )
+ else
+ allocate(temp_idx(nnz) , source = self%row )
+ end if
+ call move_alloc(from=temp_idx,to=self%row)
+
+ if(.not.allocated(self%colptr)) then
+ allocate(temp_idx(num_cols+1) , source = 0 )
+ else
+ allocate(temp_idx(num_cols+1) , source = self%colptr )
+ end if
+ call move_alloc(from=temp_idx,to=self%colptr)
+
+ select type(self)
+ #:for k1, t1 in (KINDS_TYPES)
+ type is(CSC_${k1}$)
+ block
+ ${t1}$, allocatable :: temp_data_${k1}$(:)
+ if(.not.allocated(self%data)) then
+ allocate(temp_data_${k1}$(nnz) , source = 0._${k1}$ )
+ else
+ allocate(temp_data_${k1}$(nnz) , source = self%data )
+ end if
+ call move_alloc(from=temp_data_${k1}$,to=self%data)
+ end block
+ #:endfor
+ end select
+ end subroutine
+
+ subroutine malloc_ell(self,num_rows,num_cols,num_nz_rows)
+ class(ELL_t) :: self
+ integer, intent(in) :: num_rows !! number of rows
+ integer, intent(in) :: num_cols !! number of columns
+ integer, intent(in) :: num_nz_rows !! number of non zeros per row
+
+ integer, allocatable :: temp_idx(:,:)
+ !-----------------------------------------------------
+
+ self%nrows = num_rows
+ self%ncols = num_cols
+ self%K = num_nz_rows
+
+ if(.not.allocated(self%index)) then
+ allocate(temp_idx(num_rows,num_nz_rows) , source = 0 )
+ else
+ allocate(temp_idx(num_rows,num_nz_rows) , source = self%index )
+ end if
+ call move_alloc(from=temp_idx,to=self%index)
+
+ select type(self)
+ #:for k1, t1 in (KINDS_TYPES)
+ type is(ELL_${k1}$)
+ block
+ ${t1}$, allocatable :: temp_data_${k1}$(:,:)
+ if(.not.allocated(self%data)) then
+ allocate(temp_data_${k1}$(num_rows,num_nz_rows) , source = 0._${k1}$ )
+ else
+ allocate(temp_data_${k1}$(num_rows,num_nz_rows) , source = self%data )
+ end if
+ call move_alloc(from=temp_data_${k1}$,to=self%data)
+ end block
+ #:endfor
+ end select
+ end subroutine
+
+end module stdlib_sparse_kinds
\ No newline at end of file
diff --git a/src/stdlib_sparse_matvec.fypp b/src/stdlib_sparse_matvec.fypp
new file mode 100644
index 000000000..6f01b3d25
--- /dev/null
+++ b/src/stdlib_sparse_matvec.fypp
@@ -0,0 +1,193 @@
+#:include "common.fypp"
+#:set RANKS = range(1, 2+1)
+#:set KINDS_TYPES = REAL_KINDS_TYPES
+#! define ranks without parentheses
+#:def rksfx2(rank)
+#{if rank > 0}#${":," + ":," * (rank - 1)}$#{endif}#
+#:enddef
+!> The `stdlib_sparse_matvec` module provides matrix-vector product kernels.
+!>
+!> This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
+module stdlib_sparse_matvec
+ use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
+ use stdlib_sparse_kinds
+ implicit none
+ private
+
+ public :: matvec
+ interface matvec ! call matvec(vec_y,matrix,vec_x) => Y = M * X
+ #:for k1, t1 in (KINDS_TYPES)
+ #:for rank in RANKS
+ module procedure matvec_coo_${rank}$d_${k1}$
+ module procedure matvec_csr_${rank}$d_${k1}$
+ module procedure matvec_csc_${rank}$d_${k1}$
+ module procedure matvec_ell_${rank}$d_${k1}$
+
+ #:endfor
+ #:endfor
+ end interface
+
+contains
+
+ !! matvec_coo
+ #:for k1, t1 in (KINDS_TYPES)
+ #:for rank in RANKS
+ subroutine matvec_coo_${rank}$d_${k1}$(vec_y,matrix,vec_x)
+ type(COO_${k1}$), intent(in) :: matrix
+ ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
+ ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ integer :: k, ik, jk
+
+ associate( data => matrix%data, index => matrix%index, sym => matrix%sym, nnz => matrix%nnz )
+ if( sym == k_NOSYMMETRY) then
+ do concurrent (k = 1:nnz)
+ ik = index(1,k)
+ jk = index(2,k)
+ vec_y(${rksfx2(rank-1)}$ik) = vec_y(${rksfx2(rank-1)}$ik) + data(k) * vec_x(${rksfx2(rank-1)}$jk)
+ end do
+
+ else
+ do concurrent (k = 1:nnz)
+ ik = index(1,k)
+ jk = index(2,k)
+ vec_y(${rksfx2(rank-1)}$ik) = vec_y(${rksfx2(rank-1)}$ik) + data(k) * vec_x(${rksfx2(rank-1)}$jk)
+ if( ik==jk ) cycle
+ vec_y(${rksfx2(rank-1)}$jk) = vec_y(${rksfx2(rank-1)}$jk) + data(k) * vec_x(${rksfx2(rank-1)}$ik)
+ end do
+
+ end if
+ end associate
+ end subroutine
+
+ #:endfor
+ #:endfor
+
+ !! matvec_csr
+ #:for k1, t1 in (KINDS_TYPES)
+ #:for rank in RANKS
+ subroutine matvec_csr_${rank}$d_${k1}$(vec_y,matrix,vec_x)
+ type(CSR_${k1}$), intent(in) :: matrix
+ ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
+ ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ integer :: i, j
+ #:if rank == 1
+ ${t1}$ :: aux
+ #:else
+ ${t1}$ :: aux(size(vec_x,dim=1))
+ #:endif
+
+ associate( data => matrix%data, col => matrix%col, rowptr => matrix%rowptr, &
+ & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
+ if( sym == k_NOSYMMETRY) then
+ do concurrent(i=1:nrows)
+ do j = rowptr(i), rowptr(i+1)-1
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + data(j) * vec_x(${rksfx2(rank-1)}$col(j))
+ end do
+ end do
+
+ else if( sym == k_SYMTRIINF )then
+ do i = 1 , nrows
+ aux = 0._${k1}$
+ do j = rowptr(i), rowptr(i+1)-2
+ aux = aux + data(j) * vec_x(${rksfx2(rank-1)}$col(j))
+ vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + data(j) * vec_x(${rksfx2(rank-1)}$i)
+ end do
+ aux = aux + data(j) * vec_x(${rksfx2(rank-1)}$i)
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + aux
+ end do
+
+ else if( sym == k_SYMTRISUP )then
+ do i = 1 , nrows
+ aux = vec_x(${rksfx2(rank-1)}$i) * data(rowptr(i))
+ do j = rowptr(i)+1, rowptr(i+1)-1
+ aux = aux + data(j) * vec_x(${rksfx2(rank-1)}$col(j))
+ vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + data(j) * vec_x(${rksfx2(rank-1)}$i)
+ end do
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + aux
+ end do
+
+ end if
+ end associate
+ end subroutine
+
+ #:endfor
+ #:endfor
+
+ !! matvec_csc
+ #:for k1, t1 in (KINDS_TYPES)
+ #:for rank in RANKS
+ subroutine matvec_csc_${rank}$d_${k1}$(vec_y,matrix,vec_x)
+ type(CSC_${k1}$), intent(in) :: matrix
+ ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
+ ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ integer :: i, j
+ #:if rank == 1
+ ${t1}$ :: aux
+ #:else
+ ${t1}$ :: aux(size(vec_x,dim=1))
+ #:endif
+
+ associate( data => matrix%data, colptr => matrix%colptr, row => matrix%row, &
+ & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
+ if( sym == k_NOSYMMETRY) then
+ do concurrent(j=1:ncols)
+ do i = colptr(j), colptr(j+1)-1
+ vec_y(${rksfx2(rank-1)}$row(i)) = vec_y(${rksfx2(rank-1)}$row(i)) + data(i) * vec_x(${rksfx2(rank-1)}$j)
+ end do
+ end do
+
+ else if( sym == k_SYMTRIINF )then
+ ! NOT TESTED
+ do j = 1 , ncols
+ aux = vec_x(${rksfx2(rank-1)}$j) * data(colptr(j))
+ do i = colptr(j)+1, colptr(j+1)-1
+ aux = aux + data(i) * vec_x(${rksfx2(rank-1)}$row(i))
+ vec_y(${rksfx2(rank-1)}$row(i)) = vec_y(${rksfx2(rank-1)}$row(i)) + data(i) * vec_x(${rksfx2(rank-1)}$j)
+ end do
+ vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + aux
+ end do
+
+ else if( sym == k_SYMTRISUP )then
+ ! NOT TESTED
+ do j = 1 , ncols
+ aux = 0._${k1}$
+ do i = colptr(j), colptr(i+1)-2
+ aux = aux + data(i) * vec_x(${rksfx2(rank-1)}$j)
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + data(i) * vec_x(${rksfx2(rank-1)}$row(i))
+ end do
+ aux = aux + data(colptr(j)) * vec_x(${rksfx2(rank-1)}$j)
+ vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + aux
+ end do
+
+ end if
+ end associate
+ end subroutine
+
+ #:endfor
+ #:endfor
+
+ !! matvec_ell
+ #:for k1, t1 in (KINDS_TYPES)
+ #:for rank in RANKS
+ subroutine matvec_ell_${rank}$d_${k1}$(vec_y,matrix,vec_x)
+ type(ELL_${k1}$), intent(in) :: matrix
+ ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
+ ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ integer :: i, j, k
+
+ associate( data => matrix%data, index => matrix%index, MNZ_P_ROW => matrix%K, &
+ & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
+ if( sym == k_NOSYMMETRY) then
+ do concurrent (i = 1:nrows, k = 1:MNZ_P_ROW)
+ j = index(i,k)
+ if(j>0) vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + data(i,k) * vec_x(${rksfx2(rank-1)}$j)
+ end do
+
+ end if
+ end associate
+ end subroutine
+
+ #:endfor
+ #:endfor
+
+end module stdlib_sparse_matvec
\ No newline at end of file
diff --git a/test/linalg/test_sparse_matvec.fypp b/test/linalg/test_sparse_matvec.fypp
new file mode 100644
index 000000000..4380c7117
--- /dev/null
+++ b/test/linalg/test_sparse_matvec.fypp
@@ -0,0 +1,88 @@
+#:include "common.fypp"
+#:set KINDS_TYPES = REAL_KINDS_TYPES
+module test_sparse_matvec
+ use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
+ use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64
+ use stdlib_sparse
+
+ 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("coo", test_coo) &
+ ]
+
+ end subroutine collect_suite
+
+ subroutine test_coo(error)
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+
+ #:for k1, t1 in (KINDS_TYPES)
+ block
+ ${t1}$, allocatable :: dense(:,:)
+ type(COO_${k1}$) :: COO
+ ${t1}$, allocatable :: vec_x(:)
+ ${t1}$, allocatable :: vec_y1(:), vec_y2(:)
+
+ allocate( dense(4,5) , source = &
+ reshape([9._${k1}$,4._${k1}$, 0._${k1}$,4._${k1}$, &
+ 0._${k1}$,7._${k1}$, 8._${k1}$,0._${k1}$, &
+ 0._${k1}$,0._${k1}$,-1._${k1}$,5._${k1}$, &
+ 0._${k1}$,0._${k1}$, 8._${k1}$,6._${k1}$, &
+ -3._${k1}$,0._${k1}$, 0._${k1}$,0._${k1}$],[4,5]) )
+
+ call dense2coo(dense , COO)
+
+ allocate( vec_x(5) , source = 1._${k1}$ )
+ allocate( vec_y1(4) , source = 0._${k1}$ )
+ allocate( vec_y2(4) , source = 0._${k1}$ )
+
+ vec_y1 = matmul( dense, vec_x )
+ call matvec( vec_y2 , COO , vec_x )
+
+ call check(error, all(vec_y1 == [6._${k1}$,11._${k1}$,15._${k1}$,15._${k1}$]) )
+ if (allocated(error)) return
+
+ call check(error, all(vec_y1 == vec_y2) )
+ 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_sparse_matvec, only : collect_suite
+ implicit none
+ integer :: stat, is
+ type(testsuite_type), allocatable :: testsuites(:)
+ character(len=*), parameter :: fmt = '("#", *(1x, a))'
+
+ stat = 0
+
+ testsuites = [ &
+ new_testsuite("sparse", 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 c63c0dd4eb064cf45038d11b25777d308b0934de Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Wed, 10 Jan 2024 22:18:55 +0100
Subject: [PATCH 02/78] cmake build
---
src/CMakeLists.txt | 4 ++++
test/linalg/CMakeLists.txt | 1 +
2 files changed, 5 insertions(+)
diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
index 8a6fe66cc..247f7011e 100644
--- a/src/CMakeLists.txt
+++ b/src/CMakeLists.txt
@@ -30,6 +30,9 @@ set(fppFiles
stdlib_sorting_ord_sort.fypp
stdlib_sorting_sort.fypp
stdlib_sorting_sort_index.fypp
+ stdlib_sparse_conversion.fypp
+ stdlib_sparse_kinds.fypp
+ stdlib_sparse_matvec.fypp
stdlib_specialfunctions_gamma.fypp
stdlib_stats.fypp
stdlib_stats_corr.fypp
@@ -78,6 +81,7 @@ set(SRC
stdlib_logger.f90
stdlib_sorting_radix_sort.f90
stdlib_system.F90
+ stdlib_sparse.f90
stdlib_specialfunctions.f90
stdlib_specialfunctions_legendre.f90
stdlib_quadrature_gauss.f90
diff --git a/test/linalg/CMakeLists.txt b/test/linalg/CMakeLists.txt
index 4a315f545..840599685 100644
--- a/test/linalg/CMakeLists.txt
+++ b/test/linalg/CMakeLists.txt
@@ -2,6 +2,7 @@ set(
fppFiles
"test_linalg.fypp"
"test_linalg_matrix_property_checks.fypp"
+ "test_sparse_matvec.fypp"
)
fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)
From 72481bea0f7fbe3407fd9de4e531f21042e3532a Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Thu, 11 Jan 2024 22:39:06 +0100
Subject: [PATCH 03/78] add data accessors set and get
---
src/stdlib_sparse_kinds.fypp | 148 ++++++++++++++++++++++++++++++++++-
1 file changed, 144 insertions(+), 4 deletions(-)
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 238ff5993..5cff393f2 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -35,7 +35,10 @@ module stdlib_sparse_kinds
#:for k1, t1 in (KINDS_TYPES)
type, public, extends(COO_t) :: COO_${k1}$
- ${t1}$, allocatable :: data(:) !! single precision values
+ ${t1}$, allocatable :: data(:)
+ contains
+ procedure :: get => get_value_coo_${k1}$
+ procedure :: set => set_value_coo_${k1}$
end type
#:endfor
@@ -49,7 +52,10 @@ module stdlib_sparse_kinds
#:for k1, t1 in (KINDS_TYPES)
type, public, extends(CSR_t) :: CSR_${k1}$
- ${t1}$, allocatable :: data(:) !! single precision values
+ ${t1}$, allocatable :: data(:)
+ contains
+ procedure :: get => get_value_csr_${k1}$
+ procedure :: set => set_value_csr_${k1}$
end type
#:endfor
@@ -63,7 +69,10 @@ module stdlib_sparse_kinds
#:for k1, t1 in (KINDS_TYPES)
type, public, extends(CSC_t) :: CSC_${k1}$
- ${t1}$, allocatable :: data(:) !! single precision values
+ ${t1}$, allocatable :: data(:)
+ contains
+ procedure :: get => get_value_csc_${k1}$
+ procedure :: set => set_value_csc_${k1}$
end type
#:endfor
@@ -77,7 +86,10 @@ module stdlib_sparse_kinds
#:for k1, t1 in (KINDS_TYPES)
type, public, extends(ELL_t) :: ELL_${k1}$
- ${t1}$, allocatable :: data(:,:) !! single precision values
+ ${t1}$, allocatable :: data(:,:)
+ contains
+ procedure :: get => get_value_ell_${k1}$
+ procedure :: set => set_value_ell_${k1}$
end type
#:endfor
@@ -240,5 +252,133 @@ contains
#:endfor
end select
end subroutine
+
+ !==================================================================
+ ! data accessors
+ !==================================================================
+
+ #:for k1, t1 in (KINDS_TYPES)
+ pure ${t1}$ function get_value_coo_${k1}$(self,ik,jk) result(y)
+ class(COO_${k1}$), intent(in) :: self
+ integer, intent(in) :: ik, jk
+ integer :: k
+ ! naive implementation
+ do k = 1,self%nnz
+ if( ik == self%index(1,k) .and. jk == self%index(2,k) ) then
+ y = self%data(k)
+ return
+ end if
+ end do
+ y = 0._${k1}$
+ end function
+
+ subroutine set_value_coo_${k1}$(self,ik,jk,val)
+ class(COO_${k1}$), intent(inout) :: self
+ integer, intent(in) :: ik, jk
+ ${t1}$, intent(in) :: val
+ integer :: k
+ ! naive implementation
+ do k = 1,self%nnz
+ if( ik == self%index(1,k) .and. jk == self%index(2,k) ) then
+ self%data(k) = val
+ return
+ end if
+ end do
+ end subroutine
+
+ #:endfor
+
+ #:for k1, t1 in (KINDS_TYPES)
+ pure ${t1}$ function get_value_csr_${k1}$(self,ik,jk) result(y)
+ class(CSR_${k1}$), intent(in) :: self
+ integer, intent(in) :: ik, jk
+ integer :: k
+ ! naive implementation
+ do k = self%rowptr(ik), self%rowptr(ik+1)-1
+ if( jk == self%col(k) ) then
+ y = self%data(k)
+ return
+ end if
+ end do
+ y = 0._${k1}$
+ end function
+
+ subroutine set_value_csr_${k1}$(self,ik,jk,val)
+ class(CSR_${k1}$), intent(inout) :: self
+ integer, intent(in) :: ik, jk
+ ${t1}$, intent(in) :: val
+ integer :: k
+ ! naive implementation
+ do k = self%rowptr(ik), self%rowptr(ik+1)-1
+ if( jk == self%col(k) ) then
+ self%data(k) = val
+ return
+ end if
+ end do
+ end subroutine
+
+ #:endfor
+
+ #:for k1, t1 in (KINDS_TYPES)
+ pure ${t1}$ function get_value_csc_${k1}$(self,ik,jk) result(y)
+ class(CSC_${k1}$), intent(in) :: self
+ integer, intent(in) :: ik, jk
+ integer :: k
+ ! naive implementation
+ do k = self%colptr(jk), self%colptr(jk+1)-1
+ if( ik == self%row(k) ) then
+ y = self%data(k)
+ return
+ end if
+ end do
+ y = 0._${k1}$
+ end function
+
+ subroutine set_value_csc_${k1}$(self,ik,jk,val)
+ class(CSC_${k1}$), intent(inout) :: self
+ integer, intent(in) :: ik, jk
+ ${t1}$, intent(in) :: val
+ integer :: k
+ ! naive implementation
+ do k = self%colptr(jk), self%colptr(jk+1)-1
+ if( ik == self%row(k) ) then
+ self%data(k) = val
+ return
+ end if
+ end do
+ end subroutine
+
+ #:endfor
+
+ #:for k1, t1 in (KINDS_TYPES)
+ pure ${t1}$ function get_value_ell_${k1}$(self,ik,jk) result(y)
+ class(ELL_${k1}$), intent(in) :: self
+ integer, intent(in) :: ik, jk
+ integer :: k
+ ! naive implementation
+ do k = 1 , self%K
+ if( jk == self%index(ik,k) ) then
+ y = self%data(ik,k)
+ return
+ end if
+ end do
+ y = 0._${k1}$
+ end function
+
+ subroutine set_value_ell_${k1}$(self,ik,jk,val)
+ class(ELL_${k1}$), intent(inout) :: self
+ integer, intent(in) :: ik, jk
+ ${t1}$, intent(in) :: val
+ integer :: k
+ ! naive implementation
+ do k = 1 , self%K
+ if( jk == self%index(ik,k) ) then
+ self%data(ik,k) = val
+ return
+ end if
+ end do
+ end subroutine
+
+ #:endfor
end module stdlib_sparse_kinds
\ No newline at end of file
From a7cb6be2d1d1c29ca97191416090ea6b40cfe17e Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Thu, 11 Jan 2024 22:49:52 +0100
Subject: [PATCH 04/78] fix typo
---
src/stdlib_sparse_conversion.fypp | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 3f3a9eb49..9f4903f24 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -80,7 +80,7 @@ contains
#:for k1, t1 in (KINDS_TYPES)
subroutine coo2csr_${k1}$(COO,CSR)
- !! coo2csr: This function enables transfering data from a COO matrix to a CSR matrix
+ !! coo2csr: This function enables transferring data from a COO matrix to a CSR matrix
!! under the hypothesis that the COO is already ordered.
type(COO_${k1}$), intent(in) :: COO
type(CSR_${k1}$), intent(inout) :: CSR
@@ -112,7 +112,7 @@ contains
#:for k1, t1 in (KINDS_TYPES)
subroutine csr2coo_${k1}$(CSR,COO)
- !! csr2coo: This function enables transfering data from a CSR matrix to a COO matrix
+ !! csr2coo: This function enables transferring data from a CSR matrix to a COO matrix
!! under the hypothesis that the CSR is already ordered.
type(CSR_${k1}$), intent(in) :: CSR
type(COO_${k1}$), intent(inout) :: COO
From d48dde58a0b2ff6e1acb622a4fc08d4f34239438 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Fri, 12 Jan 2024 20:30:41 +0100
Subject: [PATCH 05/78] change ij accessor as subroutine
---
src/stdlib_sparse_kinds.fypp | 52 ++++++++++++++++-------------
test/linalg/test_sparse_matvec.fypp | 15 ++++++++-
2 files changed, 42 insertions(+), 25 deletions(-)
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 5cff393f2..5ec964de8 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -258,24 +258,25 @@ contains
!==================================================================
#:for k1, t1 in (KINDS_TYPES)
- pure ${t1}$ function get_value_coo_${k1}$(self,ik,jk) result(y)
+ pure subroutine get_value_coo_${k1}$(self,val,ik,jk)
class(COO_${k1}$), intent(in) :: self
+ ${t1}$, intent(out) :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
do k = 1,self%nnz
if( ik == self%index(1,k) .and. jk == self%index(2,k) ) then
- y = self%data(k)
+ val = self%data(k)
return
end if
end do
- y = 0._${k1}$
- end function
+ val = 0._${k1}$
+ end subroutine
- subroutine set_value_coo_${k1}$(self,ik,jk,val)
+ subroutine set_value_coo_${k1}$(self,val,ik,jk)
class(COO_${k1}$), intent(inout) :: self
- integer, intent(in) :: ik, jk
${t1}$, intent(in) :: val
+ integer, intent(in) :: ik, jk
integer :: k
! naive implementation
do k = 1,self%nnz
@@ -289,24 +290,25 @@ contains
#:endfor
#:for k1, t1 in (KINDS_TYPES)
- pure ${t1}$ function get_value_csr_${k1}$(self,ik,jk) result(y)
+ pure subroutine get_value_csr_${k1}$(self,val,ik,jk)
class(CSR_${k1}$), intent(in) :: self
+ ${t1}$, intent(out) :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
do k = self%rowptr(ik), self%rowptr(ik+1)-1
if( jk == self%col(k) ) then
- y = self%data(k)
+ val = self%data(k)
return
end if
end do
- y = 0._${k1}$
- end function
+ val = 0._${k1}$
+ end subroutine
- subroutine set_value_csr_${k1}$(self,ik,jk,val)
+ subroutine set_value_csr_${k1}$(self,val,ik,jk)
class(CSR_${k1}$), intent(inout) :: self
- integer, intent(in) :: ik, jk
${t1}$, intent(in) :: val
+ integer, intent(in) :: ik, jk
integer :: k
! naive implementation
do k = self%rowptr(ik), self%rowptr(ik+1)-1
@@ -320,24 +322,25 @@ contains
#:endfor
#:for k1, t1 in (KINDS_TYPES)
- pure ${t1}$ function get_value_csc_${k1}$(self,ik,jk) result(y)
+ pure subroutine get_value_csc_${k1}$(self,val,ik,jk)
class(CSC_${k1}$), intent(in) :: self
+ ${t1}$, intent(out) :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
do k = self%colptr(jk), self%colptr(jk+1)-1
if( ik == self%row(k) ) then
- y = self%data(k)
+ val = self%data(k)
return
end if
end do
- y = 0._${k1}$
- end function
+ val = 0._${k1}$
+ end subroutine
- subroutine set_value_csc_${k1}$(self,ik,jk,val)
+ subroutine set_value_csc_${k1}$(self,val,ik,jk)
class(CSC_${k1}$), intent(inout) :: self
- integer, intent(in) :: ik, jk
${t1}$, intent(in) :: val
+ integer, intent(in) :: ik, jk
integer :: k
! naive implementation
do k = self%colptr(jk), self%colptr(jk+1)-1
@@ -351,24 +354,25 @@ contains
#:endfor
#:for k1, t1 in (KINDS_TYPES)
- pure ${t1}$ function get_value_ell_${k1}$(self,ik,jk) result(y)
+ pure subroutine get_value_ell_${k1}$(self,val,ik,jk)
class(ELL_${k1}$), intent(in) :: self
+ ${t1}$, intent(out) :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
do k = 1 , self%K
if( jk == self%index(ik,k) ) then
- y = self%data(ik,k)
+ val = self%data(ik,k)
return
end if
end do
- y = 0._${k1}$
- end function
+ val = 0._${k1}$
+ end subroutine
- subroutine set_value_ell_${k1}$(self,ik,jk,val)
+ subroutine set_value_ell_${k1}$(self,val,ik,jk)
class(ELL_${k1}$), intent(inout) :: self
- integer, intent(in) :: ik, jk
${t1}$, intent(in) :: val
+ integer, intent(in) :: ik, jk
integer :: k
! naive implementation
do k = 1 , self%K
diff --git a/test/linalg/test_sparse_matvec.fypp b/test/linalg/test_sparse_matvec.fypp
index 4380c7117..a3678dbb7 100644
--- a/test/linalg/test_sparse_matvec.fypp
+++ b/test/linalg/test_sparse_matvec.fypp
@@ -31,6 +31,7 @@ contains
type(COO_${k1}$) :: COO
${t1}$, allocatable :: vec_x(:)
${t1}$, allocatable :: vec_y1(:), vec_y2(:)
+ ${t1}$ :: val, err
allocate( dense(4,5) , source = &
reshape([9._${k1}$,4._${k1}$, 0._${k1}$,4._${k1}$, &
@@ -41,6 +42,18 @@ contains
call dense2coo(dense , COO)
+ !> Test assigned values
+ err = 0._${k1}$
+ do j = 1, size(dense,dim=2)
+ do i = 1, size(dense,dim=1)
+ call COO%get(val,i,j)
+ err = err + abs( val - dense(i,j) )
+ end do
+ end do
+ call check(error, err <= epsilon(0._${k1}$) )
+ if (allocated(error)) return
+
+ !> Test matvec
allocate( vec_x(5) , source = 1._${k1}$ )
allocate( vec_y1(4) , source = 0._${k1}$ )
allocate( vec_y2(4) , source = 0._${k1}$ )
@@ -50,7 +63,7 @@ contains
call check(error, all(vec_y1 == [6._${k1}$,11._${k1}$,15._${k1}$,15._${k1}$]) )
if (allocated(error)) return
-
+
call check(error, all(vec_y1 == vec_y2) )
if (allocated(error)) return
end block
From 6241ca310f5b0bd319a66ef98600bad17830f80b Mon Sep 17 00:00:00 2001
From: Jose Alves <jose.alves@transvalor.com>
Date: Mon, 29 Jan 2024 10:24:23 +0100
Subject: [PATCH 06/78] fix missing i,j integer declaration
---
test/linalg/test_sparse_matvec.fypp | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/test/linalg/test_sparse_matvec.fypp b/test/linalg/test_sparse_matvec.fypp
index a3678dbb7..fc4c6a685 100644
--- a/test/linalg/test_sparse_matvec.fypp
+++ b/test/linalg/test_sparse_matvec.fypp
@@ -32,7 +32,8 @@ contains
${t1}$, allocatable :: vec_x(:)
${t1}$, allocatable :: vec_y1(:), vec_y2(:)
${t1}$ :: val, err
-
+ integer :: i, j
+
allocate( dense(4,5) , source = &
reshape([9._${k1}$,4._${k1}$, 0._${k1}$,4._${k1}$, &
0._${k1}$,7._${k1}$, 8._${k1}$,0._${k1}$, &
From 2c2431db40f59b584c341aea188a52ce6adbbb2a Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Fri, 3 May 2024 19:14:16 +0200
Subject: [PATCH 07/78] add comments and change _t for _type
---
include/common.fypp | 3 +
src/stdlib_sparse_conversion.fypp | 21 +++++--
src/stdlib_sparse_kinds.fypp | 96 ++++++++++++++++---------------
src/stdlib_sparse_matvec.fypp | 8 +--
4 files changed, 75 insertions(+), 53 deletions(-)
diff --git a/include/common.fypp b/include/common.fypp
index 1683239e4..f120fc936 100644
--- a/include/common.fypp
+++ b/include/common.fypp
@@ -84,6 +84,9 @@
#! Bitset types to be considered during templating
#:set BITSET_TYPES = ["type({})".format(k) for k in BITSET_KINDS]
+#! Sparse types to be considered during templating
+#:set SPARSE_KINDS = ["COO", "CSR", "CSC", "ELL"]
+
#! Whether Fortran 90 compatible code should be generated
#:set VERSION90 = defined('VERSION90')
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 9f4903f24..bba51a233 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -10,24 +10,41 @@ module sparse_stdlib_conversion
private
public :: dense2coo, coo2dense, coo2csr, csr2coo
+
+ !> Conversion from dense to coo
+ !>
+ !> Enables extracting the non-zero elements of a dense 2D matrix and
+ !> storing those values in a COO format. The coo matrix is (re)allocated on the fly.
interface dense2coo
#:for k1, t1 in (KINDS_TYPES)
module procedure dense2coo_${k1}$
#:endfor
end interface
+ !> Conversion from coo to dense
+ !>
+ !> Enables creating a dense 2D matrix from the non-zero values tored in a COO format
+ !> The dense matrix can be allocated on the fly if not pre-allocated by the user.
interface coo2dense
#:for k1, t1 in (KINDS_TYPES)
module procedure coo2dense_${k1}$
#:endfor
end interface
+ !> Conversion from coo to csr
+ !>
+ !> Enables transferring data from a COO matrix to a CSR matrix
+ !> under the hypothesis that the COO is already ordered.
interface coo2csr
#:for k1, t1 in (KINDS_TYPES)
module procedure coo2csr_${k1}$
#:endfor
end interface
+ !> Conversion from csr to coo
+ !>
+ !> Enables transferring data from a CSR matrix to a COO matrix
+ !> under the hypothesis that the CSR is already ordered.
interface csr2coo
#:for k1, t1 in (KINDS_TYPES)
module procedure csr2coo_${k1}$
@@ -80,8 +97,6 @@ contains
#:for k1, t1 in (KINDS_TYPES)
subroutine coo2csr_${k1}$(COO,CSR)
- !! coo2csr: This function enables transferring data from a COO matrix to a CSR matrix
- !! under the hypothesis that the COO is already ordered.
type(COO_${k1}$), intent(in) :: COO
type(CSR_${k1}$), intent(inout) :: CSR
integer :: i
@@ -112,8 +127,6 @@ contains
#:for k1, t1 in (KINDS_TYPES)
subroutine csr2coo_${k1}$(CSR,COO)
- !! csr2coo: This function enables transferring data from a CSR matrix to a COO matrix
- !! under the hypothesis that the CSR is already ordered.
type(CSR_${k1}$), intent(in) :: CSR
type(COO_${k1}$), intent(inout) :: COO
integer :: i, j
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 5ec964de8..c19e1b044 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -11,30 +11,32 @@ module stdlib_sparse_kinds
! -- Global parameters
enum, bind(C)
- enumerator :: k_NOSYMMETRY !! Full Sparse matrix (no symmetry considerations)
- enumerator :: k_SYMTRIINF !! Symmetric Sparse matrix with triangular inferior storage
- enumerator :: k_SYMTRISUP !! Symmetric Sparse matrix with triangular supperior storage
+ enumerator :: k_NOSYMMETRY !> Full Sparse matrix (no symmetry considerations)
+ enumerator :: k_SYMTRIINF !> Symmetric Sparse matrix with triangular inferior storage
+ enumerator :: k_SYMTRISUP !> Symmetric Sparse matrix with triangular supperior storage
end enum
public :: k_NOSYMMETRY, k_SYMTRIINF, k_SYMTRISUP
! -- Classes
- type, public, abstract :: sparse_t
- integer :: nrows = 0 !! number of rows
- integer :: ncols = 0 !! number of columns
- integer :: nnz = 0 !! number of non-zero values
- integer :: sym = k_NOSYMMETRY !! assumed storage symmetry
- integer :: base = 1 !! index base = 0 for (C) or 1 (Fortran)
+
+ !> Base sparse type holding the meta data related to the storage capacity of a matrix.
+ type, public, abstract :: sparse_type
+ integer :: nrows = 0 !> number of rows
+ integer :: ncols = 0 !> number of columns
+ integer :: nnz = 0 !> number of non-zero values
+ integer :: sym = k_NOSYMMETRY !> assumed storage symmetry
+ integer :: base = 1 !> index base = 0 for (C) or 1 (Fortran)
end type
- !! COO: COOrdinates compresed format
- type, public, extends(sparse_t) :: COO_t
- logical :: isOrdered = .false. !! wether the matrix is ordered or not
- integer, allocatable :: index(:,:) !! Matrix coordinates index(2,nnz)
+ !> COO: COOrdinates compresed format
+ type, public, extends(sparse_type) :: COO_type
+ logical :: isOrdered = .false. !> wether the matrix is ordered or not
+ integer, allocatable :: index(:,:) !> Matrix coordinates index(2,nnz)
contains
procedure :: malloc => malloc_coo
end type
#:for k1, t1 in (KINDS_TYPES)
- type, public, extends(COO_t) :: COO_${k1}$
+ type, public, extends(COO_type) :: COO_${k1}$
${t1}$, allocatable :: data(:)
contains
procedure :: get => get_value_coo_${k1}$
@@ -42,16 +44,16 @@ module stdlib_sparse_kinds
end type
#:endfor
- !! CSR: Compressed sparse row or Yale format
- type, extends(sparse_t) :: CSR_t
- integer, allocatable :: col(:) !! matrix column pointer
- integer, allocatable :: rowptr(:) !! matrix row pointer
+ !> CSR: Compressed sparse row or Yale format
+ type, extends(sparse_type) :: CSR_type
+ integer, allocatable :: col(:) !> matrix column pointer
+ integer, allocatable :: rowptr(:) !> matrix row pointer
contains
procedure :: malloc => malloc_csr
end type
#:for k1, t1 in (KINDS_TYPES)
- type, public, extends(CSR_t) :: CSR_${k1}$
+ type, public, extends(CSR_type) :: CSR_${k1}$
${t1}$, allocatable :: data(:)
contains
procedure :: get => get_value_csr_${k1}$
@@ -59,16 +61,16 @@ module stdlib_sparse_kinds
end type
#:endfor
- !! CSC: Compressed sparse column
- type, extends(sparse_t) :: CSC_t
- integer, allocatable :: colptr(:) !! matrix column pointer
- integer, allocatable :: row(:) !! matrix row pointer
+ !> CSC: Compressed sparse column
+ type, extends(sparse_type) :: CSC_type
+ integer, allocatable :: colptr(:) !> matrix column pointer
+ integer, allocatable :: row(:) !> matrix row pointer
contains
procedure :: malloc => malloc_csc
end type
#:for k1, t1 in (KINDS_TYPES)
- type, public, extends(CSC_t) :: CSC_${k1}$
+ type, public, extends(CSC_type) :: CSC_${k1}$
${t1}$, allocatable :: data(:)
contains
procedure :: get => get_value_csc_${k1}$
@@ -76,16 +78,16 @@ module stdlib_sparse_kinds
end type
#:endfor
- !! Compressed ELLPACK
- type, extends(sparse_t) :: ELL_t
- integer :: K = 0 !! maximum number of nonzeros per row
- integer, allocatable :: index(:,:) !! column indices
+ !> Compressed ELLPACK
+ type, extends(sparse_type) :: ELL_type
+ integer :: K = 0 !> maximum number of nonzeros per row
+ integer, allocatable :: index(:,:) !> column indices
contains
procedure :: malloc => malloc_ell
end type
#:for k1, t1 in (KINDS_TYPES)
- type, public, extends(ELL_t) :: ELL_${k1}$
+ type, public, extends(ELL_type) :: ELL_${k1}$
${t1}$, allocatable :: data(:,:)
contains
procedure :: get => get_value_ell_${k1}$
@@ -95,11 +97,12 @@ module stdlib_sparse_kinds
contains
+ !> (re)Allocate matrix memory for the COO type
subroutine malloc_coo(self,num_rows,num_cols,nnz)
- class(COO_t) :: self
- integer, intent(in) :: num_rows
- integer, intent(in) :: num_cols
- integer, intent(in) :: nnz
+ class(COO_type) :: self
+ integer, intent(in) :: num_rows !> number of rows
+ integer, intent(in) :: num_cols !> number of columns
+ integer, intent(in) :: nnz !> number of non zeros
integer, allocatable :: temp_idx(:,:)
!-----------------------------------------------------
@@ -131,11 +134,12 @@ contains
end select
end subroutine
+ !> (re)Allocate matrix memory for the CSR type
subroutine malloc_csr(self,num_rows,num_cols,nnz)
- class(CSR_t) :: self
- integer, intent(in) :: num_rows
- integer, intent(in) :: num_cols
- integer, intent(in) :: nnz
+ class(CSR_type) :: self
+ integer, intent(in) :: num_rows !> number of rows
+ integer, intent(in) :: num_cols !> number of columns
+ integer, intent(in) :: nnz !> number of non zeros
integer, allocatable :: temp_idx(:)
!-----------------------------------------------------
@@ -174,11 +178,12 @@ contains
end select
end subroutine
+ !> (re)Allocate matrix memory for the CSC type
subroutine malloc_csc(self,num_rows,num_cols,nnz)
- class(CSC_t) :: self
- integer, intent(in) :: num_rows
- integer, intent(in) :: num_cols
- integer, intent(in) :: nnz
+ class(CSC_type) :: self
+ integer, intent(in) :: num_rows !> number of rows
+ integer, intent(in) :: num_cols !> number of columns
+ integer, intent(in) :: nnz !> number of non zeros
integer, allocatable :: temp_idx(:)
!-----------------------------------------------------
@@ -217,11 +222,12 @@ contains
end select
end subroutine
+ !> (re)Allocate matrix memory for the ELLPACK type
subroutine malloc_ell(self,num_rows,num_cols,num_nz_rows)
- class(ELL_t) :: self
- integer, intent(in) :: num_rows !! number of rows
- integer, intent(in) :: num_cols !! number of columns
- integer, intent(in) :: num_nz_rows !! number of non zeros per row
+ class(ELL_type) :: self
+ integer, intent(in) :: num_rows !> number of rows
+ integer, intent(in) :: num_cols !> number of columns
+ integer, intent(in) :: num_nz_rows !> number of non zeros per row
integer, allocatable :: temp_idx(:,:)
!-----------------------------------------------------
diff --git a/src/stdlib_sparse_matvec.fypp b/src/stdlib_sparse_matvec.fypp
index 6f01b3d25..57c05d0ca 100644
--- a/src/stdlib_sparse_matvec.fypp
+++ b/src/stdlib_sparse_matvec.fypp
@@ -29,7 +29,7 @@ module stdlib_sparse_matvec
contains
- !! matvec_coo
+ !> matvec_coo
#:for k1, t1 in (KINDS_TYPES)
#:for rank in RANKS
subroutine matvec_coo_${rank}$d_${k1}$(vec_y,matrix,vec_x)
@@ -62,7 +62,7 @@ contains
#:endfor
#:endfor
- !! matvec_csr
+ !> matvec_csr
#:for k1, t1 in (KINDS_TYPES)
#:for rank in RANKS
subroutine matvec_csr_${rank}$d_${k1}$(vec_y,matrix,vec_x)
@@ -113,7 +113,7 @@ contains
#:endfor
#:endfor
- !! matvec_csc
+ !> matvec_csc
#:for k1, t1 in (KINDS_TYPES)
#:for rank in RANKS
subroutine matvec_csc_${rank}$d_${k1}$(vec_y,matrix,vec_x)
@@ -166,7 +166,7 @@ contains
#:endfor
#:endfor
- !! matvec_ell
+ !> matvec_ell
#:for k1, t1 in (KINDS_TYPES)
#:for rank in RANKS
subroutine matvec_ell_${rank}$d_${k1}$(vec_y,matrix,vec_x)
From d64a0454d67b31959315956caf50b14b5886a2f4 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Fri, 3 May 2024 19:18:24 +0200
Subject: [PATCH 08/78] revert matvec convention to (matrix,x,y)
---
src/stdlib_sparse_matvec.fypp | 10 +++++-----
test/linalg/test_sparse_matvec.fypp | 2 +-
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/src/stdlib_sparse_matvec.fypp b/src/stdlib_sparse_matvec.fypp
index 57c05d0ca..d097750b4 100644
--- a/src/stdlib_sparse_matvec.fypp
+++ b/src/stdlib_sparse_matvec.fypp
@@ -15,7 +15,7 @@ module stdlib_sparse_matvec
private
public :: matvec
- interface matvec ! call matvec(vec_y,matrix,vec_x) => Y = M * X
+ interface matvec ! call matvec(matrix,vec_x,vec_y) => Y = M * X
#:for k1, t1 in (KINDS_TYPES)
#:for rank in RANKS
module procedure matvec_coo_${rank}$d_${k1}$
@@ -32,7 +32,7 @@ contains
!> matvec_coo
#:for k1, t1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_coo_${rank}$d_${k1}$(vec_y,matrix,vec_x)
+ subroutine matvec_coo_${rank}$d_${k1}$(matrix,vec_x,vec_y)
type(COO_${k1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -65,7 +65,7 @@ contains
!> matvec_csr
#:for k1, t1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_csr_${rank}$d_${k1}$(vec_y,matrix,vec_x)
+ subroutine matvec_csr_${rank}$d_${k1}$(matrix,vec_x,vec_y)
type(CSR_${k1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -116,7 +116,7 @@ contains
!> matvec_csc
#:for k1, t1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_csc_${rank}$d_${k1}$(vec_y,matrix,vec_x)
+ subroutine matvec_csc_${rank}$d_${k1}$(matrix,vec_x,vec_y)
type(CSC_${k1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -169,7 +169,7 @@ contains
!> matvec_ell
#:for k1, t1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_ell_${rank}$d_${k1}$(vec_y,matrix,vec_x)
+ subroutine matvec_ell_${rank}$d_${k1}$(matrix,vec_x,vec_y)
type(ELL_${k1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
diff --git a/test/linalg/test_sparse_matvec.fypp b/test/linalg/test_sparse_matvec.fypp
index fc4c6a685..9a456a81d 100644
--- a/test/linalg/test_sparse_matvec.fypp
+++ b/test/linalg/test_sparse_matvec.fypp
@@ -60,7 +60,7 @@ contains
allocate( vec_y2(4) , source = 0._${k1}$ )
vec_y1 = matmul( dense, vec_x )
- call matvec( vec_y2 , COO , vec_x )
+ call matvec( COO , vec_x, vec_y2 )
call check(error, all(vec_y1 == [6._${k1}$,11._${k1}$,15._${k1}$,15._${k1}$]) )
if (allocated(error)) return
From d165b8b87f0443e10b525438c52701c23bc18dc2 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 18 May 2024 19:50:50 +0200
Subject: [PATCH 09/78] upgrade sparse support with SELLC format and more tests
add suffix for function naming
---
include/common.fypp | 2 +
src/stdlib_sparse_conversion.fypp | 127 +++++++++++++---
src/stdlib_sparse_kinds.fypp | 154 ++++++++++---------
src/stdlib_sparse_matvec.fypp | 117 ++++++++++++---
test/linalg/test_sparse_matvec.fypp | 219 +++++++++++++++++++++++-----
5 files changed, 474 insertions(+), 145 deletions(-)
diff --git a/include/common.fypp b/include/common.fypp
index 4339fde73..c818d0221 100644
--- a/include/common.fypp
+++ b/include/common.fypp
@@ -38,6 +38,7 @@
#! Real types to be considered during templating
#:set REAL_TYPES = ["real({})".format(k) for k in REAL_KINDS]
+#:set REAL_SUFFIX = REAL_KINDS
#! Collected (kind, type) tuples for real types
#:set REAL_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_INIT))
@@ -62,6 +63,7 @@
#! Complex types to be considered during templating
#:set CMPLX_TYPES = ["complex({})".format(k) for k in CMPLX_KINDS]
+#:set CMPLX_SUFFIX = ["c{}".format(k) for k in CMPLX_KINDS]
#! Collected (kind, type, initial) tuples for complex types
#:set CMPLX_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_INIT))
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index bba51a233..15552a923 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -1,5 +1,7 @@
#:include "common.fypp"
-#:set KINDS_TYPES = REAL_KINDS_TYPES
+#: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 KINDS_TYPES = R_KINDS_TYPES+C_KINDS_TYPES
!> The `stdlib_sparse_conversion` module provides sparse to sparse matrix conversion utilities.
!>
!> This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
@@ -10,14 +12,15 @@ module sparse_stdlib_conversion
private
public :: dense2coo, coo2dense, coo2csr, csr2coo
+ public :: csr2sellc
!> Conversion from dense to coo
!>
!> Enables extracting the non-zero elements of a dense 2D matrix and
!> storing those values in a COO format. The coo matrix is (re)allocated on the fly.
interface dense2coo
- #:for k1, t1 in (KINDS_TYPES)
- module procedure dense2coo_${k1}$
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure dense2coo_${s1}$
#:endfor
end interface
@@ -26,8 +29,8 @@ module sparse_stdlib_conversion
!> Enables creating a dense 2D matrix from the non-zero values tored in a COO format
!> The dense matrix can be allocated on the fly if not pre-allocated by the user.
interface coo2dense
- #:for k1, t1 in (KINDS_TYPES)
- module procedure coo2dense_${k1}$
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure coo2dense_${s1}$
#:endfor
end interface
@@ -36,8 +39,8 @@ module sparse_stdlib_conversion
!> Enables transferring data from a COO matrix to a CSR matrix
!> under the hypothesis that the COO is already ordered.
interface coo2csr
- #:for k1, t1 in (KINDS_TYPES)
- module procedure coo2csr_${k1}$
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure coo2csr_${s1}$
#:endfor
end interface
@@ -46,17 +49,27 @@ module sparse_stdlib_conversion
!> Enables transferring data from a CSR matrix to a COO matrix
!> under the hypothesis that the CSR is already ordered.
interface csr2coo
- #:for k1, t1 in (KINDS_TYPES)
- module procedure csr2coo_${k1}$
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure csr2coo_${s1}$
#:endfor
end interface
+ !> Conversion from csr to SELL-C
+ !>
+ !> Enables transferring data from a CSR matrix to a SELL-C matrix
+ !> It takes an optional parameter to decide the chunck size 4, 8 or 16
+ interface csr2sellc
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure csr2sellc_${s1}$
+ #:endfor
+ end interface
+
contains
- #:for k1, t1 in (KINDS_TYPES)
- subroutine dense2coo_${k1}$(dense,COO)
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine dense2coo_${s1}$(dense,COO)
${t1}$, intent(in) :: dense(:,:)
- type(COO_${k1}$), intent(inout) :: COO
+ type(COO_${s1}$), intent(inout) :: COO
integer :: num_rows, num_cols, nnz
integer :: i, j, idx
@@ -81,13 +94,13 @@ contains
#:endfor
- #:for k1, t1 in (KINDS_TYPES)
- subroutine coo2dense_${k1}$(COO,dense)
- type(COO_${k1}$), intent(in) :: COO
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine coo2dense_${s1}$(COO,dense)
+ type(COO_${s1}$), intent(in) :: COO
${t1}$, allocatable, intent(inout) :: dense(:,:)
integer :: idx
- if(.not.allocated(dense)) allocate(dense(COO%nrows,COO%nrows),source=0._${k1}$)
+ if(.not.allocated(dense)) allocate(dense(COO%nrows,COO%nrows),source=zero_${s1}$)
do concurrent(idx = 1:COO%nnz)
dense( COO%index(1,idx) , COO%index(2,idx) ) = COO%data(idx)
end do
@@ -95,10 +108,10 @@ contains
#:endfor
- #:for k1, t1 in (KINDS_TYPES)
- subroutine coo2csr_${k1}$(COO,CSR)
- type(COO_${k1}$), intent(in) :: COO
- type(CSR_${k1}$), intent(inout) :: CSR
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine coo2csr_${s1}$(COO,CSR)
+ type(COO_${s1}$), intent(in) :: COO
+ type(CSR_${s1}$), intent(inout) :: CSR
integer :: i
CSR%nnz = COO%nnz; CSR%nrows = COO%nrows; CSR%ncols = COO%ncols
@@ -125,10 +138,10 @@ contains
#:endfor
- #:for k1, t1 in (KINDS_TYPES)
- subroutine csr2coo_${k1}$(CSR,COO)
- type(CSR_${k1}$), intent(in) :: CSR
- type(COO_${k1}$), intent(inout) :: COO
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine csr2coo_${s1}$(CSR,COO)
+ type(CSR_${s1}$), intent(in) :: CSR
+ type(COO_${s1}$), intent(inout) :: COO
integer :: i, j
COO%nnz = CSR%nnz; COO%nrows = CSR%nrows; COO%ncols = CSR%ncols
@@ -150,5 +163,71 @@ contains
end subroutine
#:endfor
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
+ !> csr2sellc: This function enables transfering data from a CSR matrix to a SELL-C matrix
+ !> This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
+ type(CSR_${s1}$), intent(in) :: CSR
+ type(SELLC_${s1}$), intent(inout) :: SELLC
+ integer, intent(in), optional :: chunk
+ ${t1}$, parameter :: zero = zero_${s1}$
+ integer :: i, j, num_chunks
+
+ if(present(chunk)) SELLC%chunk_size = chunk
+
+ SELLC%nrows = CSR%nrows; SELLC%ncols = CSR%ncols
+ SELLC%base = CSR%base; SELLC%sym = CSR%sym
+ associate( nrows=>SELLC%nrows, ncols=>SELLC%ncols, nnz=>SELLC%nnz, &
+ & chunk_size=>SELLC%chunk_size )
+ !-------------------------------------------
+ ! csr rowptr to SELL-C chunked rowptr
+ num_chunks = (nrows + chunk_size - 1)/chunk_size
+ allocate( SELLC%rowptr(num_chunks+1) )
+ block
+ integer :: cidx, rownnz, chunknnz
+ SELLC%rowptr(1) = 1
+ cidx = 1
+ do i = 1, nrows, chunk_size
+ chunknnz = 0
+ ! Iterate over rows in a given chunk
+ do j = i, min(i+chunk_size-1,nrows)
+ rownnz = CSR%rowptr(j+1) - CSR%rowptr(j)
+ chunknnz = max(chunknnz,rownnz)
+ end do
+ SELLC%rowptr(cidx+1) = SELLC%rowptr(cidx) + chunknnz
+ cidx = cidx + 1
+ end do
+ nnz = SELLC%rowptr(num_chunks+1) - 1
+ end block
+ !-------------------------------------------
+ ! copy values and colum index
+ allocate(SELLC%col(chunk_size,nnz), source = -1)
+ allocate(SELLC%data(chunk_size,nnz), source = zero )
+ block
+ integer :: lb, ri, iaa, iab, rownnz
+ do i = 1, num_chunks
+
+ lb = SELLC%rowptr(i)
+
+ ! Loop over rows of a chunk
+ do j = (i-1)*chunk_size + 1, min(i*chunk_size,nrows)
+
+ ri = j - (i - 1)*chunk_size
+
+ rownnz = CSR%rowptr(j+1) - CSR%rowptr(j) - 1
+ iaa = CSR%rowptr(j)
+ iab = CSR%rowptr(j+1) - 1
+
+ SELLC%col(ri,lb:lb+rownnz) = CSR%col(iaa:iab)
+ SELLC%data(ri,lb:lb+rownnz) = CSR%data(iaa:iab)
+
+ end do
+ end do
+ end block
+ end associate
+ end subroutine
+
+ #:endfor
end module sparse_stdlib_conversion
\ No newline at end of file
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index c19e1b044..7fd466873 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -1,5 +1,7 @@
#:include "common.fypp"
-#:set KINDS_TYPES = REAL_KINDS_TYPES
+#: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 KINDS_TYPES = R_KINDS_TYPES+C_KINDS_TYPES
!> The `stdlib_sparse_kinds` module provides derived type definitions for different sparse matrices
!>
!> This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
@@ -16,6 +18,14 @@ module stdlib_sparse_kinds
enumerator :: k_SYMTRISUP !> Symmetric Sparse matrix with triangular supperior storage
end enum
public :: k_NOSYMMETRY, k_SYMTRIINF, k_SYMTRISUP
+
+ #:for k1, t1, s1 in (R_KINDS_TYPES)
+ ${t1}$, parameter, public :: zero_${s1}$ = 0._${k1}$
+ #:endfor
+ #:for k1, t1, s1 in (C_KINDS_TYPES)
+ ${t1}$, parameter, public :: zero_${s1}$ = (0._${k1}$,0._${k1}$)
+ #:endfor
+
! -- Classes
!> Base sparse type holding the meta data related to the storage capacity of a matrix.
@@ -35,12 +45,12 @@ module stdlib_sparse_kinds
procedure :: malloc => malloc_coo
end type
- #:for k1, t1 in (KINDS_TYPES)
- type, public, extends(COO_type) :: COO_${k1}$
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ type, public, extends(COO_type) :: COO_${s1}$
${t1}$, allocatable :: data(:)
contains
- procedure :: get => get_value_coo_${k1}$
- procedure :: set => set_value_coo_${k1}$
+ procedure :: get => get_value_coo_${s1}$
+ procedure :: set => set_value_coo_${s1}$
end type
#:endfor
@@ -52,12 +62,12 @@ module stdlib_sparse_kinds
procedure :: malloc => malloc_csr
end type
- #:for k1, t1 in (KINDS_TYPES)
- type, public, extends(CSR_type) :: CSR_${k1}$
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ type, public, extends(CSR_type) :: CSR_${s1}$
${t1}$, allocatable :: data(:)
contains
- procedure :: get => get_value_csr_${k1}$
- procedure :: set => set_value_csr_${k1}$
+ procedure :: get => get_value_csr_${s1}$
+ procedure :: set => set_value_csr_${s1}$
end type
#:endfor
@@ -69,12 +79,12 @@ module stdlib_sparse_kinds
procedure :: malloc => malloc_csc
end type
- #:for k1, t1 in (KINDS_TYPES)
- type, public, extends(CSC_type) :: CSC_${k1}$
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ type, public, extends(CSC_type) :: CSC_${s1}$
${t1}$, allocatable :: data(:)
contains
- procedure :: get => get_value_csc_${k1}$
- procedure :: set => set_value_csc_${k1}$
+ procedure :: get => get_value_csc_${s1}$
+ procedure :: set => set_value_csc_${s1}$
end type
#:endfor
@@ -86,12 +96,26 @@ module stdlib_sparse_kinds
procedure :: malloc => malloc_ell
end type
- #:for k1, t1 in (KINDS_TYPES)
- type, public, extends(ELL_type) :: ELL_${k1}$
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ type, public, extends(ELL_type) :: ELL_${s1}$
${t1}$, allocatable :: data(:,:)
contains
- procedure :: get => get_value_ell_${k1}$
- procedure :: set => set_value_ell_${k1}$
+ procedure :: get => get_value_ell_${s1}$
+ procedure :: set => set_value_ell_${s1}$
+ end type
+ #:endfor
+
+ !> Compressed SELL-C
+ !> Reference : https://library.eecs.utk.edu/storage/files/ut-eecs-14-727.pdf
+ type, public, extends(sparse_type) :: SELLC_type
+ integer :: chunk_size = 8 !> default chunk size
+ integer, allocatable :: rowptr(:) !> row pointer
+ integer, allocatable :: col(:,:) !> column indices
+ end type
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ type, public, extends(SELLC_type) :: SELLC_${s1}$
+ ${t1}$, allocatable :: data(:,:)
end type
#:endfor
@@ -119,16 +143,16 @@ contains
call move_alloc(from=temp_idx,to=self%index)
select type(self)
- #:for k1, t1 in (KINDS_TYPES)
- type is(COO_${k1}$)
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ type is(COO_${s1}$)
block
- ${t1}$, allocatable :: temp_data_${k1}$(:)
+ ${t1}$, allocatable :: temp_data_${s1}$(:)
if(.not.allocated(self%data)) then
- allocate(temp_data_${k1}$(nnz) , source = 0._${k1}$ )
+ allocate(temp_data_${s1}$(nnz) , source = zero_${s1}$ )
else
- allocate(temp_data_${k1}$(nnz) , source = self%data )
+ allocate(temp_data_${s1}$(nnz) , source = self%data )
end if
- call move_alloc(from=temp_data_${k1}$,to=self%data)
+ call move_alloc(from=temp_data_${s1}$,to=self%data)
end block
#:endfor
end select
@@ -163,16 +187,16 @@ contains
call move_alloc(from=temp_idx,to=self%rowptr)
select type(self)
- #:for k1, t1 in (KINDS_TYPES)
- type is(CSR_${k1}$)
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ type is(CSR_${s1}$)
block
- ${t1}$, allocatable :: temp_data_${k1}$(:)
+ ${t1}$, allocatable :: temp_data_${s1}$(:)
if(.not.allocated(self%data)) then
- allocate(temp_data_${k1}$(nnz) , source = 0._${k1}$ )
+ allocate(temp_data_${s1}$(nnz) , source = zero_${s1}$ )
else
- allocate(temp_data_${k1}$(nnz) , source = self%data )
+ allocate(temp_data_${s1}$(nnz) , source = self%data )
end if
- call move_alloc(from=temp_data_${k1}$,to=self%data)
+ call move_alloc(from=temp_data_${s1}$,to=self%data)
end block
#:endfor
end select
@@ -207,16 +231,16 @@ contains
call move_alloc(from=temp_idx,to=self%colptr)
select type(self)
- #:for k1, t1 in (KINDS_TYPES)
- type is(CSC_${k1}$)
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ type is(CSC_${s1}$)
block
- ${t1}$, allocatable :: temp_data_${k1}$(:)
+ ${t1}$, allocatable :: temp_data_${s1}$(:)
if(.not.allocated(self%data)) then
- allocate(temp_data_${k1}$(nnz) , source = 0._${k1}$ )
+ allocate(temp_data_${s1}$(nnz) , source = zero_${s1}$ )
else
- allocate(temp_data_${k1}$(nnz) , source = self%data )
+ allocate(temp_data_${s1}$(nnz) , source = self%data )
end if
- call move_alloc(from=temp_data_${k1}$,to=self%data)
+ call move_alloc(from=temp_data_${s1}$,to=self%data)
end block
#:endfor
end select
@@ -244,16 +268,16 @@ contains
call move_alloc(from=temp_idx,to=self%index)
select type(self)
- #:for k1, t1 in (KINDS_TYPES)
- type is(ELL_${k1}$)
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ type is(ELL_${s1}$)
block
- ${t1}$, allocatable :: temp_data_${k1}$(:,:)
+ ${t1}$, allocatable :: temp_data_${s1}$(:,:)
if(.not.allocated(self%data)) then
- allocate(temp_data_${k1}$(num_rows,num_nz_rows) , source = 0._${k1}$ )
+ allocate(temp_data_${s1}$(num_rows,num_nz_rows) , source = zero_${s1}$ )
else
- allocate(temp_data_${k1}$(num_rows,num_nz_rows) , source = self%data )
+ allocate(temp_data_${s1}$(num_rows,num_nz_rows) , source = self%data )
end if
- call move_alloc(from=temp_data_${k1}$,to=self%data)
+ call move_alloc(from=temp_data_${s1}$,to=self%data)
end block
#:endfor
end select
@@ -263,9 +287,9 @@ contains
! data accessors
!==================================================================
- #:for k1, t1 in (KINDS_TYPES)
- pure subroutine get_value_coo_${k1}$(self,val,ik,jk)
- class(COO_${k1}$), intent(in) :: self
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ pure subroutine get_value_coo_${s1}$(self,val,ik,jk)
+ class(COO_${s1}$), intent(in) :: self
${t1}$, intent(out) :: val
integer, intent(in) :: ik, jk
integer :: k
@@ -276,11 +300,11 @@ contains
return
end if
end do
- val = 0._${k1}$
+ val = zero_${s1}$
end subroutine
- subroutine set_value_coo_${k1}$(self,val,ik,jk)
- class(COO_${k1}$), intent(inout) :: self
+ subroutine set_value_coo_${s1}$(self,val,ik,jk)
+ class(COO_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
integer :: k
@@ -295,9 +319,9 @@ contains
#:endfor
- #:for k1, t1 in (KINDS_TYPES)
- pure subroutine get_value_csr_${k1}$(self,val,ik,jk)
- class(CSR_${k1}$), intent(in) :: self
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ pure subroutine get_value_csr_${s1}$(self,val,ik,jk)
+ class(CSR_${s1}$), intent(in) :: self
${t1}$, intent(out) :: val
integer, intent(in) :: ik, jk
integer :: k
@@ -308,11 +332,11 @@ contains
return
end if
end do
- val = 0._${k1}$
+ val = zero_${s1}$
end subroutine
- subroutine set_value_csr_${k1}$(self,val,ik,jk)
- class(CSR_${k1}$), intent(inout) :: self
+ subroutine set_value_csr_${s1}$(self,val,ik,jk)
+ class(CSR_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
integer :: k
@@ -327,9 +351,9 @@ contains
#:endfor
- #:for k1, t1 in (KINDS_TYPES)
- pure subroutine get_value_csc_${k1}$(self,val,ik,jk)
- class(CSC_${k1}$), intent(in) :: self
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ pure subroutine get_value_csc_${s1}$(self,val,ik,jk)
+ class(CSC_${s1}$), intent(in) :: self
${t1}$, intent(out) :: val
integer, intent(in) :: ik, jk
integer :: k
@@ -340,11 +364,11 @@ contains
return
end if
end do
- val = 0._${k1}$
+ val = zero_${s1}$
end subroutine
- subroutine set_value_csc_${k1}$(self,val,ik,jk)
- class(CSC_${k1}$), intent(inout) :: self
+ subroutine set_value_csc_${s1}$(self,val,ik,jk)
+ class(CSC_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
integer :: k
@@ -359,9 +383,9 @@ contains
#:endfor
- #:for k1, t1 in (KINDS_TYPES)
- pure subroutine get_value_ell_${k1}$(self,val,ik,jk)
- class(ELL_${k1}$), intent(in) :: self
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ pure subroutine get_value_ell_${s1}$(self,val,ik,jk)
+ class(ELL_${s1}$), intent(in) :: self
${t1}$, intent(out) :: val
integer, intent(in) :: ik, jk
integer :: k
@@ -372,11 +396,11 @@ contains
return
end if
end do
- val = 0._${k1}$
+ val = zero_${s1}$
end subroutine
- subroutine set_value_ell_${k1}$(self,val,ik,jk)
- class(ELL_${k1}$), intent(inout) :: self
+ subroutine set_value_ell_${s1}$(self,val,ik,jk)
+ class(ELL_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
integer :: k
diff --git a/src/stdlib_sparse_matvec.fypp b/src/stdlib_sparse_matvec.fypp
index d097750b4..2277a808a 100644
--- a/src/stdlib_sparse_matvec.fypp
+++ b/src/stdlib_sparse_matvec.fypp
@@ -1,6 +1,8 @@
#:include "common.fypp"
#:set RANKS = range(1, 2+1)
-#:set KINDS_TYPES = REAL_KINDS_TYPES
+#: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 KINDS_TYPES = R_KINDS_TYPES+C_KINDS_TYPES
#! define ranks without parentheses
#:def rksfx2(rank)
#{if rank > 0}#${":," + ":," * (rank - 1)}$#{endif}#
@@ -15,25 +17,25 @@ module stdlib_sparse_matvec
private
public :: matvec
- interface matvec ! call matvec(matrix,vec_x,vec_y) => Y = M * X
- #:for k1, t1 in (KINDS_TYPES)
+ interface matvec ! call matvec(matrix,vec_x,vec_y) => Y = Y + M * X
+ #:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- module procedure matvec_coo_${rank}$d_${k1}$
- module procedure matvec_csr_${rank}$d_${k1}$
- module procedure matvec_csc_${rank}$d_${k1}$
- module procedure matvec_ell_${rank}$d_${k1}$
-
+ module procedure matvec_coo_${rank}$d_${s1}$
+ module procedure matvec_csr_${rank}$d_${s1}$
+ module procedure matvec_csc_${rank}$d_${s1}$
+ module procedure matvec_ell_${rank}$d_${s1}$
#:endfor
+ module procedure matvec_sellc_${s1}$
#:endfor
end interface
contains
!> matvec_coo
- #:for k1, t1 in (KINDS_TYPES)
+ #:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_coo_${rank}$d_${k1}$(matrix,vec_x,vec_y)
- type(COO_${k1}$), intent(in) :: matrix
+ subroutine matvec_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y)
+ type(COO_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
integer :: k, ik, jk
@@ -63,10 +65,10 @@ contains
#:endfor
!> matvec_csr
- #:for k1, t1 in (KINDS_TYPES)
+ #:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_csr_${rank}$d_${k1}$(matrix,vec_x,vec_y)
- type(CSR_${k1}$), intent(in) :: matrix
+ subroutine matvec_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y)
+ type(CSR_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
integer :: i, j
@@ -87,7 +89,7 @@ contains
else if( sym == k_SYMTRIINF )then
do i = 1 , nrows
- aux = 0._${k1}$
+ aux = zero_${s1}$
do j = rowptr(i), rowptr(i+1)-2
aux = aux + data(j) * vec_x(${rksfx2(rank-1)}$col(j))
vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + data(j) * vec_x(${rksfx2(rank-1)}$i)
@@ -114,10 +116,10 @@ contains
#:endfor
!> matvec_csc
- #:for k1, t1 in (KINDS_TYPES)
+ #:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_csc_${rank}$d_${k1}$(matrix,vec_x,vec_y)
- type(CSC_${k1}$), intent(in) :: matrix
+ subroutine matvec_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y)
+ type(CSC_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
integer :: i, j
@@ -150,7 +152,7 @@ contains
else if( sym == k_SYMTRISUP )then
! NOT TESTED
do j = 1 , ncols
- aux = 0._${k1}$
+ aux = zero_${s1}$
do i = colptr(j), colptr(i+1)-2
aux = aux + data(i) * vec_x(${rksfx2(rank-1)}$j)
vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + data(i) * vec_x(${rksfx2(rank-1)}$row(i))
@@ -167,10 +169,10 @@ contains
#:endfor
!> matvec_ell
- #:for k1, t1 in (KINDS_TYPES)
+ #:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_ell_${rank}$d_${k1}$(matrix,vec_x,vec_y)
- type(ELL_${k1}$), intent(in) :: matrix
+ subroutine matvec_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y)
+ type(ELL_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
integer :: i, j, k
@@ -189,5 +191,76 @@ contains
#:endfor
#:endfor
+
+ !> matvec_sellc
+ #:set CHUNKS = [4,8,16]
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine matvec_sellc_${s1}$(matrix,vec_x,vec_y)
+ !> This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
+ type(SELLC_${s1}$), intent(in) :: matrix
+ ${t1}$, intent(in) :: vec_x(:)
+ ${t1}$, intent(inout) :: vec_y(:)
+ ${t1}$, parameter :: zero = zero_${s1}$
+ integer :: i, nz, rowidx, num_chunks, rm
+
+ associate( data => matrix%data, ia => matrix%rowptr , ja => matrix%col, cs => matrix%chunk_size, &
+ & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
+ num_chunks = nrows / cs
+ rm = nrows - num_chunks * cs
+ if( sym == k_NOSYMMETRY) then
+
+ select case(cs)
+ #:for chunk in CHUNKS
+ case(${chunk}$)
+ do i = 1, num_chunks
+ nz = ia(i+1) - ia(i)
+ rowidx = (i - 1)*${chunk}$ + 1
+ call chunk_kernel_${chunk}$(nz,data(:,ia(i)),ja(:,ia(i)),vec_x,vec_y(rowidx:))
+ end do
+ #:endfor
+ case default
+ print *, "error: chunk size not supported."
+ return
+ end select
+
+ ! remainder
+ if(rm>0)then
+ i = num_chunks + 1
+ nz = ia(i+1) - ia(i)
+ rowidx = (i - 1)*cs + 1
+ call chunk_kernel_remainder(nz,cs,rm,data(:,ia(i)),ja(:,ia(i)),vec_x,vec_y(rowidx:))
+ end if
+
+ end if
+ end associate
+
+ contains
+ #:for chunk in CHUNKS
+ pure subroutine chunk_kernel_${chunk}$(nz,a,ja,x,y)
+ integer, value :: nz
+ ${t1}$, intent(in) :: a(${chunk}$,nz), x(*)
+ integer, intent(in) :: ja(${chunk}$,nz)
+ ${t1}$, intent(out) :: y(${chunk}$)
+ integer :: j
+ do j = 1, nz
+ where(ja(:,j) > 0) y = y + a(:,j) * x(ja(:,j))
+ end do
+ end subroutine
+ #:endfor
+
+ pure subroutine chunk_kernel_remainder(nz,cs,rm,a,ja,x,y)
+ integer, value :: nz, cs, rm
+ ${t1}$, intent(in) :: a(cs,nz), x(*)
+ integer, intent(in) :: ja(cs,nz)
+ ${t1}$, intent(out) :: y(rm)
+ integer :: j
+ do j = 1, nz
+ where(ja(1:rm,j) > 0) y = y + a(1:rm,j) * x(ja(1:rm,j))
+ end do
+ end subroutine
+
+ end subroutine
+
+ #:endfor
end module stdlib_sparse_matvec
\ No newline at end of file
diff --git a/test/linalg/test_sparse_matvec.fypp b/test/linalg/test_sparse_matvec.fypp
index 9a456a81d..7d3dc8592 100644
--- a/test/linalg/test_sparse_matvec.fypp
+++ b/test/linalg/test_sparse_matvec.fypp
@@ -1,5 +1,6 @@
#:include "common.fypp"
-#:set KINDS_TYPES = REAL_KINDS_TYPES
+#:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX))
+#:set KINDS_TYPES = R_KINDS_TYPES
module test_sparse_matvec
use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64
@@ -16,62 +17,212 @@ contains
type(unittest_type), allocatable, intent(out) :: testsuite(:)
testsuite = [ &
- new_unittest("coo", test_coo) &
- ]
-
- end subroutine collect_suite
+ new_unittest('coo', test_coo), &
+ new_unittest('csr', test_csr), &
+ new_unittest('csc', test_csc), &
+ new_unittest('ell', test_ell), &
+ new_unittest('sellc', test_sellc), &
+ new_unittest('symmetries', test_symmetries) &
+ ]
+ end subroutine
subroutine test_coo(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
-
- #:for k1, t1 in (KINDS_TYPES)
+ #:for k1, t1, s1 in (KINDS_TYPES)
block
+ integer, parameter :: wp = ${k1}$
+ type(COO_${s1}$) :: COO
${t1}$, allocatable :: dense(:,:)
- type(COO_${k1}$) :: COO
${t1}$, allocatable :: vec_x(:)
${t1}$, allocatable :: vec_y1(:), vec_y2(:)
- ${t1}$ :: val, err
- integer :: i, j
-
+
allocate( dense(4,5) , source = &
- reshape([9._${k1}$,4._${k1}$, 0._${k1}$,4._${k1}$, &
- 0._${k1}$,7._${k1}$, 8._${k1}$,0._${k1}$, &
- 0._${k1}$,0._${k1}$,-1._${k1}$,5._${k1}$, &
- 0._${k1}$,0._${k1}$, 8._${k1}$,6._${k1}$, &
- -3._${k1}$,0._${k1}$, 0._${k1}$,0._${k1}$],[4,5]) )
+ reshape(real([9,4, 0,4, &
+ 0,7, 8,0, &
+ 0,0,-1,5, &
+ 0,0, 8,6, &
+ -3,0, 0,0],kind=wp),[4,5]) )
- call dense2coo(dense , COO)
+ call dense2coo( dense , COO )
- !> Test assigned values
- err = 0._${k1}$
- do j = 1, size(dense,dim=2)
- do i = 1, size(dense,dim=1)
- call COO%get(val,i,j)
- err = err + abs( val - dense(i,j) )
- end do
- end do
- call check(error, err <= epsilon(0._${k1}$) )
+ allocate( vec_x(5) , source = 1._wp )
+ allocate( vec_y1(4) , source = 0._wp )
+ allocate( vec_y2(4) , source = 0._wp )
+
+ vec_y1 = matmul( dense, vec_x )
+
+ call check(error, all(vec_y1 == real([6,11,15,15],kind=wp)) )
if (allocated(error)) return
- !> Test matvec
- allocate( vec_x(5) , source = 1._${k1}$ )
- allocate( vec_y1(4) , source = 0._${k1}$ )
- allocate( vec_y2(4) , source = 0._${k1}$ )
+ call matvec( COO, vec_x, vec_y2 )
+ call check(error, all(vec_y1 == vec_y2) )
+ if (allocated(error)) return
+ end block
+ #:endfor
+ end subroutine
- vec_y1 = matmul( dense, vec_x )
- call matvec( COO , vec_x, vec_y2 )
+ subroutine test_csr(error)
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ block
+ integer, parameter :: wp = ${k1}$
+ type(CSR_${s1}$) :: CSR
+ ${t1}$, allocatable :: vec_x(:)
+ ${t1}$, allocatable :: vec_y(:)
+
+ call CSR%malloc(4,5,10)
+ CSR%data(:) = real([9,-3,4,7,8,-1,8,4,5,6],kind=wp)
+ CSR%col(:) = [1,5,1,2,2,3,4,1,3,4]
+ CSR%rowptr(:) = [1,3,5,8,11]
+
+ allocate( vec_x(5) , source = 1._wp )
+ allocate( vec_y(4) , source = 0._wp )
+ call matvec( CSR, vec_x, vec_y )
- call check(error, all(vec_y1 == [6._${k1}$,11._${k1}$,15._${k1}$,15._${k1}$]) )
+ call check(error, all(vec_y == real([6,11,15,15],kind=wp)) )
if (allocated(error)) return
+ end block
+ #:endfor
+ end subroutine
+
+ subroutine test_csc(error)
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ block
+ integer, parameter :: wp = ${k1}$
+ type(CSC_${s1}$) :: CSC
+ ${t1}$, allocatable :: vec_x(:)
+ ${t1}$, allocatable :: vec_y(:)
+
+ call CSC%malloc(4,5,10)
+ CSC%data(:) = real([9,4,4,7,8,-1,5,8,6,-3],kind=wp)
+ CSC%row(:) = [1,2,4,2,3,3,4,3,4,1]
+ CSC%colptr(:) = [1,4,6,8,10,11]
- call check(error, all(vec_y1 == vec_y2) )
+ allocate( vec_x(5) , source = 1._wp )
+ allocate( vec_y(4) , source = 0._wp )
+ call matvec( CSC, vec_x, vec_y )
+
+ call check(error, all(vec_y == real([6,11,15,15],kind=wp)) )
+ if (allocated(error)) return
+ end block
+ #:endfor
+ end subroutine
+
+ subroutine test_ell(error)
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ block
+ integer, parameter :: wp = ${k1}$
+ type(ELL_${s1}$) :: ELL
+ ${t1}$, allocatable :: vec_x(:)
+ ${t1}$, allocatable :: vec_y(:)
+
+ call ELL%malloc(4,5,10)
+ ELL%data(1,1:3) = real([9,-3,0],kind=wp)
+ ELL%data(2,1:3) = real([4,7,0],kind=wp)
+ ELL%data(3,1:3) = real([8,-1,8],kind=wp)
+ ELL%data(4,1:3) = real([4,5,6],kind=wp)
+
+ ELL%index(1,1:3) = [1,5,0]
+ ELL%index(2,1:3) = [1,2,0]
+ ELL%index(3,1:3) = [2,3,4]
+ ELL%index(4,1:3) = [1,3,4]
+
+ allocate( vec_x(5) , source = 1._wp )
+ allocate( vec_y(4) , source = 0._wp )
+ call matvec( ELL, vec_x, vec_y )
+
+ call check(error, all(vec_y == real([6,11,15,15],kind=wp)) )
if (allocated(error)) return
end block
#:endfor
end subroutine
+ subroutine test_sellc(error)
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ block
+ integer, parameter :: wp = ${k1}$
+ type(SELLC_${s1}$) :: SELLC
+ type(CSR_${s1}$) :: CSR
+ ${t1}$, allocatable :: vec_x(:)
+ ${t1}$, allocatable :: vec_y(:)
+ integer :: i
+
+ call CSR%malloc(6,6,17)
+ ! 1 2 3 4 5 6
+ CSR%col = [ 1, 3, 4, &
+ 2, 3, 5, 6, &
+ 1, 2, 3, &
+ 5, 6, &
+ 4, 5, &
+ 2, 5, 6]
+ CSR%rowptr = [1,4,8,11,13,15,18]
+ CSR%data = [(real(i,kind=wp),i=1,CSR%nnz)]
+
+ call csr2sellc(CSR,SELLC,4)
+
+ allocate( vec_x(6) , source = 1._wp )
+ allocate( vec_y(6) , source = 0._wp )
+
+ call matvec( SELLC, vec_x, vec_y )
+
+ call check(error, all(vec_y == real([6,22,27,23,27,48],kind=wp)) )
+ if (allocated(error)) return
+ end block
+ #:endfor
+ end subroutine
+
+ subroutine test_symmetries(error)
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ block
+ integer, parameter :: wp = ${k1}$
+ type(COO_${s1}$) :: COO
+ type(CSR_${s1}$) :: CSR
+ ${t1}$, allocatable :: dense(:,:)
+ ${t1}$, allocatable :: vec_x(:)
+ ${t1}$, allocatable :: vec_y1(:), vec_y2(:), vec_y3(:)
+
+ allocate( vec_x(4) , source = 1._wp )
+ allocate( vec_y1(4) , source = 0._wp )
+ allocate( vec_y2(4) , source = 0._wp )
+ allocate( vec_y3(4) , source = 0._wp )
+
+ allocate( dense(4,4) , source = &
+ reshape(real([1,0,0,0, &
+ 2,1,0,0, &
+ 0,2,1,0,&
+ 0,0,2,1],kind=wp),[4,4]) )
+
+ call dense2coo( dense , COO )
+ COO%sym = k_SYMTRISUP
+ call coo2csr(COO, CSR)
+
+ dense(2,1) = 2._wp; dense(3,2) = 2._wp; dense(4,3) = 2._wp
+ vec_y1 = matmul( dense, vec_x )
+ call check(error, all(vec_y1 == [3,5,5,3]) )
+ if (allocated(error)) return
+
+ call matvec( COO , vec_x, vec_y2 )
+ call check(error, all(vec_y1 == vec_y2) )
+ if (allocated(error)) return
+
+ call matvec( CSR , vec_x, vec_y3 )
+ call check(error, all(vec_y1 == vec_y3) )
+ if (allocated(error)) return
+ end block
+ #:endfor
+ end subroutine
+
end module
From 8f725592e636af9713cca710acffd07b83ef08f0 Mon Sep 17 00:00:00 2001
From: Jose Alves <jose.alves@transvalor.com>
Date: Tue, 21 May 2024 08:08:16 +0200
Subject: [PATCH 10/78] include alpha and beta parameters in sparse matvec
---
src/stdlib_sparse_kinds.fypp | 2 +
src/stdlib_sparse_matvec.fypp | 131 ++++++++++++++++++++++++++--------
2 files changed, 102 insertions(+), 31 deletions(-)
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 7fd466873..b9b4ab177 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -21,9 +21,11 @@ module stdlib_sparse_kinds
#:for k1, t1, s1 in (R_KINDS_TYPES)
${t1}$, parameter, public :: zero_${s1}$ = 0._${k1}$
+ ${t1}$, parameter, public :: one_${s1}$ = 1._${k1}$
#:endfor
#:for k1, t1, s1 in (C_KINDS_TYPES)
${t1}$, parameter, public :: zero_${s1}$ = (0._${k1}$,0._${k1}$)
+ ${t1}$, parameter, public :: one_${s1}$ = (1._${k1}$,1._${k1}$)
#:endfor
! -- Classes
diff --git a/src/stdlib_sparse_matvec.fypp b/src/stdlib_sparse_matvec.fypp
index 2277a808a..07f0f8108 100644
--- a/src/stdlib_sparse_matvec.fypp
+++ b/src/stdlib_sparse_matvec.fypp
@@ -17,7 +17,7 @@ module stdlib_sparse_matvec
private
public :: matvec
- interface matvec ! call matvec(matrix,vec_x,vec_y) => Y = Y + M * X
+ interface matvec ! call matvec(matrix,vec_x,vec_y [,alpha,beta]) => Y = beta * Y + alpha * M * X
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
module procedure matvec_coo_${rank}$d_${s1}$
@@ -34,27 +34,37 @@ contains
!> matvec_coo
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y)
+ subroutine matvec_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(COO_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ ${t1}$, intent(in), optional :: alpha
+ ${t1}$, intent(in), optional :: beta
+ ${t1}$ :: alpha_, beta_
integer :: k, ik, jk
+ alpha_ = one_${k1}$
+ if(present(alpha)) alpha_ = alpha
+ if(present(beta)) then
+ vec_y = beta * vec_y
+ else
+ vec_y = zero_${s1}$
+ endif
associate( data => matrix%data, index => matrix%index, sym => matrix%sym, nnz => matrix%nnz )
if( sym == k_NOSYMMETRY) then
do concurrent (k = 1:nnz)
ik = index(1,k)
jk = index(2,k)
- vec_y(${rksfx2(rank-1)}$ik) = vec_y(${rksfx2(rank-1)}$ik) + data(k) * vec_x(${rksfx2(rank-1)}$jk)
+ vec_y(${rksfx2(rank-1)}$ik) = vec_y(${rksfx2(rank-1)}$ik) + alpha_*data(k) * vec_x(${rksfx2(rank-1)}$jk)
end do
else
do concurrent (k = 1:nnz)
ik = index(1,k)
jk = index(2,k)
- vec_y(${rksfx2(rank-1)}$ik) = vec_y(${rksfx2(rank-1)}$ik) + data(k) * vec_x(${rksfx2(rank-1)}$jk)
+ vec_y(${rksfx2(rank-1)}$ik) = vec_y(${rksfx2(rank-1)}$ik) + alpha_*data(k) * vec_x(${rksfx2(rank-1)}$jk)
if( ik==jk ) cycle
- vec_y(${rksfx2(rank-1)}$jk) = vec_y(${rksfx2(rank-1)}$jk) + data(k) * vec_x(${rksfx2(rank-1)}$ik)
+ vec_y(${rksfx2(rank-1)}$jk) = vec_y(${rksfx2(rank-1)}$jk) + alpha_*data(k) * vec_x(${rksfx2(rank-1)}$ik)
end do
end if
@@ -64,48 +74,77 @@ contains
#:endfor
#:endfor
- !> matvec_csr
+ !! matvec_csr
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y)
+ subroutine matvec_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(CSR_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ ${t1}$, intent(in), optional :: alpha
+ ${t1}$, intent(in), optional :: beta
+ ${t1}$ :: alpha_, beta_
integer :: i, j
#:if rank == 1
- ${t1}$ :: aux
+ ${t1}$ :: aux, aux2
#:else
- ${t1}$ :: aux(size(vec_x,dim=1))
+ ${t1}$ :: aux(size(vec_x,dim=1)), aux2(size(vec_x,dim=1))
#:endif
+
+ alpha_ = one_${k1}$
+ if(present(alpha)) alpha_ = alpha
+ beta_ = zero_${k1}$
+ if(present(beta)) beta_ = beta
associate( data => matrix%data, col => matrix%col, rowptr => matrix%rowptr, &
& nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
if( sym == k_NOSYMMETRY) then
- do concurrent(i=1:nrows)
+ do i = 1, nrows
+ aux = zero_${k1}$
do j = rowptr(i), rowptr(i+1)-1
- vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + data(j) * vec_x(${rksfx2(rank-1)}$col(j))
+ aux = aux + data(j) * vec_x(${rksfx2(rank-1)}$col(j))
end do
+ if(present(beta)) then
+ vec_y(${rksfx2(rank-1)}$i) = beta_ * vec_y(${rksfx2(rank-1)}$i) + alpha_ * aux
+ else
+ vec_y(${rksfx2(rank-1)}$i) = alpha_ * aux
+ end if
end do
-
+
else if( sym == k_SYMTRIINF )then
do i = 1 , nrows
aux = zero_${s1}$
+ aux2 = alpha_ * vec_x(${rksfx2(rank-1)}$i)
do j = rowptr(i), rowptr(i+1)-2
aux = aux + data(j) * vec_x(${rksfx2(rank-1)}$col(j))
- vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + data(j) * vec_x(${rksfx2(rank-1)}$i)
+ vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + data(j) * aux2
end do
- aux = aux + data(j) * vec_x(${rksfx2(rank-1)}$i)
- vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + aux
+ aux = alpha_ * aux + data(j) * aux2
+
+ if(present(beta)) then
+ vec_y(${rksfx2(rank-1)}$i) = beta_ * vec_y(${rksfx2(rank-1)}$i) + aux
+ else
+ vec_y(${rksfx2(rank-1)}$i) = aux
+ end if
end do
else if( sym == k_SYMTRISUP )then
do i = 1 , nrows
aux = vec_x(${rksfx2(rank-1)}$i) * data(rowptr(i))
+ aux2 = alpha_ * vec_x(${rksfx2(rank-1)}$i)
do j = rowptr(i)+1, rowptr(i+1)-1
aux = aux + data(j) * vec_x(${rksfx2(rank-1)}$col(j))
- vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + data(j) * vec_x(${rksfx2(rank-1)}$i)
end do
- vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + aux
+ if(present(beta)) then
+ do j = rowptr(i)+1, rowptr(i+1)-1
+ vec_y(${rksfx2(rank-1)}$col(j)) = beta_ * vec_y(${rksfx2(rank-1)}$col(j)) + data(j) * aux2
+ end do
+ else
+ do j = rowptr(i)+1, rowptr(i+1)-1
+ vec_y(${rksfx2(rank-1)}$col(j)) = data(j) * aux2
+ end do
+ end if
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_ * aux
end do
end if
@@ -118,10 +157,13 @@ contains
!> matvec_csc
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y)
+ subroutine matvec_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(CSC_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ ${t1}$, intent(in), optional :: alpha
+ ${t1}$, intent(in), optional :: beta
+ ${t1}$ :: alpha_, beta_
integer :: i, j
#:if rank == 1
${t1}$ :: aux
@@ -129,12 +171,20 @@ contains
${t1}$ :: aux(size(vec_x,dim=1))
#:endif
+ alpha_ = one_${k1}$
+ if(present(alpha)) alpha_ = alpha
+ if(present(beta)) then
+ vec_y = beta * vec_y
+ else
+ vec_y = zero_${s1}$
+ endif
+
associate( data => matrix%data, colptr => matrix%colptr, row => matrix%row, &
& nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
if( sym == k_NOSYMMETRY) then
do concurrent(j=1:ncols)
do i = colptr(j), colptr(j+1)-1
- vec_y(${rksfx2(rank-1)}$row(i)) = vec_y(${rksfx2(rank-1)}$row(i)) + data(i) * vec_x(${rksfx2(rank-1)}$j)
+ vec_y(${rksfx2(rank-1)}$row(i)) = vec_y(${rksfx2(rank-1)}$row(i)) + alpha_ * data(i) * vec_x(${rksfx2(rank-1)}$j)
end do
end do
@@ -144,9 +194,9 @@ contains
aux = vec_x(${rksfx2(rank-1)}$j) * data(colptr(j))
do i = colptr(j)+1, colptr(j+1)-1
aux = aux + data(i) * vec_x(${rksfx2(rank-1)}$row(i))
- vec_y(${rksfx2(rank-1)}$row(i)) = vec_y(${rksfx2(rank-1)}$row(i)) + data(i) * vec_x(${rksfx2(rank-1)}$j)
+ vec_y(${rksfx2(rank-1)}$row(i)) = vec_y(${rksfx2(rank-1)}$row(i)) + alpha_ * data(i) * vec_x(${rksfx2(rank-1)}$j)
end do
- vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + aux
+ vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_ * aux
end do
else if( sym == k_SYMTRISUP )then
@@ -155,10 +205,10 @@ contains
aux = zero_${s1}$
do i = colptr(j), colptr(i+1)-2
aux = aux + data(i) * vec_x(${rksfx2(rank-1)}$j)
- vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + data(i) * vec_x(${rksfx2(rank-1)}$row(i))
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_ * data(i) * vec_x(${rksfx2(rank-1)}$row(i))
end do
aux = aux + data(colptr(j)) * vec_x(${rksfx2(rank-1)}$j)
- vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + aux
+ vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_ * aux
end do
end if
@@ -171,18 +221,28 @@ contains
!> matvec_ell
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y)
+ subroutine matvec_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(ELL_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ ${t1}$, intent(in), optional :: alpha
+ ${t1}$, intent(in), optional :: beta
+ ${t1}$ :: alpha_, beta_
integer :: i, j, k
+ alpha_ = one_${k1}$
+ if(present(alpha)) alpha_ = alpha
+ if(present(beta)) then
+ vec_y = beta * vec_y
+ else
+ vec_y = zero_${s1}$
+ endif
associate( data => matrix%data, index => matrix%index, MNZ_P_ROW => matrix%K, &
& nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
if( sym == k_NOSYMMETRY) then
do concurrent (i = 1:nrows, k = 1:MNZ_P_ROW)
j = index(i,k)
- if(j>0) vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + data(i,k) * vec_x(${rksfx2(rank-1)}$j)
+ if(j>0) vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_*data(i,k) * vec_x(${rksfx2(rank-1)}$j)
end do
end if
@@ -195,14 +255,23 @@ contains
!> matvec_sellc
#:set CHUNKS = [4,8,16]
#:for k1, t1, s1 in (KINDS_TYPES)
- subroutine matvec_sellc_${s1}$(matrix,vec_x,vec_y)
+ subroutine matvec_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
!> This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
type(SELLC_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x(:)
${t1}$, intent(inout) :: vec_y(:)
- ${t1}$, parameter :: zero = zero_${s1}$
+ ${t1}$, intent(in), optional :: alpha
+ ${t1}$, intent(in), optional :: beta
+ ${t1}$ :: alpha_, beta_
integer :: i, nz, rowidx, num_chunks, rm
+ alpha_ = one_${s1}$
+ if(present(alpha)) alpha_ = alpha
+ if(present(beta)) then
+ vec_y = beta * vec_y
+ else
+ vec_y = zero_${s1}$
+ endif
associate( data => matrix%data, ia => matrix%rowptr , ja => matrix%col, cs => matrix%chunk_size, &
& nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
num_chunks = nrows / cs
@@ -240,10 +309,10 @@ contains
integer, value :: nz
${t1}$, intent(in) :: a(${chunk}$,nz), x(*)
integer, intent(in) :: ja(${chunk}$,nz)
- ${t1}$, intent(out) :: y(${chunk}$)
+ ${t1}$, intent(inout) :: y(${chunk}$)
integer :: j
do j = 1, nz
- where(ja(:,j) > 0) y = y + a(:,j) * x(ja(:,j))
+ where(ja(:,j) > 0) y = y + alpha_ * a(:,j) * x(ja(:,j))
end do
end subroutine
#:endfor
@@ -252,10 +321,10 @@ contains
integer, value :: nz, cs, rm
${t1}$, intent(in) :: a(cs,nz), x(*)
integer, intent(in) :: ja(cs,nz)
- ${t1}$, intent(out) :: y(rm)
+ ${t1}$, intent(inout) :: y(rm)
integer :: j
do j = 1, nz
- where(ja(1:rm,j) > 0) y = y + a(1:rm,j) * x(ja(1:rm,j))
+ where(ja(1:rm,j) > 0) y = y + alpha_ * a(1:rm,j) * x(ja(1:rm,j))
end do
end subroutine
From 87c867a707e8b676855fc32e6b353ad31020fb0e Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 25 May 2024 13:31:48 +0200
Subject: [PATCH 11/78] wrong ellpack size
---
test/linalg/test_sparse_matvec.fypp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/test/linalg/test_sparse_matvec.fypp b/test/linalg/test_sparse_matvec.fypp
index 7d3dc8592..91fd8907a 100644
--- a/test/linalg/test_sparse_matvec.fypp
+++ b/test/linalg/test_sparse_matvec.fypp
@@ -122,7 +122,7 @@ contains
${t1}$, allocatable :: vec_x(:)
${t1}$, allocatable :: vec_y(:)
- call ELL%malloc(4,5,10)
+ call ELL%malloc(4,5,3)
ELL%data(1,1:3) = real([9,-3,0],kind=wp)
ELL%data(2,1:3) = real([4,7,0],kind=wp)
ELL%data(3,1:3) = real([8,-1,8],kind=wp)
From 59fe24ea33131642c79344e2af4c4e87694d3694 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 25 May 2024 13:33:49 +0200
Subject: [PATCH 12/78] start sparse specs
---
doc/specs/stdlib_sparse_kinds.md | 137 +++++++++++++++++++++++++++++++
src/stdlib_sparse_kinds.fypp | 2 +-
src/stdlib_sparse_matvec.fypp | 6 +-
3 files changed, 143 insertions(+), 2 deletions(-)
create mode 100644 doc/specs/stdlib_sparse_kinds.md
diff --git a/doc/specs/stdlib_sparse_kinds.md b/doc/specs/stdlib_sparse_kinds.md
new file mode 100644
index 000000000..6df135a52
--- /dev/null
+++ b/doc/specs/stdlib_sparse_kinds.md
@@ -0,0 +1,137 @@
+---
+title: sparse_kinds
+---
+
+# The `stdlib_sparse_kinds` module
+
+[TOC]
+
+## Introduction
+
+The `stdlib_sparse_kinds` provides several derived types defining known sparse matrix data structures.
+
+
+## Derived types provided
+
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+### The `sparse_type` abstract derived type
+#### Status
+
+Experimental
+
+#### Description
+The `sparse_type` is defined as an abstract derived type holding the basic common meta data needed to define a sparse matrix. All other sparse types falvors are derived from the `sparse_type`.
+
+```Fortran
+type, public, abstract :: sparse_type
+ integer :: nrows !> number of rows
+ integer :: ncols !> number of columns
+ integer :: nnz !> number of non-zero values
+ integer :: sym !> assumed storage symmetry
+ integer :: base !> index base = 0 for (C) or 1 (Fortran)
+end type
+```
+
+The symmetry integer laber should be assigned from the module's internal enumerator containing the following three enums:
+
+```Fortran
+enum, bind(C)
+ enumerator :: k_NOSYMMETRY !> Full Sparse matrix (no symmetry considerations)
+ enumerator :: k_SYMTRIINF !> Symmetric Sparse matrix with triangular inferior storage
+ enumerator :: k_SYMTRISUP !> Symmetric Sparse matrix with triangular supperior storage
+end enum
+```
+In the following, all sparse kinds will be presented in two main flavors: a data-less type `<matrix>_type` useful for topological graph operations. And real/complex valued types `<matrix>_<kind>` containing the `data` buffer for the matrix values.
+
+$$ M = \begin{bmatrix}
+ 9 & 0 & 0 & 0 & -3 \\
+ 4 & 7 & 0 & 0 & 0 \\
+ 0 & 8 & -1 & 8 & 0 \\
+ 4 & 0 & 5 & 6 & 0 \\
+ \end{bmatrix} $$
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+### `COO`: The COOrdinates compressed sparse format
+#### Status
+
+Experimental
+
+#### Description
+The `COO`, triplet or `ijv` format defines all non-zero elements of the matrix by explicitly allocating the `i,j` index and the value of the matrix.
+
+```Fortran
+type(COO_sp) :: COO
+call COO%malloc(4,5,10)
+COO%data(:) = real([9,-3,4,7,8,-1,8,4,5,6])
+COO%index(1:2,1) = [1,1]
+COO%index(1:2,2) = [1,5]
+COO%index(1:2,3) = [2,1]
+COO%index(1:2,4) = [2,2]
+COO%index(1:2,5) = [3,2]
+COO%index(1:2,6) = [3,3]
+COO%index(1:2,7) = [3,4]
+COO%index(1:2,8) = [4,1]
+COO%index(1:2,9) = [4,3]
+COO%index(1:2,10) = [4,4]
+```
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+### `CSR`: The Compressed Sparse Row or Yale format
+#### Status
+
+Experimental
+
+#### Description
+The Compressed Sparse Row or Yale format `CSR` stores the matrix index by compressing the row indeces with a counter pointer `rowptr` enabling to know the first and last non-zero colum index `col` of the given row.
+
+```Fortran
+type(CSR_sp) :: CSR
+call CSR%malloc(4,5,10)
+CSR%data(:) = real([9,-3,4,7,8,-1,8,4,5,6])
+CSR%col(:) = [1,5,1,2,2,3,4,1,3,4]
+CSR%rowptr(:) = [1,3,5,8,11]
+```
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+### `CSC`: The Compressed Sparse Column format
+#### Status
+
+Experimental
+
+#### Description
+The Compressed Sparse Colum `CSC` is similar to the `CSR` format but values are accesed first by colum, thus an index counter is given by `colptr` which enables accessing the start and ending rows of a given colum in the `row` index table.
+
+```Fortran
+type(CSC_sp) :: CSC
+call CSC%malloc(4,5,10)
+CSC%data(:) = real([9,4,4,7,8,-1,5,8,6,-3])
+CSC%row(:) = [1,2,4,2,3,3,4,3,4,1]
+CSC%colptr(:) = [1,4,6,8,10,11]
+```
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+### `ELLPACK`: ELL-pack storage format
+#### Status
+
+Experimental
+
+#### Description
+The `ELL` format stores the data in a dense matrix of $nrows \times K$ in column major order. By imposing a constant number of zeros per row $K$, this format will incure in additional zeros being stored, but it enables efficient vectorization as memory acces are carried out by constant sized strides.
+
+```Fortran
+type(ELL_sp) :: ELL
+call ELL%malloc(num_rows=4,num_cols=5,num_nz_row=3)
+ELL%data(1,1:3) = real([9,-3,0])
+ELL%data(2,1:3) = real([4,7,0])
+ELL%data(3,1:3) = real([8,-1,8])
+ELL%data(4,1:3) = real([4,5,6])
+
+ELL%index(1,1:3) = [1,5,0]
+ELL%index(2,1:3) = [1,2,0]
+ELL%index(3,1:3) = [2,3,4]
+ELL%index(4,1:3) = [1,3,4]
+```
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+### `SELL-C`: The Sliced ELLPACK with Constant blocks format
+#### Status
+
+Experimental
+
+#### Description
+The Sliced ELLPACK format `SELLC` is a variation of the `ELLPACK` format introducing the notion of blocks within which the number of columns is kept contant but can change from one block to the next. This modification reduces the storage size compared to the `ELLPACK` format but maintaining its efficient data access scheme. It can be seen as an intermediate format between `CSR` and `ELLPACK`.
\ No newline at end of file
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index b9b4ab177..d55d1e3f6 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -4,7 +4,7 @@
#:set KINDS_TYPES = R_KINDS_TYPES+C_KINDS_TYPES
!> The `stdlib_sparse_kinds` module provides derived type definitions for different sparse matrices
!>
-!> This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
+! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
module stdlib_sparse_kinds
use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
implicit none
diff --git a/src/stdlib_sparse_matvec.fypp b/src/stdlib_sparse_matvec.fypp
index 07f0f8108..6348d7536 100644
--- a/src/stdlib_sparse_matvec.fypp
+++ b/src/stdlib_sparse_matvec.fypp
@@ -17,7 +17,11 @@ module stdlib_sparse_matvec
private
public :: matvec
- interface matvec ! call matvec(matrix,vec_x,vec_y [,alpha,beta]) => Y = beta * Y + alpha * M * X
+ interface matvec
+ !! Version experimental
+ !!
+ !! Applay the sparse matrix-vector product $$y = \beta * y + \alpha * M * x $$
+ !!
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
module procedure matvec_coo_${rank}$d_${s1}$
From 43ab25f74d16a00310e7aea3b111ab7ef422932f Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 25 May 2024 14:14:59 +0200
Subject: [PATCH 13/78] fix module name
---
src/stdlib_sparse.f90 | 2 +-
src/stdlib_sparse_conversion.fypp | 6 +++---
src/stdlib_sparse_matvec.fypp | 2 +-
3 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/src/stdlib_sparse.f90 b/src/stdlib_sparse.f90
index c9d866151..6f1847ea3 100644
--- a/src/stdlib_sparse.f90
+++ b/src/stdlib_sparse.f90
@@ -2,5 +2,5 @@
module stdlib_sparse
use stdlib_sparse_kinds
use stdlib_sparse_matvec
- use sparse_stdlib_conversion
+ use stdlib_sparse_conversion
end module stdlib_sparse
\ No newline at end of file
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 15552a923..053c8d170 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -4,8 +4,8 @@
#:set KINDS_TYPES = R_KINDS_TYPES+C_KINDS_TYPES
!> The `stdlib_sparse_conversion` module provides sparse to sparse matrix conversion utilities.
!>
-!> This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
-module sparse_stdlib_conversion
+! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
+module stdlib_sparse_conversion
use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
use stdlib_sparse_kinds
implicit none
@@ -230,4 +230,4 @@ contains
#:endfor
-end module sparse_stdlib_conversion
\ No newline at end of file
+end module stdlib_sparse_conversion
\ No newline at end of file
diff --git a/src/stdlib_sparse_matvec.fypp b/src/stdlib_sparse_matvec.fypp
index 6348d7536..20a2b8ee1 100644
--- a/src/stdlib_sparse_matvec.fypp
+++ b/src/stdlib_sparse_matvec.fypp
@@ -9,7 +9,7 @@
#:enddef
!> The `stdlib_sparse_matvec` module provides matrix-vector product kernels.
!>
-!> This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
+! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
module stdlib_sparse_matvec
use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
use stdlib_sparse_kinds
From 838b1596f916248bf01f47afa56e8cbc0487c70a Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 25 May 2024 15:18:47 +0200
Subject: [PATCH 14/78] include reference
---
doc/specs/stdlib_sparse_kinds.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse_kinds.md b/doc/specs/stdlib_sparse_kinds.md
index 6df135a52..bcd0c5eb5 100644
--- a/doc/specs/stdlib_sparse_kinds.md
+++ b/doc/specs/stdlib_sparse_kinds.md
@@ -134,4 +134,4 @@ ELL%index(4,1:3) = [1,3,4]
Experimental
#### Description
-The Sliced ELLPACK format `SELLC` is a variation of the `ELLPACK` format introducing the notion of blocks within which the number of columns is kept contant but can change from one block to the next. This modification reduces the storage size compared to the `ELLPACK` format but maintaining its efficient data access scheme. It can be seen as an intermediate format between `CSR` and `ELLPACK`.
\ No newline at end of file
+The Sliced ELLPACK format `SELLC` is a variation of the `ELLPACK` format. This modification reduces the storage size compared to the `ELLPACK` format but maintaining its efficient data access scheme. It can be seen as an intermediate format between `CSR` and `ELLPACK`. For more details read [here](https://arxiv.org/pdf/1307.6209v1)
\ No newline at end of file
From c74ad09c28b74ed4a53712a6a09d8fb2e98f858a Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sun, 26 May 2024 21:42:39 +0200
Subject: [PATCH 15/78] add matvec specs
---
...tdlib_sparse_kinds.md => stdlib_sparse.md} | 37 ++++++++++++++++---
1 file changed, 32 insertions(+), 5 deletions(-)
rename doc/specs/{stdlib_sparse_kinds.md => stdlib_sparse.md} (80%)
diff --git a/doc/specs/stdlib_sparse_kinds.md b/doc/specs/stdlib_sparse.md
similarity index 80%
rename from doc/specs/stdlib_sparse_kinds.md
rename to doc/specs/stdlib_sparse.md
index bcd0c5eb5..c0ddb2674 100644
--- a/doc/specs/stdlib_sparse_kinds.md
+++ b/doc/specs/stdlib_sparse.md
@@ -1,15 +1,14 @@
---
-title: sparse_kinds
+title: sparse
---
-# The `stdlib_sparse_kinds` module
+# The `stdlib_sparse` module
[TOC]
## Introduction
-The `stdlib_sparse_kinds` provides several derived types defining known sparse matrix data structures.
-
+The `stdlib_sparse` module provides several derived types defining known sparse matrix data structures. It also provides basic sparse kernels such as sparse matrix vector and conversion between matrix types.
## Derived types provided
@@ -134,4 +133,32 @@ ELL%index(4,1:3) = [1,3,4]
Experimental
#### Description
-The Sliced ELLPACK format `SELLC` is a variation of the `ELLPACK` format. This modification reduces the storage size compared to the `ELLPACK` format but maintaining its efficient data access scheme. It can be seen as an intermediate format between `CSR` and `ELLPACK`. For more details read [here](https://arxiv.org/pdf/1307.6209v1)
\ No newline at end of file
+The Sliced ELLPACK format `SELLC` is a variation of the `ELLPACK` format. This modification reduces the storage size compared to the `ELLPACK` format but maintaining its efficient data access scheme. It can be seen as an intermediate format between `CSR` and `ELLPACK`. For more details read [here](https://arxiv.org/pdf/1307.6209v1)
+
+## `matvec` - Sparse Matrix-Vector product
+
+### Status
+
+Experimental
+
+### Description
+
+Provide sparse matrix-vector product kernels for the current supported sparse matrix types.
+
+$$y=\alpha*M*x+\beta*y$$
+
+### Syntax
+
+`call ` [[stdlib_sparse_matvec(module):matvec(interface)]] `(matrix,vec_x,vec_y [,alpha,beta])`
+
+### Arguments
+
+`matrix`, `intent(in)`: Shall be a `real` or `complex` sparse type matrix.
+
+`vec_x`, `intent(in)`: Shall be a rank-1 or rank-2 array of `real` or `complex` type array.
+
+`vec_y`, `intent(inout)`: Shall be a rank-1 or rank-2 array of `real` or `complex` type array.
+
+`alpha`, `intent(in)`, `optional` : Shall be a scalar value of the same type as `vec_x`. Default value `alpha=1`.
+
+`beta`, `intent(in)`, `optional` : Shall be a scalar value of the same type as `vec_x`. Default value `beta=0`.
\ No newline at end of file
From 14bfef9d4a1f37c9b7bc143bbba23096513794d9 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sun, 26 May 2024 22:27:32 +0200
Subject: [PATCH 16/78] start adding conversions specs
---
doc/specs/stdlib_sparse.md | 64 +++++++++++++++++++++++++++++++++++++-
1 file changed, 63 insertions(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index c0ddb2674..5c3d2c1b0 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -161,4 +161,66 @@ $$y=\alpha*M*x+\beta*y$$
`alpha`, `intent(in)`, `optional` : Shall be a scalar value of the same type as `vec_x`. Default value `alpha=1`.
-`beta`, `intent(in)`, `optional` : Shall be a scalar value of the same type as `vec_x`. Default value `beta=0`.
\ No newline at end of file
+`beta`, `intent(in)`, `optional` : Shall be a scalar value of the same type as `vec_x`. Default value `beta=0`.
+
+## `sparse_conversion` - Sparse matrix to matrix conversions
+
+### Status
+
+Experimental
+
+### Description
+
+This module provides facility functions for converting between storage formats.
+
+### Syntax
+
+`call ` [[stdlib_sparse_conversion(module):dense2coo(interface)]] `(dense,coo)`
+
+### Arguments
+
+`dense`, `intent(in)`: Shall be a rank-2 array of `real` or `complex` type.
+
+`coo`, `intent(inout)`: Shall be a `COO` type of `real` or `complex` type.
+
+### Syntax
+
+`call ` [[stdlib_sparse_conversion(module):coo2dense(interface)]] `(coo,dense)`
+
+### Arguments
+
+`coo`, `intent(in)`: Shall be a `COO` type of `real` or `complex` type.
+
+`dense`, `intent(inout)`: Shall be a rank-2 array of `real` or `complex` type.
+
+### Syntax
+
+`call ` [[stdlib_sparse_conversion(module):coo2csr(interface)]] `(coo,csr)`
+
+### Arguments
+
+`coo`, `intent(in)`: Shall be a `COO` type of `real` or `complex` type.
+
+`csr`, `intent(inout)`: Shall be a `CSR` type of `real` or `complex` type.
+
+### Syntax
+
+`call ` [[stdlib_sparse_conversion(module):csr2coo(interface)]] `(csr,coo)`
+
+### Arguments
+
+`csr`, `intent(in)`: Shall be a `CSR` type of `real` or `complex` type.
+
+`coo`, `intent(inout)`: Shall be a `COO` type of `real` or `complex` type.
+
+### Syntax
+
+`call ` [[stdlib_sparse_conversion(module):csr2sellc(interface)]] `(csr,sellc[,chunk])`
+
+### Arguments
+
+`csr`, `intent(in)`: Shall be a `CSR` type of `real` or `complex` type.
+
+`sellc`, `intent(inout)`: Shall be a `SELLC` type of `real` or `complex` type.
+
+`chunk`, `intent(in)`, `optional`: chunk size for the Sliced ELLPACK format.
\ No newline at end of file
From 23be6476aa000a1d5e6c58465881bc1f80d95c62 Mon Sep 17 00:00:00 2001
From: Jose Alves <jose.alves@transvalor.com>
Date: Mon, 27 May 2024 17:20:28 +0200
Subject: [PATCH 17/78] breaking change: rename matvec to spmv for consistency
with stdlib blas gemv
---
doc/specs/stdlib_sparse.md | 6 ++-
src/CMakeLists.txt | 2 +-
src/stdlib_sparse.f90 | 2 +-
...se_matvec.fypp => stdlib_sparse_spmv.fypp} | 40 +++++++++----------
test/linalg/CMakeLists.txt | 2 +-
...arse_matvec.fypp => test_sparse_spmv.fypp} | 18 ++++-----
6 files changed, 36 insertions(+), 34 deletions(-)
rename src/{stdlib_sparse_matvec.fypp => stdlib_sparse_spmv.fypp} (93%)
rename test/linalg/{test_sparse_matvec.fypp => test_sparse_spmv.fypp} (95%)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 5c3d2c1b0..03ae9ae7f 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -135,7 +135,8 @@ Experimental
#### Description
The Sliced ELLPACK format `SELLC` is a variation of the `ELLPACK` format. This modification reduces the storage size compared to the `ELLPACK` format but maintaining its efficient data access scheme. It can be seen as an intermediate format between `CSR` and `ELLPACK`. For more details read [here](https://arxiv.org/pdf/1307.6209v1)
-## `matvec` - Sparse Matrix-Vector product
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+## `spmv` - Sparse Matrix-Vector product
### Status
@@ -149,7 +150,7 @@ $$y=\alpha*M*x+\beta*y$$
### Syntax
-`call ` [[stdlib_sparse_matvec(module):matvec(interface)]] `(matrix,vec_x,vec_y [,alpha,beta])`
+`call ` [[stdlib_sparse_spmv(module):spmv(interface)]] `(matrix,vec_x,vec_y [,alpha,beta])`
### Arguments
@@ -163,6 +164,7 @@ $$y=\alpha*M*x+\beta*y$$
`beta`, `intent(in)`, `optional` : Shall be a scalar value of the same type as `vec_x`. Default value `beta=0`.
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
## `sparse_conversion` - Sparse matrix to matrix conversions
### Status
diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
index 19e23579c..ace3443b3 100644
--- a/src/CMakeLists.txt
+++ b/src/CMakeLists.txt
@@ -36,7 +36,7 @@ set(fppFiles
stdlib_sorting_sort_index.fypp
stdlib_sparse_conversion.fypp
stdlib_sparse_kinds.fypp
- stdlib_sparse_matvec.fypp
+ stdlib_sparse_spmv.fypp
stdlib_specialfunctions_gamma.fypp
stdlib_stats.fypp
stdlib_stats_corr.fypp
diff --git a/src/stdlib_sparse.f90 b/src/stdlib_sparse.f90
index 6f1847ea3..82e5d35de 100644
--- a/src/stdlib_sparse.f90
+++ b/src/stdlib_sparse.f90
@@ -1,6 +1,6 @@
!! public API
module stdlib_sparse
use stdlib_sparse_kinds
- use stdlib_sparse_matvec
+ use stdlib_sparse_spmv
use stdlib_sparse_conversion
end module stdlib_sparse
\ No newline at end of file
diff --git a/src/stdlib_sparse_matvec.fypp b/src/stdlib_sparse_spmv.fypp
similarity index 93%
rename from src/stdlib_sparse_matvec.fypp
rename to src/stdlib_sparse_spmv.fypp
index 20a2b8ee1..a74adccb9 100644
--- a/src/stdlib_sparse_matvec.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -7,38 +7,38 @@
#:def rksfx2(rank)
#{if rank > 0}#${":," + ":," * (rank - 1)}$#{endif}#
#:enddef
-!> The `stdlib_sparse_matvec` module provides matrix-vector product kernels.
+!> The `stdlib_sparse_spmv` module provides matrix-vector product kernels.
!>
! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
-module stdlib_sparse_matvec
+module stdlib_sparse_spmv
use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
use stdlib_sparse_kinds
implicit none
private
- public :: matvec
- interface matvec
+ public :: spmv
+ interface spmv
!! Version experimental
!!
!! Applay the sparse matrix-vector product $$y = \beta * y + \alpha * M * x $$
!!
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- module procedure matvec_coo_${rank}$d_${s1}$
- module procedure matvec_csr_${rank}$d_${s1}$
- module procedure matvec_csc_${rank}$d_${s1}$
- module procedure matvec_ell_${rank}$d_${s1}$
+ module procedure spmv_coo_${rank}$d_${s1}$
+ module procedure spmv_csr_${rank}$d_${s1}$
+ module procedure spmv_csc_${rank}$d_${s1}$
+ module procedure spmv_ell_${rank}$d_${s1}$
#:endfor
- module procedure matvec_sellc_${s1}$
+ module procedure spmv_sellc_${s1}$
#:endfor
end interface
contains
- !> matvec_coo
+ !> spmv_coo
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(COO_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -78,10 +78,10 @@ contains
#:endfor
#:endfor
- !! matvec_csr
+ !! spmv_csr
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(CSR_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -158,10 +158,10 @@ contains
#:endfor
#:endfor
- !> matvec_csc
+ !> spmv_csc
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(CSC_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -222,10 +222,10 @@ contains
#:endfor
#:endfor
- !> matvec_ell
+ !> spmv_ell
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine matvec_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(ELL_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -256,10 +256,10 @@ contains
#:endfor
#:endfor
- !> matvec_sellc
+ !> spmv_sellc
#:set CHUNKS = [4,8,16]
#:for k1, t1, s1 in (KINDS_TYPES)
- subroutine matvec_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
!> This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
type(SELLC_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x(:)
@@ -336,4 +336,4 @@ contains
#:endfor
-end module stdlib_sparse_matvec
\ No newline at end of file
+end module stdlib_sparse_spmv
\ No newline at end of file
diff --git a/test/linalg/CMakeLists.txt b/test/linalg/CMakeLists.txt
index 9a76d4b9e..20b7ab790 100644
--- a/test/linalg/CMakeLists.txt
+++ b/test/linalg/CMakeLists.txt
@@ -6,7 +6,7 @@ set(
"test_linalg_lstsq.fypp"
"test_linalg_determinant.fypp"
"test_linalg_matrix_property_checks.fypp"
- "test_sparse_matvec.fypp"
+ "test_sparse_spmv.fypp"
)
fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)
diff --git a/test/linalg/test_sparse_matvec.fypp b/test/linalg/test_sparse_spmv.fypp
similarity index 95%
rename from test/linalg/test_sparse_matvec.fypp
rename to test/linalg/test_sparse_spmv.fypp
index 91fd8907a..542679861 100644
--- a/test/linalg/test_sparse_matvec.fypp
+++ b/test/linalg/test_sparse_spmv.fypp
@@ -1,7 +1,7 @@
#:include "common.fypp"
#:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX))
#:set KINDS_TYPES = R_KINDS_TYPES
-module test_sparse_matvec
+module test_sparse_spmv
use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64
use stdlib_sparse
@@ -55,7 +55,7 @@ contains
call check(error, all(vec_y1 == real([6,11,15,15],kind=wp)) )
if (allocated(error)) return
- call matvec( COO, vec_x, vec_y2 )
+ call spmv( COO, vec_x, vec_y2 )
call check(error, all(vec_y1 == vec_y2) )
if (allocated(error)) return
end block
@@ -79,7 +79,7 @@ contains
allocate( vec_x(5) , source = 1._wp )
allocate( vec_y(4) , source = 0._wp )
- call matvec( CSR, vec_x, vec_y )
+ call spmv( CSR, vec_x, vec_y )
call check(error, all(vec_y == real([6,11,15,15],kind=wp)) )
if (allocated(error)) return
@@ -104,7 +104,7 @@ contains
allocate( vec_x(5) , source = 1._wp )
allocate( vec_y(4) , source = 0._wp )
- call matvec( CSC, vec_x, vec_y )
+ call spmv( CSC, vec_x, vec_y )
call check(error, all(vec_y == real([6,11,15,15],kind=wp)) )
if (allocated(error)) return
@@ -135,7 +135,7 @@ contains
allocate( vec_x(5) , source = 1._wp )
allocate( vec_y(4) , source = 0._wp )
- call matvec( ELL, vec_x, vec_y )
+ call spmv( ELL, vec_x, vec_y )
call check(error, all(vec_y == real([6,11,15,15],kind=wp)) )
if (allocated(error)) return
@@ -172,7 +172,7 @@ contains
allocate( vec_x(6) , source = 1._wp )
allocate( vec_y(6) , source = 0._wp )
- call matvec( SELLC, vec_x, vec_y )
+ call spmv( SELLC, vec_x, vec_y )
call check(error, all(vec_y == real([6,22,27,23,27,48],kind=wp)) )
if (allocated(error)) return
@@ -212,11 +212,11 @@ contains
call check(error, all(vec_y1 == [3,5,5,3]) )
if (allocated(error)) return
- call matvec( COO , vec_x, vec_y2 )
+ call spmv( COO , vec_x, vec_y2 )
call check(error, all(vec_y1 == vec_y2) )
if (allocated(error)) return
- call matvec( CSR , vec_x, vec_y3 )
+ call spmv( CSR , vec_x, vec_y3 )
call check(error, all(vec_y1 == vec_y3) )
if (allocated(error)) return
end block
@@ -229,7 +229,7 @@ end module
program tester
use, intrinsic :: iso_fortran_env, only : error_unit
use testdrive, only : run_testsuite, new_testsuite, testsuite_type
- use test_sparse_matvec, only : collect_suite
+ use test_sparse_spmv, only : collect_suite
implicit none
integer :: stat, is
type(testsuite_type), allocatable :: testsuites(:)
From 6e679f5681f8f897d029f76e877ae4bf0db2af7d Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Fri, 14 Jun 2024 21:31:07 +0200
Subject: [PATCH 18/78] change storage identifier names
---
doc/specs/stdlib_sparse.md | 6 +++---
src/stdlib_sparse_conversion.fypp | 6 +++---
src/stdlib_sparse_kinds.fypp | 10 +++++-----
src/stdlib_sparse_spmv.fypp | 28 ++++++++++++++--------------
test/linalg/test_sparse_spmv.fypp | 2 +-
5 files changed, 26 insertions(+), 26 deletions(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 03ae9ae7f..45d5d1c99 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -35,9 +35,9 @@ The symmetry integer laber should be assigned from the module's internal enumera
```Fortran
enum, bind(C)
- enumerator :: k_NOSYMMETRY !> Full Sparse matrix (no symmetry considerations)
- enumerator :: k_SYMTRIINF !> Symmetric Sparse matrix with triangular inferior storage
- enumerator :: k_SYMTRISUP !> Symmetric Sparse matrix with triangular supperior storage
+ enumerator :: sparse_full !> Full Sparse matrix (no symmetry considerations)
+ enumerator :: sparse_lower !> Symmetric Sparse matrix with triangular inferior storage
+ enumerator :: sparse_upper !> Symmetric Sparse matrix with triangular supperior storage
end enum
```
In the following, all sparse kinds will be presented in two main flavors: a data-less type `<matrix>_type` useful for topological graph operations. And real/complex valued types `<matrix>_<kind>` containing the `data` buffer for the matrix values.
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 053c8d170..d587108d3 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -115,7 +115,7 @@ contains
integer :: i
CSR%nnz = COO%nnz; CSR%nrows = COO%nrows; CSR%ncols = COO%ncols
- CSR%base = COO%base; CSR%sym = COO%sym
+ CSR%base = COO%base; CSR%storage = COO%storage
if( allocated(CSR%col) ) then
CSR%col(1:COO%nnz) = COO%index(2,1:COO%nnz)
@@ -145,7 +145,7 @@ contains
integer :: i, j
COO%nnz = CSR%nnz; COO%nrows = CSR%nrows; COO%ncols = CSR%ncols
- COO%base = CSR%base; COO%sym = CSR%sym
+ COO%base = CSR%base; COO%storage = CSR%storage
if( .not.allocated(COO%data) ) then
allocate( COO%data(CSR%nnz) , source = CSR%data(1:CSR%nnz) )
@@ -177,7 +177,7 @@ contains
if(present(chunk)) SELLC%chunk_size = chunk
SELLC%nrows = CSR%nrows; SELLC%ncols = CSR%ncols
- SELLC%base = CSR%base; SELLC%sym = CSR%sym
+ SELLC%base = CSR%base; SELLC%storage = CSR%storage
associate( nrows=>SELLC%nrows, ncols=>SELLC%ncols, nnz=>SELLC%nnz, &
& chunk_size=>SELLC%chunk_size )
!-------------------------------------------
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index d55d1e3f6..8d3b59e6d 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -13,11 +13,11 @@ module stdlib_sparse_kinds
! -- Global parameters
enum, bind(C)
- enumerator :: k_NOSYMMETRY !> Full Sparse matrix (no symmetry considerations)
- enumerator :: k_SYMTRIINF !> Symmetric Sparse matrix with triangular inferior storage
- enumerator :: k_SYMTRISUP !> Symmetric Sparse matrix with triangular supperior storage
+ enumerator :: sparse_full !> Full Sparse matrix (no symmetry considerations)
+ enumerator :: sparse_lower !> Symmetric Sparse matrix with triangular inferior storage
+ enumerator :: sparse_upper !> Symmetric Sparse matrix with triangular supperior storage
end enum
- public :: k_NOSYMMETRY, k_SYMTRIINF, k_SYMTRISUP
+ public :: sparse_full, sparse_lower, sparse_upper
#:for k1, t1, s1 in (R_KINDS_TYPES)
${t1}$, parameter, public :: zero_${s1}$ = 0._${k1}$
@@ -35,7 +35,7 @@ module stdlib_sparse_kinds
integer :: nrows = 0 !> number of rows
integer :: ncols = 0 !> number of columns
integer :: nnz = 0 !> number of non-zero values
- integer :: sym = k_NOSYMMETRY !> assumed storage symmetry
+ integer :: storage = sparse_full !> assumed storage symmetry
integer :: base = 1 !> index base = 0 for (C) or 1 (Fortran)
end type
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index a74adccb9..9cd1a9e5b 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -54,8 +54,8 @@ contains
else
vec_y = zero_${s1}$
endif
- associate( data => matrix%data, index => matrix%index, sym => matrix%sym, nnz => matrix%nnz )
- if( sym == k_NOSYMMETRY) then
+ associate( data => matrix%data, index => matrix%index, storage => matrix%storage, nnz => matrix%nnz )
+ if( storage == sparse_full) then
do concurrent (k = 1:nnz)
ik = index(1,k)
jk = index(2,k)
@@ -101,8 +101,8 @@ contains
if(present(beta)) beta_ = beta
associate( data => matrix%data, col => matrix%col, rowptr => matrix%rowptr, &
- & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
- if( sym == k_NOSYMMETRY) then
+ & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, storage => matrix%storage )
+ if( storage == sparse_full) then
do i = 1, nrows
aux = zero_${k1}$
do j = rowptr(i), rowptr(i+1)-1
@@ -115,7 +115,7 @@ contains
end if
end do
- else if( sym == k_SYMTRIINF )then
+ else if( storage == sparse_lower )then
do i = 1 , nrows
aux = zero_${s1}$
aux2 = alpha_ * vec_x(${rksfx2(rank-1)}$i)
@@ -132,7 +132,7 @@ contains
end if
end do
- else if( sym == k_SYMTRISUP )then
+ else if( storage == sparse_upper )then
do i = 1 , nrows
aux = vec_x(${rksfx2(rank-1)}$i) * data(rowptr(i))
aux2 = alpha_ * vec_x(${rksfx2(rank-1)}$i)
@@ -184,15 +184,15 @@ contains
endif
associate( data => matrix%data, colptr => matrix%colptr, row => matrix%row, &
- & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
- if( sym == k_NOSYMMETRY) then
+ & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, storage => matrix%storage )
+ if( storage == sparse_full) then
do concurrent(j=1:ncols)
do i = colptr(j), colptr(j+1)-1
vec_y(${rksfx2(rank-1)}$row(i)) = vec_y(${rksfx2(rank-1)}$row(i)) + alpha_ * data(i) * vec_x(${rksfx2(rank-1)}$j)
end do
end do
- else if( sym == k_SYMTRIINF )then
+ else if( storage == sparse_lower )then
! NOT TESTED
do j = 1 , ncols
aux = vec_x(${rksfx2(rank-1)}$j) * data(colptr(j))
@@ -203,7 +203,7 @@ contains
vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_ * aux
end do
- else if( sym == k_SYMTRISUP )then
+ else if( storage == sparse_upper )then
! NOT TESTED
do j = 1 , ncols
aux = zero_${s1}$
@@ -242,8 +242,8 @@ contains
vec_y = zero_${s1}$
endif
associate( data => matrix%data, index => matrix%index, MNZ_P_ROW => matrix%K, &
- & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
- if( sym == k_NOSYMMETRY) then
+ & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, storage => matrix%storage )
+ if( storage == sparse_full) then
do concurrent (i = 1:nrows, k = 1:MNZ_P_ROW)
j = index(i,k)
if(j>0) vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_*data(i,k) * vec_x(${rksfx2(rank-1)}$j)
@@ -277,10 +277,10 @@ contains
vec_y = zero_${s1}$
endif
associate( data => matrix%data, ia => matrix%rowptr , ja => matrix%col, cs => matrix%chunk_size, &
- & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, sym => matrix%sym )
+ & nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, storage => matrix%storage )
num_chunks = nrows / cs
rm = nrows - num_chunks * cs
- if( sym == k_NOSYMMETRY) then
+ if( storage == sparse_full) then
select case(cs)
#:for chunk in CHUNKS
diff --git a/test/linalg/test_sparse_spmv.fypp b/test/linalg/test_sparse_spmv.fypp
index 542679861..62c146ba1 100644
--- a/test/linalg/test_sparse_spmv.fypp
+++ b/test/linalg/test_sparse_spmv.fypp
@@ -204,7 +204,7 @@ contains
0,0,2,1],kind=wp),[4,4]) )
call dense2coo( dense , COO )
- COO%sym = k_SYMTRISUP
+ COO%storage = sparse_upper
call coo2csr(COO, CSR)
dense(2,1) = 2._wp; dense(3,2) = 2._wp; dense(4,3) = 2._wp
From 91e619aff076b62a17bb648b4f009a89653cdb5c Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Fri, 14 Jun 2024 23:25:45 +0200
Subject: [PATCH 19/78] add example with conversion and spmv
---
doc/specs/stdlib_sparse.md | 7 ++++-
example/linalg/example_sparse_spmv.f90 | 36 ++++++++++++++++++++++++++
2 files changed, 42 insertions(+), 1 deletion(-)
create mode 100644 example/linalg/example_sparse_spmv.f90
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 45d5d1c99..69c192645 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -225,4 +225,9 @@ This module provides facility functions for converting between storage formats.
`sellc`, `intent(inout)`: Shall be a `SELLC` type of `real` or `complex` type.
-`chunk`, `intent(in)`, `optional`: chunk size for the Sliced ELLPACK format.
\ No newline at end of file
+`chunk`, `intent(in)`, `optional`: chunk size for the Sliced ELLPACK format.
+
+## Example
+```fortran
+{!example/strings/example_sparse_spmv.f90!}
+```
\ No newline at end of file
diff --git a/example/linalg/example_sparse_spmv.f90 b/example/linalg/example_sparse_spmv.f90
new file mode 100644
index 000000000..9b30b35e2
--- /dev/null
+++ b/example/linalg/example_sparse_spmv.f90
@@ -0,0 +1,36 @@
+program example_sparse_spmv
+ use stdlib_linalg_constants, only: dp
+ use stdlib_sparse
+ implicit none
+
+ integer, parameter :: m = 4, n = 2
+ real(dp) :: A(m,n), x(n)
+ real(dp) :: y_dense(m), y_coo(m), y_csr(m)
+ real(dp) :: alpha, beta
+ type(COO_dp) :: COO
+ type(CSR_dp) :: CSR
+
+ call random_number(A)
+ ! Convert from dense to COO and CSR matrices
+ call dense2coo( A , COO )
+ call coo2csr( COO , CSR )
+
+ ! Initialize vectors
+ x = 1._dp
+ y_dense = 2._dp
+ y_coo = y_dense
+ y_csr = y_dense
+
+ ! Perform matrix-vector product
+ alpha = 3._dp; beta = 2._dp
+ y_dense = alpha * matmul(A,x) + beta * y_dense
+ call spmv( COO , x , y_coo , alpha = alpha, beta = beta )
+ call spmv( CSR , x , y_csr , alpha = alpha, beta = beta )
+
+ print *, 'dense :', y_dense
+ print *, 'coo :', y_coo
+ print *, 'csr :', y_csr
+
+ end program example_sparse_spmv
+
+
\ No newline at end of file
From 7117d16ac496d03eeb59077a46aca55bcab215a5 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Fri, 14 Jun 2024 23:27:10 +0200
Subject: [PATCH 20/78] fix example path
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 69c192645..312b8ba38 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -229,5 +229,5 @@ This module provides facility functions for converting between storage formats.
## Example
```fortran
-{!example/strings/example_sparse_spmv.f90!}
+{!example/linalg/example_sparse_spmv.f90!}
```
\ No newline at end of file
From 5b0aadf534c33037e0bc3da65e8c7aee79dd541a Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 15 Jun 2024 12:10:34 +0200
Subject: [PATCH 21/78] make example runnable with cmake
---
example/linalg/CMakeLists.txt | 1 +
1 file changed, 1 insertion(+)
diff --git a/example/linalg/CMakeLists.txt b/example/linalg/CMakeLists.txt
index e9ad22a03..1ede8d326 100644
--- a/example/linalg/CMakeLists.txt
+++ b/example/linalg/CMakeLists.txt
@@ -23,6 +23,7 @@ ADD_EXAMPLE(lstsq2)
ADD_EXAMPLE(solve1)
ADD_EXAMPLE(solve2)
ADD_EXAMPLE(solve3)
+ADD_EXAMPLE(sparse_spmv)
ADD_EXAMPLE(svd)
ADD_EXAMPLE(svdvals)
ADD_EXAMPLE(determinant)
From c0438f083587a4c43ee3962449b8f0c4d8b20cf9 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 15 Jun 2024 12:29:09 +0200
Subject: [PATCH 22/78] update spec
---
doc/specs/stdlib_sparse.md | 22 +++++++++++-----------
1 file changed, 11 insertions(+), 11 deletions(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 312b8ba38..aac2e31bc 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -23,24 +23,24 @@ The `sparse_type` is defined as an abstract derived type holding the basic commo
```Fortran
type, public, abstract :: sparse_type
- integer :: nrows !> number of rows
- integer :: ncols !> number of columns
- integer :: nnz !> number of non-zero values
- integer :: sym !> assumed storage symmetry
- integer :: base !> index base = 0 for (C) or 1 (Fortran)
+ integer :: nrows !> number of rows
+ integer :: ncols !> number of columns
+ integer :: nnz !> number of non-zero values
+ integer :: storage !> assumed storage symmetry
+ integer :: base !> index base = 0 for (C) or 1 (Fortran)
end type
```
-The symmetry integer laber should be assigned from the module's internal enumerator containing the following three enums:
+The storage integer label should be assigned from the module's internal enumerator containing the following three enums:
```Fortran
enum, bind(C)
- enumerator :: sparse_full !> Full Sparse matrix (no symmetry considerations)
- enumerator :: sparse_lower !> Symmetric Sparse matrix with triangular inferior storage
- enumerator :: sparse_upper !> Symmetric Sparse matrix with triangular supperior storage
+ enumerator :: sparse_full !> Full Sparse matrix (no symmetry considerations)
+ enumerator :: sparse_lower !> Symmetric Sparse matrix with triangular inferior storage
+ enumerator :: sparse_upper !> Symmetric Sparse matrix with triangular supperior storage
end enum
```
-In the following, all sparse kinds will be presented in two main flavors: a data-less type `<matrix>_type` useful for topological graph operations. And real/complex valued types `<matrix>_<kind>` containing the `data` buffer for the matrix values.
+In the following, all sparse kinds will be presented in two main flavors: a data-less type `<matrix>_type` useful for topological graph operations. And real/complex valued types `<matrix>_<kind>` containing the `data` buffer for the matrix values. The following rectangular matrix will be used to showcase how each sparse matrix holds the data internally:
$$ M = \begin{bmatrix}
9 & 0 & 0 & 0 & -3 \\
@@ -55,7 +55,7 @@ $$ M = \begin{bmatrix}
Experimental
#### Description
-The `COO`, triplet or `ijv` format defines all non-zero elements of the matrix by explicitly allocating the `i,j` index and the value of the matrix.
+The `COO`, triplet or `ijv` format defines all non-zero elements of the matrix by explicitly allocating the `i,j` index and the value of the matrix. While some implementations use separate `row` and `col` arrays for the index, here we use a 2D array in order to promote fast memory acces to `ij`.
```Fortran
type(COO_sp) :: COO
From e18b3fcd3557ea34ee452f796f547b90e609eb50 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 15 Jun 2024 13:37:36 +0200
Subject: [PATCH 23/78] add coo2ordered procedure
---
doc/specs/stdlib_sparse.md | 10 ++
src/stdlib_sparse_conversion.fypp | 219 ++++++++++++++++++++++++++++++
test/linalg/test_sparse_spmv.fypp | 37 +++++
3 files changed, 266 insertions(+)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index aac2e31bc..b49cfd89a 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -177,6 +177,16 @@ This module provides facility functions for converting between storage formats.
### Syntax
+`call ` [[stdlib_sparse_conversion(module):coo2ordered(interface)]] `(coo)`
+
+### Arguments
+
+`COO`, `intent(inout)`: Shall be any `COO` type. The same object will be returned with the arrays reallocated to the correct size after removing duplicates.
+
+`sort_data`, `logical(in)`, `optional`:: Boolean optional to determine whether to sort the data in the COO graph while sorting the index array, defult `.false.`.
+
+### Syntax
+
`call ` [[stdlib_sparse_conversion(module):dense2coo(interface)]] `(dense,coo)`
### Arguments
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index d587108d3..72eee8b51 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -13,6 +13,7 @@ module stdlib_sparse_conversion
public :: dense2coo, coo2dense, coo2csr, csr2coo
public :: csr2sellc
+ public :: coo2ordered
!> Conversion from dense to coo
!>
@@ -63,6 +64,15 @@ module stdlib_sparse_conversion
module procedure csr2sellc_${s1}$
#:endfor
end interface
+
+ !> Sort arrays of a COO matrix
+ !>
+ interface sort_coo
+ module procedure sort_coo_unique
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure sort_coo_unique_${s1}$
+ #:endfor
+ end interface
contains
@@ -229,5 +239,214 @@ contains
end subroutine
#:endfor
+
+ recursive subroutine quicksort_i(a, first, last)
+ ! ref: https://gist.github.com/t-nissie/479f0f16966925fa29ea
+ integer, intent(inout) :: a(*)
+ integer, intent(in) :: first, last
+ integer :: i, j, x, t
+
+ x = a( (first+last) / 2 )
+ i = first
+ j = last
+ do
+ do while (a(i) < x)
+ i=i+1
+ end do
+ do while (x < a(j))
+ j=j-1
+ end do
+ if (i >= j) exit
+ t = a(i); a(i) = a(j); a(j) = t
+ i=i+1
+ j=j-1
+ end do
+ if (first < i-1) call quicksort_i(a, first, i-1)
+ if (j+1 < last) call quicksort_i(a, j+1, last)
+ end subroutine
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ recursive subroutine quicksort_i_${s1}$(a, b, first, last)
+ integer, parameter :: wp = sp
+ integer, intent(inout) :: a(*) !! reference table to sort
+ ${t1}$, intent(inout) :: b(*) !! secondary real data to sort w.r.t. a
+ integer, intent(in) :: first, last
+ integer :: i, j, x, t
+ ${t1}$ :: d
+
+ x = a( (first+last) / 2 )
+ i = first
+ j = last
+ do
+ do while (a(i) < x)
+ i=i+1
+ end do
+ do while (x < a(j))
+ j=j-1
+ end do
+ if (i >= j) exit
+ t = a(i); a(i) = a(j); a(j) = t
+ d = b(i); b(i) = b(j); b(j) = d
+ i=i+1
+ j=j-1
+ end do
+ if (first < i-1) call quicksort_i_${s1}$(a, b, first, i-1)
+ if (j+1 < last) call quicksort_i_${s1}$(a, b, j+1, last)
+ end subroutine
+
+ #:endfor
+
+ subroutine sort_coo_unique( a, n, num_rows, num_cols )
+ !! Sort a 2d array in increasing order first by index 1 and then by index 2
+ integer, intent(inout) :: a(2,*)
+ integer, intent(inout) :: n
+ integer, intent(in) :: num_rows
+ integer, intent(in) :: num_cols
+
+ integer :: stride, adr0, adr1, dd
+ integer :: n_i, pos, ed
+ integer, allocatable :: count_i(:), count_i_aux(:), rows_(:), cols_(:)
+ !---------------------------------------------------------
+ ! Sort a first time with respect to first index using count sort
+ allocate( count_i( 0:num_rows ) , source = 0 )
+ do ed = 1, n
+ count_i( a(1,ed) ) = count_i( a(1,ed) ) + 1
+ end do
+ do n_i = 2, num_rows
+ count_i(n_i) = count_i(n_i) + count_i(n_i-1)
+ end do
+ allocate( count_i_aux( 0:num_rows ) , source = count_i )
+
+ allocate( rows_(n), cols_(n) )
+ do ed = n, 1, -1
+ n_i = a(1,ed)
+ pos = count_i(n_i)
+ rows_(pos) = a(1,ed)
+ cols_(pos) = a(2,ed)
+ count_i(n_i) = count_i(n_i) - 1
+ end do
+ !---------------------------------------------------------
+ ! Sort with respect to second column
+ do n_i = 1, num_rows
+ adr0 = count_i_aux(n_i-1)+1
+ adr1 = count_i_aux(n_i)
+ dd = adr1-adr0+1
+ if(dd>0) call quicksort_i(cols_(adr0),1,dd)
+ end do
+ !---------------------------------------------------------
+ ! Remove duplicates
+ do ed = 1,n
+ a(1:2,ed) = [rows_(ed),cols_(ed)]
+ end do
+ stride = 0
+ do ed = 2, n
+ if( a(1,ed) == a(1,ed-1) .and. a(2,ed) == a(2,ed-1) ) then
+ stride = stride + 1
+ else
+ a(1:2,ed-stride) = a(1:2,ed)
+ end if
+ end do
+ n = n - stride
+ end subroutine
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine sort_coo_unique_${s1}$( a, data, n, num_rows, num_cols )
+ !! Sort a 2d array in increasing order first by index 1 and then by index 2
+ integer, parameter :: wp = ${k1}$
+ ${t1}$, intent(inout) :: data(*)
+ integer, intent(inout) :: a(2,*)
+ integer, intent(inout) :: n
+ integer, intent(in) :: num_rows
+ integer, intent(in) :: num_cols
+
+ integer :: stride, adr0, adr1, dd
+ integer :: n_i, pos, ed
+ integer, allocatable :: count_i(:), count_i_aux(:), rows_(:), cols_(:)
+ ${t1}$, allocatable :: temp(:)
+ !---------------------------------------------------------
+ ! Sort a first time with respect to first index using Count sort
+ allocate( count_i( 0:num_rows ) , source = 0 )
+ do ed = 1, n
+ count_i( a(1,ed) ) = count_i( a(1,ed) ) + 1
+ end do
+ do n_i = 2, num_rows
+ count_i(n_i) = count_i(n_i) + count_i(n_i-1)
+ end do
+ allocate( count_i_aux( 0:num_rows ) , source = count_i )
+
+ allocate( rows_(n), cols_(n), temp(n) )
+ do ed = n, 1, -1
+ n_i = a(1,ed)
+ pos = count_i(n_i)
+ rows_(pos) = a(1,ed)
+ cols_(pos) = a(2,ed)
+ temp(pos) = data(ed)
+ count_i(n_i) = count_i(n_i) - 1
+ end do
+ !---------------------------------------------------------
+ ! Sort with respect to second colum using a quicksort
+ do n_i = 1, num_rows
+ adr0 = count_i_aux(n_i-1)+1
+ adr1 = count_i_aux(n_i)
+ dd = adr1-adr0+1
+ if(dd>0) call quicksort_i_${s1}$(cols_(adr0),temp(adr0),1,dd)
+ end do
+ !---------------------------------------------------------
+ ! Remove duplicates
+ do ed = 1,n
+ a(1:2,ed) = [rows_(ed),cols_(ed)]
+ end do
+ data(1:n) = temp(1:n)
+ stride = 0
+ do ed = 2, n
+ if( a(1,ed) == a(1,ed-1) .and. a(2,ed) == a(2,ed-1) ) then
+ data(ed-1-stride) = data(ed-1-stride) + data(ed)
+ data(ed) = data(ed-1-stride)
+ stride = stride + 1
+ else
+ a(1:2,ed-stride) = a(1:2,ed)
+ data(ed-stride) = data(ed)
+ end if
+ end do
+ n = n - stride
+ end subroutine
+
+ #:endfor
+
+ subroutine coo2ordered(COO,sort_data)
+ class(COO_type), intent(inout) :: COO
+ logical, intent(in), optional :: sort_data
+ integer, allocatable :: itemp(:,:)
+ logical :: sort_data_
+
+ if(COO%isOrdered) return
+
+ sort_data_ = .false.
+ if(present(sort_data)) sort_data_ = sort_data
+
+ select type (COO)
+ type is( COO_type )
+ call sort_coo(COO%index, COO%nnz, COO%nrows, COO%ncols)
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ type is( COO_${s1}$ )
+ block
+ ${t1}$, allocatable :: temp(:)
+ if( sort_data_ ) then
+ call sort_coo(COO%index, COO%data, COO%nnz, COO%nrows, COO%ncols)
+ allocate( temp(COO%nnz) , source=COO%data(1:COO%nnz) )
+ else
+ call sort_coo(COO%index, COO%nnz, COO%nrows, COO%ncols)
+ allocate( temp(COO%nnz) )
+ end if
+ call move_alloc( temp , COO%data )
+ end block
+ #:endfor
+ end select
+
+ allocate( itemp(2,COO%nnz) , source=COO%index(1:2,1:COO%nnz) )
+ call move_alloc( itemp , COO%index )
+
+ COO%isOrdered = .true.
+ end subroutine
end module stdlib_sparse_conversion
\ No newline at end of file
diff --git a/test/linalg/test_sparse_spmv.fypp b/test/linalg/test_sparse_spmv.fypp
index 62c146ba1..deda95fec 100644
--- a/test/linalg/test_sparse_spmv.fypp
+++ b/test/linalg/test_sparse_spmv.fypp
@@ -18,6 +18,7 @@ contains
testsuite = [ &
new_unittest('coo', test_coo), &
+ new_unittest('coo2ordered', test_coo2ordered), &
new_unittest('csr', test_csr), &
new_unittest('csc', test_csc), &
new_unittest('ell', test_ell), &
@@ -62,6 +63,42 @@ contains
#:endfor
end subroutine
+ subroutine test_coo2ordered(error)
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+ type(COO_sp) :: COO
+
+ call COO%malloc(4,4,12)
+ COO%data(:) = 1
+ COO%index(:,1) = [1,2]
+ COO%index(:,2) = [1,3]
+ COO%index(:,3) = [1,4]
+ COO%index(:,4) = [2,3]
+ COO%index(:,5) = [2,4]
+ COO%index(:,6) = [3,4]
+
+ COO%index(:,7) = [2,3]
+ COO%index(:,8) = [2,4]
+ COO%index(:,9) = [2,5]
+ COO%index(:,10) = [3,4]
+ COO%index(:,11) = [3,5]
+ COO%index(:,12) = [4,5]
+
+ call coo2ordered(COO,sort_data=.true.)
+ call check(error, COO%nnz < 12 .and. COO%nnz == 9 )
+ if (allocated(error)) return
+
+ call check(error, all(COO%data==[1,1,1,2,2,1,2,1,1]) )
+ if (allocated(error)) return
+
+ call check(error, all(COO%index(1,:)==[1,1,1,2,2,2,3,3,4]) )
+ if (allocated(error)) return
+
+ call check(error, all(COO%index(2,:)==[2,3,4,3,4,5,4,5,5]) )
+ if (allocated(error)) return
+
+ end subroutine
+
subroutine test_csr(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
From 79534b35ec7839a563922d527e81efb30e105d41 Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Wed, 19 Jun 2024 12:52:44 +0200
Subject: [PATCH 24/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Federico Perini <federico.perini@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index b49cfd89a..89c169659 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -8,7 +8,7 @@ title: sparse
## Introduction
-The `stdlib_sparse` module provides several derived types defining known sparse matrix data structures. It also provides basic sparse kernels such as sparse matrix vector and conversion between matrix types.
+The `stdlib_sparse` module provides derived types for standard sparse matrix data structures. It also provides math kernels such as sparse matrix-vector product and conversion between matrix types.
## Derived types provided
From 5f35174ac00fcd86be8068e35344447fab954dbc Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Wed, 19 Jun 2024 12:52:55 +0200
Subject: [PATCH 25/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Federico Perini <federico.perini@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 89c169659..d7c5705f0 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -10,7 +10,7 @@ title: sparse
The `stdlib_sparse` module provides derived types for standard sparse matrix data structures. It also provides math kernels such as sparse matrix-vector product and conversion between matrix types.
-## Derived types provided
+## Sparse matrix derived types
<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
### The `sparse_type` abstract derived type
From b3de0160d2400db3304df2efa9fc0e6e5850f1f2 Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Wed, 19 Jun 2024 12:53:24 +0200
Subject: [PATCH 26/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Federico Perini <federico.perini@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index d7c5705f0..71be0334f 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -19,7 +19,7 @@ The `stdlib_sparse` module provides derived types for standard sparse matrix dat
Experimental
#### Description
-The `sparse_type` is defined as an abstract derived type holding the basic common meta data needed to define a sparse matrix. All other sparse types falvors are derived from the `sparse_type`.
+The parent `sparse_type` is as an abstract derived type holding the basic common meta data needed to define a sparse matrix, as well as shared APIs. All sparse matrix flavors are extended from the `sparse_type`.
```Fortran
type, public, abstract :: sparse_type
From 181760b7d34e93f099b7bb9bee19e21cbfa5826c Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Wed, 19 Jun 2024 12:53:51 +0200
Subject: [PATCH 27/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Federico Perini <federico.perini@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 71be0334f..9bc2dafe7 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -79,7 +79,7 @@ COO%index(1:2,10) = [4,4]
Experimental
#### Description
-The Compressed Sparse Row or Yale format `CSR` stores the matrix index by compressing the row indeces with a counter pointer `rowptr` enabling to know the first and last non-zero colum index `col` of the given row.
+The Compressed Sparse Row or Yale format `CSR` stores the matrix structure by compressing the row indices with a counter pointer `rowptr` enabling to know the first and last non-zero column index `col` of the given row.
```Fortran
type(CSR_sp) :: CSR
From 147a5c97478ab449267eaf7c78fe077f1698a898 Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Wed, 19 Jun 2024 12:54:11 +0200
Subject: [PATCH 28/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Federico Perini <federico.perini@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 9bc2dafe7..118d46107 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -95,7 +95,7 @@ CSR%rowptr(:) = [1,3,5,8,11]
Experimental
#### Description
-The Compressed Sparse Colum `CSC` is similar to the `CSR` format but values are accesed first by colum, thus an index counter is given by `colptr` which enables accessing the start and ending rows of a given colum in the `row` index table.
+The Compressed Sparse Colum `CSC` is similar to the `CSR` format but values are accesed first by column, thus an index counter is given by `colptr` which enables accessing the start and ending rows of a given colum in the `row` index table.
```Fortran
type(CSC_sp) :: CSC
From c832eebd010ab6bf2390048833b39d5f5d4d8731 Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Wed, 19 Jun 2024 12:54:32 +0200
Subject: [PATCH 29/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Federico Perini <federico.perini@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 118d46107..b31aa4e3d 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -111,7 +111,7 @@ CSC%colptr(:) = [1,4,6,8,10,11]
Experimental
#### Description
-The `ELL` format stores the data in a dense matrix of $nrows \times K$ in column major order. By imposing a constant number of zeros per row $K$, this format will incure in additional zeros being stored, but it enables efficient vectorization as memory acces are carried out by constant sized strides.
+The `ELL` format stores data in a dense matrix of $nrows \times K$ in column major order. By imposing a constant number of zeros per row $K$, this format will incur in additional zeros being stored, but it enables efficient vectorization as memory acces is carried out by constant sized strides.
```Fortran
type(ELL_sp) :: ELL
From 22a70b1912c3c368dcbb7dcf93b60621ac7918d3 Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Wed, 19 Jun 2024 12:54:48 +0200
Subject: [PATCH 30/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Federico Perini <federico.perini@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index b31aa4e3d..5f5cc33d3 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -133,7 +133,7 @@ ELL%index(4,1:3) = [1,3,4]
Experimental
#### Description
-The Sliced ELLPACK format `SELLC` is a variation of the `ELLPACK` format. This modification reduces the storage size compared to the `ELLPACK` format but maintaining its efficient data access scheme. It can be seen as an intermediate format between `CSR` and `ELLPACK`. For more details read [here](https://arxiv.org/pdf/1307.6209v1)
+The Sliced ELLPACK format `SELLC` is a variation of the `ELLPACK` format. This modification reduces the storage size compared to the `ELLPACK` format but maintaining its efficient data access scheme. It can be seen as an intermediate format between `CSR` and `ELLPACK`. For more details read [the reference](https://arxiv.org/pdf/1307.6209v1)
<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
## `spmv` - Sparse Matrix-Vector product
From 92233453e35e075c693d9beed294ffdd4cbdf6db Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Wed, 19 Jun 2024 12:56:38 +0200
Subject: [PATCH 31/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Federico Perini <federico.perini@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 5f5cc33d3..c103fd915 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -183,7 +183,7 @@ This module provides facility functions for converting between storage formats.
`COO`, `intent(inout)`: Shall be any `COO` type. The same object will be returned with the arrays reallocated to the correct size after removing duplicates.
-`sort_data`, `logical(in)`, `optional`:: Boolean optional to determine whether to sort the data in the COO graph while sorting the index array, defult `.false.`.
+`sort_data`, `logical(in)`, `optional`:: Shall be an optional `logical` argument to determine whether data in the COO graph should be sorted while sorting the index array, defult `.false.`.
### Syntax
From 827a1efe9b9fba743d7f93915dddb8d20f77dee2 Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Wed, 19 Jun 2024 13:11:31 +0200
Subject: [PATCH 32/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Ivan Pribec <ivan.pribec@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index c103fd915..092cc8be8 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -183,7 +183,7 @@ This module provides facility functions for converting between storage formats.
`COO`, `intent(inout)`: Shall be any `COO` type. The same object will be returned with the arrays reallocated to the correct size after removing duplicates.
-`sort_data`, `logical(in)`, `optional`:: Shall be an optional `logical` argument to determine whether data in the COO graph should be sorted while sorting the index array, defult `.false.`.
+`sort_data`, `logical(in)`, `optional`:: Shall be an optional `logical` argument to determine whether data in the COO graph should be sorted while sorting the index array, default `.false.`.
### Syntax
From 21a8547d2eec103fe04a6a825b8994a4cac71c5d Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Wed, 19 Jun 2024 21:24:09 +0200
Subject: [PATCH 33/78] change get_value to function and add NaN if out of
bounds
---
src/stdlib_sparse_kinds.fypp | 47 ++++++++++++++++++++++++------------
1 file changed, 32 insertions(+), 15 deletions(-)
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 8d3b59e6d..0e271d0d4 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -6,6 +6,7 @@
!>
! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
module stdlib_sparse_kinds
+ use ieee_arithmetic
use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
implicit none
@@ -13,9 +14,9 @@ module stdlib_sparse_kinds
! -- Global parameters
enum, bind(C)
- enumerator :: sparse_full !> Full Sparse matrix (no symmetry considerations)
- enumerator :: sparse_lower !> Symmetric Sparse matrix with triangular inferior storage
- enumerator :: sparse_upper !> Symmetric Sparse matrix with triangular supperior storage
+ enumerator :: sparse_full !> Full Sparse matrix (no symmetry considerations)
+ enumerator :: sparse_lower !> Symmetric Sparse matrix with triangular inferior storage
+ enumerator :: sparse_upper !> Symmetric Sparse matrix with triangular supperior storage
end enum
public :: sparse_full, sparse_lower, sparse_upper
@@ -290,12 +291,16 @@ contains
!==================================================================
#:for k1, t1, s1 in (KINDS_TYPES)
- pure subroutine get_value_coo_${s1}$(self,val,ik,jk)
+ pure function get_value_coo_${s1}$(self,ik,jk) result(val)
class(COO_${s1}$), intent(in) :: self
- ${t1}$, intent(out) :: val
+ ${t1}$ :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
+ if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
+ val = ieee_value( 0._${k1}$ , ieee_quiet_nan)
+ return
+ end if
do k = 1,self%nnz
if( ik == self%index(1,k) .and. jk == self%index(2,k) ) then
val = self%data(k)
@@ -303,7 +308,7 @@ contains
end if
end do
val = zero_${s1}$
- end subroutine
+ end function
subroutine set_value_coo_${s1}$(self,val,ik,jk)
class(COO_${s1}$), intent(inout) :: self
@@ -322,12 +327,16 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- pure subroutine get_value_csr_${s1}$(self,val,ik,jk)
+ pure function get_value_csr_${s1}$(self,ik,jk) result(val)
class(CSR_${s1}$), intent(in) :: self
- ${t1}$, intent(out) :: val
+ ${t1}$ :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
+ if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
+ val = ieee_value( 0._${k1}$ , ieee_quiet_nan)
+ return
+ end if
do k = self%rowptr(ik), self%rowptr(ik+1)-1
if( jk == self%col(k) ) then
val = self%data(k)
@@ -335,7 +344,7 @@ contains
end if
end do
val = zero_${s1}$
- end subroutine
+ end function
subroutine set_value_csr_${s1}$(self,val,ik,jk)
class(CSR_${s1}$), intent(inout) :: self
@@ -354,12 +363,16 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- pure subroutine get_value_csc_${s1}$(self,val,ik,jk)
+ pure function get_value_csc_${s1}$(self,ik,jk) result(val)
class(CSC_${s1}$), intent(in) :: self
- ${t1}$, intent(out) :: val
+ ${t1}$ :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
+ if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
+ val = ieee_value( 0._${k1}$ , ieee_quiet_nan)
+ return
+ end if
do k = self%colptr(jk), self%colptr(jk+1)-1
if( ik == self%row(k) ) then
val = self%data(k)
@@ -367,7 +380,7 @@ contains
end if
end do
val = zero_${s1}$
- end subroutine
+ end function
subroutine set_value_csc_${s1}$(self,val,ik,jk)
class(CSC_${s1}$), intent(inout) :: self
@@ -386,12 +399,16 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- pure subroutine get_value_ell_${s1}$(self,val,ik,jk)
+ pure function get_value_ell_${s1}$(self,ik,jk) result(val)
class(ELL_${s1}$), intent(in) :: self
- ${t1}$, intent(out) :: val
+ ${t1}$ :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
+ if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
+ val = ieee_value( 0._${k1}$ , ieee_quiet_nan)
+ return
+ end if
do k = 1 , self%K
if( jk == self%index(ik,k) ) then
val = self%data(ik,k)
@@ -399,7 +416,7 @@ contains
end if
end do
val = zero_${s1}$
- end subroutine
+ end function
subroutine set_value_ell_${s1}$(self,val,ik,jk)
class(ELL_${s1}$), intent(inout) :: self
From da9f1714df743d4f82f3259e00f56c4761c8a18c Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Wed, 19 Jun 2024 21:42:34 +0200
Subject: [PATCH 34/78] change is ordered by is_sorted
---
src/stdlib_sparse_conversion.fypp | 6 +++---
src/stdlib_sparse_kinds.fypp | 2 +-
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 72eee8b51..f3431bdbf 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -99,7 +99,7 @@ contains
idx = idx + 1
end do
end do
- COO%isOrdered = .true.
+ COO%is_sorted = .true.
end subroutine
#:endfor
@@ -419,7 +419,7 @@ contains
integer, allocatable :: itemp(:,:)
logical :: sort_data_
- if(COO%isOrdered) return
+ if(COO%is_sorted) return
sort_data_ = .false.
if(present(sort_data)) sort_data_ = sort_data
@@ -446,7 +446,7 @@ contains
allocate( itemp(2,COO%nnz) , source=COO%index(1:2,1:COO%nnz) )
call move_alloc( itemp , COO%index )
- COO%isOrdered = .true.
+ COO%is_sorted = .true.
end subroutine
end module stdlib_sparse_conversion
\ No newline at end of file
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 0e271d0d4..759bcc27f 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -42,7 +42,7 @@ module stdlib_sparse_kinds
!> COO: COOrdinates compresed format
type, public, extends(sparse_type) :: COO_type
- logical :: isOrdered = .false. !> wether the matrix is ordered or not
+ logical :: is_sorted = .false. !> wether the matrix is ordered or not
integer, allocatable :: index(:,:) !> Matrix coordinates index(2,nnz)
contains
procedure :: malloc => malloc_coo
From 1cbb982b0811b17dc6de7953cb818d4d032f4fff Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Wed, 19 Jun 2024 21:48:14 +0200
Subject: [PATCH 35/78] remove unused base attribute
---
doc/specs/stdlib_sparse.md | 1 -
src/stdlib_sparse_kinds.fypp | 1 -
2 files changed, 2 deletions(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 092cc8be8..e888ec1bf 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -27,7 +27,6 @@ type, public, abstract :: sparse_type
integer :: ncols !> number of columns
integer :: nnz !> number of non-zero values
integer :: storage !> assumed storage symmetry
- integer :: base !> index base = 0 for (C) or 1 (Fortran)
end type
```
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 759bcc27f..8d8ce7eb5 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -37,7 +37,6 @@ module stdlib_sparse_kinds
integer :: ncols = 0 !> number of columns
integer :: nnz = 0 !> number of non-zero values
integer :: storage = sparse_full !> assumed storage symmetry
- integer :: base = 1 !> index base = 0 for (C) or 1 (Fortran)
end type
!> COO: COOrdinates compresed format
From a3c155a4021f0070f7622886169908d80db92319 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Thu, 20 Jun 2024 21:16:32 +0200
Subject: [PATCH 36/78] forgotten base attribute
---
src/stdlib_sparse_conversion.fypp | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index f3431bdbf..d089e7f87 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -125,7 +125,7 @@ contains
integer :: i
CSR%nnz = COO%nnz; CSR%nrows = COO%nrows; CSR%ncols = COO%ncols
- CSR%base = COO%base; CSR%storage = COO%storage
+ CSR%storage = COO%storage
if( allocated(CSR%col) ) then
CSR%col(1:COO%nnz) = COO%index(2,1:COO%nnz)
@@ -155,7 +155,7 @@ contains
integer :: i, j
COO%nnz = CSR%nnz; COO%nrows = CSR%nrows; COO%ncols = CSR%ncols
- COO%base = CSR%base; COO%storage = CSR%storage
+ COO%storage = CSR%storage
if( .not.allocated(COO%data) ) then
allocate( COO%data(CSR%nnz) , source = CSR%data(1:CSR%nnz) )
@@ -187,7 +187,7 @@ contains
if(present(chunk)) SELLC%chunk_size = chunk
SELLC%nrows = CSR%nrows; SELLC%ncols = CSR%ncols
- SELLC%base = CSR%base; SELLC%storage = CSR%storage
+ SELLC%storage = CSR%storage
associate( nrows=>SELLC%nrows, ncols=>SELLC%ncols, nnz=>SELLC%nnz, &
& chunk_size=>SELLC%chunk_size )
!-------------------------------------------
From 2fb4e83c3835c4a2ef67c15dc0a6a7112c132c59 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Fri, 21 Jun 2024 20:09:38 +0200
Subject: [PATCH 37/78] make set/get non_overridable
---
src/stdlib_sparse_kinds.fypp | 36 ++++++++++++++++--------------------
1 file changed, 16 insertions(+), 20 deletions(-)
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 8d8ce7eb5..ea47f181f 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -51,8 +51,8 @@ module stdlib_sparse_kinds
type, public, extends(COO_type) :: COO_${s1}$
${t1}$, allocatable :: data(:)
contains
- procedure :: get => get_value_coo_${s1}$
- procedure :: set => set_value_coo_${s1}$
+ procedure, non_overridable :: get => get_value_coo_${s1}$
+ procedure, non_overridable :: set => set_value_coo_${s1}$
end type
#:endfor
@@ -68,8 +68,8 @@ module stdlib_sparse_kinds
type, public, extends(CSR_type) :: CSR_${s1}$
${t1}$, allocatable :: data(:)
contains
- procedure :: get => get_value_csr_${s1}$
- procedure :: set => set_value_csr_${s1}$
+ procedure, non_overridable :: get => get_value_csr_${s1}$
+ procedure, non_overridable :: set => set_value_csr_${s1}$
end type
#:endfor
@@ -85,8 +85,8 @@ module stdlib_sparse_kinds
type, public, extends(CSC_type) :: CSC_${s1}$
${t1}$, allocatable :: data(:)
contains
- procedure :: get => get_value_csc_${s1}$
- procedure :: set => set_value_csc_${s1}$
+ procedure, non_overridable :: get => get_value_csc_${s1}$
+ procedure, non_overridable :: set => set_value_csc_${s1}$
end type
#:endfor
@@ -102,8 +102,8 @@ module stdlib_sparse_kinds
type, public, extends(ELL_type) :: ELL_${s1}$
${t1}$, allocatable :: data(:,:)
contains
- procedure :: get => get_value_ell_${s1}$
- procedure :: set => set_value_ell_${s1}$
+ procedure, non_overridable :: get => get_value_ell_${s1}$
+ procedure, non_overridable :: set => set_value_ell_${s1}$
end type
#:endfor
@@ -290,9 +290,8 @@ contains
!==================================================================
#:for k1, t1, s1 in (KINDS_TYPES)
- pure function get_value_coo_${s1}$(self,ik,jk) result(val)
+ pure ${t1}$ function get_value_coo_${s1}$(self,ik,jk) result(val)
class(COO_${s1}$), intent(in) :: self
- ${t1}$ :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
@@ -309,7 +308,7 @@ contains
val = zero_${s1}$
end function
- subroutine set_value_coo_${s1}$(self,val,ik,jk)
+ subroutine set_value_coo_${s1}$(self,ik,jk,val)
class(COO_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
@@ -326,9 +325,8 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- pure function get_value_csr_${s1}$(self,ik,jk) result(val)
+ pure ${t1}$ function get_value_csr_${s1}$(self,ik,jk) result(val)
class(CSR_${s1}$), intent(in) :: self
- ${t1}$ :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
@@ -345,7 +343,7 @@ contains
val = zero_${s1}$
end function
- subroutine set_value_csr_${s1}$(self,val,ik,jk)
+ subroutine set_value_csr_${s1}$(self,ik,jk,val)
class(CSR_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
@@ -362,9 +360,8 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- pure function get_value_csc_${s1}$(self,ik,jk) result(val)
+ pure ${t1}$ function get_value_csc_${s1}$(self,ik,jk) result(val)
class(CSC_${s1}$), intent(in) :: self
- ${t1}$ :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
@@ -381,7 +378,7 @@ contains
val = zero_${s1}$
end function
- subroutine set_value_csc_${s1}$(self,val,ik,jk)
+ subroutine set_value_csc_${s1}$(self,ik,jk,val)
class(CSC_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
@@ -398,9 +395,8 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- pure function get_value_ell_${s1}$(self,ik,jk) result(val)
+ pure ${t1}$ function get_value_ell_${s1}$(self,ik,jk) result(val)
class(ELL_${s1}$), intent(in) :: self
- ${t1}$ :: val
integer, intent(in) :: ik, jk
integer :: k
! naive implementation
@@ -417,7 +413,7 @@ contains
val = zero_${s1}$
end function
- subroutine set_value_ell_${s1}$(self,val,ik,jk)
+ subroutine set_value_ell_${s1}$(self,ik,jk,val)
class(ELL_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
From e78c0269f26327f40478b8ca0550502eff27e67c Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sun, 23 Jun 2024 15:58:53 +0200
Subject: [PATCH 38/78] replace quicksort 1D by stdlib sort
---
src/stdlib_sparse_conversion.fypp | 28 ++--------------------------
1 file changed, 2 insertions(+), 26 deletions(-)
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index d089e7f87..8e87bb801 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -8,6 +8,7 @@
module stdlib_sparse_conversion
use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
use stdlib_sparse_kinds
+ use stdlib_sorting, only: sort
implicit none
private
@@ -240,31 +241,6 @@ contains
#:endfor
- recursive subroutine quicksort_i(a, first, last)
- ! ref: https://gist.github.com/t-nissie/479f0f16966925fa29ea
- integer, intent(inout) :: a(*)
- integer, intent(in) :: first, last
- integer :: i, j, x, t
-
- x = a( (first+last) / 2 )
- i = first
- j = last
- do
- do while (a(i) < x)
- i=i+1
- end do
- do while (x < a(j))
- j=j-1
- end do
- if (i >= j) exit
- t = a(i); a(i) = a(j); a(j) = t
- i=i+1
- j=j-1
- end do
- if (first < i-1) call quicksort_i(a, first, i-1)
- if (j+1 < last) call quicksort_i(a, j+1, last)
- end subroutine
-
#:for k1, t1, s1 in (KINDS_TYPES)
recursive subroutine quicksort_i_${s1}$(a, b, first, last)
integer, parameter :: wp = sp
@@ -331,7 +307,7 @@ contains
adr0 = count_i_aux(n_i-1)+1
adr1 = count_i_aux(n_i)
dd = adr1-adr0+1
- if(dd>0) call quicksort_i(cols_(adr0),1,dd)
+ if(dd>0) call sort(cols_(adr0:adr1))
end do
!---------------------------------------------------------
! Remove duplicates
From f25e07ddd5fb982a03c49abaf8c05f74511ed6fe Mon Sep 17 00:00:00 2001
From: Jose Alves <jose.alves@transvalor.com>
Date: Thu, 27 Jun 2024 15:47:36 +0200
Subject: [PATCH 39/78] Setter procedure name change to 'add' covering scalar
and array data
---
src/stdlib_sparse_kinds.fypp | 150 +++++++++++++++++++++++++++++------
1 file changed, 125 insertions(+), 25 deletions(-)
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index ea47f181f..b28c255a0 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -41,7 +41,7 @@ module stdlib_sparse_kinds
!> COO: COOrdinates compresed format
type, public, extends(sparse_type) :: COO_type
- logical :: is_sorted = .false. !> wether the matrix is ordered or not
+ logical :: is_sorted = .false. !> whether the matrix is sorted or not
integer, allocatable :: index(:,:) !> Matrix coordinates index(2,nnz)
contains
procedure :: malloc => malloc_coo
@@ -52,7 +52,9 @@ module stdlib_sparse_kinds
${t1}$, allocatable :: data(:)
contains
procedure, non_overridable :: get => get_value_coo_${s1}$
- procedure, non_overridable :: set => set_value_coo_${s1}$
+ procedure, non_overridable :: add_value => add_value_coo_${s1}$
+ procedure, non_overridable :: add_block => add_block_coo_${s1}$
+ generic :: add => add_value, add_block
end type
#:endfor
@@ -69,7 +71,9 @@ module stdlib_sparse_kinds
${t1}$, allocatable :: data(:)
contains
procedure, non_overridable :: get => get_value_csr_${s1}$
- procedure, non_overridable :: set => set_value_csr_${s1}$
+ procedure, non_overridable :: add_value => add_value_csr_${s1}$
+ procedure, non_overridable :: add_block => add_block_csr_${s1}$
+ generic :: add => add_value, add_block
end type
#:endfor
@@ -86,7 +90,9 @@ module stdlib_sparse_kinds
${t1}$, allocatable :: data(:)
contains
procedure, non_overridable :: get => get_value_csc_${s1}$
- procedure, non_overridable :: set => set_value_csc_${s1}$
+ procedure, non_overridable :: add_value => add_value_csc_${s1}$
+ procedure, non_overridable :: add_block => add_block_csc_${s1}$
+ generic :: add => add_value, add_block
end type
#:endfor
@@ -103,7 +109,9 @@ module stdlib_sparse_kinds
${t1}$, allocatable :: data(:,:)
contains
procedure, non_overridable :: get => get_value_ell_${s1}$
- procedure, non_overridable :: set => set_value_ell_${s1}$
+ procedure, non_overridable :: add_value => add_value_ell_${s1}$
+ procedure, non_overridable :: add_block => add_block_ell_${s1}$
+ generic :: add => add_value, add_block
end type
#:endfor
@@ -293,14 +301,20 @@ contains
pure ${t1}$ function get_value_coo_${s1}$(self,ik,jk) result(val)
class(COO_${s1}$), intent(in) :: self
integer, intent(in) :: ik, jk
- integer :: k
+ integer :: k, ik_, jk_
+ logical :: transpose
! naive implementation
if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
val = ieee_value( 0._${k1}$ , ieee_quiet_nan)
return
end if
- do k = 1,self%nnz
- if( ik == self%index(1,k) .and. jk == self%index(2,k) ) then
+ ik_ = ik; jk_ = jk
+ transpose = (self%storage == sparse_lower .and. ik > jk) .or. (self%storage == sparse_upper .and. ik < jk)
+ if(transpose) then ! allow extraction of symmetric elements
+ ik_ = jk; jk_ = ik
+ end if
+ do k = 1, self%nnz
+ if( ik_ == self%index(1,k) .and. jk_ == self%index(2,k) ) then
val = self%data(k)
return
end if
@@ -308,7 +322,7 @@ contains
val = zero_${s1}$
end function
- subroutine set_value_coo_${s1}$(self,ik,jk,val)
+ subroutine add_value_coo_${s1}$(self,ik,jk,val)
class(COO_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
@@ -316,26 +330,49 @@ contains
! naive implementation
do k = 1,self%nnz
if( ik == self%index(1,k) .and. jk == self%index(2,k) ) then
- self%data(k) = val
+ self%data(k) = self%data(k) + val
return
end if
end do
end subroutine
+ subroutine add_block_coo_${s1}$(self,ik,jk,val)
+ class(COO_${s1}$), intent(inout) :: self
+ ${t1}$, intent(in) :: val(:,:)
+ integer, intent(in) :: ik(:), jk(:)
+ integer :: k, i, j
+ ! naive implementation
+ do k = 1, self%nnz
+ do i = 1, size(ik)
+ if( ik(i) /= self%index(1,k) ) cycle
+ do j = 1, size(jk)
+ if( jk(j) /= self%index(2,k) ) cycle
+ self%data(k) = self%data(k) + val(i,j)
+ end do
+ end do
+ end do
+ end subroutine
+
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function get_value_csr_${s1}$(self,ik,jk) result(val)
class(CSR_${s1}$), intent(in) :: self
integer, intent(in) :: ik, jk
- integer :: k
+ integer :: k, ik_, jk_
+ logical :: transpose
! naive implementation
if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
val = ieee_value( 0._${k1}$ , ieee_quiet_nan)
return
end if
- do k = self%rowptr(ik), self%rowptr(ik+1)-1
- if( jk == self%col(k) ) then
+ ik_ = ik; jk_ = jk
+ transpose = (self%storage == sparse_lower .and. ik > jk) .or. (self%storage == sparse_upper .and. ik < jk)
+ if(transpose) then ! allow extraction of symmetric elements
+ ik_ = jk; jk_ = ik
+ end if
+ do k = self%rowptr(ik_), self%rowptr(ik_+1)-1
+ if( jk_ == self%col(k) ) then
val = self%data(k)
return
end if
@@ -343,7 +380,7 @@ contains
val = zero_${s1}$
end function
- subroutine set_value_csr_${s1}$(self,ik,jk,val)
+ subroutine add_value_csr_${s1}$(self,ik,jk,val)
class(CSR_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
@@ -351,26 +388,49 @@ contains
! naive implementation
do k = self%rowptr(ik), self%rowptr(ik+1)-1
if( jk == self%col(k) ) then
- self%data(k) = val
+ self%data(k) = self%data(k) + val
return
end if
end do
end subroutine
+ subroutine add_block_csr_${s1}$(self,ik,jk,val)
+ class(CSR_${s1}$), intent(inout) :: self
+ ${t1}$, intent(in) :: val(:,:)
+ integer, intent(in) :: ik(:), jk(:)
+ integer :: k, i, j
+ ! naive implementation
+ do i = 1, size(ik)
+ do k = self%rowptr(ik(i)), self%rowptr(ik(i)+1)-1
+ do j = 1, size(jk)
+ if( jk(j) == self%col(k) ) then
+ self%data(k) = self%data(k) + val(i,j)
+ end if
+ end do
+ end do
+ end do
+ end subroutine
+
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function get_value_csc_${s1}$(self,ik,jk) result(val)
class(CSC_${s1}$), intent(in) :: self
integer, intent(in) :: ik, jk
- integer :: k
+ integer :: k, ik_, jk_
+ logical :: transpose
! naive implementation
if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
val = ieee_value( 0._${k1}$ , ieee_quiet_nan)
return
end if
- do k = self%colptr(jk), self%colptr(jk+1)-1
- if( ik == self%row(k) ) then
+ ik_ = ik; jk_ = jk
+ transpose = (self%storage == sparse_lower .and. ik > jk) .or. (self%storage == sparse_upper .and. ik < jk)
+ if(transpose) then ! allow extraction of symmetric elements
+ ik_ = jk; jk_ = ik
+ end if
+ do k = self%colptr(jk_), self%colptr(jk_+1)-1
+ if( ik_ == self%row(k) ) then
val = self%data(k)
return
end if
@@ -378,7 +438,7 @@ contains
val = zero_${s1}$
end function
- subroutine set_value_csc_${s1}$(self,ik,jk,val)
+ subroutine add_value_csc_${s1}$(self,ik,jk,val)
class(CSC_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
@@ -386,34 +446,57 @@ contains
! naive implementation
do k = self%colptr(jk), self%colptr(jk+1)-1
if( ik == self%row(k) ) then
- self%data(k) = val
+ self%data(k) = self%data(k) + val
return
end if
end do
end subroutine
+ subroutine add_block_csc_${s1}$(self,ik,jk,val)
+ class(CSC_${s1}$), intent(inout) :: self
+ ${t1}$, intent(in) :: val(:,:)
+ integer, intent(in) :: ik(:), jk(:)
+ integer :: k, i, j
+ ! naive implementation
+ do j = 1, size(jk)
+ do k = self%colptr(jk(j)), self%colptr(jk(j)+1)-1
+ do i = 1, size(ik)
+ if( ik(i) == self%row(k) ) then
+ self%data(k) = self%data(k) + val(i,j)
+ end if
+ end do
+ end do
+ end do
+ end subroutine
+
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function get_value_ell_${s1}$(self,ik,jk) result(val)
class(ELL_${s1}$), intent(in) :: self
integer, intent(in) :: ik, jk
- integer :: k
+ integer :: k, ik_, jk_
+ logical :: transpose
! naive implementation
if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
val = ieee_value( 0._${k1}$ , ieee_quiet_nan)
return
end if
+ ik_ = ik; jk_ = jk
+ transpose = (self%storage == sparse_lower .and. ik > jk) .or. (self%storage == sparse_upper .and. ik < jk)
+ if(transpose) then ! allow extraction of symmetric elements
+ ik_ = jk; jk_ = ik
+ end if
do k = 1 , self%K
- if( jk == self%index(ik,k) ) then
- val = self%data(ik,k)
+ if( jk_ == self%index(ik_,k) ) then
+ val = self%data(ik_,k)
return
end if
end do
val = zero_${s1}$
end function
- subroutine set_value_ell_${s1}$(self,ik,jk,val)
+ subroutine add_value_ell_${s1}$(self,ik,jk,val)
class(ELL_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
integer, intent(in) :: ik, jk
@@ -421,12 +504,29 @@ contains
! naive implementation
do k = 1 , self%K
if( jk == self%index(ik,k) ) then
- self%data(ik,k) = val
+ self%data(ik,k) = self%data(ik,k) + val
return
end if
end do
end subroutine
+ subroutine add_block_ell_${s1}$(self,ik,jk,val)
+ class(ELL_${s1}$), intent(inout) :: self
+ ${t1}$, intent(in) :: val(:,:)
+ integer, intent(in) :: ik(:), jk(:)
+ integer :: k, i, j
+ ! naive implementation
+ do k = 1 , self%K
+ do j = 1, size(jk)
+ do i = 1, size(ik)
+ if( jk(j) == self%index(ik(i),k) ) then
+ self%data(ik(i),k) = self%data(ik(i),k) + val(i,j)
+ end if
+ end do
+ end do
+ end do
+ end subroutine
+
#:endfor
end module stdlib_sparse_kinds
\ No newline at end of file
From c7035c90a23e96aa6e4554403b8d94a0cc77059b Mon Sep 17 00:00:00 2001
From: Jose Alves <jose.alves@transvalor.com>
Date: Fri, 28 Jun 2024 00:02:43 +0200
Subject: [PATCH 40/78] add sparse test for add or getting values
---
test/linalg/test_sparse_spmv.fypp | 47 ++++++++++++++++++++++++++++++-
1 file changed, 46 insertions(+), 1 deletion(-)
diff --git a/test/linalg/test_sparse_spmv.fypp b/test/linalg/test_sparse_spmv.fypp
index deda95fec..a3092229c 100644
--- a/test/linalg/test_sparse_spmv.fypp
+++ b/test/linalg/test_sparse_spmv.fypp
@@ -23,7 +23,8 @@ contains
new_unittest('csc', test_csc), &
new_unittest('ell', test_ell), &
new_unittest('sellc', test_sellc), &
- new_unittest('symmetries', test_symmetries) &
+ new_unittest('symmetries', test_symmetries), &
+ new_unittest('add_get_values', test_add_get_values) &
]
end subroutine
@@ -260,6 +261,50 @@ contains
#:endfor
end subroutine
+ subroutine test_add_get_values(error)
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ block
+ integer, parameter :: wp = ${k1}$
+ real(wp) :: dense(5,5), mat(2,2)
+ type(COO_${s1}$) :: COO
+ type(CSR_${s1}$) :: CSR
+ ${t1}$:: err
+ integer :: i, j, locdof(2)
+
+ mat(:,1) = [1,2]; mat(:,2) = [2,1]
+ dense = 0._wp
+ do i = 0, 3
+ dense(1+i:2+i,1+i:2+i) = dense(1+i:2+i,1+i:2+i) + mat
+ end do
+
+ call dense2coo(dense,COO)
+ call coo2csr(COO,CSR)
+
+ CSR%data = 0._wp
+
+ do i = 0, 3
+ locdof(1:2) = [1+i,2+i]
+ call CSR%add(locdof,locdof,mat)
+ end do
+
+ call check(error, all(CSR%data == COO%data) )
+ if (allocated(error)) return
+
+ do i = 1, 5
+ do j = 1, 5
+ err = err + abs(dense(i,j) - CSR%get(i,j))
+ end do
+ end do
+ err = err / 5*5
+
+ call check(error, err <= epsilon(0._wp) )
+ if (allocated(error)) return
+ end block
+ #:endfor
+ end subroutine
+
end module
From 82950e00218f509ca0e2eb5c3e494073aaab5aa9 Mon Sep 17 00:00:00 2001
From: Jose Alves <jose.alves@transvalor.com>
Date: Fri, 28 Jun 2024 00:17:42 +0200
Subject: [PATCH 41/78] change name of value retrival function to at
---
src/stdlib_sparse_kinds.fypp | 16 ++++++++--------
test/linalg/test_sparse_spmv.fypp | 3 ++-
2 files changed, 10 insertions(+), 9 deletions(-)
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index b28c255a0..fd04ea410 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -51,7 +51,7 @@ module stdlib_sparse_kinds
type, public, extends(COO_type) :: COO_${s1}$
${t1}$, allocatable :: data(:)
contains
- procedure, non_overridable :: get => get_value_coo_${s1}$
+ procedure, non_overridable :: at => at_value_coo_${s1}$
procedure, non_overridable :: add_value => add_value_coo_${s1}$
procedure, non_overridable :: add_block => add_block_coo_${s1}$
generic :: add => add_value, add_block
@@ -70,7 +70,7 @@ module stdlib_sparse_kinds
type, public, extends(CSR_type) :: CSR_${s1}$
${t1}$, allocatable :: data(:)
contains
- procedure, non_overridable :: get => get_value_csr_${s1}$
+ procedure, non_overridable :: at => at_value_csr_${s1}$
procedure, non_overridable :: add_value => add_value_csr_${s1}$
procedure, non_overridable :: add_block => add_block_csr_${s1}$
generic :: add => add_value, add_block
@@ -89,7 +89,7 @@ module stdlib_sparse_kinds
type, public, extends(CSC_type) :: CSC_${s1}$
${t1}$, allocatable :: data(:)
contains
- procedure, non_overridable :: get => get_value_csc_${s1}$
+ procedure, non_overridable :: at => at_value_csc_${s1}$
procedure, non_overridable :: add_value => add_value_csc_${s1}$
procedure, non_overridable :: add_block => add_block_csc_${s1}$
generic :: add => add_value, add_block
@@ -108,7 +108,7 @@ module stdlib_sparse_kinds
type, public, extends(ELL_type) :: ELL_${s1}$
${t1}$, allocatable :: data(:,:)
contains
- procedure, non_overridable :: get => get_value_ell_${s1}$
+ procedure, non_overridable :: at => at_value_ell_${s1}$
procedure, non_overridable :: add_value => add_value_ell_${s1}$
procedure, non_overridable :: add_block => add_block_ell_${s1}$
generic :: add => add_value, add_block
@@ -298,7 +298,7 @@ contains
!==================================================================
#:for k1, t1, s1 in (KINDS_TYPES)
- pure ${t1}$ function get_value_coo_${s1}$(self,ik,jk) result(val)
+ pure ${t1}$ function at_value_coo_${s1}$(self,ik,jk) result(val)
class(COO_${s1}$), intent(in) :: self
integer, intent(in) :: ik, jk
integer :: k, ik_, jk_
@@ -356,7 +356,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- pure ${t1}$ function get_value_csr_${s1}$(self,ik,jk) result(val)
+ pure ${t1}$ function at_value_csr_${s1}$(self,ik,jk) result(val)
class(CSR_${s1}$), intent(in) :: self
integer, intent(in) :: ik, jk
integer :: k, ik_, jk_
@@ -414,7 +414,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- pure ${t1}$ function get_value_csc_${s1}$(self,ik,jk) result(val)
+ pure ${t1}$ function at_value_csc_${s1}$(self,ik,jk) result(val)
class(CSC_${s1}$), intent(in) :: self
integer, intent(in) :: ik, jk
integer :: k, ik_, jk_
@@ -472,7 +472,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- pure ${t1}$ function get_value_ell_${s1}$(self,ik,jk) result(val)
+ pure ${t1}$ function at_value_ell_${s1}$(self,ik,jk) result(val)
class(ELL_${s1}$), intent(in) :: self
integer, intent(in) :: ik, jk
integer :: k, ik_, jk_
diff --git a/test/linalg/test_sparse_spmv.fypp b/test/linalg/test_sparse_spmv.fypp
index a3092229c..82a6471e6 100644
--- a/test/linalg/test_sparse_spmv.fypp
+++ b/test/linalg/test_sparse_spmv.fypp
@@ -292,9 +292,10 @@ contains
call check(error, all(CSR%data == COO%data) )
if (allocated(error)) return
+ err = 0._wp
do i = 1, 5
do j = 1, 5
- err = err + abs(dense(i,j) - CSR%get(i,j))
+ err = err + abs(dense(i,j) - CSR%at(i,j))
end do
end do
err = err / 5*5
From 93c1e55411724adb3da9770555288bf1095419ec Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Fri, 28 Jun 2024 23:19:26 +0200
Subject: [PATCH 42/78] sellc add/at
---
src/stdlib_sparse_conversion.fypp | 1 -
src/stdlib_sparse_kinds.fypp | 69 ++++++++++++++++++++++++++++++-
2 files changed, 68 insertions(+), 2 deletions(-)
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 8e87bb801..6686d7fbb 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -328,7 +328,6 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
subroutine sort_coo_unique_${s1}$( a, data, n, num_rows, num_cols )
!! Sort a 2d array in increasing order first by index 1 and then by index 2
- integer, parameter :: wp = ${k1}$
${t1}$, intent(inout) :: data(*)
integer, intent(inout) :: a(2,*)
integer, intent(inout) :: n
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index fd04ea410..9be4df0a6 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -125,7 +125,12 @@ module stdlib_sparse_kinds
#:for k1, t1, s1 in (KINDS_TYPES)
type, public, extends(SELLC_type) :: SELLC_${s1}$
- ${t1}$, allocatable :: data(:,:)
+ ${t1}$, allocatable :: data(:,:)
+ contains
+ procedure, non_overridable :: at => at_value_sellc_${s1}$
+ procedure, non_overridable :: add_value => add_value_sellc_${s1}$
+ procedure, non_overridable :: add_block => add_block_sellc_${s1}$
+ generic :: add => add_value, add_block
end type
#:endfor
@@ -528,5 +533,67 @@ contains
end subroutine
#:endfor
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ pure ${t1}$ function at_value_sellc_${s1}$(self,ik,jk) result(val)
+ class(SELLC_${s1}$), intent(in) :: self
+ integer, intent(in) :: ik, jk
+ integer :: k, ik_, jk_, idx
+ logical :: transpose
+ ! naive implementation
+ if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
+ val = ieee_value( 0._${k1}$ , ieee_quiet_nan)
+ return
+ end if
+ ik_ = ik; jk_ = jk
+ transpose = (self%storage == sparse_lower .and. ik > jk) .or. (self%storage == sparse_upper .and. ik < jk)
+ if(transpose) then ! allow extraction of symmetric elements
+ ik_ = jk; jk_ = ik
+ end if
+
+ idx = self%rowptr((ik_ - 1)/self%chunk_size + 1)
+ do k = 1, self%chunk_size
+ if ( jk_ == self%col(k,idx) )then
+ val = self%data(k,idx)
+ return
+ endif
+ end do
+ val = zero_${s1}$
+ end function
+
+ subroutine add_value_sellc_${s1}$(self,ik,jk,val)
+ class(SELLC_${s1}$), intent(inout) :: self
+ ${t1}$, intent(in) :: val
+ integer, intent(in) :: ik, jk
+ integer :: k, idx
+ ! naive implementation
+ idx = self%rowptr((ik - 1)/self%chunk_size + 1)
+ do k = 1, self%chunk_size
+ if ( jk == self%col(k,idx) )then
+ self%data(k,idx) = self%data(k,idx) + val
+ return
+ endif
+ end do
+ end subroutine
+
+ subroutine add_block_sellc_${s1}$(self,ik,jk,val)
+ class(SELLC_${s1}$), intent(inout) :: self
+ ${t1}$, intent(in) :: val(:,:)
+ integer, intent(in) :: ik(:), jk(:)
+ integer :: k, i, j, idx
+ ! naive implementation
+ do k = 1 , self%chunk_size
+ do j = 1, size(jk)
+ do i = 1, size(ik)
+ idx = self%rowptr((ik(i) - 1)/self%chunk_size + 1)
+ if( jk(j) == self%col(k,idx) ) then
+ self%data(k,idx) = self%data(k,idx) + val(i,j)
+ end if
+ end do
+ end do
+ end do
+ end subroutine
+
+ #:endfor
end module stdlib_sparse_kinds
\ No newline at end of file
From c1f30f66aa2c2e76c0dc036558994e5a73a7fcce Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 29 Jun 2024 13:09:30 +0200
Subject: [PATCH 43/78] refactoring to enable a from_ijv initialization
interface
---
doc/specs/stdlib_sparse.md | 19 ++++
src/stdlib_sparse.f90 | 1 -
src/stdlib_sparse_conversion.fypp | 77 ++--------------
src/stdlib_sparse_kinds.fypp | 148 +++++++++++++++++++++++++++++-
test/linalg/test_sparse_spmv.fypp | 22 ++---
5 files changed, 183 insertions(+), 84 deletions(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index e888ec1bf..6b20764a7 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -184,6 +184,25 @@ This module provides facility functions for converting between storage formats.
`sort_data`, `logical(in)`, `optional`:: Shall be an optional `logical` argument to determine whether data in the COO graph should be sorted while sorting the index array, default `.false.`.
+### Syntax
+
+`call ` [[stdlib_sparse_conversion(module):from_ijv(interface)]] `(coo,row,col,data,nrows,ncols)`
+
+### Arguments
+
+`COO`, `intent(inout)`: Shall be any `COO` type. The graph object will be returned with a canonical shape after sorting and removing duplicates from the `(row,col,data)` triplet. If the graph is `COO_type` no data buffer is allowed.
+
+`row`, `integer(in)`:: rows index array.
+
+`col`, `integer(in)`:: columns index array.
+
+`data`, `real/complex(in)`, `optional`:: data array.
+
+`nrows`, `integer(in)`, `optional`:: number of rows, if not given it will be computed from the `row` array.
+
+`ncols`, `integer(in)`, `optional`:: number of columns, if not given it will be computed from the `col` array.
+
+
### Syntax
`call ` [[stdlib_sparse_conversion(module):dense2coo(interface)]] `(dense,coo)`
diff --git a/src/stdlib_sparse.f90 b/src/stdlib_sparse.f90
index 82e5d35de..58e7663d3 100644
--- a/src/stdlib_sparse.f90
+++ b/src/stdlib_sparse.f90
@@ -2,5 +2,4 @@
module stdlib_sparse
use stdlib_sparse_kinds
use stdlib_sparse_spmv
- use stdlib_sparse_conversion
end module stdlib_sparse
\ No newline at end of file
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 6686d7fbb..ea1a5c774 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -5,67 +5,10 @@
!> The `stdlib_sparse_conversion` module provides sparse to sparse matrix conversion utilities.
!>
! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
-module stdlib_sparse_conversion
- use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
- use stdlib_sparse_kinds
+submodule(stdlib_sparse_kinds) stdlib_sparse_conversion
use stdlib_sorting, only: sort
implicit none
- private
- public :: dense2coo, coo2dense, coo2csr, csr2coo
- public :: csr2sellc
- public :: coo2ordered
-
- !> Conversion from dense to coo
- !>
- !> Enables extracting the non-zero elements of a dense 2D matrix and
- !> storing those values in a COO format. The coo matrix is (re)allocated on the fly.
- interface dense2coo
- #:for k1, t1, s1 in (KINDS_TYPES)
- module procedure dense2coo_${s1}$
- #:endfor
- end interface
-
- !> Conversion from coo to dense
- !>
- !> Enables creating a dense 2D matrix from the non-zero values tored in a COO format
- !> The dense matrix can be allocated on the fly if not pre-allocated by the user.
- interface coo2dense
- #:for k1, t1, s1 in (KINDS_TYPES)
- module procedure coo2dense_${s1}$
- #:endfor
- end interface
-
- !> Conversion from coo to csr
- !>
- !> Enables transferring data from a COO matrix to a CSR matrix
- !> under the hypothesis that the COO is already ordered.
- interface coo2csr
- #:for k1, t1, s1 in (KINDS_TYPES)
- module procedure coo2csr_${s1}$
- #:endfor
- end interface
-
- !> Conversion from csr to coo
- !>
- !> Enables transferring data from a CSR matrix to a COO matrix
- !> under the hypothesis that the CSR is already ordered.
- interface csr2coo
- #:for k1, t1, s1 in (KINDS_TYPES)
- module procedure csr2coo_${s1}$
- #:endfor
- end interface
-
- !> Conversion from csr to SELL-C
- !>
- !> Enables transferring data from a CSR matrix to a SELL-C matrix
- !> It takes an optional parameter to decide the chunck size 4, 8 or 16
- interface csr2sellc
- #:for k1, t1, s1 in (KINDS_TYPES)
- module procedure csr2sellc_${s1}$
- #:endfor
- end interface
-
!> Sort arrays of a COO matrix
!>
interface sort_coo
@@ -78,7 +21,7 @@ module stdlib_sparse_conversion
contains
#:for k1, t1, s1 in (KINDS_TYPES)
- subroutine dense2coo_${s1}$(dense,COO)
+ module subroutine dense2coo_${s1}$(dense,COO)
${t1}$, intent(in) :: dense(:,:)
type(COO_${s1}$), intent(inout) :: COO
integer :: num_rows, num_cols, nnz
@@ -106,7 +49,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- subroutine coo2dense_${s1}$(COO,dense)
+ module subroutine coo2dense_${s1}$(COO,dense)
type(COO_${s1}$), intent(in) :: COO
${t1}$, allocatable, intent(inout) :: dense(:,:)
integer :: idx
@@ -120,7 +63,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- subroutine coo2csr_${s1}$(COO,CSR)
+ module subroutine coo2csr_${s1}$(COO,CSR)
type(COO_${s1}$), intent(in) :: COO
type(CSR_${s1}$), intent(inout) :: CSR
integer :: i
@@ -150,7 +93,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- subroutine csr2coo_${s1}$(CSR,COO)
+ module subroutine csr2coo_${s1}$(CSR,COO)
type(CSR_${s1}$), intent(in) :: CSR
type(COO_${s1}$), intent(inout) :: COO
integer :: i, j
@@ -176,7 +119,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
+ module subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
!> csr2sellc: This function enables transfering data from a CSR matrix to a SELL-C matrix
!> This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
type(CSR_${s1}$), intent(in) :: CSR
@@ -326,7 +269,7 @@ contains
end subroutine
#:for k1, t1, s1 in (KINDS_TYPES)
- subroutine sort_coo_unique_${s1}$( a, data, n, num_rows, num_cols )
+ module subroutine sort_coo_unique_${s1}$( a, data, n, num_rows, num_cols )
!! Sort a 2d array in increasing order first by index 1 and then by index 2
${t1}$, intent(inout) :: data(*)
integer, intent(inout) :: a(2,*)
@@ -388,7 +331,7 @@ contains
#:endfor
- subroutine coo2ordered(COO,sort_data)
+ module subroutine coo2ordered(COO,sort_data)
class(COO_type), intent(inout) :: COO
logical, intent(in), optional :: sort_data
integer, allocatable :: itemp(:,:)
@@ -423,5 +366,5 @@ contains
COO%is_sorted = .true.
end subroutine
-
-end module stdlib_sparse_conversion
\ No newline at end of file
+
+end submodule
\ No newline at end of file
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 9be4df0a6..51e1685fd 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -11,7 +11,9 @@ module stdlib_sparse_kinds
implicit none
private
-
+ public :: dense2coo, coo2dense, csr2coo, coo2csr
+ public :: csr2sellc
+ public :: coo2ordered, from_ijv
! -- Global parameters
enum, bind(C)
enumerator :: sparse_full !> Full Sparse matrix (no symmetry considerations)
@@ -134,6 +136,88 @@ module stdlib_sparse_kinds
end type
#:endfor
+ !> Conversion from dense to coo
+ !>
+ !> Enables extracting the non-zero elements of a dense 2D matrix and
+ !> storing those values in a COO format. The coo matrix is (re)allocated on the fly.
+ interface dense2coo
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module subroutine dense2coo_${s1}$(dense,COO)
+ ${t1}$, intent(in) :: dense(:,:)
+ type(COO_${s1}$), intent(inout) :: COO
+ end subroutine
+ #:endfor
+ end interface
+
+ !> Conversion from coo to dense
+ !>
+ !> Enables creating a dense 2D matrix from the non-zero values tored in a COO format
+ !> The dense matrix can be allocated on the fly if not pre-allocated by the user.
+ interface coo2dense
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module subroutine coo2dense_${s1}$(COO,dense)
+ type(COO_${s1}$), intent(in) :: COO
+ ${t1}$, allocatable, intent(inout) :: dense(:,:)
+ end subroutine
+ #:endfor
+ end interface
+
+ !> Conversion from coo to csr
+ !>
+ !> Enables transferring data from a COO matrix to a CSR matrix
+ !> under the hypothesis that the COO is already ordered.
+ interface coo2csr
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module subroutine coo2csr_${s1}$(COO,CSR)
+ type(COO_${s1}$), intent(in) :: COO
+ type(CSR_${s1}$), intent(inout) :: CSR
+ end subroutine
+ #:endfor
+ end interface
+
+ !> Conversion from csr to coo
+ !>
+ !> Enables transferring data from a CSR matrix to a COO matrix
+ !> under the hypothesis that the CSR is already ordered.
+ interface csr2coo
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module subroutine csr2coo_${s1}$(CSR,COO)
+ type(CSR_${s1}$), intent(in) :: CSR
+ type(COO_${s1}$), intent(inout) :: COO
+ end subroutine
+ #:endfor
+ end interface
+
+ !> Conversion from csr to SELL-C
+ !>
+ !> Enables transferring data from a CSR matrix to a SELL-C matrix
+ !> It takes an optional parameter to decide the chunck size 4, 8 or 16
+ interface csr2sellc
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
+ type(CSR_${s1}$), intent(in) :: CSR
+ type(SELLC_${s1}$), intent(inout) :: SELLC
+ integer, intent(in), optional :: chunk
+ end subroutine
+ #:endfor
+ end interface
+
+ !> Transform COO matrix to canonical form with ordered and unique entries
+ interface coo2ordered
+ module subroutine coo2ordered(COO,sort_data)
+ class(COO_type), intent(inout) :: COO
+ logical, intent(in), optional :: sort_data
+ end subroutine
+ end interface
+
+ !> Enable creating a sparse matrix from ijv (row,col,data) triplet
+ interface from_ijv
+ module procedure :: coo_from_ijv_type
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: coo_from_ijv_${s1}$
+ #:endfor
+ end interface
+
contains
!> (re)Allocate matrix memory for the COO type
@@ -298,6 +382,68 @@ contains
end select
end subroutine
+ subroutine coo_from_ijv_type(COO,row,col,nrows,ncols)
+ type(COO_type), intent(inout) :: COO
+ integer, intent(in) :: row(:)
+ integer, intent(in) :: col(:)
+ integer, intent(in), optional :: nrows
+ integer, intent(in), optional :: ncols
+
+ integer :: nrows_, ncols_, nnz, ed
+ !---------------------------------------------------------
+ if(present(nrows)) then
+ nrows_ = nrows
+ else
+ nrows_ = size(row)
+ end if
+ if(present(ncols)) then
+ ncols_ = ncols
+ else
+ ncols_ = size(col)
+ end if
+ nnz = size(row)
+ !---------------------------------------------------------
+ call COO%malloc(nrows_,ncols_,nnz)
+ do ed = 1, nnz
+ COO%index(1:2,ed) = [row(ed),col(ed)]
+ end do
+
+ call coo2ordered(COO,.true.)
+ end subroutine
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine coo_from_ijv_${s1}$(COO,row,col,data,nrows,ncols)
+ type(COO_${s1}$), intent(inout) :: COO
+ integer, intent(in) :: row(:)
+ integer, intent(in) :: col(:)
+ ${t1}$, intent(in), optional :: data(:)
+ integer, intent(in), optional :: nrows
+ integer, intent(in), optional :: ncols
+
+ integer :: nrows_, ncols_, nnz, ed
+ !---------------------------------------------------------
+ if(present(nrows)) then
+ nrows_ = nrows
+ else
+ nrows_ = maxval(row)
+ end if
+ if(present(ncols)) then
+ ncols_ = ncols
+ else
+ ncols_ = maxval(col)
+ end if
+ nnz = size(row)
+ !---------------------------------------------------------
+ call COO%malloc(nrows_,ncols_,nnz)
+ do ed = 1, nnz
+ COO%index(1:2,ed) = [row(ed),col(ed)]
+ end do
+ if(present(data)) COO%data = data
+
+ call coo2ordered(COO,.true.)
+ end subroutine
+ #:endfor
+
!==================================================================
! data accessors
!==================================================================
diff --git a/test/linalg/test_sparse_spmv.fypp b/test/linalg/test_sparse_spmv.fypp
index 82a6471e6..8638ef2cd 100644
--- a/test/linalg/test_sparse_spmv.fypp
+++ b/test/linalg/test_sparse_spmv.fypp
@@ -68,22 +68,14 @@ contains
!> Error handling
type(error_type), allocatable, intent(out) :: error
type(COO_sp) :: COO
+ integer :: row(12), col(12)
+ real :: data(12)
- call COO%malloc(4,4,12)
- COO%data(:) = 1
- COO%index(:,1) = [1,2]
- COO%index(:,2) = [1,3]
- COO%index(:,3) = [1,4]
- COO%index(:,4) = [2,3]
- COO%index(:,5) = [2,4]
- COO%index(:,6) = [3,4]
-
- COO%index(:,7) = [2,3]
- COO%index(:,8) = [2,4]
- COO%index(:,9) = [2,5]
- COO%index(:,10) = [3,4]
- COO%index(:,11) = [3,5]
- COO%index(:,12) = [4,5]
+ row = [1,1,1,2,2,3,2,2,2,3,3,4]
+ col = [2,3,4,3,4,4,3,4,5,4,5,5]
+ data = 1.0
+
+ call from_ijv(COO,row,col,data)
call coo2ordered(COO,sort_data=.true.)
call check(error, COO%nnz < 12 .and. COO%nnz == 9 )
From 4c16f4aa42234ddd428bf2cc403c7aa176a8ca34 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 29 Jun 2024 13:19:22 +0200
Subject: [PATCH 44/78] fix module procedure attribute
---
src/stdlib_sparse_conversion.fypp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index ea1a5c774..5801d5a4d 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -269,7 +269,7 @@ contains
end subroutine
#:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine sort_coo_unique_${s1}$( a, data, n, num_rows, num_cols )
+ subroutine sort_coo_unique_${s1}$( a, data, n, num_rows, num_cols )
!! Sort a 2d array in increasing order first by index 1 and then by index 2
${t1}$, intent(inout) :: data(*)
integer, intent(inout) :: a(2,*)
From 944212da2c0e8f88b8a46ad066d2925bdd6e1b07 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 29 Jun 2024 14:17:58 +0200
Subject: [PATCH 45/78] enable creating CSR, ELL and SELLC using the from_ijv
interface
---
doc/specs/stdlib_sparse.md | 8 +-
src/stdlib_sparse_conversion.fypp | 30 +++++++
src/stdlib_sparse_kinds.fypp | 126 ++++++++++++++++++++++++++++++
3 files changed, 162 insertions(+), 2 deletions(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 6b20764a7..dfa663b2e 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -186,11 +186,11 @@ This module provides facility functions for converting between storage formats.
### Syntax
-`call ` [[stdlib_sparse_conversion(module):from_ijv(interface)]] `(coo,row,col,data,nrows,ncols)`
+`call ` [[stdlib_sparse_conversion(module):from_ijv(interface)]] `(sparse,row,col[,data,nrows,ncols,num_nz_rows,chunk])`
### Arguments
-`COO`, `intent(inout)`: Shall be any `COO` type. The graph object will be returned with a canonical shape after sorting and removing duplicates from the `(row,col,data)` triplet. If the graph is `COO_type` no data buffer is allowed.
+`sparse`, `intent(inout)`: Shall be a `COO`, `CSR`, `ELL` or `SELLC` type. The graph object will be returned with a canonical shape after sorting and removing duplicates from the `(row,col,data)` triplet. If the graph is `COO_type` no data buffer is allowed.
`row`, `integer(in)`:: rows index array.
@@ -202,6 +202,10 @@ This module provides facility functions for converting between storage formats.
`ncols`, `integer(in)`, `optional`:: number of columns, if not given it will be computed from the `col` array.
+`num_nz_rows`, `integer(in)`, `optional`:: number of non zeros per row, only valid in the case of an `ELL` matrix, by default it will computed from the largest row.
+
+`chunk`, `integer(in)`, `optional`:: chunk size, only valid in the case of a `SELLC` matrix, by default it will be taken from the `SELLC` default attribute chunk size.
+
### Syntax
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 5801d5a4d..5b8b017ec 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -118,6 +118,36 @@ contains
#:endfor
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module subroutine csr2ell_${s1}$(CSR,ELL,num_nz_rows)
+ type(CSR_${s1}$), intent(in) :: CSR
+ type(ELL_${s1}$), intent(inout) :: ELL
+ integer, intent(in), optional :: num_nz_rows !> number of non zeros per row
+
+ integer :: i, j, num_nz_rows_, adr1, adr2
+ !-------------------------------------------
+ num_nz_rows_ = 0
+ if(present(num_nz_rows)) then
+ num_nz_rows_ = num_nz_rows
+ else
+ do i = 1, CSR%nrows
+ num_nz_rows_ = max(num_nz_rows_, CSR%rowptr( i+1 ) - CSR%rowptr( i ) )
+ end do
+ end if
+ call ELL%malloc(CSR%nrows,CSR%ncols,num_nz_rows_)
+ !-------------------------------------------
+ do i = 1, CSR%nrows
+ adr1 = CSR%rowptr(i)
+ adr2 = min( adr1+num_nz_rows_ , CSR%rowptr(i+1)-1)
+ do j = adr1, adr2
+ ELL%index(i,j-adr1+1) = CSR%col(j)
+ ELL%data(i,j-adr1+1) = CSR%data(j)
+ end do
+ end do
+ end subroutine
+
+ #:endfor
+
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
!> csr2sellc: This function enables transfering data from a CSR matrix to a SELL-C matrix
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 51e1685fd..103a32314 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -188,6 +188,20 @@ module stdlib_sparse_kinds
#:endfor
end interface
+ !> Conversion from csr to ell
+ !>
+ !> Enables transferring data from a CSR matrix to a ELL matrix
+ !> under the hypothesis that the CSR is already ordered.
+ interface csr2ell
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module subroutine csr2ell_${s1}$(CSR,ELL,num_nz_rows)
+ type(CSR_${s1}$), intent(in) :: CSR
+ type(ELL_${s1}$), intent(inout) :: ELL
+ integer, intent(in), optional :: num_nz_rows
+ end subroutine
+ #:endfor
+ end interface
+
!> Conversion from csr to SELL-C
!>
!> Enables transferring data from a CSR matrix to a SELL-C matrix
@@ -215,6 +229,9 @@ module stdlib_sparse_kinds
module procedure :: coo_from_ijv_type
#:for k1, t1, s1 in (KINDS_TYPES)
module procedure :: coo_from_ijv_${s1}$
+ module procedure :: csr_from_ijv_${s1}$
+ module procedure :: ell_from_ijv_${s1}$
+ module procedure :: sellc_from_ijv_${s1}$
#:endfor
end interface
@@ -444,6 +461,115 @@ contains
end subroutine
#:endfor
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine csr_from_ijv_${s1}$(CSR,row,col,data,nrows,ncols)
+ type(CSR_${s1}$), intent(inout) :: CSR
+ integer, intent(in) :: row(:)
+ integer, intent(in) :: col(:)
+ ${t1}$, intent(in), optional :: data(:)
+ integer, intent(in), optional :: nrows
+ integer, intent(in), optional :: ncols
+
+ integer :: nrows_, ncols_
+ !---------------------------------------------------------
+ if(present(nrows)) then
+ nrows_ = nrows
+ else
+ nrows_ = maxval(row)
+ end if
+ if(present(ncols)) then
+ ncols_ = ncols
+ else
+ ncols_ = maxval(col)
+ end if
+ !---------------------------------------------------------
+ block
+ type(COO_${s1}$) :: COO
+ if(present(data)) then
+ call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
+ else
+ call from_ijv(COO,row,col,nrows=nrows_,ncols=ncols_)
+ end if
+ call coo2csr(COO,CSR)
+ end block
+ end subroutine
+ #:endfor
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine ell_from_ijv_${s1}$(ELL,row,col,data,nrows,ncols,num_nz_rows)
+ type(ELL_${s1}$), intent(inout) :: ELL
+ integer, intent(in) :: row(:)
+ integer, intent(in) :: col(:)
+ ${t1}$, intent(in), optional :: data(:)
+ integer, intent(in), optional :: nrows
+ integer, intent(in), optional :: ncols
+ integer, intent(in), optional :: num_nz_rows
+
+ integer :: nrows_, ncols_, num_nz_rows_
+ !---------------------------------------------------------
+ if(present(nrows)) then
+ nrows_ = nrows
+ else
+ nrows_ = maxval(row)
+ end if
+ if(present(ncols)) then
+ ncols_ = ncols
+ else
+ ncols_ = maxval(col)
+ end if
+ !---------------------------------------------------------
+ block
+ type(COO_${s1}$) :: COO
+ type(CSR_${s1}$) :: CSR
+ if(present(data)) then
+ call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
+ else
+ call from_ijv(COO,row,col,nrows=nrows_,ncols=ncols_)
+ end if
+ call coo2csr(COO,CSR)
+ call csr2ell(CSR,ELL,num_nz_rows_)
+ end block
+ end subroutine
+ #:endfor
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine sellc_from_ijv_${s1}$(SELLC,row,col,data,nrows,ncols,chunk)
+ type(SELLC_${s1}$), intent(inout) :: SELLC
+ integer, intent(in) :: row(:)
+ integer, intent(in) :: col(:)
+ ${t1}$, intent(in), optional :: data(:)
+ integer, intent(in), optional :: nrows
+ integer, intent(in), optional :: ncols
+ integer, intent(in), optional :: chunk
+
+ integer :: nrows_, ncols_
+ !---------------------------------------------------------
+ if(present(nrows)) then
+ nrows_ = nrows
+ else
+ nrows_ = maxval(row)
+ end if
+ if(present(ncols)) then
+ ncols_ = ncols
+ else
+ ncols_ = maxval(col)
+ end if
+ if(present(chunk)) SELLC%chunk_size = chunk
+ !---------------------------------------------------------
+ block
+ type(COO_${s1}$) :: COO
+ type(CSR_${s1}$) :: CSR
+ if(present(data)) then
+ call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
+ else
+ call from_ijv(COO,row,col,nrows=nrows_,ncols=ncols_)
+ end if
+ call coo2csr(COO,CSR)
+ call csr2sellc(CSR,SELLC)
+ end block
+ end subroutine
+ #:endfor
+
!==================================================================
! data accessors
!==================================================================
From dd4dbd8f02a542f129ba184d40d5dd5b0d28b79a Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 29 Jun 2024 18:17:25 +0200
Subject: [PATCH 46/78] add example from_ijv
---
doc/specs/stdlib_sparse.md | 4 +++
example/linalg/CMakeLists.txt | 1 +
example/linalg/example_sparse_from_ijv.f90 | 42 ++++++++++++++++++++++
example/linalg/example_sparse_spmv.f90 | 4 +--
src/stdlib_sparse_kinds.fypp | 8 +++--
5 files changed, 54 insertions(+), 5 deletions(-)
create mode 100644 example/linalg/example_sparse_from_ijv.f90
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index dfa663b2e..845e64924 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -206,6 +206,10 @@ This module provides facility functions for converting between storage formats.
`chunk`, `integer(in)`, `optional`:: chunk size, only valid in the case of a `SELLC` matrix, by default it will be taken from the `SELLC` default attribute chunk size.
+## Example
+```fortran
+{!example/linalg/example_sparse_from_ijv.f90!}
+```
### Syntax
diff --git a/example/linalg/CMakeLists.txt b/example/linalg/CMakeLists.txt
index 1ede8d326..6f25f2f2a 100644
--- a/example/linalg/CMakeLists.txt
+++ b/example/linalg/CMakeLists.txt
@@ -23,6 +23,7 @@ ADD_EXAMPLE(lstsq2)
ADD_EXAMPLE(solve1)
ADD_EXAMPLE(solve2)
ADD_EXAMPLE(solve3)
+ADD_EXAMPLE(sparse_from_ijv)
ADD_EXAMPLE(sparse_spmv)
ADD_EXAMPLE(svd)
ADD_EXAMPLE(svdvals)
diff --git a/example/linalg/example_sparse_from_ijv.f90 b/example/linalg/example_sparse_from_ijv.f90
new file mode 100644
index 000000000..da3b259dc
--- /dev/null
+++ b/example/linalg/example_sparse_from_ijv.f90
@@ -0,0 +1,42 @@
+program example_sparse_from_ijv
+ use stdlib_linalg_constants, only: dp
+ use stdlib_sparse
+ implicit none
+
+ integer :: row(10), col(10)
+ real(dp) :: data(10)
+ type(COO_dp) :: COO
+ type(CSR_dp) :: CSR
+ type(ELL_dp) :: ELL
+ type(SELLC_dp) :: SELLC
+ integer :: i, j
+
+ ! Initial data
+ row = [1,1,2,2,3,3,3,4,4,4]
+ col = [1,5,1,2,2,3,4,1,3,4]
+ data = real([9,-3,4,7,8,-1,8,4,5,6] , kind = dp )
+
+ ! Create a COO matrix from triplet
+ call from_ijv(COO,row,col,data)
+ print *, 'COO'
+ print *, ' i, j, v'
+ do i = 1, COO%nnz
+ print '(2I4,f8.1)', COO%index(:,i), COO%data(i)
+ end do
+
+ ! Create a CSR matrix from triplet
+ call from_ijv(CSR,row,col,data)
+ print *, 'CSR'
+ print '(A,5I8)', 'rowptr :', CSR%rowptr
+ print '(A,10I8)', 'col :', CSR%col
+ print '(A,10f8.1)', 'data :', CSR%data
+
+ ! Create an ELL matrix from triplet
+ call from_ijv(ELL,row,col,data)
+ print *, 'ELL'
+ print *, ' index | data'
+ do i = 1, ELL%nrows
+ print '(3I4,x,3f8.1)', ELL%index(i,:) , ELL%data(i,:)
+ end do
+
+end program example_sparse_from_ijv
\ No newline at end of file
diff --git a/example/linalg/example_sparse_spmv.f90 b/example/linalg/example_sparse_spmv.f90
index 9b30b35e2..25052710c 100644
--- a/example/linalg/example_sparse_spmv.f90
+++ b/example/linalg/example_sparse_spmv.f90
@@ -31,6 +31,4 @@ program example_sparse_spmv
print *, 'coo :', y_coo
print *, 'csr :', y_csr
- end program example_sparse_spmv
-
-
\ No newline at end of file
+end program example_sparse_spmv
\ No newline at end of file
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 103a32314..413eadcc5 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -505,7 +505,7 @@ contains
integer, intent(in), optional :: ncols
integer, intent(in), optional :: num_nz_rows
- integer :: nrows_, ncols_, num_nz_rows_
+ integer :: nrows_, ncols_
!---------------------------------------------------------
if(present(nrows)) then
nrows_ = nrows
@@ -527,7 +527,11 @@ contains
call from_ijv(COO,row,col,nrows=nrows_,ncols=ncols_)
end if
call coo2csr(COO,CSR)
- call csr2ell(CSR,ELL,num_nz_rows_)
+ if(present(num_nz_rows)) then
+ call csr2ell(CSR,ELL,num_nz_rows)
+ else
+ call csr2ell(CSR,ELL)
+ end if
end block
end subroutine
#:endfor
From 2d7701e88c01a78bd7dd421508e60d3ab67f60e0 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 29 Jun 2024 18:20:48 +0200
Subject: [PATCH 47/78] unused matrix
---
example/linalg/example_sparse_from_ijv.f90 | 1 -
1 file changed, 1 deletion(-)
diff --git a/example/linalg/example_sparse_from_ijv.f90 b/example/linalg/example_sparse_from_ijv.f90
index da3b259dc..1382cd3dd 100644
--- a/example/linalg/example_sparse_from_ijv.f90
+++ b/example/linalg/example_sparse_from_ijv.f90
@@ -8,7 +8,6 @@ program example_sparse_from_ijv
type(COO_dp) :: COO
type(CSR_dp) :: CSR
type(ELL_dp) :: ELL
- type(SELLC_dp) :: SELLC
integer :: i, j
! Initial data
From 98a564bf764c1bfc09b8c15e33c5d285a2de38b4 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 29 Jun 2024 19:15:25 +0200
Subject: [PATCH 48/78] add example and spec for add/at
---
doc/specs/stdlib_sparse.md | 36 +++++++++++++
example/linalg/CMakeLists.txt | 1 +
.../linalg/example_sparse_data_accessors.f90 | 50 +++++++++++++++++++
3 files changed, 87 insertions(+)
create mode 100644 example/linalg/example_sparse_data_accessors.f90
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 845e64924..b785a7c0d 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -134,6 +134,42 @@ Experimental
#### Description
The Sliced ELLPACK format `SELLC` is a variation of the `ELLPACK` format. This modification reduces the storage size compared to the `ELLPACK` format but maintaining its efficient data access scheme. It can be seen as an intermediate format between `CSR` and `ELLPACK`. For more details read [the reference](https://arxiv.org/pdf/1307.6209v1)
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+## `add`/`at` - Sparse Matrix data accessors
+
+### Status
+
+Experimental
+
+### Description
+Type-bound procedures to enable adding or requesting data in/from a sparse matrix.
+
+### Syntax
+
+`call matrix%add(i,j,v)` or
+`call matrix%add(i(:),j(:),v(:,:))`
+
+### Arguments
+
+`i`, `intent(in)`: Shall be an integer value or rank-1 array.
+`j`, `intent(in)`: Shall be an integer value or rank-1 array.
+`v`, `intent(in)`: Shall be a `real` or `complex` value or rank-2 array. The type shall be in accordance to the declared sparse matrix object.
+
+### Syntax
+
+`v = matrix%at(i,j)`
+
+### Arguments
+
+`i`, `intent(in)` : Shall be an integer value.
+`j`, `intent(in)` : Shall be an integer value.
+`v`, `result` : Shall be a `real` or `complex` value in accordance to the declared sparse matrix object. If the `ij` tuple is within the sparse pattern, `v` returns the value in the data buffer. If the `ij` tuple is outside the sparse pattern, `v` returns `0`. If the `ij` tuple is outside the matrix pattern `(nrows,ncols)`, `v` returns `NaN`.
+
+## Example
+```fortran
+{!example/linalg/example_sparse_data_accessors.f90!}
+```
+
<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
## `spmv` - Sparse Matrix-Vector product
diff --git a/example/linalg/CMakeLists.txt b/example/linalg/CMakeLists.txt
index 6f25f2f2a..36117886d 100644
--- a/example/linalg/CMakeLists.txt
+++ b/example/linalg/CMakeLists.txt
@@ -24,6 +24,7 @@ ADD_EXAMPLE(solve1)
ADD_EXAMPLE(solve2)
ADD_EXAMPLE(solve3)
ADD_EXAMPLE(sparse_from_ijv)
+ADD_EXAMPLE(sparse_data_accessors)
ADD_EXAMPLE(sparse_spmv)
ADD_EXAMPLE(svd)
ADD_EXAMPLE(svdvals)
diff --git a/example/linalg/example_sparse_data_accessors.f90 b/example/linalg/example_sparse_data_accessors.f90
new file mode 100644
index 000000000..b3be5eb55
--- /dev/null
+++ b/example/linalg/example_sparse_data_accessors.f90
@@ -0,0 +1,50 @@
+program example_sparse_data_accessors
+ use stdlib_linalg_constants, only: dp
+ use stdlib_sparse
+ implicit none
+
+ real(dp) :: mat(2,2)
+ real(dp), allocatable :: dense(:,:)
+ type(CSR_dp) :: CSR
+ type(COO_dp) :: COO
+ integer :: i, j, locdof(2)
+
+ ! Initial data
+ mat(:,1) = [1._dp,2._dp]
+ mat(:,2) = [2._dp,1._dp]
+ allocate(dense(5,5) , source = 0._dp)
+ do i = 0, 3
+ dense(1+i:2+i,1+i:2+i) = dense(1+i:2+i,1+i:2+i) + mat
+ end do
+
+ print *, 'Original Matrix'
+ do j = 1 , 5
+ print '(5f8.1)',dense(j,:)
+ end do
+
+ ! Initialize CSR data and reset dense reference matrix
+ call dense2coo(dense,COO)
+ call coo2csr(COO,CSR)
+ CSR%data = 0._dp
+ dense = 0._dp
+
+ ! Iteratively add blocks of data
+ do i = 0, 3
+ locdof(1:2) = [1+i,2+i]
+ call CSR%add(locdof,locdof,mat)
+ ! lets print a dense view of every step
+ call csr2coo(CSR,COO)
+ call coo2dense(COO,dense)
+ print '(A,I2)', 'Add block :', i
+ do j = 1 , 5
+ print '(5f8.1)',dense(j,:)
+ end do
+ end do
+
+ ! Request values from the matrix
+ print *, ''
+ print *, 'within sparse pattern :',CSR%at(2,1)
+ print *, 'outside sparse pattern :',CSR%at(5,2)
+ print *, 'outside matrix pattern :',CSR%at(7,7)
+
+end program example_sparse_data_accessors
\ No newline at end of file
From b65d933e390fbe0e7dce520d29558b9f17d139fa Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 29 Jun 2024 19:22:12 +0200
Subject: [PATCH 49/78] example print index
---
example/linalg/example_sparse_data_accessors.f90 | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/example/linalg/example_sparse_data_accessors.f90 b/example/linalg/example_sparse_data_accessors.f90
index b3be5eb55..4076dd898 100644
--- a/example/linalg/example_sparse_data_accessors.f90
+++ b/example/linalg/example_sparse_data_accessors.f90
@@ -35,7 +35,7 @@ program example_sparse_data_accessors
! lets print a dense view of every step
call csr2coo(CSR,COO)
call coo2dense(COO,dense)
- print '(A,I2)', 'Add block :', i
+ print '(A,I2)', 'Add block :', i+1
do j = 1 , 5
print '(5f8.1)',dense(j,:)
end do
From a94272e9d712d38b478bb7fc86b58780f8273aa0 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 29 Jun 2024 20:07:16 +0200
Subject: [PATCH 50/78] add csr2dense direct conversion
---
.../linalg/example_sparse_data_accessors.f90 | 3 +-
src/stdlib_sparse_conversion.fypp | 26 ++++++++++++++
src/stdlib_sparse_kinds.fypp | 35 ++++++++++++++-----
3 files changed, 54 insertions(+), 10 deletions(-)
diff --git a/example/linalg/example_sparse_data_accessors.f90 b/example/linalg/example_sparse_data_accessors.f90
index 4076dd898..e4de820f3 100644
--- a/example/linalg/example_sparse_data_accessors.f90
+++ b/example/linalg/example_sparse_data_accessors.f90
@@ -33,8 +33,7 @@ program example_sparse_data_accessors
locdof(1:2) = [1+i,2+i]
call CSR%add(locdof,locdof,mat)
! lets print a dense view of every step
- call csr2coo(CSR,COO)
- call coo2dense(COO,dense)
+ call csr2dense(CSR,dense)
print '(A,I2)', 'Add block :', i+1
do j = 1 , 5
print '(5f8.1)',dense(j,:)
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 5b8b017ec..605daa5fc 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -92,6 +92,32 @@ contains
#:endfor
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module subroutine csr2dense_${s1}$(CSR,dense)
+ type(CSR_${s1}$), intent(in) :: CSR
+ ${t1}$, allocatable, intent(inout) :: dense(:,:)
+ integer :: i, j
+
+ if(.not.allocated(dense)) allocate(dense(CSR%nrows,CSR%nrows),source=zero_${s1}$)
+ if( CSR%storage == sparse_full) then
+ do i = 1, CSR%nrows
+ do j = CSR%rowptr(i), CSR%rowptr(i+1)-1
+ dense(i,CSR%col(j)) = CSR%data(j)
+ end do
+ end do
+ else
+ do i = 1, CSR%nrows
+ do j = CSR%rowptr(i), CSR%rowptr(i+1)-1
+ dense(i,CSR%col(j)) = CSR%data(j)
+ if( i == CSR%col(j) ) cycle
+ dense(CSR%col(j),i) = CSR%data(j)
+ end do
+ end do
+ end if
+ end subroutine
+
+ #:endfor
+
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2coo_${s1}$(CSR,COO)
type(CSR_${s1}$), intent(in) :: CSR
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 413eadcc5..72d62c9fc 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -9,11 +9,8 @@ module stdlib_sparse_kinds
use ieee_arithmetic
use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
implicit none
-
private
- public :: dense2coo, coo2dense, csr2coo, coo2csr
- public :: csr2sellc
- public :: coo2ordered, from_ijv
+
! -- Global parameters
enum, bind(C)
enumerator :: sparse_full !> Full Sparse matrix (no symmetry considerations)
@@ -61,7 +58,7 @@ module stdlib_sparse_kinds
#:endfor
!> CSR: Compressed sparse row or Yale format
- type, extends(sparse_type) :: CSR_type
+ type, public, extends(sparse_type) :: CSR_type
integer, allocatable :: col(:) !> matrix column pointer
integer, allocatable :: rowptr(:) !> matrix row pointer
contains
@@ -80,7 +77,7 @@ module stdlib_sparse_kinds
#:endfor
!> CSC: Compressed sparse column
- type, extends(sparse_type) :: CSC_type
+ type, public, extends(sparse_type) :: CSC_type
integer, allocatable :: colptr(:) !> matrix column pointer
integer, allocatable :: row(:) !> matrix row pointer
contains
@@ -99,7 +96,7 @@ module stdlib_sparse_kinds
#:endfor
!> Compressed ELLPACK
- type, extends(sparse_type) :: ELL_type
+ type, public, extends(sparse_type) :: ELL_type
integer :: K = 0 !> maximum number of nonzeros per row
integer, allocatable :: index(:,:) !> column indices
contains
@@ -148,10 +145,11 @@ module stdlib_sparse_kinds
end subroutine
#:endfor
end interface
+ public :: dense2coo
!> Conversion from coo to dense
!>
- !> Enables creating a dense 2D matrix from the non-zero values tored in a COO format
+ !> Enables creating a dense 2D matrix from the non-zero values stored in a COO format
!> The dense matrix can be allocated on the fly if not pre-allocated by the user.
interface coo2dense
#:for k1, t1, s1 in (KINDS_TYPES)
@@ -161,6 +159,7 @@ module stdlib_sparse_kinds
end subroutine
#:endfor
end interface
+ public :: coo2dense
!> Conversion from coo to csr
!>
@@ -174,6 +173,21 @@ module stdlib_sparse_kinds
end subroutine
#:endfor
end interface
+ public :: coo2csr
+
+ !> Conversion from csr to dense
+ !>
+ !> Enables creating a dense 2D matrix from the non-zero values stored in a CSR format
+ !> The dense matrix can be allocated on the fly if not pre-allocated by the user.
+ interface csr2dense
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module subroutine csr2dense_${s1}$(CSR,dense)
+ type(CSR_${s1}$), intent(in) :: CSR
+ ${t1}$, allocatable, intent(inout) :: dense(:,:)
+ end subroutine
+ #:endfor
+ end interface
+ public :: csr2dense
!> Conversion from csr to coo
!>
@@ -187,6 +201,7 @@ module stdlib_sparse_kinds
end subroutine
#:endfor
end interface
+ public :: csr2coo
!> Conversion from csr to ell
!>
@@ -201,6 +216,7 @@ module stdlib_sparse_kinds
end subroutine
#:endfor
end interface
+ public :: csr2ell
!> Conversion from csr to SELL-C
!>
@@ -215,6 +231,7 @@ module stdlib_sparse_kinds
end subroutine
#:endfor
end interface
+ public :: csr2sellc
!> Transform COO matrix to canonical form with ordered and unique entries
interface coo2ordered
@@ -223,6 +240,7 @@ module stdlib_sparse_kinds
logical, intent(in), optional :: sort_data
end subroutine
end interface
+ public :: coo2ordered
!> Enable creating a sparse matrix from ijv (row,col,data) triplet
interface from_ijv
@@ -234,6 +252,7 @@ module stdlib_sparse_kinds
module procedure :: sellc_from_ijv_${s1}$
#:endfor
end interface
+ public :: from_ijv
contains
From b53eca29a81ce2115537307c222d395f2cafd32b Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Tue, 9 Jul 2024 07:09:13 +0200
Subject: [PATCH 51/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Jeremie Vandenplas <jeremie.vandenplas@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index b785a7c0d..cf57c0c57 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -23,7 +23,7 @@ The parent `sparse_type` is as an abstract derived type holding the basic common
```Fortran
type, public, abstract :: sparse_type
- integer :: nrows !> number of rows
+ integer :: nrows !! number of rows
integer :: ncols !> number of columns
integer :: nnz !> number of non-zero values
integer :: storage !> assumed storage symmetry
From 65e3fcbe090332553b3d2f44b3350b42c7da0e0c Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Tue, 9 Jul 2024 07:09:50 +0200
Subject: [PATCH 52/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Jeremie Vandenplas <jeremie.vandenplas@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index cf57c0c57..21413195c 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -94,7 +94,7 @@ CSR%rowptr(:) = [1,3,5,8,11]
Experimental
#### Description
-The Compressed Sparse Colum `CSC` is similar to the `CSR` format but values are accesed first by column, thus an index counter is given by `colptr` which enables accessing the start and ending rows of a given colum in the `row` index table.
+The Compressed Sparse Colum `CSC` is similar to the `CSR` format but values are accesed first by column, thus an index counter is given by `colptr` which enables to know the first and last non-zero row index of a given colum.
```Fortran
type(CSC_sp) :: CSC
From 2f56cd40a09d7f0ac60ae3a91aaa1d94308e4144 Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Tue, 9 Jul 2024 07:10:48 +0200
Subject: [PATCH 53/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Jeremie Vandenplas <jeremie.vandenplas@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 21413195c..2f77f2232 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -110,7 +110,7 @@ CSC%colptr(:) = [1,4,6,8,10,11]
Experimental
#### Description
-The `ELL` format stores data in a dense matrix of $nrows \times K$ in column major order. By imposing a constant number of zeros per row $K$, this format will incur in additional zeros being stored, but it enables efficient vectorization as memory acces is carried out by constant sized strides.
+The `ELL` format stores data in a dense matrix of $nrows \times K$ in column major order. By imposing a constant number of elements per row $K$, this format will incur in additional zeros being stored, but it enables efficient vectorization as memory acces is carried out by constant sized strides.
```Fortran
type(ELL_sp) :: ELL
From 941de3a17e79cb17bef3d3fd040bdd8f00a384a5 Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Tue, 9 Jul 2024 07:13:58 +0200
Subject: [PATCH 54/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Jeremie Vandenplas <jeremie.vandenplas@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 2f77f2232..4888a4532 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -163,7 +163,7 @@ Type-bound procedures to enable adding or requesting data in/from a sparse matri
`i`, `intent(in)` : Shall be an integer value.
`j`, `intent(in)` : Shall be an integer value.
-`v`, `result` : Shall be a `real` or `complex` value in accordance to the declared sparse matrix object. If the `ij` tuple is within the sparse pattern, `v` returns the value in the data buffer. If the `ij` tuple is outside the sparse pattern, `v` returns `0`. If the `ij` tuple is outside the matrix pattern `(nrows,ncols)`, `v` returns `NaN`.
+`v`, `result` : Shall be a `real` or `complex` value in accordance to the declared sparse matrix object. If the `ij` tuple is within the sparse pattern, `v` contains the value in the data buffer. If the `ij` tuple is outside the sparse pattern, `v` is equal `0`. If the `ij` tuple is outside the matrix pattern `(nrows,ncols)`, `v` is `NaN`.
## Example
```fortran
From 575c426b109a9294c17b6426fff9dd3ff461ceea Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Tue, 9 Jul 2024 07:15:22 +0200
Subject: [PATCH 55/78] Update doc/specs/stdlib_sparse.md
Co-authored-by: Jeremie Vandenplas <jeremie.vandenplas@gmail.com>
---
doc/specs/stdlib_sparse.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 4888a4532..8f39b0922 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -232,7 +232,7 @@ This module provides facility functions for converting between storage formats.
`col`, `integer(in)`:: columns index array.
-`data`, `real/complex(in)`, `optional`:: data array.
+`data`, `real/complex(in)`, `optional`:: `real` or `complex` data array.
`nrows`, `integer(in)`, `optional`:: number of rows, if not given it will be computed from the `row` array.
From db73fdc2d8900b930f19b4251bff8890a06b3008 Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Tue, 9 Jul 2024 07:15:42 +0200
Subject: [PATCH 56/78] Update src/stdlib_sparse_kinds.fypp
Co-authored-by: Jeremie Vandenplas <jeremie.vandenplas@gmail.com>
---
src/stdlib_sparse_kinds.fypp | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 72d62c9fc..16f337210 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -59,8 +59,8 @@ module stdlib_sparse_kinds
!> CSR: Compressed sparse row or Yale format
type, public, extends(sparse_type) :: CSR_type
- integer, allocatable :: col(:) !> matrix column pointer
- integer, allocatable :: rowptr(:) !> matrix row pointer
+ integer, allocatable :: col(:) !! matrix column pointer
+ integer, allocatable :: rowptr(:) !! matrix row pointer
contains
procedure :: malloc => malloc_csr
end type
From 697afa248d3388a7ff322be698cee9ea8bc8e9b2 Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Tue, 9 Jul 2024 07:16:49 +0200
Subject: [PATCH 57/78] Update src/stdlib_sparse_kinds.fypp
Co-authored-by: Jeremie Vandenplas <jeremie.vandenplas@gmail.com>
---
src/stdlib_sparse_kinds.fypp | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 16f337210..8502c3236 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -32,10 +32,10 @@ module stdlib_sparse_kinds
!> Base sparse type holding the meta data related to the storage capacity of a matrix.
type, public, abstract :: sparse_type
- integer :: nrows = 0 !> number of rows
- integer :: ncols = 0 !> number of columns
- integer :: nnz = 0 !> number of non-zero values
- integer :: storage = sparse_full !> assumed storage symmetry
+ integer :: nrows = 0 !! number of rows
+ integer :: ncols = 0 !! number of columns
+ integer :: nnz = 0 !! number of non-zero values
+ integer :: storage = sparse_full !! assumed storage symmetry
end type
!> COO: COOrdinates compresed format
From c97e665bfe24fcf4bbabf2a46d9dc61c583e776a Mon Sep 17 00:00:00 2001
From: jalvesz <102541118+jalvesz@users.noreply.github.com>
Date: Tue, 9 Jul 2024 07:17:24 +0200
Subject: [PATCH 58/78] Update src/stdlib_sparse_kinds.fypp
Co-authored-by: Jeremie Vandenplas <jeremie.vandenplas@gmail.com>
---
src/stdlib_sparse_kinds.fypp | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 8502c3236..bcaf9f84e 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -40,8 +40,8 @@ module stdlib_sparse_kinds
!> COO: COOrdinates compresed format
type, public, extends(sparse_type) :: COO_type
- logical :: is_sorted = .false. !> whether the matrix is sorted or not
- integer, allocatable :: index(:,:) !> Matrix coordinates index(2,nnz)
+ logical :: is_sorted = .false. !! whether the matrix is sorted or not
+ integer, allocatable :: index(:,:) !! Matrix coordinates index(2,nnz)
contains
procedure :: malloc => malloc_coo
end type
From dde88a732d67a0b0bd4425d7734ffeccc53e28d0 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Wed, 10 Jul 2024 21:00:05 +0200
Subject: [PATCH 59/78] refactor spmv as submodule to keep parameters private,
rework specs
---
doc/specs/stdlib_sparse.md | 97 +++++++-----
src/stdlib_sparse.f90 | 1 -
src/stdlib_sparse_conversion.fypp | 36 ++---
src/stdlib_sparse_kinds.fypp | 244 ++++++++++++++++++++----------
src/stdlib_sparse_spmv.fypp | 48 ++----
5 files changed, 248 insertions(+), 178 deletions(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 8f39b0922..2e8e6ceb5 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -24,9 +24,9 @@ The parent `sparse_type` is as an abstract derived type holding the basic common
```Fortran
type, public, abstract :: sparse_type
integer :: nrows !! number of rows
- integer :: ncols !> number of columns
- integer :: nnz !> number of non-zero values
- integer :: storage !> assumed storage symmetry
+ integer :: ncols !! number of columns
+ integer :: nnz !! number of non-zero values
+ integer :: storage !! assumed storage symmetry
end type
```
@@ -34,9 +34,9 @@ The storage integer label should be assigned from the module's internal enumerat
```Fortran
enum, bind(C)
- enumerator :: sparse_full !> Full Sparse matrix (no symmetry considerations)
- enumerator :: sparse_lower !> Symmetric Sparse matrix with triangular inferior storage
- enumerator :: sparse_upper !> Symmetric Sparse matrix with triangular supperior storage
+ enumerator :: sparse_full !! Full Sparse matrix (no symmetry considerations)
+ enumerator :: sparse_lower !! Symmetric Sparse matrix with triangular inferior storage
+ enumerator :: sparse_upper !! Symmetric Sparse matrix with triangular supperior storage
end enum
```
In the following, all sparse kinds will be presented in two main flavors: a data-less type `<matrix>_type` useful for topological graph operations. And real/complex valued types `<matrix>_<kind>` containing the `data` buffer for the matrix values. The following rectangular matrix will be used to showcase how each sparse matrix holds the data internally:
@@ -135,14 +135,14 @@ Experimental
The Sliced ELLPACK format `SELLC` is a variation of the `ELLPACK` format. This modification reduces the storage size compared to the `ELLPACK` format but maintaining its efficient data access scheme. It can be seen as an intermediate format between `CSR` and `ELLPACK`. For more details read [the reference](https://arxiv.org/pdf/1307.6209v1)
<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
-## `add`/`at` - Sparse Matrix data accessors
+## `add`- sparse matrix data accessors
### Status
Experimental
### Description
-Type-bound procedures to enable adding or requesting data in/from a sparse matrix.
+Type-bound procedures to enable adding data in a sparse matrix.
### Syntax
@@ -151,9 +151,20 @@ Type-bound procedures to enable adding or requesting data in/from a sparse matri
### Arguments
-`i`, `intent(in)`: Shall be an integer value or rank-1 array.
-`j`, `intent(in)`: Shall be an integer value or rank-1 array.
-`v`, `intent(in)`: Shall be a `real` or `complex` value or rank-2 array. The type shall be in accordance to the declared sparse matrix object.
+`i`: Shall be an integer value or rank-1 array. It is an `intent(in)` argument.
+
+`j`: Shall be an integer value or rank-1 array. It is an `intent(in)` argument.
+
+`v`: Shall be a `real` or `complex` value or rank-2 array. The type shall be in accordance to the declared sparse matrix object. It is an `intent(in)` argument.
+
+## `at`- sparse matrix data accessors
+
+### Status
+
+Experimental
+
+### Description
+Type-bound procedures to enable requesting data from a sparse matrix.
### Syntax
@@ -161,9 +172,11 @@ Type-bound procedures to enable adding or requesting data in/from a sparse matri
### Arguments
-`i`, `intent(in)` : Shall be an integer value.
-`j`, `intent(in)` : Shall be an integer value.
-`v`, `result` : Shall be a `real` or `complex` value in accordance to the declared sparse matrix object. If the `ij` tuple is within the sparse pattern, `v` contains the value in the data buffer. If the `ij` tuple is outside the sparse pattern, `v` is equal `0`. If the `ij` tuple is outside the matrix pattern `(nrows,ncols)`, `v` is `NaN`.
+`i` : Shall be an integer value. It is an `intent(in)` argument.
+
+`j` : Shall be an integer value. It is an `intent(in)` argument.
+
+`v` : Shall be a `real` or `complex` value in accordance to the declared sparse matrix object. If the `ij` tuple is within the sparse pattern, `v` contains the value in the data buffer. If the `ij` tuple is outside the sparse pattern, `v` is equal `0`. If the `ij` tuple is outside the matrix pattern `(nrows,ncols)`, `v` is `NaN`.
## Example
```fortran
@@ -189,18 +202,18 @@ $$y=\alpha*M*x+\beta*y$$
### Arguments
-`matrix`, `intent(in)`: Shall be a `real` or `complex` sparse type matrix.
+`matrix`: Shall be a `real` or `complex` sparse type matrix. It is an `intent(in)` argument.
-`vec_x`, `intent(in)`: Shall be a rank-1 or rank-2 array of `real` or `complex` type array.
+`vec_x`: Shall be a rank-1 or rank-2 array of `real` or `complex` type array. It is an `intent(in)` argument.
-`vec_y`, `intent(inout)`: Shall be a rank-1 or rank-2 array of `real` or `complex` type array.
+`vec_y`: Shall be a rank-1 or rank-2 array of `real` or `complex` type array. . It is an `intent(inout)` argument.
-`alpha`, `intent(in)`, `optional` : Shall be a scalar value of the same type as `vec_x`. Default value `alpha=1`.
+`alpha`, `optional` : Shall be a scalar value of the same type as `vec_x`. Default value `alpha=1`. It is an `intent(in)` argument.
-`beta`, `intent(in)`, `optional` : Shall be a scalar value of the same type as `vec_x`. Default value `beta=0`.
+`beta`, `optional` : Shall be a scalar value of the same type as `vec_x`. Default value `beta=0`. It is an `intent(in)` argument.
<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
-## `sparse_conversion` - Sparse matrix to matrix conversions
+## Sparse matrix to matrix conversions
### Status
@@ -212,13 +225,13 @@ This module provides facility functions for converting between storage formats.
### Syntax
-`call ` [[stdlib_sparse_conversion(module):coo2ordered(interface)]] `(coo)`
+`call ` [[stdlib_sparse_conversion(module):coo2ordered(interface)]] `(coo[,sort_data])`
### Arguments
-`COO`, `intent(inout)`: Shall be any `COO` type. The same object will be returned with the arrays reallocated to the correct size after removing duplicates.
+`COO` : Shall be any `COO` type. The same object will be returned with the arrays reallocated to the correct size after removing duplicates. It is an `intent(inout)` argument.
-`sort_data`, `logical(in)`, `optional`:: Shall be an optional `logical` argument to determine whether data in the COO graph should be sorted while sorting the index array, default `.false.`.
+`sort_data`, `optional` : Shall be a `logical` argument to determine whether data in the COO graph should be sorted while sorting the index array, default `.false.`. It is an `intent(in)` argument.
### Syntax
@@ -226,21 +239,21 @@ This module provides facility functions for converting between storage formats.
### Arguments
-`sparse`, `intent(inout)`: Shall be a `COO`, `CSR`, `ELL` or `SELLC` type. The graph object will be returned with a canonical shape after sorting and removing duplicates from the `(row,col,data)` triplet. If the graph is `COO_type` no data buffer is allowed.
+`sparse` : Shall be a `COO`, `CSR`, `ELL` or `SELLC` type. The graph object will be returned with a canonical shape after sorting and removing duplicates from the `(row,col,data)` triplet. If the graph is `COO_type` no data buffer is allowed. It is an `intent(inout)` argument.
-`row`, `integer(in)`:: rows index array.
+`row` : rows index array. It is an `intent(in)` argument.
-`col`, `integer(in)`:: columns index array.
+`col` : columns index array. It is an `intent(in)` argument.
-`data`, `real/complex(in)`, `optional`:: `real` or `complex` data array.
+`data`, `optional`: `real` or `complex` data array. It is an `intent(in)` argument.
-`nrows`, `integer(in)`, `optional`:: number of rows, if not given it will be computed from the `row` array.
+`nrows`, `optional`: number of rows, if not given it will be computed from the `row` array. It is an `intent(in)` argument.
-`ncols`, `integer(in)`, `optional`:: number of columns, if not given it will be computed from the `col` array.
+`ncols`, `optional`: number of columns, if not given it will be computed from the `col` array. It is an `intent(in)` argument.
-`num_nz_rows`, `integer(in)`, `optional`:: number of non zeros per row, only valid in the case of an `ELL` matrix, by default it will computed from the largest row.
+`num_nz_rows`, `optional`: number of non zeros per row, only valid in the case of an `ELL` matrix, by default it will computed from the largest row. It is an `intent(in)` argument.
-`chunk`, `integer(in)`, `optional`:: chunk size, only valid in the case of a `SELLC` matrix, by default it will be taken from the `SELLC` default attribute chunk size.
+`chunk`, `optional`: chunk size, only valid in the case of a `SELLC` matrix, by default it will be taken from the `SELLC` default attribute chunk size. It is an `intent(in)` argument.
## Example
```fortran
@@ -253,9 +266,9 @@ This module provides facility functions for converting between storage formats.
### Arguments
-`dense`, `intent(in)`: Shall be a rank-2 array of `real` or `complex` type.
+`dense` : Shall be a rank-2 array of `real` or `complex` type. It is an `intent(in)` argument.
-`coo`, `intent(inout)`: Shall be a `COO` type of `real` or `complex` type.
+`coo` : Shall be a `COO` type of `real` or `complex` type. It is an `intent(out)` argument.
### Syntax
@@ -263,9 +276,9 @@ This module provides facility functions for converting between storage formats.
### Arguments
-`coo`, `intent(in)`: Shall be a `COO` type of `real` or `complex` type.
+`coo` : Shall be a `COO` type of `real` or `complex` type. It is an `intent(in)` argument.
-`dense`, `intent(inout)`: Shall be a rank-2 array of `real` or `complex` type.
+`dense` : Shall be a rank-2 array of `real` or `complex` type. It is an `intent(out)` argument.
### Syntax
@@ -273,9 +286,9 @@ This module provides facility functions for converting between storage formats.
### Arguments
-`coo`, `intent(in)`: Shall be a `COO` type of `real` or `complex` type.
+`coo` : Shall be a `COO` type of `real` or `complex` type. It is an `intent(in)` argument.
-`csr`, `intent(inout)`: Shall be a `CSR` type of `real` or `complex` type.
+`csr` : Shall be a `CSR` type of `real` or `complex` type. It is an `intent(out)` argument.
### Syntax
@@ -283,9 +296,9 @@ This module provides facility functions for converting between storage formats.
### Arguments
-`csr`, `intent(in)`: Shall be a `CSR` type of `real` or `complex` type.
+`csr` : Shall be a `CSR` type of `real` or `complex` type. It is an `intent(in)` argument.
-`coo`, `intent(inout)`: Shall be a `COO` type of `real` or `complex` type.
+`coo` : Shall be a `COO` type of `real` or `complex` type. It is an `intent(out)` argument.
### Syntax
@@ -293,11 +306,11 @@ This module provides facility functions for converting between storage formats.
### Arguments
-`csr`, `intent(in)`: Shall be a `CSR` type of `real` or `complex` type.
+`csr` : Shall be a `CSR` type of `real` or `complex` type. It is an `intent(in)` argument.
-`sellc`, `intent(inout)`: Shall be a `SELLC` type of `real` or `complex` type.
+`sellc` : Shall be a `SELLC` type of `real` or `complex` type. It is an `intent(out)` argument.
-`chunk`, `intent(in)`, `optional`: chunk size for the Sliced ELLPACK format.
+`chunk`, `optional`: chunk size for the Sliced ELLPACK format. It is an `intent(in)` argument.
## Example
```fortran
diff --git a/src/stdlib_sparse.f90 b/src/stdlib_sparse.f90
index 58e7663d3..6465d68d5 100644
--- a/src/stdlib_sparse.f90
+++ b/src/stdlib_sparse.f90
@@ -1,5 +1,4 @@
!! public API
module stdlib_sparse
use stdlib_sparse_kinds
- use stdlib_sparse_spmv
end module stdlib_sparse
\ No newline at end of file
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 605daa5fc..9df336359 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -2,15 +2,15 @@
#: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 KINDS_TYPES = R_KINDS_TYPES+C_KINDS_TYPES
-!> The `stdlib_sparse_conversion` module provides sparse to sparse matrix conversion utilities.
-!>
+!! The `stdlib_sparse_conversion` submodule provides sparse to sparse matrix conversion utilities.
+!!
! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
submodule(stdlib_sparse_kinds) stdlib_sparse_conversion
use stdlib_sorting, only: sort
implicit none
- !> Sort arrays of a COO matrix
- !>
+ !! Sort arrays of a COO matrix
+ !!
interface sort_coo
module procedure sort_coo_unique
#:for k1, t1, s1 in (KINDS_TYPES)
@@ -23,7 +23,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine dense2coo_${s1}$(dense,COO)
${t1}$, intent(in) :: dense(:,:)
- type(COO_${s1}$), intent(inout) :: COO
+ type(COO_${s1}$), intent(out) :: COO
integer :: num_rows, num_cols, nnz
integer :: i, j, idx
@@ -51,7 +51,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine coo2dense_${s1}$(COO,dense)
type(COO_${s1}$), intent(in) :: COO
- ${t1}$, allocatable, intent(inout) :: dense(:,:)
+ ${t1}$, allocatable, intent(out) :: dense(:,:)
integer :: idx
if(.not.allocated(dense)) allocate(dense(COO%nrows,COO%nrows),source=zero_${s1}$)
@@ -64,8 +64,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine coo2csr_${s1}$(COO,CSR)
- type(COO_${s1}$), intent(in) :: COO
- type(CSR_${s1}$), intent(inout) :: CSR
+ type(COO_${s1}$), intent(in) :: COO
+ type(CSR_${s1}$), intent(out) :: CSR
integer :: i
CSR%nnz = COO%nnz; CSR%nrows = COO%nrows; CSR%ncols = COO%ncols
@@ -95,7 +95,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2dense_${s1}$(CSR,dense)
type(CSR_${s1}$), intent(in) :: CSR
- ${t1}$, allocatable, intent(inout) :: dense(:,:)
+ ${t1}$, allocatable, intent(out) :: dense(:,:)
integer :: i, j
if(.not.allocated(dense)) allocate(dense(CSR%nrows,CSR%nrows),source=zero_${s1}$)
@@ -120,8 +120,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2coo_${s1}$(CSR,COO)
- type(CSR_${s1}$), intent(in) :: CSR
- type(COO_${s1}$), intent(inout) :: COO
+ type(CSR_${s1}$), intent(in) :: CSR
+ type(COO_${s1}$), intent(out) :: COO
integer :: i, j
COO%nnz = CSR%nnz; COO%nrows = CSR%nrows; COO%ncols = CSR%ncols
@@ -146,9 +146,9 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2ell_${s1}$(CSR,ELL,num_nz_rows)
- type(CSR_${s1}$), intent(in) :: CSR
- type(ELL_${s1}$), intent(inout) :: ELL
- integer, intent(in), optional :: num_nz_rows !> number of non zeros per row
+ type(CSR_${s1}$), intent(in) :: CSR
+ type(ELL_${s1}$), intent(out) :: ELL
+ integer, intent(in), optional :: num_nz_rows !! number of non zeros per row
integer :: i, j, num_nz_rows_, adr1, adr2
!-------------------------------------------
@@ -176,10 +176,10 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
- !> csr2sellc: This function enables transfering data from a CSR matrix to a SELL-C matrix
- !> This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
- type(CSR_${s1}$), intent(in) :: CSR
- type(SELLC_${s1}$), intent(inout) :: SELLC
+ !! csr2sellc: This function enables transfering data from a CSR matrix to a SELL-C matrix
+ !! This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
+ type(CSR_${s1}$), intent(in) :: CSR
+ type(SELLC_${s1}$), intent(out) :: SELLC
integer, intent(in), optional :: chunk
${t1}$, parameter :: zero = zero_${s1}$
integer :: i, j, num_chunks
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index bcaf9f84e..42180f8c9 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -1,9 +1,10 @@
#:include "common.fypp"
+#:set RANKS = range(1, 2+1)
#: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 KINDS_TYPES = R_KINDS_TYPES+C_KINDS_TYPES
-!> The `stdlib_sparse_kinds` module provides derived type definitions for different sparse matrices
-!>
+!! The `stdlib_sparse_kinds` module provides derived type definitions for different sparse matrices
+!!
! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
module stdlib_sparse_kinds
use ieee_arithmetic
@@ -11,26 +12,25 @@ module stdlib_sparse_kinds
implicit none
private
- ! -- Global parameters
enum, bind(C)
- enumerator :: sparse_full !> Full Sparse matrix (no symmetry considerations)
- enumerator :: sparse_lower !> Symmetric Sparse matrix with triangular inferior storage
- enumerator :: sparse_upper !> Symmetric Sparse matrix with triangular supperior storage
+ enumerator :: sparse_full !! Full Sparse matrix (no symmetry considerations)
+ enumerator :: sparse_lower !! Symmetric Sparse matrix with triangular inferior storage
+ enumerator :: sparse_upper !! Symmetric Sparse matrix with triangular supperior storage
end enum
public :: sparse_full, sparse_lower, sparse_upper
#:for k1, t1, s1 in (R_KINDS_TYPES)
- ${t1}$, parameter, public :: zero_${s1}$ = 0._${k1}$
- ${t1}$, parameter, public :: one_${s1}$ = 1._${k1}$
+ ${t1}$, parameter :: zero_${s1}$ = 0._${k1}$
+ ${t1}$, parameter :: one_${s1}$ = 1._${k1}$
#:endfor
#:for k1, t1, s1 in (C_KINDS_TYPES)
- ${t1}$, parameter, public :: zero_${s1}$ = (0._${k1}$,0._${k1}$)
- ${t1}$, parameter, public :: one_${s1}$ = (1._${k1}$,1._${k1}$)
+ ${t1}$, parameter :: zero_${s1}$ = (0._${k1}$,0._${k1}$)
+ ${t1}$, parameter :: one_${s1}$ = (1._${k1}$,1._${k1}$)
#:endfor
- ! -- Classes
-
- !> Base sparse type holding the meta data related to the storage capacity of a matrix.
+ !! version: experimental
+ !!
+ !! Base sparse type holding the meta data related to the storage capacity of a matrix.
type, public, abstract :: sparse_type
integer :: nrows = 0 !! number of rows
integer :: ncols = 0 !! number of columns
@@ -38,7 +38,9 @@ module stdlib_sparse_kinds
integer :: storage = sparse_full !! assumed storage symmetry
end type
- !> COO: COOrdinates compresed format
+ !! version: experimental
+ !!
+ !! COO: COOrdinates compresed format
type, public, extends(sparse_type) :: COO_type
logical :: is_sorted = .false. !! whether the matrix is sorted or not
integer, allocatable :: index(:,:) !! Matrix coordinates index(2,nnz)
@@ -57,7 +59,9 @@ module stdlib_sparse_kinds
end type
#:endfor
- !> CSR: Compressed sparse row or Yale format
+ !! version: experimental
+ !!
+ !! CSR: Compressed sparse row or Yale format
type, public, extends(sparse_type) :: CSR_type
integer, allocatable :: col(:) !! matrix column pointer
integer, allocatable :: rowptr(:) !! matrix row pointer
@@ -76,10 +80,12 @@ module stdlib_sparse_kinds
end type
#:endfor
- !> CSC: Compressed sparse column
+ !! version: experimental
+ !!
+ !! CSC: Compressed sparse column
type, public, extends(sparse_type) :: CSC_type
- integer, allocatable :: colptr(:) !> matrix column pointer
- integer, allocatable :: row(:) !> matrix row pointer
+ integer, allocatable :: colptr(:) !! matrix column pointer
+ integer, allocatable :: row(:) !! matrix row pointer
contains
procedure :: malloc => malloc_csc
end type
@@ -94,11 +100,13 @@ module stdlib_sparse_kinds
generic :: add => add_value, add_block
end type
#:endfor
-
- !> Compressed ELLPACK
+
+ !! version: experimental
+ !!
+ !! Compressed ELLPACK
type, public, extends(sparse_type) :: ELL_type
- integer :: K = 0 !> maximum number of nonzeros per row
- integer, allocatable :: index(:,:) !> column indices
+ integer :: K = 0 !! maximum number of nonzeros per row
+ integer, allocatable :: index(:,:) !! column indices
contains
procedure :: malloc => malloc_ell
end type
@@ -114,12 +122,14 @@ module stdlib_sparse_kinds
end type
#:endfor
- !> Compressed SELL-C
- !> Reference : https://library.eecs.utk.edu/storage/files/ut-eecs-14-727.pdf
+ !! version: experimental
+ !!
+ !! Compressed SELL-C
+ !! Reference : https://library.eecs.utk.edu/storage/files/ut-eecs-14-727.pdf
type, public, extends(sparse_type) :: SELLC_type
- integer :: chunk_size = 8 !> default chunk size
- integer, allocatable :: rowptr(:) !> row pointer
- integer, allocatable :: col(:,:) !> column indices
+ integer :: chunk_size = 8 !! default chunk size
+ integer, allocatable :: rowptr(:) !! row pointer
+ integer, allocatable :: col(:,:) !! column indices
end type
#:for k1, t1, s1 in (KINDS_TYPES)
@@ -133,107 +143,124 @@ module stdlib_sparse_kinds
end type
#:endfor
- !> Conversion from dense to coo
- !>
- !> Enables extracting the non-zero elements of a dense 2D matrix and
- !> storing those values in a COO format. The coo matrix is (re)allocated on the fly.
+ !! version: experimental
+ !!
+ !! Conversion from dense to coo
+ !! Enables extracting the non-zero elements of a dense 2D matrix and
+ !! storing those values in a COO format. The coo matrix is (re)allocated on the fly.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
interface dense2coo
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine dense2coo_${s1}$(dense,COO)
${t1}$, intent(in) :: dense(:,:)
- type(COO_${s1}$), intent(inout) :: COO
+ type(COO_${s1}$), intent(out) :: COO
end subroutine
#:endfor
end interface
public :: dense2coo
- !> Conversion from coo to dense
- !>
- !> Enables creating a dense 2D matrix from the non-zero values stored in a COO format
- !> The dense matrix can be allocated on the fly if not pre-allocated by the user.
+ !! version: experimental
+ !!
+ !! Conversion from coo to dense
+ !! Enables creating a dense 2D matrix from the non-zero values stored in a COO format
+ !! The dense matrix can be allocated on the fly if not pre-allocated by the user.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
interface coo2dense
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine coo2dense_${s1}$(COO,dense)
type(COO_${s1}$), intent(in) :: COO
- ${t1}$, allocatable, intent(inout) :: dense(:,:)
+ ${t1}$, allocatable, intent(out) :: dense(:,:)
end subroutine
#:endfor
end interface
public :: coo2dense
- !> Conversion from coo to csr
- !>
- !> Enables transferring data from a COO matrix to a CSR matrix
- !> under the hypothesis that the COO is already ordered.
+ !! version: experimental
+ !!
+ !! Conversion from coo to csr
+ !! Enables transferring data from a COO matrix to a CSR matrix
+ !! under the hypothesis that the COO is already ordered.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
interface coo2csr
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine coo2csr_${s1}$(COO,CSR)
type(COO_${s1}$), intent(in) :: COO
- type(CSR_${s1}$), intent(inout) :: CSR
+ type(CSR_${s1}$), intent(out) :: CSR
end subroutine
#:endfor
end interface
public :: coo2csr
- !> Conversion from csr to dense
- !>
- !> Enables creating a dense 2D matrix from the non-zero values stored in a CSR format
- !> The dense matrix can be allocated on the fly if not pre-allocated by the user.
+ !! version: experimental
+ !!
+ !! Conversion from csr to dense
+ !! Enables creating a dense 2D matrix from the non-zero values stored in a CSR format
+ !! The dense matrix can be allocated on the fly if not pre-allocated by the user.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
interface csr2dense
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2dense_${s1}$(CSR,dense)
type(CSR_${s1}$), intent(in) :: CSR
- ${t1}$, allocatable, intent(inout) :: dense(:,:)
+ ${t1}$, allocatable, intent(out) :: dense(:,:)
end subroutine
#:endfor
end interface
public :: csr2dense
- !> Conversion from csr to coo
- !>
- !> Enables transferring data from a CSR matrix to a COO matrix
- !> under the hypothesis that the CSR is already ordered.
+ !! version: experimental
+ !!
+ !! Conversion from csr to coo
+ !! Enables transferring data from a CSR matrix to a COO matrix
+ !! under the hypothesis that the CSR is already ordered.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
interface csr2coo
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2coo_${s1}$(CSR,COO)
type(CSR_${s1}$), intent(in) :: CSR
- type(COO_${s1}$), intent(inout) :: COO
+ type(COO_${s1}$), intent(out) :: COO
end subroutine
#:endfor
end interface
public :: csr2coo
- !> Conversion from csr to ell
- !>
- !> Enables transferring data from a CSR matrix to a ELL matrix
- !> under the hypothesis that the CSR is already ordered.
+ !! version: experimental
+ !!
+ !! Conversion from csr to ell
+ !! Enables transferring data from a CSR matrix to a ELL matrix
+ !! under the hypothesis that the CSR is already ordered.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
interface csr2ell
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2ell_${s1}$(CSR,ELL,num_nz_rows)
- type(CSR_${s1}$), intent(in) :: CSR
- type(ELL_${s1}$), intent(inout) :: ELL
- integer, intent(in), optional :: num_nz_rows
+ type(CSR_${s1}$), intent(in) :: CSR
+ type(ELL_${s1}$), intent(out) :: ELL
+ integer, intent(in), optional :: num_nz_rows
end subroutine
#:endfor
end interface
public :: csr2ell
- !> Conversion from csr to SELL-C
- !>
- !> Enables transferring data from a CSR matrix to a SELL-C matrix
- !> It takes an optional parameter to decide the chunck size 4, 8 or 16
+ !! version: experimental
+ !!
+ !! Conversion from csr to SELL-C
+ !! Enables transferring data from a CSR matrix to a SELL-C matrix
+ !! It takes an optional parameter to decide the chunck size 4, 8 or 16
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
interface csr2sellc
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
- type(CSR_${s1}$), intent(in) :: CSR
- type(SELLC_${s1}$), intent(inout) :: SELLC
+ type(CSR_${s1}$), intent(in) :: CSR
+ type(SELLC_${s1}$), intent(out) :: SELLC
integer, intent(in), optional :: chunk
end subroutine
#:endfor
end interface
public :: csr2sellc
- !> Transform COO matrix to canonical form with ordered and unique entries
+ !! version: experimental
+ !!
+ !! Transform COO matrix to canonical form with ordered and unique entries
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
interface coo2ordered
module subroutine coo2ordered(COO,sort_data)
class(COO_type), intent(inout) :: COO
@@ -242,7 +269,10 @@ module stdlib_sparse_kinds
end interface
public :: coo2ordered
- !> Enable creating a sparse matrix from ijv (row,col,data) triplet
+ !! version: experimental
+ !!
+ !! Enable creating a sparse matrix from ijv (row,col,data) triplet
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
interface from_ijv
module procedure :: coo_from_ijv_type
#:for k1, t1, s1 in (KINDS_TYPES)
@@ -254,14 +284,62 @@ module stdlib_sparse_kinds
end interface
public :: from_ijv
+ !! Version experimental
+ !!
+ !! Applay the sparse matrix-vector product $$y = \alpha * M * x + \beta * y $$
+ !! [Specifications](../page/specs/stdlib_sparse.html#spmv)
+ interface spmv
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ #:for rank in RANKS
+ module subroutine spmv_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ type(COO_${s1}$), intent(in) :: matrix
+ ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
+ ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ ${t1}$, intent(in), optional :: alpha
+ ${t1}$, intent(in), optional :: beta
+ end subroutine
+ module subroutine spmv_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ type(CSR_${s1}$), intent(in) :: matrix
+ ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
+ ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ ${t1}$, intent(in), optional :: alpha
+ ${t1}$, intent(in), optional :: beta
+ end subroutine
+ module subroutine spmv_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ type(CSC_${s1}$), intent(in) :: matrix
+ ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
+ ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ ${t1}$, intent(in), optional :: alpha
+ ${t1}$, intent(in), optional :: beta
+ end subroutine
+ module subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ type(ELL_${s1}$), intent(in) :: matrix
+ ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
+ ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
+ ${t1}$, intent(in), optional :: alpha
+ ${t1}$, intent(in), optional :: beta
+ end subroutine
+ #:endfor
+ module subroutine spmv_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ !! This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
+ type(SELLC_${s1}$), intent(in) :: matrix
+ ${t1}$, intent(in) :: vec_x(:)
+ ${t1}$, intent(inout) :: vec_y(:)
+ ${t1}$, intent(in), optional :: alpha
+ ${t1}$, intent(in), optional :: beta
+ end subroutine
+ #:endfor
+ end interface
+ public :: spmv
+
contains
- !> (re)Allocate matrix memory for the COO type
+ !! (re)Allocate matrix memory for the COO type
subroutine malloc_coo(self,num_rows,num_cols,nnz)
class(COO_type) :: self
- integer, intent(in) :: num_rows !> number of rows
- integer, intent(in) :: num_cols !> number of columns
- integer, intent(in) :: nnz !> number of non zeros
+ integer, intent(in) :: num_rows !! number of rows
+ integer, intent(in) :: num_cols !! number of columns
+ integer, intent(in) :: nnz !! number of non zeros
integer, allocatable :: temp_idx(:,:)
!-----------------------------------------------------
@@ -293,12 +371,12 @@ contains
end select
end subroutine
- !> (re)Allocate matrix memory for the CSR type
+ !! (re)Allocate matrix memory for the CSR type
subroutine malloc_csr(self,num_rows,num_cols,nnz)
class(CSR_type) :: self
- integer, intent(in) :: num_rows !> number of rows
- integer, intent(in) :: num_cols !> number of columns
- integer, intent(in) :: nnz !> number of non zeros
+ integer, intent(in) :: num_rows !! number of rows
+ integer, intent(in) :: num_cols !! number of columns
+ integer, intent(in) :: nnz !! number of non zeros
integer, allocatable :: temp_idx(:)
!-----------------------------------------------------
@@ -337,12 +415,12 @@ contains
end select
end subroutine
- !> (re)Allocate matrix memory for the CSC type
+ !! (re)Allocate matrix memory for the CSC type
subroutine malloc_csc(self,num_rows,num_cols,nnz)
class(CSC_type) :: self
- integer, intent(in) :: num_rows !> number of rows
- integer, intent(in) :: num_cols !> number of columns
- integer, intent(in) :: nnz !> number of non zeros
+ integer, intent(in) :: num_rows !! number of rows
+ integer, intent(in) :: num_cols !! number of columns
+ integer, intent(in) :: nnz !! number of non zeros
integer, allocatable :: temp_idx(:)
!-----------------------------------------------------
@@ -381,12 +459,12 @@ contains
end select
end subroutine
- !> (re)Allocate matrix memory for the ELLPACK type
+ !! (re)Allocate matrix memory for the ELLPACK type
subroutine malloc_ell(self,num_rows,num_cols,num_nz_rows)
class(ELL_type) :: self
- integer, intent(in) :: num_rows !> number of rows
- integer, intent(in) :: num_cols !> number of columns
- integer, intent(in) :: num_nz_rows !> number of non zeros per row
+ integer, intent(in) :: num_rows !! number of rows
+ integer, intent(in) :: num_cols !! number of columns
+ integer, intent(in) :: num_nz_rows !! number of non zeros per row
integer, allocatable :: temp_idx(:,:)
!-----------------------------------------------------
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index 9cd1a9e5b..b569aafb6 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -7,38 +7,18 @@
#:def rksfx2(rank)
#{if rank > 0}#${":," + ":," * (rank - 1)}$#{endif}#
#:enddef
-!> The `stdlib_sparse_spmv` module provides matrix-vector product kernels.
-!>
+!! The `stdlib_sparse_spmv` submodule provides matrix-vector product kernels.
+!!
! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
-module stdlib_sparse_spmv
- use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
- use stdlib_sparse_kinds
+submodule(stdlib_sparse_kinds) stdlib_sparse_spmv
implicit none
- private
-
- public :: spmv
- interface spmv
- !! Version experimental
- !!
- !! Applay the sparse matrix-vector product $$y = \beta * y + \alpha * M * x $$
- !!
- #:for k1, t1, s1 in (KINDS_TYPES)
- #:for rank in RANKS
- module procedure spmv_coo_${rank}$d_${s1}$
- module procedure spmv_csr_${rank}$d_${s1}$
- module procedure spmv_csc_${rank}$d_${s1}$
- module procedure spmv_ell_${rank}$d_${s1}$
- #:endfor
- module procedure spmv_sellc_${s1}$
- #:endfor
- end interface
contains
- !> spmv_coo
+ !! spmv_coo
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine spmv_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ module subroutine spmv_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(COO_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -81,7 +61,7 @@ contains
!! spmv_csr
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine spmv_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ module subroutine spmv_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(CSR_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -158,10 +138,10 @@ contains
#:endfor
#:endfor
- !> spmv_csc
+ !! spmv_csc
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine spmv_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ module subroutine spmv_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(CSC_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -222,10 +202,10 @@ contains
#:endfor
#:endfor
- !> spmv_ell
+ !! spmv_ell
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ module subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(ELL_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -256,11 +236,11 @@ contains
#:endfor
#:endfor
- !> spmv_sellc
+ !! spmv_sellc
#:set CHUNKS = [4,8,16]
#:for k1, t1, s1 in (KINDS_TYPES)
- subroutine spmv_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- !> This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
+ module subroutine spmv_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ !! This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
type(SELLC_${s1}$), intent(in) :: matrix
${t1}$, intent(in) :: vec_x(:)
${t1}$, intent(inout) :: vec_y(:)
@@ -336,4 +316,4 @@ contains
#:endfor
-end module stdlib_sparse_spmv
\ No newline at end of file
+end submodule
\ No newline at end of file
From 6ae038bd54ab9927aec20bb0787ba89fa5769c17 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Wed, 10 Jul 2024 22:06:43 +0200
Subject: [PATCH 60/78] add an ilp parameter to change in the future for int64
if needed for large arrays
---
src/stdlib_sparse_conversion.fypp | 56 +++++-----
src/stdlib_sparse_kinds.fypp | 167 +++++++++++++++---------------
src/stdlib_sparse_spmv.fypp | 14 +--
3 files changed, 120 insertions(+), 117 deletions(-)
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 9df336359..7918f5ade 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -24,8 +24,8 @@ contains
module subroutine dense2coo_${s1}$(dense,COO)
${t1}$, intent(in) :: dense(:,:)
type(COO_${s1}$), intent(out) :: COO
- integer :: num_rows, num_cols, nnz
- integer :: i, j, idx
+ integer(ilp) :: num_rows, num_cols, nnz
+ integer(ilp) :: i, j, idx
num_rows = size(dense,dim=1)
num_cols = size(dense,dim=2)
@@ -52,7 +52,7 @@ contains
module subroutine coo2dense_${s1}$(COO,dense)
type(COO_${s1}$), intent(in) :: COO
${t1}$, allocatable, intent(out) :: dense(:,:)
- integer :: idx
+ integer(ilp) :: idx
if(.not.allocated(dense)) allocate(dense(COO%nrows,COO%nrows),source=zero_${s1}$)
do concurrent(idx = 1:COO%nnz)
@@ -66,7 +66,7 @@ contains
module subroutine coo2csr_${s1}$(COO,CSR)
type(COO_${s1}$), intent(in) :: COO
type(CSR_${s1}$), intent(out) :: CSR
- integer :: i
+ integer(ilp) :: i
CSR%nnz = COO%nnz; CSR%nrows = COO%nrows; CSR%ncols = COO%ncols
CSR%storage = COO%storage
@@ -96,7 +96,7 @@ contains
module subroutine csr2dense_${s1}$(CSR,dense)
type(CSR_${s1}$), intent(in) :: CSR
${t1}$, allocatable, intent(out) :: dense(:,:)
- integer :: i, j
+ integer(ilp) :: i, j
if(.not.allocated(dense)) allocate(dense(CSR%nrows,CSR%nrows),source=zero_${s1}$)
if( CSR%storage == sparse_full) then
@@ -122,7 +122,7 @@ contains
module subroutine csr2coo_${s1}$(CSR,COO)
type(CSR_${s1}$), intent(in) :: CSR
type(COO_${s1}$), intent(out) :: COO
- integer :: i, j
+ integer(ilp) :: i, j
COO%nnz = CSR%nnz; COO%nrows = CSR%nrows; COO%ncols = CSR%ncols
COO%storage = CSR%storage
@@ -150,7 +150,7 @@ contains
type(ELL_${s1}$), intent(out) :: ELL
integer, intent(in), optional :: num_nz_rows !! number of non zeros per row
- integer :: i, j, num_nz_rows_, adr1, adr2
+ integer(ilp) :: i, j, num_nz_rows_, adr1, adr2
!-------------------------------------------
num_nz_rows_ = 0
if(present(num_nz_rows)) then
@@ -182,7 +182,7 @@ contains
type(SELLC_${s1}$), intent(out) :: SELLC
integer, intent(in), optional :: chunk
${t1}$, parameter :: zero = zero_${s1}$
- integer :: i, j, num_chunks
+ integer(ilp) :: i, j, num_chunks
if(present(chunk)) SELLC%chunk_size = chunk
@@ -243,10 +243,10 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
recursive subroutine quicksort_i_${s1}$(a, b, first, last)
integer, parameter :: wp = sp
- integer, intent(inout) :: a(*) !! reference table to sort
+ integer(ilp), intent(inout) :: a(*) !! reference table to sort
${t1}$, intent(inout) :: b(*) !! secondary real data to sort w.r.t. a
- integer, intent(in) :: first, last
- integer :: i, j, x, t
+ integer(ilp), intent(in) :: first, last
+ integer(ilp) :: i, j, x, t
${t1}$ :: d
x = a( (first+last) / 2 )
@@ -273,14 +273,14 @@ contains
subroutine sort_coo_unique( a, n, num_rows, num_cols )
!! Sort a 2d array in increasing order first by index 1 and then by index 2
- integer, intent(inout) :: a(2,*)
- integer, intent(inout) :: n
- integer, intent(in) :: num_rows
- integer, intent(in) :: num_cols
-
- integer :: stride, adr0, adr1, dd
- integer :: n_i, pos, ed
- integer, allocatable :: count_i(:), count_i_aux(:), rows_(:), cols_(:)
+ integer(ilp), intent(inout) :: a(2,*)
+ integer(ilp), intent(inout) :: n
+ integer(ilp), intent(in) :: num_rows
+ integer(ilp), intent(in) :: num_cols
+
+ integer(ilp) :: stride, adr0, adr1, dd
+ integer(ilp) :: n_i, pos, ed
+ integer(ilp), allocatable :: count_i(:), count_i_aux(:), rows_(:), cols_(:)
!---------------------------------------------------------
! Sort a first time with respect to first index using count sort
allocate( count_i( 0:num_rows ) , source = 0 )
@@ -328,14 +328,14 @@ contains
subroutine sort_coo_unique_${s1}$( a, data, n, num_rows, num_cols )
!! Sort a 2d array in increasing order first by index 1 and then by index 2
${t1}$, intent(inout) :: data(*)
- integer, intent(inout) :: a(2,*)
- integer, intent(inout) :: n
- integer, intent(in) :: num_rows
- integer, intent(in) :: num_cols
-
- integer :: stride, adr0, adr1, dd
- integer :: n_i, pos, ed
- integer, allocatable :: count_i(:), count_i_aux(:), rows_(:), cols_(:)
+ integer(ilp), intent(inout) :: a(2,*)
+ integer(ilp), intent(inout) :: n
+ integer(ilp), intent(in) :: num_rows
+ integer(ilp), intent(in) :: num_cols
+
+ integer(ilp) :: stride, adr0, adr1, dd
+ integer(ilp) :: n_i, pos, ed
+ integer(ilp), allocatable :: count_i(:), count_i_aux(:), rows_(:), cols_(:)
${t1}$, allocatable :: temp(:)
!---------------------------------------------------------
! Sort a first time with respect to first index using Count sort
@@ -390,7 +390,7 @@ contains
module subroutine coo2ordered(COO,sort_data)
class(COO_type), intent(inout) :: COO
logical, intent(in), optional :: sort_data
- integer, allocatable :: itemp(:,:)
+ integer(ilp), allocatable :: itemp(:,:)
logical :: sort_data_
if(COO%is_sorted) return
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 42180f8c9..127dbee91 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -19,6 +19,9 @@ module stdlib_sparse_kinds
end enum
public :: sparse_full, sparse_lower, sparse_upper
+ ! Integer size support for ILP64 builds should be done here
+ integer, parameter :: ilp = int32
+
#:for k1, t1, s1 in (R_KINDS_TYPES)
${t1}$, parameter :: zero_${s1}$ = 0._${k1}$
${t1}$, parameter :: one_${s1}$ = 1._${k1}$
@@ -32,9 +35,9 @@ module stdlib_sparse_kinds
!!
!! Base sparse type holding the meta data related to the storage capacity of a matrix.
type, public, abstract :: sparse_type
- integer :: nrows = 0 !! number of rows
- integer :: ncols = 0 !! number of columns
- integer :: nnz = 0 !! number of non-zero values
+ integer(ilp) :: nrows = 0 !! number of rows
+ integer(ilp) :: ncols = 0 !! number of columns
+ integer(ilp) :: nnz = 0 !! number of non-zero values
integer :: storage = sparse_full !! assumed storage symmetry
end type
@@ -43,7 +46,7 @@ module stdlib_sparse_kinds
!! COO: COOrdinates compresed format
type, public, extends(sparse_type) :: COO_type
logical :: is_sorted = .false. !! whether the matrix is sorted or not
- integer, allocatable :: index(:,:) !! Matrix coordinates index(2,nnz)
+ integer(ilp), allocatable :: index(:,:) !! Matrix coordinates index(2,nnz)
contains
procedure :: malloc => malloc_coo
end type
@@ -63,8 +66,8 @@ module stdlib_sparse_kinds
!!
!! CSR: Compressed sparse row or Yale format
type, public, extends(sparse_type) :: CSR_type
- integer, allocatable :: col(:) !! matrix column pointer
- integer, allocatable :: rowptr(:) !! matrix row pointer
+ integer(ilp), allocatable :: col(:) !! matrix column pointer
+ integer(ilp), allocatable :: rowptr(:) !! matrix row pointer
contains
procedure :: malloc => malloc_csr
end type
@@ -84,8 +87,8 @@ module stdlib_sparse_kinds
!!
!! CSC: Compressed sparse column
type, public, extends(sparse_type) :: CSC_type
- integer, allocatable :: colptr(:) !! matrix column pointer
- integer, allocatable :: row(:) !! matrix row pointer
+ integer(ilp), allocatable :: colptr(:) !! matrix column pointer
+ integer(ilp), allocatable :: row(:) !! matrix row pointer
contains
procedure :: malloc => malloc_csc
end type
@@ -106,7 +109,7 @@ module stdlib_sparse_kinds
!! Compressed ELLPACK
type, public, extends(sparse_type) :: ELL_type
integer :: K = 0 !! maximum number of nonzeros per row
- integer, allocatable :: index(:,:) !! column indices
+ integer(ilp), allocatable :: index(:,:) !! column indices
contains
procedure :: malloc => malloc_ell
end type
@@ -128,8 +131,8 @@ module stdlib_sparse_kinds
!! Reference : https://library.eecs.utk.edu/storage/files/ut-eecs-14-727.pdf
type, public, extends(sparse_type) :: SELLC_type
integer :: chunk_size = 8 !! default chunk size
- integer, allocatable :: rowptr(:) !! row pointer
- integer, allocatable :: col(:,:) !! column indices
+ integer(ilp), allocatable :: rowptr(:) !! row pointer
+ integer(ilp), allocatable :: col(:,:) !! column indices
end type
#:for k1, t1, s1 in (KINDS_TYPES)
@@ -337,11 +340,11 @@ contains
!! (re)Allocate matrix memory for the COO type
subroutine malloc_coo(self,num_rows,num_cols,nnz)
class(COO_type) :: self
- integer, intent(in) :: num_rows !! number of rows
- integer, intent(in) :: num_cols !! number of columns
- integer, intent(in) :: nnz !! number of non zeros
+ integer(ilp), intent(in) :: num_rows !! number of rows
+ integer(ilp), intent(in) :: num_cols !! number of columns
+ integer(ilp), intent(in) :: nnz !! number of non zeros
- integer, allocatable :: temp_idx(:,:)
+ integer(ilp), allocatable :: temp_idx(:,:)
!-----------------------------------------------------
self%nrows = num_rows
@@ -374,11 +377,11 @@ contains
!! (re)Allocate matrix memory for the CSR type
subroutine malloc_csr(self,num_rows,num_cols,nnz)
class(CSR_type) :: self
- integer, intent(in) :: num_rows !! number of rows
- integer, intent(in) :: num_cols !! number of columns
- integer, intent(in) :: nnz !! number of non zeros
+ integer(ilp), intent(in) :: num_rows !! number of rows
+ integer(ilp), intent(in) :: num_cols !! number of columns
+ integer(ilp), intent(in) :: nnz !! number of non zeros
- integer, allocatable :: temp_idx(:)
+ integer(ilp), allocatable :: temp_idx(:)
!-----------------------------------------------------
self%nrows = num_rows
@@ -418,11 +421,11 @@ contains
!! (re)Allocate matrix memory for the CSC type
subroutine malloc_csc(self,num_rows,num_cols,nnz)
class(CSC_type) :: self
- integer, intent(in) :: num_rows !! number of rows
- integer, intent(in) :: num_cols !! number of columns
- integer, intent(in) :: nnz !! number of non zeros
+ integer(ilp), intent(in) :: num_rows !! number of rows
+ integer(ilp), intent(in) :: num_cols !! number of columns
+ integer(ilp), intent(in) :: nnz !! number of non zeros
- integer, allocatable :: temp_idx(:)
+ integer(ilp), allocatable :: temp_idx(:)
!-----------------------------------------------------
self%nrows = num_rows
@@ -462,11 +465,11 @@ contains
!! (re)Allocate matrix memory for the ELLPACK type
subroutine malloc_ell(self,num_rows,num_cols,num_nz_rows)
class(ELL_type) :: self
- integer, intent(in) :: num_rows !! number of rows
- integer, intent(in) :: num_cols !! number of columns
- integer, intent(in) :: num_nz_rows !! number of non zeros per row
+ integer(ilp), intent(in) :: num_rows !! number of rows
+ integer(ilp), intent(in) :: num_cols !! number of columns
+ integer(ilp), intent(in) :: num_nz_rows !! number of non zeros per row
- integer, allocatable :: temp_idx(:,:)
+ integer(ilp), allocatable :: temp_idx(:,:)
!-----------------------------------------------------
self%nrows = num_rows
@@ -498,12 +501,12 @@ contains
subroutine coo_from_ijv_type(COO,row,col,nrows,ncols)
type(COO_type), intent(inout) :: COO
- integer, intent(in) :: row(:)
- integer, intent(in) :: col(:)
- integer, intent(in), optional :: nrows
- integer, intent(in), optional :: ncols
+ integer(ilp), intent(in) :: row(:)
+ integer(ilp), intent(in) :: col(:)
+ integer(ilp), intent(in), optional :: nrows
+ integer(ilp), intent(in), optional :: ncols
- integer :: nrows_, ncols_, nnz, ed
+ integer(ilp) :: nrows_, ncols_, nnz, ed
!---------------------------------------------------------
if(present(nrows)) then
nrows_ = nrows
@@ -528,13 +531,13 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
subroutine coo_from_ijv_${s1}$(COO,row,col,data,nrows,ncols)
type(COO_${s1}$), intent(inout) :: COO
- integer, intent(in) :: row(:)
- integer, intent(in) :: col(:)
+ integer(ilp), intent(in) :: row(:)
+ integer(ilp), intent(in) :: col(:)
${t1}$, intent(in), optional :: data(:)
- integer, intent(in), optional :: nrows
- integer, intent(in), optional :: ncols
+ integer(ilp), intent(in), optional :: nrows
+ integer(ilp), intent(in), optional :: ncols
- integer :: nrows_, ncols_, nnz, ed
+ integer(ilp) :: nrows_, ncols_, nnz, ed
!---------------------------------------------------------
if(present(nrows)) then
nrows_ = nrows
@@ -561,13 +564,13 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
subroutine csr_from_ijv_${s1}$(CSR,row,col,data,nrows,ncols)
type(CSR_${s1}$), intent(inout) :: CSR
- integer, intent(in) :: row(:)
- integer, intent(in) :: col(:)
+ integer(ilp), intent(in) :: row(:)
+ integer(ilp), intent(in) :: col(:)
${t1}$, intent(in), optional :: data(:)
- integer, intent(in), optional :: nrows
- integer, intent(in), optional :: ncols
+ integer(ilp), intent(in), optional :: nrows
+ integer(ilp), intent(in), optional :: ncols
- integer :: nrows_, ncols_
+ integer(ilp) :: nrows_, ncols_
!---------------------------------------------------------
if(present(nrows)) then
nrows_ = nrows
@@ -595,14 +598,14 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
subroutine ell_from_ijv_${s1}$(ELL,row,col,data,nrows,ncols,num_nz_rows)
type(ELL_${s1}$), intent(inout) :: ELL
- integer, intent(in) :: row(:)
- integer, intent(in) :: col(:)
+ integer(ilp), intent(in) :: row(:)
+ integer(ilp), intent(in) :: col(:)
${t1}$, intent(in), optional :: data(:)
- integer, intent(in), optional :: nrows
- integer, intent(in), optional :: ncols
+ integer(ilp), intent(in), optional :: nrows
+ integer(ilp), intent(in), optional :: ncols
integer, intent(in), optional :: num_nz_rows
- integer :: nrows_, ncols_
+ integer(ilp) :: nrows_, ncols_
!---------------------------------------------------------
if(present(nrows)) then
nrows_ = nrows
@@ -636,14 +639,14 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
subroutine sellc_from_ijv_${s1}$(SELLC,row,col,data,nrows,ncols,chunk)
type(SELLC_${s1}$), intent(inout) :: SELLC
- integer, intent(in) :: row(:)
- integer, intent(in) :: col(:)
+ integer(ilp), intent(in) :: row(:)
+ integer(ilp), intent(in) :: col(:)
${t1}$, intent(in), optional :: data(:)
- integer, intent(in), optional :: nrows
- integer, intent(in), optional :: ncols
+ integer(ilp), intent(in), optional :: nrows
+ integer(ilp), intent(in), optional :: ncols
integer, intent(in), optional :: chunk
- integer :: nrows_, ncols_
+ integer(ilp) :: nrows_, ncols_
!---------------------------------------------------------
if(present(nrows)) then
nrows_ = nrows
@@ -678,8 +681,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function at_value_coo_${s1}$(self,ik,jk) result(val)
class(COO_${s1}$), intent(in) :: self
- integer, intent(in) :: ik, jk
- integer :: k, ik_, jk_
+ integer(ilp), intent(in) :: ik, jk
+ integer(ilp) :: k, ik_, jk_
logical :: transpose
! naive implementation
if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
@@ -703,8 +706,8 @@ contains
subroutine add_value_coo_${s1}$(self,ik,jk,val)
class(COO_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
- integer, intent(in) :: ik, jk
- integer :: k
+ integer(ilp), intent(in) :: ik, jk
+ integer(ilp) :: k
! naive implementation
do k = 1,self%nnz
if( ik == self%index(1,k) .and. jk == self%index(2,k) ) then
@@ -717,8 +720,8 @@ contains
subroutine add_block_coo_${s1}$(self,ik,jk,val)
class(COO_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val(:,:)
- integer, intent(in) :: ik(:), jk(:)
- integer :: k, i, j
+ integer(ilp), intent(in) :: ik(:), jk(:)
+ integer(ilp) :: k, i, j
! naive implementation
do k = 1, self%nnz
do i = 1, size(ik)
@@ -736,8 +739,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function at_value_csr_${s1}$(self,ik,jk) result(val)
class(CSR_${s1}$), intent(in) :: self
- integer, intent(in) :: ik, jk
- integer :: k, ik_, jk_
+ integer(ilp), intent(in) :: ik, jk
+ integer(ilp) :: k, ik_, jk_
logical :: transpose
! naive implementation
if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
@@ -761,8 +764,8 @@ contains
subroutine add_value_csr_${s1}$(self,ik,jk,val)
class(CSR_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
- integer, intent(in) :: ik, jk
- integer :: k
+ integer(ilp), intent(in) :: ik, jk
+ integer(ilp) :: k
! naive implementation
do k = self%rowptr(ik), self%rowptr(ik+1)-1
if( jk == self%col(k) ) then
@@ -775,8 +778,8 @@ contains
subroutine add_block_csr_${s1}$(self,ik,jk,val)
class(CSR_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val(:,:)
- integer, intent(in) :: ik(:), jk(:)
- integer :: k, i, j
+ integer(ilp), intent(in) :: ik(:), jk(:)
+ integer(ilp) :: k, i, j
! naive implementation
do i = 1, size(ik)
do k = self%rowptr(ik(i)), self%rowptr(ik(i)+1)-1
@@ -794,8 +797,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function at_value_csc_${s1}$(self,ik,jk) result(val)
class(CSC_${s1}$), intent(in) :: self
- integer, intent(in) :: ik, jk
- integer :: k, ik_, jk_
+ integer(ilp), intent(in) :: ik, jk
+ integer(ilp) :: k, ik_, jk_
logical :: transpose
! naive implementation
if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
@@ -819,8 +822,8 @@ contains
subroutine add_value_csc_${s1}$(self,ik,jk,val)
class(CSC_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
- integer, intent(in) :: ik, jk
- integer :: k
+ integer(ilp), intent(in) :: ik, jk
+ integer(ilp) :: k
! naive implementation
do k = self%colptr(jk), self%colptr(jk+1)-1
if( ik == self%row(k) ) then
@@ -833,8 +836,8 @@ contains
subroutine add_block_csc_${s1}$(self,ik,jk,val)
class(CSC_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val(:,:)
- integer, intent(in) :: ik(:), jk(:)
- integer :: k, i, j
+ integer(ilp), intent(in) :: ik(:), jk(:)
+ integer(ilp) :: k, i, j
! naive implementation
do j = 1, size(jk)
do k = self%colptr(jk(j)), self%colptr(jk(j)+1)-1
@@ -852,8 +855,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function at_value_ell_${s1}$(self,ik,jk) result(val)
class(ELL_${s1}$), intent(in) :: self
- integer, intent(in) :: ik, jk
- integer :: k, ik_, jk_
+ integer(ilp), intent(in) :: ik, jk
+ integer(ilp) :: k, ik_, jk_
logical :: transpose
! naive implementation
if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
@@ -877,8 +880,8 @@ contains
subroutine add_value_ell_${s1}$(self,ik,jk,val)
class(ELL_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
- integer, intent(in) :: ik, jk
- integer :: k
+ integer(ilp), intent(in) :: ik, jk
+ integer(ilp) :: k
! naive implementation
do k = 1 , self%K
if( jk == self%index(ik,k) ) then
@@ -891,8 +894,8 @@ contains
subroutine add_block_ell_${s1}$(self,ik,jk,val)
class(ELL_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val(:,:)
- integer, intent(in) :: ik(:), jk(:)
- integer :: k, i, j
+ integer(ilp), intent(in) :: ik(:), jk(:)
+ integer(ilp) :: k, i, j
! naive implementation
do k = 1 , self%K
do j = 1, size(jk)
@@ -910,8 +913,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function at_value_sellc_${s1}$(self,ik,jk) result(val)
class(SELLC_${s1}$), intent(in) :: self
- integer, intent(in) :: ik, jk
- integer :: k, ik_, jk_, idx
+ integer(ilp), intent(in) :: ik, jk
+ integer(ilp) :: k, ik_, jk_, idx
logical :: transpose
! naive implementation
if( (ik<1 .or. ik>self%nrows) .or. (jk<1 .or. jk>self%ncols) ) then
@@ -937,8 +940,8 @@ contains
subroutine add_value_sellc_${s1}$(self,ik,jk,val)
class(SELLC_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val
- integer, intent(in) :: ik, jk
- integer :: k, idx
+ integer(ilp), intent(in) :: ik, jk
+ integer(ilp) :: k, idx
! naive implementation
idx = self%rowptr((ik - 1)/self%chunk_size + 1)
do k = 1, self%chunk_size
@@ -952,8 +955,8 @@ contains
subroutine add_block_sellc_${s1}$(self,ik,jk,val)
class(SELLC_${s1}$), intent(inout) :: self
${t1}$, intent(in) :: val(:,:)
- integer, intent(in) :: ik(:), jk(:)
- integer :: k, i, j, idx
+ integer(ilp), intent(in) :: ik(:), jk(:)
+ integer(ilp) :: k, i, j, idx
! naive implementation
do k = 1 , self%chunk_size
do j = 1, size(jk)
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index b569aafb6..e329c75c0 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -25,7 +25,7 @@ contains
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
${t1}$ :: alpha_, beta_
- integer :: k, ik, jk
+ integer(ilp) :: k, ik, jk
alpha_ = one_${k1}$
if(present(alpha)) alpha_ = alpha
@@ -68,7 +68,7 @@ contains
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
${t1}$ :: alpha_, beta_
- integer :: i, j
+ integer(ilp) :: i, j
#:if rank == 1
${t1}$ :: aux, aux2
#:else
@@ -148,7 +148,7 @@ contains
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
${t1}$ :: alpha_, beta_
- integer :: i, j
+ integer(ilp) :: i, j
#:if rank == 1
${t1}$ :: aux
#:else
@@ -212,7 +212,7 @@ contains
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
${t1}$ :: alpha_, beta_
- integer :: i, j, k
+ integer(ilp) :: i, j, k
alpha_ = one_${k1}$
if(present(alpha)) alpha_ = alpha
@@ -247,7 +247,7 @@ contains
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
${t1}$ :: alpha_, beta_
- integer :: i, nz, rowidx, num_chunks, rm
+ integer(ilp) :: i, nz, rowidx, num_chunks, rm
alpha_ = one_${s1}$
if(present(alpha)) alpha_ = alpha
@@ -292,7 +292,7 @@ contains
pure subroutine chunk_kernel_${chunk}$(nz,a,ja,x,y)
integer, value :: nz
${t1}$, intent(in) :: a(${chunk}$,nz), x(*)
- integer, intent(in) :: ja(${chunk}$,nz)
+ integer(ilp), intent(in) :: ja(${chunk}$,nz)
${t1}$, intent(inout) :: y(${chunk}$)
integer :: j
do j = 1, nz
@@ -304,7 +304,7 @@ contains
pure subroutine chunk_kernel_remainder(nz,cs,rm,a,ja,x,y)
integer, value :: nz, cs, rm
${t1}$, intent(in) :: a(cs,nz), x(*)
- integer, intent(in) :: ja(cs,nz)
+ integer(ilp), intent(in) :: ja(cs,nz)
${t1}$, intent(inout) :: y(rm)
integer :: j
do j = 1, nz
From 3596f3fdd10a444f4abacb40ff6e84d5fcd70c78 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Fri, 12 Jul 2024 23:43:16 +0200
Subject: [PATCH 61/78] add the _type suffix to all sparse types
---
doc/specs/stdlib_sparse.md | 10 +-
.../linalg/example_sparse_data_accessors.f90 | 4 +-
example/linalg/example_sparse_from_ijv.f90 | 6 +-
example/linalg/example_sparse_spmv.f90 | 4 +-
src/stdlib_sparse_conversion.fypp | 24 ++---
src/stdlib_sparse_kinds.fypp | 98 +++++++++----------
src/stdlib_sparse_spmv.fypp | 10 +-
test/linalg/test_sparse_spmv.fypp | 22 ++---
8 files changed, 89 insertions(+), 89 deletions(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 2e8e6ceb5..88d28d4f0 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -39,7 +39,7 @@ enum, bind(C)
enumerator :: sparse_upper !! Symmetric Sparse matrix with triangular supperior storage
end enum
```
-In the following, all sparse kinds will be presented in two main flavors: a data-less type `<matrix>_type` useful for topological graph operations. And real/complex valued types `<matrix>_<kind>` containing the `data` buffer for the matrix values. The following rectangular matrix will be used to showcase how each sparse matrix holds the data internally:
+In the following, all sparse kinds will be presented in two main flavors: a data-less type `<matrix>_type` useful for topological graph operations. And real/complex valued types `<matrix>_<kind>_type` containing the `data` buffer for the matrix values. The following rectangular matrix will be used to showcase how each sparse matrix holds the data internally:
$$ M = \begin{bmatrix}
9 & 0 & 0 & 0 & -3 \\
@@ -57,7 +57,7 @@ Experimental
The `COO`, triplet or `ijv` format defines all non-zero elements of the matrix by explicitly allocating the `i,j` index and the value of the matrix. While some implementations use separate `row` and `col` arrays for the index, here we use a 2D array in order to promote fast memory acces to `ij`.
```Fortran
-type(COO_sp) :: COO
+type(COO_sp_type) :: COO
call COO%malloc(4,5,10)
COO%data(:) = real([9,-3,4,7,8,-1,8,4,5,6])
COO%index(1:2,1) = [1,1]
@@ -81,7 +81,7 @@ Experimental
The Compressed Sparse Row or Yale format `CSR` stores the matrix structure by compressing the row indices with a counter pointer `rowptr` enabling to know the first and last non-zero column index `col` of the given row.
```Fortran
-type(CSR_sp) :: CSR
+type(CSR_sp_type) :: CSR
call CSR%malloc(4,5,10)
CSR%data(:) = real([9,-3,4,7,8,-1,8,4,5,6])
CSR%col(:) = [1,5,1,2,2,3,4,1,3,4]
@@ -97,7 +97,7 @@ Experimental
The Compressed Sparse Colum `CSC` is similar to the `CSR` format but values are accesed first by column, thus an index counter is given by `colptr` which enables to know the first and last non-zero row index of a given colum.
```Fortran
-type(CSC_sp) :: CSC
+type(CSC_sp_type) :: CSC
call CSC%malloc(4,5,10)
CSC%data(:) = real([9,4,4,7,8,-1,5,8,6,-3])
CSC%row(:) = [1,2,4,2,3,3,4,3,4,1]
@@ -113,7 +113,7 @@ Experimental
The `ELL` format stores data in a dense matrix of $nrows \times K$ in column major order. By imposing a constant number of elements per row $K$, this format will incur in additional zeros being stored, but it enables efficient vectorization as memory acces is carried out by constant sized strides.
```Fortran
-type(ELL_sp) :: ELL
+type(ELL_sp_type) :: ELL
call ELL%malloc(num_rows=4,num_cols=5,num_nz_row=3)
ELL%data(1,1:3) = real([9,-3,0])
ELL%data(2,1:3) = real([4,7,0])
diff --git a/example/linalg/example_sparse_data_accessors.f90 b/example/linalg/example_sparse_data_accessors.f90
index e4de820f3..e23164524 100644
--- a/example/linalg/example_sparse_data_accessors.f90
+++ b/example/linalg/example_sparse_data_accessors.f90
@@ -5,8 +5,8 @@ program example_sparse_data_accessors
real(dp) :: mat(2,2)
real(dp), allocatable :: dense(:,:)
- type(CSR_dp) :: CSR
- type(COO_dp) :: COO
+ type(CSR_dp_type) :: CSR
+ type(COO_dp_type) :: COO
integer :: i, j, locdof(2)
! Initial data
diff --git a/example/linalg/example_sparse_from_ijv.f90 b/example/linalg/example_sparse_from_ijv.f90
index 1382cd3dd..628955361 100644
--- a/example/linalg/example_sparse_from_ijv.f90
+++ b/example/linalg/example_sparse_from_ijv.f90
@@ -5,9 +5,9 @@ program example_sparse_from_ijv
integer :: row(10), col(10)
real(dp) :: data(10)
- type(COO_dp) :: COO
- type(CSR_dp) :: CSR
- type(ELL_dp) :: ELL
+ type(COO_dp_type) :: COO
+ type(CSR_dp_type) :: CSR
+ type(ELL_dp_type) :: ELL
integer :: i, j
! Initial data
diff --git a/example/linalg/example_sparse_spmv.f90 b/example/linalg/example_sparse_spmv.f90
index 25052710c..27b27b8db 100644
--- a/example/linalg/example_sparse_spmv.f90
+++ b/example/linalg/example_sparse_spmv.f90
@@ -7,8 +7,8 @@ program example_sparse_spmv
real(dp) :: A(m,n), x(n)
real(dp) :: y_dense(m), y_coo(m), y_csr(m)
real(dp) :: alpha, beta
- type(COO_dp) :: COO
- type(CSR_dp) :: CSR
+ type(COO_dp_type) :: COO
+ type(CSR_dp_type) :: CSR
call random_number(A)
! Convert from dense to COO and CSR matrices
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 7918f5ade..d81508ecd 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -23,7 +23,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine dense2coo_${s1}$(dense,COO)
${t1}$, intent(in) :: dense(:,:)
- type(COO_${s1}$), intent(out) :: COO
+ type(COO_${s1}$_type), intent(out) :: COO
integer(ilp) :: num_rows, num_cols, nnz
integer(ilp) :: i, j, idx
@@ -50,7 +50,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine coo2dense_${s1}$(COO,dense)
- type(COO_${s1}$), intent(in) :: COO
+ type(COO_${s1}$_type), intent(in) :: COO
${t1}$, allocatable, intent(out) :: dense(:,:)
integer(ilp) :: idx
@@ -64,8 +64,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine coo2csr_${s1}$(COO,CSR)
- type(COO_${s1}$), intent(in) :: COO
- type(CSR_${s1}$), intent(out) :: CSR
+ type(COO_${s1}$_type), intent(in) :: COO
+ type(CSR_${s1}$_type), intent(out) :: CSR
integer(ilp) :: i
CSR%nnz = COO%nnz; CSR%nrows = COO%nrows; CSR%ncols = COO%ncols
@@ -94,7 +94,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2dense_${s1}$(CSR,dense)
- type(CSR_${s1}$), intent(in) :: CSR
+ type(CSR_${s1}$_type), intent(in) :: CSR
${t1}$, allocatable, intent(out) :: dense(:,:)
integer(ilp) :: i, j
@@ -120,8 +120,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2coo_${s1}$(CSR,COO)
- type(CSR_${s1}$), intent(in) :: CSR
- type(COO_${s1}$), intent(out) :: COO
+ type(CSR_${s1}$_type), intent(in) :: CSR
+ type(COO_${s1}$_type), intent(out) :: COO
integer(ilp) :: i, j
COO%nnz = CSR%nnz; COO%nrows = CSR%nrows; COO%ncols = CSR%ncols
@@ -146,8 +146,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2ell_${s1}$(CSR,ELL,num_nz_rows)
- type(CSR_${s1}$), intent(in) :: CSR
- type(ELL_${s1}$), intent(out) :: ELL
+ type(CSR_${s1}$_type), intent(in) :: CSR
+ type(ELL_${s1}$_type), intent(out) :: ELL
integer, intent(in), optional :: num_nz_rows !! number of non zeros per row
integer(ilp) :: i, j, num_nz_rows_, adr1, adr2
@@ -178,8 +178,8 @@ contains
module subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
!! csr2sellc: This function enables transfering data from a CSR matrix to a SELL-C matrix
!! This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
- type(CSR_${s1}$), intent(in) :: CSR
- type(SELLC_${s1}$), intent(out) :: SELLC
+ type(CSR_${s1}$_type), intent(in) :: CSR
+ type(SELLC_${s1}$_type), intent(out) :: SELLC
integer, intent(in), optional :: chunk
${t1}$, parameter :: zero = zero_${s1}$
integer(ilp) :: i, j, num_chunks
@@ -402,7 +402,7 @@ contains
type is( COO_type )
call sort_coo(COO%index, COO%nnz, COO%nrows, COO%ncols)
#:for k1, t1, s1 in (KINDS_TYPES)
- type is( COO_${s1}$ )
+ type is( COO_${s1}$_type )
block
${t1}$, allocatable :: temp(:)
if( sort_data_ ) then
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 127dbee91..baa21851c 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -52,7 +52,7 @@ module stdlib_sparse_kinds
end type
#:for k1, t1, s1 in (KINDS_TYPES)
- type, public, extends(COO_type) :: COO_${s1}$
+ type, public, extends(COO_type) :: COO_${s1}$_type
${t1}$, allocatable :: data(:)
contains
procedure, non_overridable :: at => at_value_coo_${s1}$
@@ -73,7 +73,7 @@ module stdlib_sparse_kinds
end type
#:for k1, t1, s1 in (KINDS_TYPES)
- type, public, extends(CSR_type) :: CSR_${s1}$
+ type, public, extends(CSR_type) :: CSR_${s1}$_type
${t1}$, allocatable :: data(:)
contains
procedure, non_overridable :: at => at_value_csr_${s1}$
@@ -94,7 +94,7 @@ module stdlib_sparse_kinds
end type
#:for k1, t1, s1 in (KINDS_TYPES)
- type, public, extends(CSC_type) :: CSC_${s1}$
+ type, public, extends(CSC_type) :: CSC_${s1}$_type
${t1}$, allocatable :: data(:)
contains
procedure, non_overridable :: at => at_value_csc_${s1}$
@@ -115,7 +115,7 @@ module stdlib_sparse_kinds
end type
#:for k1, t1, s1 in (KINDS_TYPES)
- type, public, extends(ELL_type) :: ELL_${s1}$
+ type, public, extends(ELL_type) :: ELL_${s1}$_type
${t1}$, allocatable :: data(:,:)
contains
procedure, non_overridable :: at => at_value_ell_${s1}$
@@ -136,7 +136,7 @@ module stdlib_sparse_kinds
end type
#:for k1, t1, s1 in (KINDS_TYPES)
- type, public, extends(SELLC_type) :: SELLC_${s1}$
+ type, public, extends(SELLC_type) :: SELLC_${s1}$_type
${t1}$, allocatable :: data(:,:)
contains
procedure, non_overridable :: at => at_value_sellc_${s1}$
@@ -156,7 +156,7 @@ module stdlib_sparse_kinds
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine dense2coo_${s1}$(dense,COO)
${t1}$, intent(in) :: dense(:,:)
- type(COO_${s1}$), intent(out) :: COO
+ type(COO_${s1}$_type), intent(out) :: COO
end subroutine
#:endfor
end interface
@@ -171,7 +171,7 @@ module stdlib_sparse_kinds
interface coo2dense
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine coo2dense_${s1}$(COO,dense)
- type(COO_${s1}$), intent(in) :: COO
+ type(COO_${s1}$_type), intent(in) :: COO
${t1}$, allocatable, intent(out) :: dense(:,:)
end subroutine
#:endfor
@@ -187,8 +187,8 @@ module stdlib_sparse_kinds
interface coo2csr
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine coo2csr_${s1}$(COO,CSR)
- type(COO_${s1}$), intent(in) :: COO
- type(CSR_${s1}$), intent(out) :: CSR
+ type(COO_${s1}$_type), intent(in) :: COO
+ type(CSR_${s1}$_type), intent(out) :: CSR
end subroutine
#:endfor
end interface
@@ -203,7 +203,7 @@ module stdlib_sparse_kinds
interface csr2dense
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2dense_${s1}$(CSR,dense)
- type(CSR_${s1}$), intent(in) :: CSR
+ type(CSR_${s1}$_type), intent(in) :: CSR
${t1}$, allocatable, intent(out) :: dense(:,:)
end subroutine
#:endfor
@@ -219,8 +219,8 @@ module stdlib_sparse_kinds
interface csr2coo
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2coo_${s1}$(CSR,COO)
- type(CSR_${s1}$), intent(in) :: CSR
- type(COO_${s1}$), intent(out) :: COO
+ type(CSR_${s1}$_type), intent(in) :: CSR
+ type(COO_${s1}$_type), intent(out) :: COO
end subroutine
#:endfor
end interface
@@ -235,8 +235,8 @@ module stdlib_sparse_kinds
interface csr2ell
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2ell_${s1}$(CSR,ELL,num_nz_rows)
- type(CSR_${s1}$), intent(in) :: CSR
- type(ELL_${s1}$), intent(out) :: ELL
+ type(CSR_${s1}$_type), intent(in) :: CSR
+ type(ELL_${s1}$_type), intent(out) :: ELL
integer, intent(in), optional :: num_nz_rows
end subroutine
#:endfor
@@ -252,8 +252,8 @@ module stdlib_sparse_kinds
interface csr2sellc
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
- type(CSR_${s1}$), intent(in) :: CSR
- type(SELLC_${s1}$), intent(out) :: SELLC
+ type(CSR_${s1}$_type), intent(in) :: CSR
+ type(SELLC_${s1}$_type), intent(out) :: SELLC
integer, intent(in), optional :: chunk
end subroutine
#:endfor
@@ -295,28 +295,28 @@ module stdlib_sparse_kinds
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
module subroutine spmv_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(COO_${s1}$), intent(in) :: matrix
+ type(COO_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
end subroutine
module subroutine spmv_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(CSR_${s1}$), intent(in) :: matrix
+ type(CSR_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
end subroutine
module subroutine spmv_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(CSC_${s1}$), intent(in) :: matrix
+ type(CSC_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
end subroutine
module subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(ELL_${s1}$), intent(in) :: matrix
+ type(ELL_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
@@ -325,7 +325,7 @@ module stdlib_sparse_kinds
#:endfor
module subroutine spmv_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
!! This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
- type(SELLC_${s1}$), intent(in) :: matrix
+ type(SELLC_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x(:)
${t1}$, intent(inout) :: vec_y(:)
${t1}$, intent(in), optional :: alpha
@@ -360,7 +360,7 @@ contains
select type(self)
#:for k1, t1, s1 in (KINDS_TYPES)
- type is(COO_${s1}$)
+ type is(COO_${s1}$_type)
block
${t1}$, allocatable :: temp_data_${s1}$(:)
if(.not.allocated(self%data)) then
@@ -404,7 +404,7 @@ contains
select type(self)
#:for k1, t1, s1 in (KINDS_TYPES)
- type is(CSR_${s1}$)
+ type is(CSR_${s1}$_type)
block
${t1}$, allocatable :: temp_data_${s1}$(:)
if(.not.allocated(self%data)) then
@@ -448,7 +448,7 @@ contains
select type(self)
#:for k1, t1, s1 in (KINDS_TYPES)
- type is(CSC_${s1}$)
+ type is(CSC_${s1}$_type)
block
${t1}$, allocatable :: temp_data_${s1}$(:)
if(.not.allocated(self%data)) then
@@ -485,7 +485,7 @@ contains
select type(self)
#:for k1, t1, s1 in (KINDS_TYPES)
- type is(ELL_${s1}$)
+ type is(ELL_${s1}$_type)
block
${t1}$, allocatable :: temp_data_${s1}$(:,:)
if(.not.allocated(self%data)) then
@@ -530,7 +530,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
subroutine coo_from_ijv_${s1}$(COO,row,col,data,nrows,ncols)
- type(COO_${s1}$), intent(inout) :: COO
+ type(COO_${s1}$_type), intent(inout) :: COO
integer(ilp), intent(in) :: row(:)
integer(ilp), intent(in) :: col(:)
${t1}$, intent(in), optional :: data(:)
@@ -563,7 +563,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
subroutine csr_from_ijv_${s1}$(CSR,row,col,data,nrows,ncols)
- type(CSR_${s1}$), intent(inout) :: CSR
+ type(CSR_${s1}$_type), intent(inout) :: CSR
integer(ilp), intent(in) :: row(:)
integer(ilp), intent(in) :: col(:)
${t1}$, intent(in), optional :: data(:)
@@ -584,7 +584,7 @@ contains
end if
!---------------------------------------------------------
block
- type(COO_${s1}$) :: COO
+ type(COO_${s1}$_type) :: COO
if(present(data)) then
call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
else
@@ -597,7 +597,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
subroutine ell_from_ijv_${s1}$(ELL,row,col,data,nrows,ncols,num_nz_rows)
- type(ELL_${s1}$), intent(inout) :: ELL
+ type(ELL_${s1}$_type), intent(inout) :: ELL
integer(ilp), intent(in) :: row(:)
integer(ilp), intent(in) :: col(:)
${t1}$, intent(in), optional :: data(:)
@@ -619,8 +619,8 @@ contains
end if
!---------------------------------------------------------
block
- type(COO_${s1}$) :: COO
- type(CSR_${s1}$) :: CSR
+ type(COO_${s1}$_type) :: COO
+ type(CSR_${s1}$_type) :: CSR
if(present(data)) then
call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
else
@@ -638,7 +638,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
subroutine sellc_from_ijv_${s1}$(SELLC,row,col,data,nrows,ncols,chunk)
- type(SELLC_${s1}$), intent(inout) :: SELLC
+ type(SELLC_${s1}$_type), intent(inout) :: SELLC
integer(ilp), intent(in) :: row(:)
integer(ilp), intent(in) :: col(:)
${t1}$, intent(in), optional :: data(:)
@@ -661,8 +661,8 @@ contains
if(present(chunk)) SELLC%chunk_size = chunk
!---------------------------------------------------------
block
- type(COO_${s1}$) :: COO
- type(CSR_${s1}$) :: CSR
+ type(COO_${s1}$_type) :: COO
+ type(CSR_${s1}$_type) :: CSR
if(present(data)) then
call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
else
@@ -680,7 +680,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function at_value_coo_${s1}$(self,ik,jk) result(val)
- class(COO_${s1}$), intent(in) :: self
+ class(COO_${s1}$_type), intent(in) :: self
integer(ilp), intent(in) :: ik, jk
integer(ilp) :: k, ik_, jk_
logical :: transpose
@@ -704,7 +704,7 @@ contains
end function
subroutine add_value_coo_${s1}$(self,ik,jk,val)
- class(COO_${s1}$), intent(inout) :: self
+ class(COO_${s1}$_type), intent(inout) :: self
${t1}$, intent(in) :: val
integer(ilp), intent(in) :: ik, jk
integer(ilp) :: k
@@ -718,7 +718,7 @@ contains
end subroutine
subroutine add_block_coo_${s1}$(self,ik,jk,val)
- class(COO_${s1}$), intent(inout) :: self
+ class(COO_${s1}$_type), intent(inout) :: self
${t1}$, intent(in) :: val(:,:)
integer(ilp), intent(in) :: ik(:), jk(:)
integer(ilp) :: k, i, j
@@ -738,7 +738,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function at_value_csr_${s1}$(self,ik,jk) result(val)
- class(CSR_${s1}$), intent(in) :: self
+ class(CSR_${s1}$_type), intent(in) :: self
integer(ilp), intent(in) :: ik, jk
integer(ilp) :: k, ik_, jk_
logical :: transpose
@@ -762,7 +762,7 @@ contains
end function
subroutine add_value_csr_${s1}$(self,ik,jk,val)
- class(CSR_${s1}$), intent(inout) :: self
+ class(CSR_${s1}$_type), intent(inout) :: self
${t1}$, intent(in) :: val
integer(ilp), intent(in) :: ik, jk
integer(ilp) :: k
@@ -776,7 +776,7 @@ contains
end subroutine
subroutine add_block_csr_${s1}$(self,ik,jk,val)
- class(CSR_${s1}$), intent(inout) :: self
+ class(CSR_${s1}$_type), intent(inout) :: self
${t1}$, intent(in) :: val(:,:)
integer(ilp), intent(in) :: ik(:), jk(:)
integer(ilp) :: k, i, j
@@ -796,7 +796,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function at_value_csc_${s1}$(self,ik,jk) result(val)
- class(CSC_${s1}$), intent(in) :: self
+ class(CSC_${s1}$_type), intent(in) :: self
integer(ilp), intent(in) :: ik, jk
integer(ilp) :: k, ik_, jk_
logical :: transpose
@@ -820,7 +820,7 @@ contains
end function
subroutine add_value_csc_${s1}$(self,ik,jk,val)
- class(CSC_${s1}$), intent(inout) :: self
+ class(CSC_${s1}$_type), intent(inout) :: self
${t1}$, intent(in) :: val
integer(ilp), intent(in) :: ik, jk
integer(ilp) :: k
@@ -834,7 +834,7 @@ contains
end subroutine
subroutine add_block_csc_${s1}$(self,ik,jk,val)
- class(CSC_${s1}$), intent(inout) :: self
+ class(CSC_${s1}$_type), intent(inout) :: self
${t1}$, intent(in) :: val(:,:)
integer(ilp), intent(in) :: ik(:), jk(:)
integer(ilp) :: k, i, j
@@ -854,7 +854,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function at_value_ell_${s1}$(self,ik,jk) result(val)
- class(ELL_${s1}$), intent(in) :: self
+ class(ELL_${s1}$_type), intent(in) :: self
integer(ilp), intent(in) :: ik, jk
integer(ilp) :: k, ik_, jk_
logical :: transpose
@@ -878,7 +878,7 @@ contains
end function
subroutine add_value_ell_${s1}$(self,ik,jk,val)
- class(ELL_${s1}$), intent(inout) :: self
+ class(ELL_${s1}$_type), intent(inout) :: self
${t1}$, intent(in) :: val
integer(ilp), intent(in) :: ik, jk
integer(ilp) :: k
@@ -892,7 +892,7 @@ contains
end subroutine
subroutine add_block_ell_${s1}$(self,ik,jk,val)
- class(ELL_${s1}$), intent(inout) :: self
+ class(ELL_${s1}$_type), intent(inout) :: self
${t1}$, intent(in) :: val(:,:)
integer(ilp), intent(in) :: ik(:), jk(:)
integer(ilp) :: k, i, j
@@ -912,7 +912,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
pure ${t1}$ function at_value_sellc_${s1}$(self,ik,jk) result(val)
- class(SELLC_${s1}$), intent(in) :: self
+ class(SELLC_${s1}$_type), intent(in) :: self
integer(ilp), intent(in) :: ik, jk
integer(ilp) :: k, ik_, jk_, idx
logical :: transpose
@@ -938,7 +938,7 @@ contains
end function
subroutine add_value_sellc_${s1}$(self,ik,jk,val)
- class(SELLC_${s1}$), intent(inout) :: self
+ class(SELLC_${s1}$_type), intent(inout) :: self
${t1}$, intent(in) :: val
integer(ilp), intent(in) :: ik, jk
integer(ilp) :: k, idx
@@ -953,7 +953,7 @@ contains
end subroutine
subroutine add_block_sellc_${s1}$(self,ik,jk,val)
- class(SELLC_${s1}$), intent(inout) :: self
+ class(SELLC_${s1}$_type), intent(inout) :: self
${t1}$, intent(in) :: val(:,:)
integer(ilp), intent(in) :: ik(:), jk(:)
integer(ilp) :: k, i, j, idx
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index e329c75c0..9a2ef3f48 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -19,7 +19,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
module subroutine spmv_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(COO_${s1}$), intent(in) :: matrix
+ type(COO_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
@@ -62,7 +62,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
module subroutine spmv_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(CSR_${s1}$), intent(in) :: matrix
+ type(CSR_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
@@ -142,7 +142,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
module subroutine spmv_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(CSC_${s1}$), intent(in) :: matrix
+ type(CSC_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
@@ -206,7 +206,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
module subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(ELL_${s1}$), intent(in) :: matrix
+ type(ELL_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
@@ -241,7 +241,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
module subroutine spmv_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
!! This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
- type(SELLC_${s1}$), intent(in) :: matrix
+ type(SELLC_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x(:)
${t1}$, intent(inout) :: vec_y(:)
${t1}$, intent(in), optional :: alpha
diff --git a/test/linalg/test_sparse_spmv.fypp b/test/linalg/test_sparse_spmv.fypp
index 8638ef2cd..0f42cad5b 100644
--- a/test/linalg/test_sparse_spmv.fypp
+++ b/test/linalg/test_sparse_spmv.fypp
@@ -34,7 +34,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
block
integer, parameter :: wp = ${k1}$
- type(COO_${s1}$) :: COO
+ type(COO_${s1}$_type) :: COO
${t1}$, allocatable :: dense(:,:)
${t1}$, allocatable :: vec_x(:)
${t1}$, allocatable :: vec_y1(:), vec_y2(:)
@@ -67,7 +67,7 @@ contains
subroutine test_coo2ordered(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
- type(COO_sp) :: COO
+ type(COO_sp_type) :: COO
integer :: row(12), col(12)
real :: data(12)
@@ -98,7 +98,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
block
integer, parameter :: wp = ${k1}$
- type(CSR_${s1}$) :: CSR
+ type(CSR_${s1}$_type) :: CSR
${t1}$, allocatable :: vec_x(:)
${t1}$, allocatable :: vec_y(:)
@@ -123,7 +123,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
block
integer, parameter :: wp = ${k1}$
- type(CSC_${s1}$) :: CSC
+ type(CSC_${s1}$_type) :: CSC
${t1}$, allocatable :: vec_x(:)
${t1}$, allocatable :: vec_y(:)
@@ -148,7 +148,7 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
block
integer, parameter :: wp = ${k1}$
- type(ELL_${s1}$) :: ELL
+ type(ELL_${s1}$_type) :: ELL
${t1}$, allocatable :: vec_x(:)
${t1}$, allocatable :: vec_y(:)
@@ -180,8 +180,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
block
integer, parameter :: wp = ${k1}$
- type(SELLC_${s1}$) :: SELLC
- type(CSR_${s1}$) :: CSR
+ type(SELLC_${s1}$_type) :: SELLC
+ type(CSR_${s1}$_type) :: CSR
${t1}$, allocatable :: vec_x(:)
${t1}$, allocatable :: vec_y(:)
integer :: i
@@ -216,8 +216,8 @@ contains
#:for k1, t1, s1 in (KINDS_TYPES)
block
integer, parameter :: wp = ${k1}$
- type(COO_${s1}$) :: COO
- type(CSR_${s1}$) :: CSR
+ type(COO_${s1}$_type) :: COO
+ type(CSR_${s1}$_type) :: CSR
${t1}$, allocatable :: dense(:,:)
${t1}$, allocatable :: vec_x(:)
${t1}$, allocatable :: vec_y1(:), vec_y2(:), vec_y3(:)
@@ -260,8 +260,8 @@ contains
block
integer, parameter :: wp = ${k1}$
real(wp) :: dense(5,5), mat(2,2)
- type(COO_${s1}$) :: COO
- type(CSR_${s1}$) :: CSR
+ type(COO_${s1}$_type) :: COO
+ type(CSR_${s1}$_type) :: CSR
${t1}$:: err
integer :: i, j, locdof(2)
From c8d94a3e2544da0f1d40f21967ac424c751c159a Mon Sep 17 00:00:00 2001
From: Jose Alves <jose.alves@transvalor.com>
Date: Wed, 31 Jul 2024 12:28:54 +0200
Subject: [PATCH 62/78] rollback on submodules
---
src/stdlib_sparse.f90 | 2 +
src/stdlib_sparse_constants.fypp | 28 +++
src/stdlib_sparse_conversion.fypp | 315 +++++++++++++++++++++++-
src/stdlib_sparse_kinds.fypp | 385 +-----------------------------
src/stdlib_sparse_spmv.fypp | 34 ++-
5 files changed, 360 insertions(+), 404 deletions(-)
create mode 100644 src/stdlib_sparse_constants.fypp
diff --git a/src/stdlib_sparse.f90 b/src/stdlib_sparse.f90
index 6465d68d5..4c1cbcf26 100644
--- a/src/stdlib_sparse.f90
+++ b/src/stdlib_sparse.f90
@@ -1,4 +1,6 @@
!! public API
module stdlib_sparse
use stdlib_sparse_kinds
+ use stdlib_sparse_conversion
+ use stdlib_sparse_spmv
end module stdlib_sparse
\ No newline at end of file
diff --git a/src/stdlib_sparse_constants.fypp b/src/stdlib_sparse_constants.fypp
new file mode 100644
index 000000000..9fbbe38f6
--- /dev/null
+++ b/src/stdlib_sparse_constants.fypp
@@ -0,0 +1,28 @@
+#: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))
+module stdlib_sparse_constants
+ use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
+
+ implicit none
+ public
+
+ enum, bind(C)
+ enumerator :: sparse_full !! Full Sparse matrix (no symmetry considerations)
+ enumerator :: sparse_lower !! Symmetric Sparse matrix with triangular inferior storage
+ enumerator :: sparse_upper !! Symmetric Sparse matrix with triangular supperior storage
+ end enum
+
+ ! Integer size support for ILP64 builds should be done here
+ integer, parameter :: ilp = int32
+
+ #:for k1, t1, s1 in (R_KINDS_TYPES)
+ ${t1}$, parameter :: zero_${s1}$ = 0._${k1}$
+ ${t1}$, parameter :: one_${s1}$ = 1._${k1}$
+ #:endfor
+ #:for k1, t1, s1 in (C_KINDS_TYPES)
+ ${t1}$, parameter :: zero_${s1}$ = (0._${k1}$,0._${k1}$)
+ ${t1}$, parameter :: one_${s1}$ = (1._${k1}$,1._${k1}$)
+ #:endfor
+
+end module stdlib_sparse_constants
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index d81508ecd..7516a223b 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -5,23 +5,133 @@
!! The `stdlib_sparse_conversion` submodule provides sparse to sparse matrix conversion utilities.
!!
! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
-submodule(stdlib_sparse_kinds) stdlib_sparse_conversion
+module stdlib_sparse_conversion
use stdlib_sorting, only: sort
+ use stdlib_sparse_constants
+ use stdlib_sparse_kinds
implicit none
-
+ private
!! Sort arrays of a COO matrix
!!
interface sort_coo
- module procedure sort_coo_unique
+ module procedure :: sort_coo_unique
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: sort_coo_unique_${s1}$
+ #:endfor
+ end interface
+
+ !! version: experimental
+ !!
+ !! Conversion from dense to coo
+ !! Enables extracting the non-zero elements of a dense 2D matrix and
+ !! storing those values in a COO format. The coo matrix is (re)allocated on the fly.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ interface dense2coo
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: dense2coo_${s1}$
+ #:endfor
+ end interface
+ public :: dense2coo
+
+ !! version: experimental
+ !!
+ !! Conversion from coo to dense
+ !! Enables creating a dense 2D matrix from the non-zero values stored in a COO format
+ !! The dense matrix can be allocated on the fly if not pre-allocated by the user.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ interface coo2dense
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: coo2dense_${s1}$
+ #:endfor
+ end interface
+ public :: coo2dense
+
+ !! version: experimental
+ !!
+ !! Conversion from coo to csr
+ !! Enables transferring data from a COO matrix to a CSR matrix
+ !! under the hypothesis that the COO is already ordered.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ interface coo2csr
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: coo2csr_${s1}$
+ #:endfor
+ end interface
+ public :: coo2csr
+
+ !! version: experimental
+ !!
+ !! Conversion from csr to dense
+ !! Enables creating a dense 2D matrix from the non-zero values stored in a CSR format
+ !! The dense matrix can be allocated on the fly if not pre-allocated by the user.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ interface csr2dense
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: csr2dense_${s1}$
+ #:endfor
+ end interface
+ public :: csr2dense
+
+ !! version: experimental
+ !!
+ !! Conversion from csr to coo
+ !! Enables transferring data from a CSR matrix to a COO matrix
+ !! under the hypothesis that the CSR is already ordered.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ interface csr2coo
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: csr2coo_${s1}$
+ #:endfor
+ end interface
+ public :: csr2coo
+
+ !! version: experimental
+ !!
+ !! Conversion from csr to ell
+ !! Enables transferring data from a CSR matrix to a ELL matrix
+ !! under the hypothesis that the CSR is already ordered.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ interface csr2ell
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: csr2ell_${s1}$
+ #:endfor
+ end interface
+ public :: csr2ell
+
+ !! version: experimental
+ !!
+ !! Conversion from csr to SELL-C
+ !! Enables transferring data from a CSR matrix to a SELL-C matrix
+ !! It takes an optional parameter to decide the chunck size 4, 8 or 16
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ interface csr2sellc
#:for k1, t1, s1 in (KINDS_TYPES)
- module procedure sort_coo_unique_${s1}$
+ module procedure :: csr2sellc_${s1}$
#:endfor
end interface
+ public :: csr2sellc
+
+ !! version: experimental
+ !!
+ !! Enable creating a sparse matrix from ijv (row,col,data) triplet
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ interface from_ijv
+ module procedure :: coo_from_ijv_type
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: coo_from_ijv_${s1}$
+ module procedure :: csr_from_ijv_${s1}$
+ module procedure :: ell_from_ijv_${s1}$
+ module procedure :: sellc_from_ijv_${s1}$
+ #:endfor
+ end interface
+ public :: from_ijv
+
+ public :: coo2ordered
contains
#:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine dense2coo_${s1}$(dense,COO)
+ subroutine dense2coo_${s1}$(dense,COO)
${t1}$, intent(in) :: dense(:,:)
type(COO_${s1}$_type), intent(out) :: COO
integer(ilp) :: num_rows, num_cols, nnz
@@ -49,7 +159,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine coo2dense_${s1}$(COO,dense)
+ subroutine coo2dense_${s1}$(COO,dense)
type(COO_${s1}$_type), intent(in) :: COO
${t1}$, allocatable, intent(out) :: dense(:,:)
integer(ilp) :: idx
@@ -63,7 +173,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine coo2csr_${s1}$(COO,CSR)
+ subroutine coo2csr_${s1}$(COO,CSR)
type(COO_${s1}$_type), intent(in) :: COO
type(CSR_${s1}$_type), intent(out) :: CSR
integer(ilp) :: i
@@ -93,7 +203,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine csr2dense_${s1}$(CSR,dense)
+ subroutine csr2dense_${s1}$(CSR,dense)
type(CSR_${s1}$_type), intent(in) :: CSR
${t1}$, allocatable, intent(out) :: dense(:,:)
integer(ilp) :: i, j
@@ -119,7 +229,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine csr2coo_${s1}$(CSR,COO)
+ subroutine csr2coo_${s1}$(CSR,COO)
type(CSR_${s1}$_type), intent(in) :: CSR
type(COO_${s1}$_type), intent(out) :: COO
integer(ilp) :: i, j
@@ -145,7 +255,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine csr2ell_${s1}$(CSR,ELL,num_nz_rows)
+ subroutine csr2ell_${s1}$(CSR,ELL,num_nz_rows)
type(CSR_${s1}$_type), intent(in) :: CSR
type(ELL_${s1}$_type), intent(out) :: ELL
integer, intent(in), optional :: num_nz_rows !! number of non zeros per row
@@ -175,7 +285,7 @@ contains
#:endfor
#:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
+ subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
!! csr2sellc: This function enables transfering data from a CSR matrix to a SELL-C matrix
!! This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
type(CSR_${s1}$_type), intent(in) :: CSR
@@ -387,7 +497,11 @@ contains
#:endfor
- module subroutine coo2ordered(COO,sort_data)
+ !! version: experimental
+ !!
+ !! Transform COO matrix to canonical form with ordered and unique entries
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ subroutine coo2ordered(COO,sort_data)
class(COO_type), intent(inout) :: COO
logical, intent(in), optional :: sort_data
integer(ilp), allocatable :: itemp(:,:)
@@ -423,4 +537,179 @@ contains
COO%is_sorted = .true.
end subroutine
-end submodule
\ No newline at end of file
+ subroutine coo_from_ijv_type(COO,row,col,nrows,ncols)
+ type(COO_type), intent(inout) :: COO
+ integer(ilp), intent(in) :: row(:)
+ integer(ilp), intent(in) :: col(:)
+ integer(ilp), intent(in), optional :: nrows
+ integer(ilp), intent(in), optional :: ncols
+
+ integer(ilp) :: nrows_, ncols_, nnz, ed
+ !---------------------------------------------------------
+ if(present(nrows)) then
+ nrows_ = nrows
+ else
+ nrows_ = size(row)
+ end if
+ if(present(ncols)) then
+ ncols_ = ncols
+ else
+ ncols_ = size(col)
+ end if
+ nnz = size(row)
+ !---------------------------------------------------------
+ call COO%malloc(nrows_,ncols_,nnz)
+ do ed = 1, nnz
+ COO%index(1:2,ed) = [row(ed),col(ed)]
+ end do
+
+ call coo2ordered(COO,.true.)
+ end subroutine
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine coo_from_ijv_${s1}$(COO,row,col,data,nrows,ncols)
+ type(COO_${s1}$_type), intent(inout) :: COO
+ integer(ilp), intent(in) :: row(:)
+ integer(ilp), intent(in) :: col(:)
+ ${t1}$, intent(in), optional :: data(:)
+ integer(ilp), intent(in), optional :: nrows
+ integer(ilp), intent(in), optional :: ncols
+
+ integer(ilp) :: nrows_, ncols_, nnz, ed
+ !---------------------------------------------------------
+ if(present(nrows)) then
+ nrows_ = nrows
+ else
+ nrows_ = maxval(row)
+ end if
+ if(present(ncols)) then
+ ncols_ = ncols
+ else
+ ncols_ = maxval(col)
+ end if
+ nnz = size(row)
+ !---------------------------------------------------------
+ call COO%malloc(nrows_,ncols_,nnz)
+ do ed = 1, nnz
+ COO%index(1:2,ed) = [row(ed),col(ed)]
+ end do
+ if(present(data)) COO%data = data
+
+ call coo2ordered(COO,.true.)
+ end subroutine
+ #:endfor
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine csr_from_ijv_${s1}$(CSR,row,col,data,nrows,ncols)
+ type(CSR_${s1}$_type), intent(inout) :: CSR
+ integer(ilp), intent(in) :: row(:)
+ integer(ilp), intent(in) :: col(:)
+ ${t1}$, intent(in), optional :: data(:)
+ integer(ilp), intent(in), optional :: nrows
+ integer(ilp), intent(in), optional :: ncols
+
+ integer(ilp) :: nrows_, ncols_
+ !---------------------------------------------------------
+ if(present(nrows)) then
+ nrows_ = nrows
+ else
+ nrows_ = maxval(row)
+ end if
+ if(present(ncols)) then
+ ncols_ = ncols
+ else
+ ncols_ = maxval(col)
+ end if
+ !---------------------------------------------------------
+ block
+ type(COO_${s1}$_type) :: COO
+ if(present(data)) then
+ call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
+ else
+ call from_ijv(COO,row,col,nrows=nrows_,ncols=ncols_)
+ end if
+ call coo2csr(COO,CSR)
+ end block
+ end subroutine
+ #:endfor
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine ell_from_ijv_${s1}$(ELL,row,col,data,nrows,ncols,num_nz_rows)
+ type(ELL_${s1}$_type), intent(inout) :: ELL
+ integer(ilp), intent(in) :: row(:)
+ integer(ilp), intent(in) :: col(:)
+ ${t1}$, intent(in), optional :: data(:)
+ integer(ilp), intent(in), optional :: nrows
+ integer(ilp), intent(in), optional :: ncols
+ integer, intent(in), optional :: num_nz_rows
+
+ integer(ilp) :: nrows_, ncols_
+ !---------------------------------------------------------
+ if(present(nrows)) then
+ nrows_ = nrows
+ else
+ nrows_ = maxval(row)
+ end if
+ if(present(ncols)) then
+ ncols_ = ncols
+ else
+ ncols_ = maxval(col)
+ end if
+ !---------------------------------------------------------
+ block
+ type(COO_${s1}$_type) :: COO
+ type(CSR_${s1}$_type) :: CSR
+ if(present(data)) then
+ call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
+ else
+ call from_ijv(COO,row,col,nrows=nrows_,ncols=ncols_)
+ end if
+ call coo2csr(COO,CSR)
+ if(present(num_nz_rows)) then
+ call csr2ell(CSR,ELL,num_nz_rows)
+ else
+ call csr2ell(CSR,ELL)
+ end if
+ end block
+ end subroutine
+ #:endfor
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine sellc_from_ijv_${s1}$(SELLC,row,col,data,nrows,ncols,chunk)
+ type(SELLC_${s1}$_type), intent(inout) :: SELLC
+ integer(ilp), intent(in) :: row(:)
+ integer(ilp), intent(in) :: col(:)
+ ${t1}$, intent(in), optional :: data(:)
+ integer(ilp), intent(in), optional :: nrows
+ integer(ilp), intent(in), optional :: ncols
+ integer, intent(in), optional :: chunk
+
+ integer(ilp) :: nrows_, ncols_
+ !---------------------------------------------------------
+ if(present(nrows)) then
+ nrows_ = nrows
+ else
+ nrows_ = maxval(row)
+ end if
+ if(present(ncols)) then
+ ncols_ = ncols
+ else
+ ncols_ = maxval(col)
+ end if
+ if(present(chunk)) SELLC%chunk_size = chunk
+ !---------------------------------------------------------
+ block
+ type(COO_${s1}$_type) :: COO
+ type(CSR_${s1}$_type) :: CSR
+ if(present(data)) then
+ call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
+ else
+ call from_ijv(COO,row,col,nrows=nrows_,ncols=ncols_)
+ end if
+ call coo2csr(COO,CSR)
+ call csr2sellc(CSR,SELLC)
+ end block
+ end subroutine
+ #:endfor
+
+end module
\ No newline at end of file
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index baa21851c..4bbea1b94 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -8,29 +8,10 @@
! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
module stdlib_sparse_kinds
use ieee_arithmetic
- use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
+ use stdlib_sparse_constants
implicit none
private
-
- enum, bind(C)
- enumerator :: sparse_full !! Full Sparse matrix (no symmetry considerations)
- enumerator :: sparse_lower !! Symmetric Sparse matrix with triangular inferior storage
- enumerator :: sparse_upper !! Symmetric Sparse matrix with triangular supperior storage
- end enum
public :: sparse_full, sparse_lower, sparse_upper
-
- ! Integer size support for ILP64 builds should be done here
- integer, parameter :: ilp = int32
-
- #:for k1, t1, s1 in (R_KINDS_TYPES)
- ${t1}$, parameter :: zero_${s1}$ = 0._${k1}$
- ${t1}$, parameter :: one_${s1}$ = 1._${k1}$
- #:endfor
- #:for k1, t1, s1 in (C_KINDS_TYPES)
- ${t1}$, parameter :: zero_${s1}$ = (0._${k1}$,0._${k1}$)
- ${t1}$, parameter :: one_${s1}$ = (1._${k1}$,1._${k1}$)
- #:endfor
-
!! version: experimental
!!
!! Base sparse type holding the meta data related to the storage capacity of a matrix.
@@ -146,195 +127,6 @@ module stdlib_sparse_kinds
end type
#:endfor
- !! version: experimental
- !!
- !! Conversion from dense to coo
- !! Enables extracting the non-zero elements of a dense 2D matrix and
- !! storing those values in a COO format. The coo matrix is (re)allocated on the fly.
- !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
- interface dense2coo
- #:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine dense2coo_${s1}$(dense,COO)
- ${t1}$, intent(in) :: dense(:,:)
- type(COO_${s1}$_type), intent(out) :: COO
- end subroutine
- #:endfor
- end interface
- public :: dense2coo
-
- !! version: experimental
- !!
- !! Conversion from coo to dense
- !! Enables creating a dense 2D matrix from the non-zero values stored in a COO format
- !! The dense matrix can be allocated on the fly if not pre-allocated by the user.
- !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
- interface coo2dense
- #:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine coo2dense_${s1}$(COO,dense)
- type(COO_${s1}$_type), intent(in) :: COO
- ${t1}$, allocatable, intent(out) :: dense(:,:)
- end subroutine
- #:endfor
- end interface
- public :: coo2dense
-
- !! version: experimental
- !!
- !! Conversion from coo to csr
- !! Enables transferring data from a COO matrix to a CSR matrix
- !! under the hypothesis that the COO is already ordered.
- !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
- interface coo2csr
- #:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine coo2csr_${s1}$(COO,CSR)
- type(COO_${s1}$_type), intent(in) :: COO
- type(CSR_${s1}$_type), intent(out) :: CSR
- end subroutine
- #:endfor
- end interface
- public :: coo2csr
-
- !! version: experimental
- !!
- !! Conversion from csr to dense
- !! Enables creating a dense 2D matrix from the non-zero values stored in a CSR format
- !! The dense matrix can be allocated on the fly if not pre-allocated by the user.
- !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
- interface csr2dense
- #:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine csr2dense_${s1}$(CSR,dense)
- type(CSR_${s1}$_type), intent(in) :: CSR
- ${t1}$, allocatable, intent(out) :: dense(:,:)
- end subroutine
- #:endfor
- end interface
- public :: csr2dense
-
- !! version: experimental
- !!
- !! Conversion from csr to coo
- !! Enables transferring data from a CSR matrix to a COO matrix
- !! under the hypothesis that the CSR is already ordered.
- !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
- interface csr2coo
- #:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine csr2coo_${s1}$(CSR,COO)
- type(CSR_${s1}$_type), intent(in) :: CSR
- type(COO_${s1}$_type), intent(out) :: COO
- end subroutine
- #:endfor
- end interface
- public :: csr2coo
-
- !! version: experimental
- !!
- !! Conversion from csr to ell
- !! Enables transferring data from a CSR matrix to a ELL matrix
- !! under the hypothesis that the CSR is already ordered.
- !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
- interface csr2ell
- #:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine csr2ell_${s1}$(CSR,ELL,num_nz_rows)
- type(CSR_${s1}$_type), intent(in) :: CSR
- type(ELL_${s1}$_type), intent(out) :: ELL
- integer, intent(in), optional :: num_nz_rows
- end subroutine
- #:endfor
- end interface
- public :: csr2ell
-
- !! version: experimental
- !!
- !! Conversion from csr to SELL-C
- !! Enables transferring data from a CSR matrix to a SELL-C matrix
- !! It takes an optional parameter to decide the chunck size 4, 8 or 16
- !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
- interface csr2sellc
- #:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine csr2sellc_${s1}$(CSR,SELLC,chunk)
- type(CSR_${s1}$_type), intent(in) :: CSR
- type(SELLC_${s1}$_type), intent(out) :: SELLC
- integer, intent(in), optional :: chunk
- end subroutine
- #:endfor
- end interface
- public :: csr2sellc
-
- !! version: experimental
- !!
- !! Transform COO matrix to canonical form with ordered and unique entries
- !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
- interface coo2ordered
- module subroutine coo2ordered(COO,sort_data)
- class(COO_type), intent(inout) :: COO
- logical, intent(in), optional :: sort_data
- end subroutine
- end interface
- public :: coo2ordered
-
- !! version: experimental
- !!
- !! Enable creating a sparse matrix from ijv (row,col,data) triplet
- !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
- interface from_ijv
- module procedure :: coo_from_ijv_type
- #:for k1, t1, s1 in (KINDS_TYPES)
- module procedure :: coo_from_ijv_${s1}$
- module procedure :: csr_from_ijv_${s1}$
- module procedure :: ell_from_ijv_${s1}$
- module procedure :: sellc_from_ijv_${s1}$
- #:endfor
- end interface
- public :: from_ijv
-
- !! Version experimental
- !!
- !! Applay the sparse matrix-vector product $$y = \alpha * M * x + \beta * y $$
- !! [Specifications](../page/specs/stdlib_sparse.html#spmv)
- interface spmv
- #:for k1, t1, s1 in (KINDS_TYPES)
- #:for rank in RANKS
- module subroutine spmv_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(COO_${s1}$_type), intent(in) :: matrix
- ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
- ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
- ${t1}$, intent(in), optional :: alpha
- ${t1}$, intent(in), optional :: beta
- end subroutine
- module subroutine spmv_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(CSR_${s1}$_type), intent(in) :: matrix
- ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
- ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
- ${t1}$, intent(in), optional :: alpha
- ${t1}$, intent(in), optional :: beta
- end subroutine
- module subroutine spmv_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(CSC_${s1}$_type), intent(in) :: matrix
- ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
- ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
- ${t1}$, intent(in), optional :: alpha
- ${t1}$, intent(in), optional :: beta
- end subroutine
- module subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- type(ELL_${s1}$_type), intent(in) :: matrix
- ${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
- ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
- ${t1}$, intent(in), optional :: alpha
- ${t1}$, intent(in), optional :: beta
- end subroutine
- #:endfor
- module subroutine spmv_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
- !! This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
- type(SELLC_${s1}$_type), intent(in) :: matrix
- ${t1}$, intent(in) :: vec_x(:)
- ${t1}$, intent(inout) :: vec_y(:)
- ${t1}$, intent(in), optional :: alpha
- ${t1}$, intent(in), optional :: beta
- end subroutine
- #:endfor
- end interface
- public :: spmv
-
contains
!! (re)Allocate matrix memory for the COO type
@@ -499,181 +291,6 @@ contains
end select
end subroutine
- subroutine coo_from_ijv_type(COO,row,col,nrows,ncols)
- type(COO_type), intent(inout) :: COO
- integer(ilp), intent(in) :: row(:)
- integer(ilp), intent(in) :: col(:)
- integer(ilp), intent(in), optional :: nrows
- integer(ilp), intent(in), optional :: ncols
-
- integer(ilp) :: nrows_, ncols_, nnz, ed
- !---------------------------------------------------------
- if(present(nrows)) then
- nrows_ = nrows
- else
- nrows_ = size(row)
- end if
- if(present(ncols)) then
- ncols_ = ncols
- else
- ncols_ = size(col)
- end if
- nnz = size(row)
- !---------------------------------------------------------
- call COO%malloc(nrows_,ncols_,nnz)
- do ed = 1, nnz
- COO%index(1:2,ed) = [row(ed),col(ed)]
- end do
-
- call coo2ordered(COO,.true.)
- end subroutine
-
- #:for k1, t1, s1 in (KINDS_TYPES)
- subroutine coo_from_ijv_${s1}$(COO,row,col,data,nrows,ncols)
- type(COO_${s1}$_type), intent(inout) :: COO
- integer(ilp), intent(in) :: row(:)
- integer(ilp), intent(in) :: col(:)
- ${t1}$, intent(in), optional :: data(:)
- integer(ilp), intent(in), optional :: nrows
- integer(ilp), intent(in), optional :: ncols
-
- integer(ilp) :: nrows_, ncols_, nnz, ed
- !---------------------------------------------------------
- if(present(nrows)) then
- nrows_ = nrows
- else
- nrows_ = maxval(row)
- end if
- if(present(ncols)) then
- ncols_ = ncols
- else
- ncols_ = maxval(col)
- end if
- nnz = size(row)
- !---------------------------------------------------------
- call COO%malloc(nrows_,ncols_,nnz)
- do ed = 1, nnz
- COO%index(1:2,ed) = [row(ed),col(ed)]
- end do
- if(present(data)) COO%data = data
-
- call coo2ordered(COO,.true.)
- end subroutine
- #:endfor
-
- #:for k1, t1, s1 in (KINDS_TYPES)
- subroutine csr_from_ijv_${s1}$(CSR,row,col,data,nrows,ncols)
- type(CSR_${s1}$_type), intent(inout) :: CSR
- integer(ilp), intent(in) :: row(:)
- integer(ilp), intent(in) :: col(:)
- ${t1}$, intent(in), optional :: data(:)
- integer(ilp), intent(in), optional :: nrows
- integer(ilp), intent(in), optional :: ncols
-
- integer(ilp) :: nrows_, ncols_
- !---------------------------------------------------------
- if(present(nrows)) then
- nrows_ = nrows
- else
- nrows_ = maxval(row)
- end if
- if(present(ncols)) then
- ncols_ = ncols
- else
- ncols_ = maxval(col)
- end if
- !---------------------------------------------------------
- block
- type(COO_${s1}$_type) :: COO
- if(present(data)) then
- call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
- else
- call from_ijv(COO,row,col,nrows=nrows_,ncols=ncols_)
- end if
- call coo2csr(COO,CSR)
- end block
- end subroutine
- #:endfor
-
- #:for k1, t1, s1 in (KINDS_TYPES)
- subroutine ell_from_ijv_${s1}$(ELL,row,col,data,nrows,ncols,num_nz_rows)
- type(ELL_${s1}$_type), intent(inout) :: ELL
- integer(ilp), intent(in) :: row(:)
- integer(ilp), intent(in) :: col(:)
- ${t1}$, intent(in), optional :: data(:)
- integer(ilp), intent(in), optional :: nrows
- integer(ilp), intent(in), optional :: ncols
- integer, intent(in), optional :: num_nz_rows
-
- integer(ilp) :: nrows_, ncols_
- !---------------------------------------------------------
- if(present(nrows)) then
- nrows_ = nrows
- else
- nrows_ = maxval(row)
- end if
- if(present(ncols)) then
- ncols_ = ncols
- else
- ncols_ = maxval(col)
- end if
- !---------------------------------------------------------
- block
- type(COO_${s1}$_type) :: COO
- type(CSR_${s1}$_type) :: CSR
- if(present(data)) then
- call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
- else
- call from_ijv(COO,row,col,nrows=nrows_,ncols=ncols_)
- end if
- call coo2csr(COO,CSR)
- if(present(num_nz_rows)) then
- call csr2ell(CSR,ELL,num_nz_rows)
- else
- call csr2ell(CSR,ELL)
- end if
- end block
- end subroutine
- #:endfor
-
- #:for k1, t1, s1 in (KINDS_TYPES)
- subroutine sellc_from_ijv_${s1}$(SELLC,row,col,data,nrows,ncols,chunk)
- type(SELLC_${s1}$_type), intent(inout) :: SELLC
- integer(ilp), intent(in) :: row(:)
- integer(ilp), intent(in) :: col(:)
- ${t1}$, intent(in), optional :: data(:)
- integer(ilp), intent(in), optional :: nrows
- integer(ilp), intent(in), optional :: ncols
- integer, intent(in), optional :: chunk
-
- integer(ilp) :: nrows_, ncols_
- !---------------------------------------------------------
- if(present(nrows)) then
- nrows_ = nrows
- else
- nrows_ = maxval(row)
- end if
- if(present(ncols)) then
- ncols_ = ncols
- else
- ncols_ = maxval(col)
- end if
- if(present(chunk)) SELLC%chunk_size = chunk
- !---------------------------------------------------------
- block
- type(COO_${s1}$_type) :: COO
- type(CSR_${s1}$_type) :: CSR
- if(present(data)) then
- call from_ijv(COO,row,col,data=data,nrows=nrows_,ncols=ncols_)
- else
- call from_ijv(COO,row,col,nrows=nrows_,ncols=ncols_)
- end if
- call coo2csr(COO,CSR)
- call csr2sellc(CSR,SELLC)
- end block
- end subroutine
- #:endfor
-
!==================================================================
! data accessors
!==================================================================
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index 9a2ef3f48..5bcc067a4 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -10,15 +10,35 @@
!! The `stdlib_sparse_spmv` submodule provides matrix-vector product kernels.
!!
! This code was modified from https://github.com/jalvesz/FSPARSE by its author: Alves Jose
-submodule(stdlib_sparse_kinds) stdlib_sparse_spmv
+module stdlib_sparse_spmv
+ use stdlib_sparse_constants
+ use stdlib_sparse_kinds
implicit none
+ private
+
+ !! Version experimental
+ !!
+ !! Applay the sparse matrix-vector product $$y = \alpha * M * x + \beta * y $$
+ !! [Specifications](../page/specs/stdlib_sparse.html#spmv)
+ interface spmv
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ #:for rank in RANKS
+ module procedure :: spmv_coo_${rank}$d_${s1}$
+ module procedure :: spmv_csr_${rank}$d_${s1}$
+ module procedure :: spmv_csc_${rank}$d_${s1}$
+ module procedure :: spmv_ell_${rank}$d_${s1}$
+ #:endfor
+ module procedure :: spmv_sellc_${s1}$
+ #:endfor
+ end interface
+ public :: spmv
contains
!! spmv_coo
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- module subroutine spmv_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(COO_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -61,7 +81,7 @@ contains
!! spmv_csr
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- module subroutine spmv_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(CSR_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -141,7 +161,7 @@ contains
!! spmv_csc
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- module subroutine spmv_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(CSC_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -205,7 +225,7 @@ contains
!! spmv_ell
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- module subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
type(ELL_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
@@ -239,7 +259,7 @@ contains
!! spmv_sellc
#:set CHUNKS = [4,8,16]
#:for k1, t1, s1 in (KINDS_TYPES)
- module subroutine spmv_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
!! This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
type(SELLC_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x(:)
@@ -316,4 +336,4 @@ contains
#:endfor
-end submodule
\ No newline at end of file
+end module
\ No newline at end of file
From 82dbe02a1a38320ffd1f09612cf2dfd7452668ca Mon Sep 17 00:00:00 2001
From: Jose Alves <jose.alves@transvalor.com>
Date: Wed, 31 Jul 2024 12:31:57 +0200
Subject: [PATCH 63/78] forgotten file in cmake
---
src/CMakeLists.txt | 1 +
1 file changed, 1 insertion(+)
diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
index 877d690fb..7a868dadc 100644
--- a/src/CMakeLists.txt
+++ b/src/CMakeLists.txt
@@ -39,6 +39,7 @@ set(fppFiles
stdlib_sorting_ord_sort.fypp
stdlib_sorting_sort.fypp
stdlib_sorting_sort_index.fypp
+ stdlib_sparse_constants.fypp
stdlib_sparse_conversion.fypp
stdlib_sparse_kinds.fypp
stdlib_sparse_spmv.fypp
From bc0021b0885f653ba0d519877368cf25be6ce17c Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Fri, 20 Sep 2024 23:28:16 +0200
Subject: [PATCH 64/78] add csc/coo conversions and diagonal extraction
---
doc/specs/stdlib_sparse.md | 32 +++++
src/stdlib_sparse_conversion.fypp | 222 ++++++++++++++++++++++++++++++
test/linalg/test_sparse_spmv.fypp | 45 ++++++
3 files changed, 299 insertions(+)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 88d28d4f0..54bf42365 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -259,6 +259,18 @@ This module provides facility functions for converting between storage formats.
```fortran
{!example/linalg/example_sparse_from_ijv.f90!}
```
+### Syntax
+
+`call ` [[stdlib_sparse_conversion(module):diag(interface)]] `(matrix,diagonal)`
+
+### Arguments
+
+`matrix` : Shall be a `dense`, `COO`, `CSR` or `ELL` type. It is an `intent(in)` argument.
+
+`diagonal` : A rank-1 array of the same type as the `matrix`. It is an `intent(inout)` and `allocatable` argument.
+
+#### Note
+If the `diagonal` array has not been previously allocated, the `diag` subroutine will allocate it using the `nrows` of the `matrix`.
### Syntax
@@ -292,6 +304,16 @@ This module provides facility functions for converting between storage formats.
### Syntax
+`call ` [[stdlib_sparse_conversion(module):coo2csc(interface)]] `(coo,csc)`
+
+### Arguments
+
+`coo` : Shall be a `COO` type of `real` or `complex` type. It is an `intent(in)` argument.
+
+`csc` : Shall be a `CSC` type of `real` or `complex` type. It is an `intent(out)` argument.
+
+### Syntax
+
`call ` [[stdlib_sparse_conversion(module):csr2coo(interface)]] `(csr,coo)`
### Arguments
@@ -312,6 +334,16 @@ This module provides facility functions for converting between storage formats.
`chunk`, `optional`: chunk size for the Sliced ELLPACK format. It is an `intent(in)` argument.
+### Syntax
+
+`call ` [[stdlib_sparse_conversion(module):csc2coo(interface)]] `(csc,coo)`
+
+### Arguments
+
+`csc` : Shall be a `CSC` type of `real` or `complex` type. It is an `intent(in)` argument.
+
+`coo` : Shall be a `COO` type of `real` or `complex` type. It is an `intent(out)` argument.
+
## Example
```fortran
{!example/linalg/example_sparse_spmv.f90!}
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 7516a223b..78b546190 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -58,6 +58,19 @@ module stdlib_sparse_conversion
#:endfor
end interface
public :: coo2csr
+
+ !! version: experimental
+ !!
+ !! Conversion from coo to csc
+ !! Enables transferring data from a COO matrix to a CSC matrix
+ !! under the hypothesis that the COO is already ordered.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ interface coo2csc
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: coo2csc_${s1}$
+ #:endfor
+ end interface
+ public :: coo2csc
!! version: experimental
!!
@@ -111,6 +124,34 @@ module stdlib_sparse_conversion
end interface
public :: csr2sellc
+ !! version: experimental
+ !!
+ !! Conversion from csc to coo
+ !! Enables transferring data from a CSC matrix to a COO matrix
+ !! under the hypothesis that the CSC is already ordered.
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ interface csc2coo
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: csc2coo_${s1}$
+ #:endfor
+ end interface
+ public :: csc2coo
+
+ !! version: experimental
+ !!
+ !! Extraction of diagonal values
+ !! [Specifications](../page/specs/stdlib_sparse.html#sparse_conversion)
+ interface diag
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ module procedure :: dense2diagonal_${s1}$
+ module procedure :: coo2diagonal_${s1}$
+ module procedure :: csr2diagonal_${s1}$
+ module procedure :: csc2diagonal_${s1}$
+ module procedure :: ell2diagonal_${s1}$
+ #:endfor
+ end interface
+ public :: diag
+
!! version: experimental
!!
!! Enable creating a sparse matrix from ijv (row,col,data) triplet
@@ -202,6 +243,45 @@ contains
#:endfor
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine coo2csc_${s1}$(COO,CSC)
+ type(COO_${s1}$_type), intent(in) :: COO
+ type(CSC_${s1}$_type), intent(out) :: CSC
+ ${t1}$, allocatable :: data(:)
+ integer(ilp), allocatable :: temp(:,:)
+ integer(ilp) :: i, nnz
+
+ CSC%nnz = COO%nnz; CSC%nrows = COO%nrows; CSC%ncols = COO%ncols
+ CSC%storage = COO%storage
+
+ allocate(temp(2,COO%nnz))
+ temp(1,1:COO%nnz) = COO%index(2,1:COO%nnz)
+ temp(2,1:COO%nnz) = COO%index(1,1:COO%nnz)
+ allocate(data, source = COO%data )
+ nnz = COO%nnz
+ call sort_coo_unique_${s1}$( temp, data, nnz, COO%nrows, COO%ncols )
+
+ if( allocated(CSC%row) ) then
+ CSC%row(1:COO%nnz) = temp(2,1:COO%nnz)
+ CSC%colptr(1:CSC%ncols) = 0
+ CSC%data(1:CSC%nnz) = data(1:COO%nnz)
+ else
+ allocate( CSC%row(CSC%nnz) , source = temp(2,1:COO%nnz) )
+ allocate( CSC%colptr(CSC%ncols+1) , source = 0 )
+ allocate( CSC%data(CSC%nnz) , source = data(1:COO%nnz) )
+ end if
+
+ CSC%colptr(1) = 1
+ do i = 1, COO%nnz
+ CSC%colptr( temp(1,i)+1 ) = CSC%colptr( temp(1,i)+1 ) + 1
+ end do
+ do i = 1, CSC%ncols
+ CSC%colptr( i+1 ) = CSC%colptr( i+1 ) + CSC%colptr( i )
+ end do
+ end subroutine
+
+ #:endfor
+
#:for k1, t1, s1 in (KINDS_TYPES)
subroutine csr2dense_${s1}$(CSR,dense)
type(CSR_${s1}$_type), intent(in) :: CSR
@@ -254,6 +334,33 @@ contains
#:endfor
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine csc2coo_${s1}$(CSC,COO)
+ type(CSC_${s1}$_type), intent(in) :: CSC
+ type(COO_${s1}$_type), intent(out) :: COO
+ integer(ilp) :: i, j
+
+ COO%nnz = CSC%nnz; COO%nrows = CSC%nrows; COO%ncols = CSC%ncols
+ COO%storage = CSC%storage
+
+ if( .not.allocated(COO%data) ) then
+ allocate( COO%data(CSC%nnz) , source = CSC%data(1:CSC%nnz) )
+ else
+ COO%data(1:CSC%nnz) = CSC%data(1:CSC%nnz)
+ end if
+
+ if( .not.allocated(COO%index) ) allocate( COO%index(2,CSC%nnz) )
+
+ do j = 1, CSC%ncols
+ do i = CSC%colptr(j), CSC%colptr(j+1)-1
+ COO%index(1:2,i) = [CSC%row(i),j]
+ end do
+ end do
+ call sort_coo_unique_${s1}$( COO%index, COO%data, COO%nnz, COO%nrows, COO%ncols )
+ end subroutine
+
+ #:endfor
+
#:for k1, t1, s1 in (KINDS_TYPES)
subroutine csr2ell_${s1}$(CSR,ELL,num_nz_rows)
type(CSR_${s1}$_type), intent(in) :: CSR
@@ -712,4 +819,119 @@ contains
end subroutine
#:endfor
+ !! Diagonal extraction
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine dense2diagonal_${s1}$(dense,diagonal)
+ ${t1}$, intent(in) :: dense(:,:)
+ ${t1}$, intent(inout), allocatable :: diagonal(:)
+ integer :: num_rows
+ integer :: i
+
+ num_rows = size(dense,dim=1)
+ if(.not.allocated(diagonal)) allocate(diagonal(num_rows))
+
+ do i = 1, num_rows
+ diagonal(i) = dense(i,i)
+ end do
+ end subroutine
+
+ #:endfor
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine coo2diagonal_${s1}$(COO,diagonal)
+ type(COO_${s1}$_type), intent(in) :: COO
+ ${t1}$, intent(inout), allocatable :: diagonal(:)
+ integer :: idx
+
+ if(.not.allocated(diagonal)) allocate(diagonal(COO%nrows))
+
+ do concurrent(idx = 1:COO%nnz)
+ if(COO%index(1,idx)==COO%index(2,idx)) &
+ & diagonal( COO%index(1,idx) ) = COO%data(idx)
+ end do
+ end subroutine
+
+ #:endfor
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine csr2diagonal_${s1}$(CSR,diagonal)
+ type(CSR_${s1}$_type), intent(in) :: CSR
+ ${t1}$, intent(inout), allocatable :: diagonal(:)
+ integer :: i, j
+
+ if(.not.allocated(diagonal)) allocate(diagonal(CSR%nrows))
+
+ select case(CSR%storage)
+ case(sparse_lower)
+ do i = 1, CSR%nrows
+ diagonal(i) = CSR%data( CSR%rowptr(i+1)-1 )
+ end do
+ case(sparse_upper)
+ do i = 1, CSR%nrows
+ diagonal(i) = CSR%data( CSR%rowptr(i) )
+ end do
+ case(sparse_full)
+ do i = 1, CSR%nrows
+ do j = CSR%rowptr(i), CSR%rowptr(i+1)-1
+ if( CSR%col(j) == i ) then
+ diagonal(i) = CSR%data(j)
+ exit
+ end if
+ end do
+ end do
+ end select
+ end subroutine
+
+ #:endfor
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine csc2diagonal_${s1}$(CSC,diagonal)
+ type(CSC_${s1}$_type), intent(in) :: CSC
+ ${t1}$, intent(inout), allocatable :: diagonal(:)
+ integer :: i, j
+
+ if(.not.allocated(diagonal)) allocate(diagonal(CSC%nrows))
+
+ select case(CSC%storage)
+ case(sparse_lower)
+ do i = 1, CSC%ncols
+ diagonal(i) = CSC%data( CSC%colptr(i+1)-1 )
+ end do
+ case(sparse_upper)
+ do i = 1, CSC%ncols
+ diagonal(i) = CSC%data( CSC%colptr(i) )
+ end do
+ case(sparse_full)
+ do i = 1, CSC%ncols
+ do j = CSC%colptr(i), CSC%colptr(i+1)-1
+ if( CSC%row(j) == i ) then
+ diagonal(i) = CSC%data(j)
+ exit
+ end if
+ end do
+ end do
+ end select
+ end subroutine
+
+ #:endfor
+
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ subroutine ell2diagonal_${s1}$(ELL,diagonal)
+ type(ELL_${s1}$_type), intent(in) :: ELL
+ ${t1}$, intent(inout), allocatable :: diagonal(:)
+ integer :: i, k
+
+ if(.not.allocated(diagonal)) allocate(diagonal(ELL%nrows))
+ if( ELL%storage == sparse_full) then
+ do i = 1, ELL%nrows
+ do k = 1, ELL%K
+ if(ELL%index(i,k)==i) diagonal(i) = ELL%data(i,k)
+ end do
+ end do
+ end if
+ end subroutine
+
+ #:endfor
+
end module
\ No newline at end of file
diff --git a/test/linalg/test_sparse_spmv.fypp b/test/linalg/test_sparse_spmv.fypp
index 0f42cad5b..1be0c778b 100644
--- a/test/linalg/test_sparse_spmv.fypp
+++ b/test/linalg/test_sparse_spmv.fypp
@@ -24,6 +24,7 @@ contains
new_unittest('ell', test_ell), &
new_unittest('sellc', test_sellc), &
new_unittest('symmetries', test_symmetries), &
+ new_unittest('diagonal', test_diagonal), &
new_unittest('add_get_values', test_add_get_values) &
]
end subroutine
@@ -253,6 +254,50 @@ contains
#:endfor
end subroutine
+ subroutine test_diagonal(error)
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+ #:for k1, t1, s1 in (KINDS_TYPES)
+ block
+ integer, parameter :: wp = ${k1}$
+ ${t1}$, allocatable :: dense(:,:)
+ type(COO_${s1}$_type) :: COO
+ type(CSR_${s1}$_type) :: CSR
+ type(CSC_${s1}$_type) :: CSC
+ type(ELL_${s1}$_type) :: ELL
+ ${t1}$, allocatable :: diagonal(:)
+
+ allocate( dense(4,4) , source = &
+ reshape(real([1,0,0,5, &
+ 0,2,0,0, &
+ 0,6,3,0,&
+ 0,0,7,4],kind=wp),[4,4]) )
+
+ call diag(dense,diagonal)
+ call check(error, all(diagonal == [1,2,3,4]) )
+ if (allocated(error)) return
+
+ diagonal = 0.0
+ call dense2coo( dense , COO )
+ call diag( COO , diagonal )
+ call check(error, all(diagonal == [1,2,3,4]) )
+ if (allocated(error)) return
+
+ diagonal = 0.0
+ call coo2csr( COO, CSR )
+ call diag( CSR , diagonal )
+ call check(error, all(diagonal == [1,2,3,4]) )
+ if (allocated(error)) return
+
+ diagonal = 0.0
+ call coo2csc( COO, CSC )
+ call diag( CSC , diagonal )
+ call check(error, all(diagonal == [1,2,3,4]) )
+ if (allocated(error)) return
+ end block
+ #:endfor
+ end subroutine
+
subroutine test_add_get_values(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
From a4d9306734b256f3a0c8e83d374ebc9d216b70a0 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 19 Oct 2024 14:30:38 +0200
Subject: [PATCH 65/78] Add in place operator for coo and csr spmv
---
doc/specs/stdlib_sparse.md | 6 +-
src/stdlib_sparse_constants.fypp | 4 +
src/stdlib_sparse_kinds.fypp | 1 +
src/stdlib_sparse_spmv.fypp | 144 ++++++++++++++++++++++++++++---
4 files changed, 140 insertions(+), 15 deletions(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index 54bf42365..df95a2f88 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -194,11 +194,11 @@ Experimental
Provide sparse matrix-vector product kernels for the current supported sparse matrix types.
-$$y=\alpha*M*x+\beta*y$$
+$$y=\alpha*op(M)*x+\beta*y$$
### Syntax
-`call ` [[stdlib_sparse_spmv(module):spmv(interface)]] `(matrix,vec_x,vec_y [,alpha,beta])`
+`call ` [[stdlib_sparse_spmv(module):spmv(interface)]] `(matrix,vec_x,vec_y [,alpha,beta,op])`
### Arguments
@@ -212,6 +212,8 @@ $$y=\alpha*M*x+\beta*y$$
`beta`, `optional` : Shall be a scalar value of the same type as `vec_x`. Default value `beta=0`. It is an `intent(in)` argument.
+`op`, `optional`: In-place operator identifier. Shall be a `character(1)` argument. It can have any of the following values: `N`: no transpose, `T`: transpose, `H`: hermitian or complex transpose. These values are provided as constants by the `stdlib_sparse` module: `sparse_op_none`, `sparse_op_transpose`, `sparse_op_hermitian`
+
<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
## Sparse matrix to matrix conversions
diff --git a/src/stdlib_sparse_constants.fypp b/src/stdlib_sparse_constants.fypp
index 9fbbe38f6..1e8374bd9 100644
--- a/src/stdlib_sparse_constants.fypp
+++ b/src/stdlib_sparse_constants.fypp
@@ -12,6 +12,10 @@ module stdlib_sparse_constants
enumerator :: sparse_lower !! Symmetric Sparse matrix with triangular inferior storage
enumerator :: sparse_upper !! Symmetric Sparse matrix with triangular supperior storage
end enum
+
+ character(1), parameter :: sparse_op_none = 'N' !! no transpose
+ character(1), parameter :: sparse_op_transpose = 'T' !! transpose
+ character(1), parameter :: sparse_op_hermitian = 'H' !! conjugate or hermitian transpose
! Integer size support for ILP64 builds should be done here
integer, parameter :: ilp = int32
diff --git a/src/stdlib_sparse_kinds.fypp b/src/stdlib_sparse_kinds.fypp
index 4bbea1b94..ceba2a62d 100644
--- a/src/stdlib_sparse_kinds.fypp
+++ b/src/stdlib_sparse_kinds.fypp
@@ -12,6 +12,7 @@ module stdlib_sparse_kinds
implicit none
private
public :: sparse_full, sparse_lower, sparse_upper
+ public :: sparse_op_none, sparse_op_transpose, sparse_op_hermitian
!! version: experimental
!!
!! Base sparse type holding the meta data related to the storage capacity of a matrix.
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index 5bcc067a4..d506d96c0 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -18,7 +18,7 @@ module stdlib_sparse_spmv
!! Version experimental
!!
- !! Applay the sparse matrix-vector product $$y = \alpha * M * x + \beta * y $$
+ !! Applay the sparse matrix-vector product $$y = \alpha * op(M) * x + \beta * y $$
!! [Specifications](../page/specs/stdlib_sparse.html#spmv)
interface spmv
#:for k1, t1, s1 in (KINDS_TYPES)
@@ -38,15 +38,18 @@ contains
!! spmv_coo
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine spmv_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_coo_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta,op)
type(COO_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
+ character(1), intent(in), optional :: op
${t1}$ :: alpha_, beta_
+ character(1) :: op_
integer(ilp) :: k, ik, jk
+ op_ = sparse_op_none; if(present(op)) op_ = op
alpha_ = one_${k1}$
if(present(alpha)) alpha_ = alpha
if(present(beta)) then
@@ -55,7 +58,9 @@ contains
vec_y = zero_${s1}$
endif
associate( data => matrix%data, index => matrix%index, storage => matrix%storage, nnz => matrix%nnz )
- if( storage == sparse_full) then
+ select case(op_)
+ case(sparse_op_none)
+ if(storage == sparse_full) then
do concurrent (k = 1:nnz)
ik = index(1,k)
jk = index(2,k)
@@ -72,6 +77,45 @@ contains
end do
end if
+ case(sparse_op_transpose)
+ if(storage == sparse_full) then
+ do concurrent (k = 1:nnz)
+ jk = index(1,k)
+ ik = index(2,k)
+ vec_y(${rksfx2(rank-1)}$ik) = vec_y(${rksfx2(rank-1)}$ik) + alpha_*data(k) * vec_x(${rksfx2(rank-1)}$jk)
+ end do
+
+ else
+ do concurrent (k = 1:nnz)
+ jk = index(1,k)
+ ik = index(2,k)
+ vec_y(${rksfx2(rank-1)}$ik) = vec_y(${rksfx2(rank-1)}$ik) + alpha_*data(k) * vec_x(${rksfx2(rank-1)}$jk)
+ if( ik==jk ) cycle
+ vec_y(${rksfx2(rank-1)}$jk) = vec_y(${rksfx2(rank-1)}$jk) + alpha_*data(k) * vec_x(${rksfx2(rank-1)}$ik)
+ end do
+
+ end if
+ #:if t1.startswith('complex')
+ case(sparse_op_hermitian)
+ if(storage == sparse_full) then
+ do concurrent (k = 1:nnz)
+ jk = index(1,k)
+ ik = index(2,k)
+ vec_y(${rksfx2(rank-1)}$ik) = vec_y(${rksfx2(rank-1)}$ik) + alpha_*conjg(data(k)) * vec_x(${rksfx2(rank-1)}$jk)
+ end do
+
+ else
+ do concurrent (k = 1:nnz)
+ jk = index(1,k)
+ ik = index(2,k)
+ vec_y(${rksfx2(rank-1)}$ik) = vec_y(${rksfx2(rank-1)}$ik) + alpha_*conjg(data(k)) * vec_x(${rksfx2(rank-1)}$jk)
+ if( ik==jk ) cycle
+ vec_y(${rksfx2(rank-1)}$jk) = vec_y(${rksfx2(rank-1)}$jk) + alpha_*conjg(data(k)) * vec_x(${rksfx2(rank-1)}$ik)
+ end do
+
+ end if
+ #:endif
+ end select
end associate
end subroutine
@@ -81,13 +125,15 @@ contains
!! spmv_csr
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine spmv_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_csr_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta,op)
type(CSR_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
+ character(1), intent(in), optional :: op
${t1}$ :: alpha_, beta_
+ character(1) :: op_
integer(ilp) :: i, j
#:if rank == 1
${t1}$ :: aux, aux2
@@ -95,6 +141,7 @@ contains
${t1}$ :: aux(size(vec_x,dim=1)), aux2(size(vec_x,dim=1))
#:endif
+ op_ = sparse_op_none; if(present(op)) op_ = op
alpha_ = one_${k1}$
if(present(alpha)) alpha_ = alpha
beta_ = zero_${k1}$
@@ -102,7 +149,8 @@ contains
associate( data => matrix%data, col => matrix%col, rowptr => matrix%rowptr, &
& nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, storage => matrix%storage )
- if( storage == sparse_full) then
+
+ if( storage == sparse_full .and. op_==sparse_op_none ) then
do i = 1, nrows
aux = zero_${k1}$
do j = rowptr(i), rowptr(i+1)-1
@@ -114,8 +162,21 @@ contains
vec_y(${rksfx2(rank-1)}$i) = alpha_ * aux
end if
end do
+
+ else if( storage == sparse_full .and. op_==sparse_op_transpose ) then
+ if(present(beta)) then
+ vec_y = beta * vec_y
+ else
+ vec_y = zero_${s1}$
+ endif
+ do i = 1, nrows
+ aux = alpha_ * vec_x(${rksfx2(rank-1)}$i)
+ do j = rowptr(i), rowptr(i+1)-1
+ vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + data(j) * aux
+ end do
+ end do
- else if( storage == sparse_lower )then
+ else if( storage == sparse_lower .and. op_/=sparse_op_hermitian )then
do i = 1 , nrows
aux = zero_${s1}$
aux2 = alpha_ * vec_x(${rksfx2(rank-1)}$i)
@@ -132,7 +193,7 @@ contains
end if
end do
- else if( storage == sparse_upper )then
+ else if( storage == sparse_upper .and. op_/=sparse_op_hermitian )then
do i = 1 , nrows
aux = vec_x(${rksfx2(rank-1)}$i) * data(rowptr(i))
aux2 = alpha_ * vec_x(${rksfx2(rank-1)}$i)
@@ -150,7 +211,57 @@ contains
end if
vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_ * aux
end do
+
+ #:if t1.startswith('complex')
+ else if( storage == sparse_full .and. op_==sparse_op_hermitian) then
+ if(present(beta)) then
+ vec_y = beta * vec_y
+ else
+ vec_y = zero_${s1}$
+ endif
+ do i = 1, nrows
+ aux = alpha_ * vec_x(${rksfx2(rank-1)}$i)
+ do j = rowptr(i), rowptr(i+1)-1
+ vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + conjg(data(j)) * aux
+ end do
+ end do
+
+ else if( storage == sparse_lower .and. op_==sparse_op_hermitian )then
+ do i = 1 , nrows
+ aux = zero_${s1}$
+ aux2 = alpha_ * vec_x(${rksfx2(rank-1)}$i)
+ do j = rowptr(i), rowptr(i+1)-2
+ aux = aux + conjg(data(j)) * vec_x(${rksfx2(rank-1)}$col(j))
+ vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + conjg(data(j)) * aux2
+ end do
+ aux = alpha_ * aux + conjg(data(j)) * aux2
+
+ if(present(beta)) then
+ vec_y(${rksfx2(rank-1)}$i) = beta_ * vec_y(${rksfx2(rank-1)}$i) + aux
+ else
+ vec_y(${rksfx2(rank-1)}$i) = aux
+ end if
+ end do
+ else if( storage == sparse_upper .and. op_==sparse_op_hermitian )then
+ do i = 1 , nrows
+ aux = vec_x(${rksfx2(rank-1)}$i) * conjg(data(rowptr(i)))
+ aux2 = alpha_ * vec_x(${rksfx2(rank-1)}$i)
+ do j = rowptr(i)+1, rowptr(i+1)-1
+ aux = aux + conjg(data(j)) * vec_x(${rksfx2(rank-1)}$col(j))
+ end do
+ if(present(beta)) then
+ do j = rowptr(i)+1, rowptr(i+1)-1
+ vec_y(${rksfx2(rank-1)}$col(j)) = beta_ * vec_y(${rksfx2(rank-1)}$col(j)) + conjg(data(j)) * aux2
+ end do
+ else
+ do j = rowptr(i)+1, rowptr(i+1)-1
+ vec_y(${rksfx2(rank-1)}$col(j)) = conjg(data(j)) * aux2
+ end do
+ end if
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_ * aux
+ end do
+ #:endif
end if
end associate
end subroutine
@@ -161,13 +272,15 @@ contains
!! spmv_csc
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine spmv_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_csc_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta,op)
type(CSC_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
+ character(1), intent(in), optional :: op
${t1}$ :: alpha_, beta_
+ character(1) :: op_
integer(ilp) :: i, j
#:if rank == 1
${t1}$ :: aux
@@ -175,6 +288,7 @@ contains
${t1}$ :: aux(size(vec_x,dim=1))
#:endif
+ op_ = sparse_op_none; if(present(op)) op_ = op
alpha_ = one_${k1}$
if(present(alpha)) alpha_ = alpha
if(present(beta)) then
@@ -193,7 +307,6 @@ contains
end do
else if( storage == sparse_lower )then
- ! NOT TESTED
do j = 1 , ncols
aux = vec_x(${rksfx2(rank-1)}$j) * data(colptr(j))
do i = colptr(j)+1, colptr(j+1)-1
@@ -204,7 +317,6 @@ contains
end do
else if( storage == sparse_upper )then
- ! NOT TESTED
do j = 1 , ncols
aux = zero_${s1}$
do i = colptr(j), colptr(i+1)-2
@@ -225,15 +337,18 @@ contains
!! spmv_ell
#:for k1, t1, s1 in (KINDS_TYPES)
#:for rank in RANKS
- subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta,op)
type(ELL_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x${ranksuffix(rank)}$
${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
+ character(1), intent(in), optional :: op
${t1}$ :: alpha_, beta_
+ character(1) :: op_
integer(ilp) :: i, j, k
-
+
+ op_ = sparse_op_none; if(present(op)) op_ = op
alpha_ = one_${k1}$
if(present(alpha)) alpha_ = alpha
if(present(beta)) then
@@ -259,16 +374,19 @@ contains
!! spmv_sellc
#:set CHUNKS = [4,8,16]
#:for k1, t1, s1 in (KINDS_TYPES)
- subroutine spmv_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta)
+ subroutine spmv_sellc_${s1}$(matrix,vec_x,vec_y,alpha,beta,op)
!! This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves
type(SELLC_${s1}$_type), intent(in) :: matrix
${t1}$, intent(in) :: vec_x(:)
${t1}$, intent(inout) :: vec_y(:)
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
+ character(1), intent(in), optional :: op
${t1}$ :: alpha_, beta_
+ character(1) :: op_
integer(ilp) :: i, nz, rowidx, num_chunks, rm
+ op_ = sparse_op_none; if(present(op)) op_ = op
alpha_ = one_${s1}$
if(present(alpha)) alpha_ = alpha
if(present(beta)) then
From cd30636befb12ddbad963815b2cb39a87a99df2f Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 19 Oct 2024 14:44:08 +0200
Subject: [PATCH 66/78] add support for op with ellpack
---
src/stdlib_sparse_spmv.fypp | 15 +++++++++++++--
1 file changed, 13 insertions(+), 2 deletions(-)
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index d506d96c0..1ac961561 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -358,12 +358,23 @@ contains
endif
associate( data => matrix%data, index => matrix%index, MNZ_P_ROW => matrix%K, &
& nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, storage => matrix%storage )
- if( storage == sparse_full) then
+ if( storage == sparse_full .and. op_==sparse_op_none ) then
do concurrent (i = 1:nrows, k = 1:MNZ_P_ROW)
j = index(i,k)
if(j>0) vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_*data(i,k) * vec_x(${rksfx2(rank-1)}$j)
end do
-
+ else if( storage == sparse_full .and. op_==sparse_op_transpose ) then
+ do concurrent (i = 1:nrows, k = 1:MNZ_P_ROW)
+ j = index(i,k)
+ if(j>0) vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_*data(i,k) * vec_x(${rksfx2(rank-1)}$i)
+ end do
+ #:if t1.startswith('complex')
+ else if( storage == sparse_full .and. op_==sparse_op_hermitian ) then
+ do concurrent (i = 1:nrows, k = 1:MNZ_P_ROW)
+ j = index(i,k)
+ if(j>0) vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_*conjg(data(i,k)) * vec_x(${rksfx2(rank-1)}$i)
+ end do
+ #:endif
end if
end associate
end subroutine
From b68b4c8fd6e73ca87e59f10294396bf2147b2389 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 19 Oct 2024 15:14:20 +0200
Subject: [PATCH 67/78] add support for op with csc format
---
src/stdlib_sparse_spmv.fypp | 51 +++++++++++++++++++++++++++++++++----
1 file changed, 46 insertions(+), 5 deletions(-)
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index 1ac961561..48db61732 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -299,14 +299,24 @@ contains
associate( data => matrix%data, colptr => matrix%colptr, row => matrix%row, &
& nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, storage => matrix%storage )
- if( storage == sparse_full) then
+ if( storage == sparse_full .and. op_==sparse_op_none ) then
do concurrent(j=1:ncols)
+ aux = alpha_ * vec_x(${rksfx2(rank-1)}$j)
do i = colptr(j), colptr(j+1)-1
- vec_y(${rksfx2(rank-1)}$row(i)) = vec_y(${rksfx2(rank-1)}$row(i)) + alpha_ * data(i) * vec_x(${rksfx2(rank-1)}$j)
+ vec_y(${rksfx2(rank-1)}$row(i)) = vec_y(${rksfx2(rank-1)}$row(i)) + data(i) * aux
+ end do
+ end do
+
+ else if( storage == sparse_full .and. op_==sparse_op_transpose ) then
+ do concurrent(j=1:ncols)
+ aux = zero_${k1}$
+ do i = colptr(j), colptr(j+1)-1
+ aux = aux + data(i) * vec_x(${rksfx2(rank-1)}$row(i))
end do
+ vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_ * aux
end do
- else if( storage == sparse_lower )then
+ else if( storage == sparse_lower .and. op_/=sparse_op_hermitian )then
do j = 1 , ncols
aux = vec_x(${rksfx2(rank-1)}$j) * data(colptr(j))
do i = colptr(j)+1, colptr(j+1)-1
@@ -316,7 +326,7 @@ contains
vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_ * aux
end do
- else if( storage == sparse_upper )then
+ else if( storage == sparse_upper .and. op_/=sparse_op_hermitian )then
do j = 1 , ncols
aux = zero_${s1}$
do i = colptr(j), colptr(i+1)-2
@@ -326,7 +336,38 @@ contains
aux = aux + data(colptr(j)) * vec_x(${rksfx2(rank-1)}$j)
vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_ * aux
end do
-
+
+ #:if t1.startswith('complex')
+ else if( storage == sparse_full .and. op_==sparse_op_hermitian ) then
+ do concurrent(j=1:ncols)
+ aux = zero_${k1}$
+ do i = colptr(j), colptr(j+1)-1
+ aux = aux + conjg(data(i)) * vec_x(${rksfx2(rank-1)}$row(i))
+ end do
+ vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_ * aux
+ end do
+
+ else if( storage == sparse_lower .and. op_==sparse_op_hermitian )then
+ do j = 1 , ncols
+ aux = vec_x(${rksfx2(rank-1)}$j) * conjg(data(colptr(j)))
+ do i = colptr(j)+1, colptr(j+1)-1
+ aux = aux + conjg(data(i)) * vec_x(${rksfx2(rank-1)}$row(i))
+ vec_y(${rksfx2(rank-1)}$row(i)) = vec_y(${rksfx2(rank-1)}$row(i)) + alpha_ * conjg(data(i)) * vec_x(${rksfx2(rank-1)}$j)
+ end do
+ vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_ * aux
+ end do
+
+ else if( storage == sparse_upper .and. op_==sparse_op_hermitian )then
+ do j = 1 , ncols
+ aux = zero_${s1}$
+ do i = colptr(j), colptr(i+1)-2
+ aux = aux + conjg(data(i)) * vec_x(${rksfx2(rank-1)}$j)
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_ * conjg(data(i)) * vec_x(${rksfx2(rank-1)}$row(i))
+ end do
+ aux = aux + conjg(data(colptr(j))) * vec_x(${rksfx2(rank-1)}$j)
+ vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_ * aux
+ end do
+ #:endif
end if
end associate
end subroutine
From 62c702be14e3839c429af79c8aa0ae1c2639517b Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 19 Oct 2024 15:17:04 +0200
Subject: [PATCH 68/78] unit test in-place transpose
---
test/linalg/test_sparse_spmv.fypp | 24 ++++++++++++++++++++++++
1 file changed, 24 insertions(+)
diff --git a/test/linalg/test_sparse_spmv.fypp b/test/linalg/test_sparse_spmv.fypp
index 1be0c778b..f1fac9e2c 100644
--- a/test/linalg/test_sparse_spmv.fypp
+++ b/test/linalg/test_sparse_spmv.fypp
@@ -61,6 +61,12 @@ contains
call spmv( COO, vec_x, vec_y2 )
call check(error, all(vec_y1 == vec_y2) )
if (allocated(error)) return
+
+ ! Test in-place transpose
+ vec_y1 = 1._wp
+ call spmv( COO, vec_y1, vec_x, op=sparse_op_transpose )
+ call check(error, all(vec_x == real([17,15,4,14,-3],kind=wp)) )
+ if (allocated(error)) return
end block
#:endfor
end subroutine
@@ -114,6 +120,12 @@ contains
call check(error, all(vec_y == real([6,11,15,15],kind=wp)) )
if (allocated(error)) return
+
+ ! Test in-place transpose
+ vec_y = 1._wp
+ call spmv( CSR, vec_y, vec_x, op=sparse_op_transpose )
+ call check(error, all(vec_x == real([17,15,4,14,-3],kind=wp)) )
+ if (allocated(error)) return
end block
#:endfor
end subroutine
@@ -139,6 +151,12 @@ contains
call check(error, all(vec_y == real([6,11,15,15],kind=wp)) )
if (allocated(error)) return
+
+ ! Test in-place transpose
+ vec_y = 1._wp
+ call spmv( CSC, vec_y, vec_x, op=sparse_op_transpose )
+ call check(error, all(vec_x == real([17,15,4,14,-3],kind=wp)) )
+ if (allocated(error)) return
end block
#:endfor
end subroutine
@@ -170,6 +188,12 @@ contains
call check(error, all(vec_y == real([6,11,15,15],kind=wp)) )
if (allocated(error)) return
+
+ ! Test in-place transpose
+ vec_y = 1._wp
+ call spmv( ELL, vec_y, vec_x, op=sparse_op_transpose )
+ call check(error, all(vec_x == real([17,15,4,14,-3],kind=wp)) )
+ if (allocated(error)) return
end block
#:endfor
From 59d33f034e44c421e66f099617bb1acc474db12f Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sat, 19 Oct 2024 17:07:37 +0200
Subject: [PATCH 69/78] complete spmv for the ellpack format including
symmetric representations
---
doc/specs/stdlib_sparse.md | 12 ++++++++++++
src/stdlib_sparse_conversion.fypp | 1 +
src/stdlib_sparse_spmv.fypp | 18 ++++++++++++++++++
test/linalg/test_sparse_spmv.fypp | 9 ++++++++-
4 files changed, 39 insertions(+), 1 deletion(-)
diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md
index df95a2f88..fc9d0a0c0 100644
--- a/doc/specs/stdlib_sparse.md
+++ b/doc/specs/stdlib_sparse.md
@@ -338,6 +338,18 @@ If the `diagonal` array has not been previously allocated, the `diag` subroutine
### Syntax
+`call ` [[stdlib_sparse_conversion(module):csr2sellc(interface)]] `(csr,ell[,num_nz_rows])`
+
+### Arguments
+
+`csr` : Shall be a `CSR` type of `real` or `complex` type. It is an `intent(in)` argument.
+
+`ell` : Shall be a `ELL` type of `real` or `complex` type. It is an `intent(out)` argument.
+
+`num_nz_rows`, `optional`: number of non zeros per row. If not give, it will correspond to the size of the longest row in the `CSR` matrix. It is an `intent(in)` argument.
+
+### Syntax
+
`call ` [[stdlib_sparse_conversion(module):csc2coo(interface)]] `(csc,coo)`
### Arguments
diff --git a/src/stdlib_sparse_conversion.fypp b/src/stdlib_sparse_conversion.fypp
index 78b546190..d2f4936c5 100644
--- a/src/stdlib_sparse_conversion.fypp
+++ b/src/stdlib_sparse_conversion.fypp
@@ -378,6 +378,7 @@ contains
end do
end if
call ELL%malloc(CSR%nrows,CSR%ncols,num_nz_rows_)
+ ELL%storage = CSR%storage
!-------------------------------------------
do i = 1, CSR%nrows
adr1 = CSR%rowptr(i)
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index 48db61732..841c064e1 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -409,12 +409,30 @@ contains
j = index(i,k)
if(j>0) vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_*data(i,k) * vec_x(${rksfx2(rank-1)}$i)
end do
+ else if( storage /= sparse_full .and. op_/=sparse_op_hermitian ) then
+ do concurrent (i = 1:nrows, k = 1:MNZ_P_ROW)
+ j = index(i,k)
+ if(j>0) then
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_*data(i,k) * vec_x(${rksfx2(rank-1)}$j)
+ if(i==j) cycle
+ vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_*data(i,k) * vec_x(${rksfx2(rank-1)}$i)
+ end if
+ end do
#:if t1.startswith('complex')
else if( storage == sparse_full .and. op_==sparse_op_hermitian ) then
do concurrent (i = 1:nrows, k = 1:MNZ_P_ROW)
j = index(i,k)
if(j>0) vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_*conjg(data(i,k)) * vec_x(${rksfx2(rank-1)}$i)
end do
+ else if( storage /= sparse_full .and. op_==sparse_op_hermitian ) then
+ do concurrent (i = 1:nrows, k = 1:MNZ_P_ROW)
+ j = index(i,k)
+ if(j>0) then
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_*conjg(data(i,k)) * vec_x(${rksfx2(rank-1)}$j)
+ if(i==j) cycle
+ vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha_*conjg(data(i,k)) * vec_x(${rksfx2(rank-1)}$i)
+ end if
+ end do
#:endif
end if
end associate
diff --git a/test/linalg/test_sparse_spmv.fypp b/test/linalg/test_sparse_spmv.fypp
index f1fac9e2c..838243505 100644
--- a/test/linalg/test_sparse_spmv.fypp
+++ b/test/linalg/test_sparse_spmv.fypp
@@ -243,14 +243,16 @@ contains
integer, parameter :: wp = ${k1}$
type(COO_${s1}$_type) :: COO
type(CSR_${s1}$_type) :: CSR
+ type(ELL_${s1}$_type) :: ELL
${t1}$, allocatable :: dense(:,:)
${t1}$, allocatable :: vec_x(:)
- ${t1}$, allocatable :: vec_y1(:), vec_y2(:), vec_y3(:)
+ ${t1}$, allocatable :: vec_y1(:), vec_y2(:), vec_y3(:), vec_y4(:)
allocate( vec_x(4) , source = 1._wp )
allocate( vec_y1(4) , source = 0._wp )
allocate( vec_y2(4) , source = 0._wp )
allocate( vec_y3(4) , source = 0._wp )
+ allocate( vec_y4(4) , source = 0._wp )
allocate( dense(4,4) , source = &
reshape(real([1,0,0,0, &
@@ -261,6 +263,7 @@ contains
call dense2coo( dense , COO )
COO%storage = sparse_upper
call coo2csr(COO, CSR)
+ call csr2ell(CSR, ELL)
dense(2,1) = 2._wp; dense(3,2) = 2._wp; dense(4,3) = 2._wp
vec_y1 = matmul( dense, vec_x )
@@ -274,6 +277,10 @@ contains
call spmv( CSR , vec_x, vec_y3 )
call check(error, all(vec_y1 == vec_y3) )
if (allocated(error)) return
+
+ call spmv( ELL , vec_x, vec_y4 )
+ call check(error, all(vec_y1 == vec_y4) )
+ if (allocated(error)) return
end block
#:endfor
end subroutine
From beafb3c78d0270bf3cd6ff7f093942f7f934c37f Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Sun, 20 Oct 2024 23:58:45 +0200
Subject: [PATCH 70/78] simplify csr spmv, remove unused var beta_
---
src/stdlib_sparse_spmv.fypp | 68 +++++++++----------------------------
1 file changed, 16 insertions(+), 52 deletions(-)
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index 841c064e1..04fe7dd2b 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -45,7 +45,7 @@ contains
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
character(1), intent(in), optional :: op
- ${t1}$ :: alpha_, beta_
+ ${t1}$ :: alpha_
character(1) :: op_
integer(ilp) :: k, ik, jk
@@ -57,6 +57,7 @@ contains
else
vec_y = zero_${s1}$
endif
+
associate( data => matrix%data, index => matrix%index, storage => matrix%storage, nnz => matrix%nnz )
select case(op_)
case(sparse_op_none)
@@ -132,7 +133,7 @@ contains
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
character(1), intent(in), optional :: op
- ${t1}$ :: alpha_, beta_
+ ${t1}$ :: alpha_
character(1) :: op_
integer(ilp) :: i, j
#:if rank == 1
@@ -144,8 +145,11 @@ contains
op_ = sparse_op_none; if(present(op)) op_ = op
alpha_ = one_${k1}$
if(present(alpha)) alpha_ = alpha
- beta_ = zero_${k1}$
- if(present(beta)) beta_ = beta
+ if(present(beta)) then
+ vec_y = beta * vec_y
+ else
+ vec_y = zero_${s1}$
+ endif
associate( data => matrix%data, col => matrix%col, rowptr => matrix%rowptr, &
& nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, storage => matrix%storage )
@@ -156,19 +160,10 @@ contains
do j = rowptr(i), rowptr(i+1)-1
aux = aux + data(j) * vec_x(${rksfx2(rank-1)}$col(j))
end do
- if(present(beta)) then
- vec_y(${rksfx2(rank-1)}$i) = beta_ * vec_y(${rksfx2(rank-1)}$i) + alpha_ * aux
- else
- vec_y(${rksfx2(rank-1)}$i) = alpha_ * aux
- end if
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_ * aux
end do
else if( storage == sparse_full .and. op_==sparse_op_transpose ) then
- if(present(beta)) then
- vec_y = beta * vec_y
- else
- vec_y = zero_${s1}$
- endif
do i = 1, nrows
aux = alpha_ * vec_x(${rksfx2(rank-1)}$i)
do j = rowptr(i), rowptr(i+1)-1
@@ -185,12 +180,7 @@ contains
vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + data(j) * aux2
end do
aux = alpha_ * aux + data(j) * aux2
-
- if(present(beta)) then
- vec_y(${rksfx2(rank-1)}$i) = beta_ * vec_y(${rksfx2(rank-1)}$i) + aux
- else
- vec_y(${rksfx2(rank-1)}$i) = aux
- end if
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + aux
end do
else if( storage == sparse_upper .and. op_/=sparse_op_hermitian )then
@@ -199,26 +189,13 @@ contains
aux2 = alpha_ * vec_x(${rksfx2(rank-1)}$i)
do j = rowptr(i)+1, rowptr(i+1)-1
aux = aux + data(j) * vec_x(${rksfx2(rank-1)}$col(j))
+ vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + data(j) * aux2
end do
- if(present(beta)) then
- do j = rowptr(i)+1, rowptr(i+1)-1
- vec_y(${rksfx2(rank-1)}$col(j)) = beta_ * vec_y(${rksfx2(rank-1)}$col(j)) + data(j) * aux2
- end do
- else
- do j = rowptr(i)+1, rowptr(i+1)-1
- vec_y(${rksfx2(rank-1)}$col(j)) = data(j) * aux2
- end do
- end if
vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_ * aux
end do
#:if t1.startswith('complex')
else if( storage == sparse_full .and. op_==sparse_op_hermitian) then
- if(present(beta)) then
- vec_y = beta * vec_y
- else
- vec_y = zero_${s1}$
- endif
do i = 1, nrows
aux = alpha_ * vec_x(${rksfx2(rank-1)}$i)
do j = rowptr(i), rowptr(i+1)-1
@@ -235,12 +212,7 @@ contains
vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + conjg(data(j)) * aux2
end do
aux = alpha_ * aux + conjg(data(j)) * aux2
-
- if(present(beta)) then
- vec_y(${rksfx2(rank-1)}$i) = beta_ * vec_y(${rksfx2(rank-1)}$i) + aux
- else
- vec_y(${rksfx2(rank-1)}$i) = aux
- end if
+ vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + aux
end do
else if( storage == sparse_upper .and. op_==sparse_op_hermitian )then
@@ -249,16 +221,8 @@ contains
aux2 = alpha_ * vec_x(${rksfx2(rank-1)}$i)
do j = rowptr(i)+1, rowptr(i+1)-1
aux = aux + conjg(data(j)) * vec_x(${rksfx2(rank-1)}$col(j))
+ vec_y(${rksfx2(rank-1)}$col(j)) = vec_y(${rksfx2(rank-1)}$col(j)) + conjg(data(j)) * aux2
end do
- if(present(beta)) then
- do j = rowptr(i)+1, rowptr(i+1)-1
- vec_y(${rksfx2(rank-1)}$col(j)) = beta_ * vec_y(${rksfx2(rank-1)}$col(j)) + conjg(data(j)) * aux2
- end do
- else
- do j = rowptr(i)+1, rowptr(i+1)-1
- vec_y(${rksfx2(rank-1)}$col(j)) = conjg(data(j)) * aux2
- end do
- end if
vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha_ * aux
end do
#:endif
@@ -279,7 +243,7 @@ contains
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
character(1), intent(in), optional :: op
- ${t1}$ :: alpha_, beta_
+ ${t1}$ :: alpha_
character(1) :: op_
integer(ilp) :: i, j
#:if rank == 1
@@ -385,7 +349,7 @@ contains
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
character(1), intent(in), optional :: op
- ${t1}$ :: alpha_, beta_
+ ${t1}$ :: alpha_
character(1) :: op_
integer(ilp) :: i, j, k
@@ -452,7 +416,7 @@ contains
${t1}$, intent(in), optional :: alpha
${t1}$, intent(in), optional :: beta
character(1), intent(in), optional :: op
- ${t1}$ :: alpha_, beta_
+ ${t1}$ :: alpha_
character(1) :: op_
integer(ilp) :: i, nz, rowidx, num_chunks, rm
From 7a26174440c312eea238a2e1c3527c2c1c787cd6 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Mon, 21 Oct 2024 00:16:17 +0200
Subject: [PATCH 71/78] typo
---
src/stdlib_sparse_spmv.fypp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index 04fe7dd2b..dd53f5596 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -18,7 +18,7 @@ module stdlib_sparse_spmv
!! Version experimental
!!
- !! Applay the sparse matrix-vector product $$y = \alpha * op(M) * x + \beta * y $$
+ !! Apply the sparse matrix-vector product $$y = \alpha * op(M) * x + \beta * y $$
!! [Specifications](../page/specs/stdlib_sparse.html#spmv)
interface spmv
#:for k1, t1, s1 in (KINDS_TYPES)
From 3746331262de55d8d56f6a42d77846256f2d2028 Mon Sep 17 00:00:00 2001
From: Jose Alves <jose.alves@transvalor.com>
Date: Wed, 30 Oct 2024 16:01:24 +0100
Subject: [PATCH 72/78] change file name
---
test/linalg/CMakeLists.txt | 2 +-
test/linalg/{test_sparse_spmv.fypp => test_linalg_sparse.fypp} | 0
2 files changed, 1 insertion(+), 1 deletion(-)
rename test/linalg/{test_sparse_spmv.fypp => test_linalg_sparse.fypp} (100%)
diff --git a/test/linalg/CMakeLists.txt b/test/linalg/CMakeLists.txt
index c3b3a721f..58469833d 100644
--- a/test/linalg/CMakeLists.txt
+++ b/test/linalg/CMakeLists.txt
@@ -12,7 +12,7 @@ set(
"test_linalg_qr.fypp"
"test_linalg_svd.fypp"
"test_linalg_matrix_property_checks.fypp"
- "test_sparse_spmv.fypp"
+ "test_linalg_sparse.fypp"
)
fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)
diff --git a/test/linalg/test_sparse_spmv.fypp b/test/linalg/test_linalg_sparse.fypp
similarity index 100%
rename from test/linalg/test_sparse_spmv.fypp
rename to test/linalg/test_linalg_sparse.fypp
From 3dfcecd11d75496ab14e6b1779d7a06ca3ebe309 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Thu, 31 Oct 2024 15:02:04 +0100
Subject: [PATCH 73/78] addtest
---
test/linalg/CMakeLists.txt | 1 +
1 file changed, 1 insertion(+)
diff --git a/test/linalg/CMakeLists.txt b/test/linalg/CMakeLists.txt
index 58469833d..ad41e5bb0 100644
--- a/test/linalg/CMakeLists.txt
+++ b/test/linalg/CMakeLists.txt
@@ -28,3 +28,4 @@ ADDTEST(linalg_lstsq)
ADDTEST(linalg_qr)
ADDTEST(linalg_svd)
ADDTEST(blas_lapack)
+ADDTEST(linalg_sparse)
\ No newline at end of file
From 89a993e00258211565ffd2a08b955e91cb486c9c Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Thu, 31 Oct 2024 18:19:27 +0100
Subject: [PATCH 74/78] add in place transpose spmv for SELLC
---
src/stdlib_sparse_spmv.fypp | 83 +++++++++++++++++++++++------
test/linalg/test_linalg_sparse.fypp | 14 ++++-
2 files changed, 79 insertions(+), 18 deletions(-)
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index dd53f5596..8835a4cea 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -428,11 +428,18 @@ contains
else
vec_y = zero_${s1}$
endif
+
associate( data => matrix%data, ia => matrix%rowptr , ja => matrix%col, cs => matrix%chunk_size, &
& nnz => matrix%nnz, nrows => matrix%nrows, ncols => matrix%ncols, storage => matrix%storage )
+
+ if( .not.any( ${CHUNKS}$ == cs ) ) then
+ print *, "error: sellc chunk size not supported."
+ return
+ end if
+
num_chunks = nrows / cs
rm = nrows - num_chunks * cs
- if( storage == sparse_full) then
+ if( storage == sparse_full .and. op_==sparse_op_none ) then
select case(cs)
#:for chunk in CHUNKS
@@ -443,9 +450,6 @@ contains
call chunk_kernel_${chunk}$(nz,data(:,ia(i)),ja(:,ia(i)),vec_x,vec_y(rowidx:))
end do
#:endfor
- case default
- print *, "error: chunk size not supported."
- return
end select
! remainder
@@ -455,32 +459,79 @@ contains
rowidx = (i - 1)*cs + 1
call chunk_kernel_remainder(nz,cs,rm,data(:,ia(i)),ja(:,ia(i)),vec_x,vec_y(rowidx:))
end if
+
+ else if( storage == sparse_full .and. op_==sparse_op_transpose ) then
+ select case(cs)
+ #:for chunk in CHUNKS
+ case(${chunk}$)
+ do i = 1, num_chunks
+ nz = ia(i+1) - ia(i)
+ rowidx = (i - 1)*${chunk}$ + 1
+ call chunk_kernel_trans_${chunk}$(nz,data(:,ia(i)),ja(:,ia(i)),vec_x(rowidx:),vec_y)
+ end do
+ #:endfor
+ end select
+
+ ! remainder
+ if(rm>0)then
+ i = num_chunks + 1
+ nz = ia(i+1) - ia(i)
+ rowidx = (i - 1)*cs + 1
+ call chunk_kernel_remainder_trans(nz,cs,rm,data(:,ia(i)),ja(:,ia(i)),vec_x(rowidx:),vec_y)
+ end if
+ else
+ print *, "error: sellc format for spmv operation not yet supported."
+ return
end if
end associate
contains
#:for chunk in CHUNKS
- pure subroutine chunk_kernel_${chunk}$(nz,a,ja,x,y)
- integer, value :: nz
- ${t1}$, intent(in) :: a(${chunk}$,nz), x(*)
- integer(ilp), intent(in) :: ja(${chunk}$,nz)
+ pure subroutine chunk_kernel_${chunk}$(n,a,col,x,y)
+ integer, value :: n
+ ${t1}$, intent(in) :: a(${chunk}$,n), x(*)
+ integer(ilp), intent(in) :: col(${chunk}$,n)
${t1}$, intent(inout) :: y(${chunk}$)
integer :: j
- do j = 1, nz
- where(ja(:,j) > 0) y = y + alpha_ * a(:,j) * x(ja(:,j))
+ do j = 1, n
+ where(col(:,j) > 0) y = y + alpha_ * a(:,j) * x(col(:,j))
+ end do
+ end subroutine
+ pure subroutine chunk_kernel_trans_${chunk}$(n,a,col,x,y)
+ integer, value :: n
+ ${t1}$, intent(in) :: a(${chunk}$,n), x(${chunk}$)
+ integer(ilp), intent(in) :: col(${chunk}$,n)
+ ${t1}$, intent(inout) :: y(*)
+ integer :: j, k
+ do j = 1, n
+ do k = 1, ${chunk}$
+ if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * a(k,j) * x(k)
+ end do
end do
end subroutine
#:endfor
- pure subroutine chunk_kernel_remainder(nz,cs,rm,a,ja,x,y)
- integer, value :: nz, cs, rm
- ${t1}$, intent(in) :: a(cs,nz), x(*)
- integer(ilp), intent(in) :: ja(cs,nz)
+ pure subroutine chunk_kernel_remainder(n,cs,rm,a,col,x,y)
+ integer, value :: n, cs, rm
+ ${t1}$, intent(in) :: a(cs,n), x(*)
+ integer(ilp), intent(in) :: col(cs,n)
${t1}$, intent(inout) :: y(rm)
integer :: j
- do j = 1, nz
- where(ja(1:rm,j) > 0) y = y + alpha_ * a(1:rm,j) * x(ja(1:rm,j))
+ do j = 1, n
+ where(col(1:rm,j) > 0) y = y + alpha_ * a(1:rm,j) * x(col(1:rm,j))
+ end do
+ end subroutine
+ pure subroutine chunk_kernel_remainder_trans(n,cs,rm,a,col,x,y)
+ integer, value :: n, cs, rm
+ ${t1}$, intent(in) :: a(cs,n), x(rm)
+ integer(ilp), intent(in) :: col(cs,n)
+ ${t1}$, intent(inout) :: y(*)
+ integer :: j, k
+ do j = 1, n
+ do k = 1, rm
+ if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * a(k,j) * x(k)
+ end do
end do
end subroutine
diff --git a/test/linalg/test_linalg_sparse.fypp b/test/linalg/test_linalg_sparse.fypp
index 838243505..969f84dd4 100644
--- a/test/linalg/test_linalg_sparse.fypp
+++ b/test/linalg/test_linalg_sparse.fypp
@@ -208,7 +208,7 @@ contains
type(SELLC_${s1}$_type) :: SELLC
type(CSR_${s1}$_type) :: CSR
${t1}$, allocatable :: vec_x(:)
- ${t1}$, allocatable :: vec_y(:)
+ ${t1}$, allocatable :: vec_y(:), vec_y2(:)
integer :: i
call CSR%malloc(6,6,17)
@@ -226,11 +226,21 @@ contains
allocate( vec_x(6) , source = 1._wp )
allocate( vec_y(6) , source = 0._wp )
-
+
call spmv( SELLC, vec_x, vec_y )
call check(error, all(vec_y == real([6,22,27,23,27,48],kind=wp)) )
if (allocated(error)) return
+
+ ! Test in-place transpose
+ vec_x = real( [1,2,3,4,5,6] , kind=wp )
+ call spmv( CSR, vec_x, vec_y , op = sparse_op_transpose )
+ allocate( vec_y2(6) , source = 0._wp )
+ call spmv( SELLC, vec_x, vec_y2 , op = sparse_op_transpose )
+
+ call check(error, all(vec_y == vec_y2))
+ if (allocated(error)) return
+
end block
#:endfor
end subroutine
From ae02481ee097114c64298665baf18c3744929905 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Thu, 31 Oct 2024 18:59:39 +0100
Subject: [PATCH 75/78] simplify sellc spmv kernel
---
src/stdlib_sparse_spmv.fypp | 83 +++++++++++++------------------------
1 file changed, 29 insertions(+), 54 deletions(-)
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index 8835a4cea..a56a51e9c 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -418,7 +418,7 @@ contains
character(1), intent(in), optional :: op
${t1}$ :: alpha_
character(1) :: op_
- integer(ilp) :: i, nz, rowidx, num_chunks, rm
+ integer(ilp) :: i, j, k, nz, rowidx, num_chunks, rm
op_ = sparse_op_none; if(present(op)) op_ = op
alpha_ = one_${s1}$
@@ -447,7 +447,12 @@ contains
do i = 1, num_chunks
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*${chunk}$ + 1
- call chunk_kernel_${chunk}$(nz,data(:,ia(i)),ja(:,ia(i)),vec_x,vec_y(rowidx:))
+ associate(col => ja(1:${chunk}$,ia(i):ia(i)+nz-1), mat => data(1:${chunk}$,ia(i):ia(i)+nz-1), &
+ & x => vec_x, y => vec_y(rowidx:rowidx+${chunk}$-1) )
+ do j = 1, nz
+ where(col(:,j) > 0) y = y + alpha_ * mat(:,j) * x(col(:,j))
+ end do
+ end associate
end do
#:endfor
end select
@@ -457,7 +462,12 @@ contains
i = num_chunks + 1
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*cs + 1
- call chunk_kernel_remainder(nz,cs,rm,data(:,ia(i)),ja(:,ia(i)),vec_x,vec_y(rowidx:))
+ associate(col => ja(1:${chunk}$,ia(i):ia(i)+nz-1), mat => data(1:${chunk}$,ia(i):ia(i)+nz-1), &
+ & x => vec_x, y => vec_y(rowidx:rowidx+rm-1) )
+ do j = 1, nz
+ where(col(1:rm,j) > 0) y = y + alpha_ * mat(1:rm,j) * x(col(1:rm,j))
+ end do
+ end associate
end if
else if( storage == sparse_full .and. op_==sparse_op_transpose ) then
@@ -468,7 +478,14 @@ contains
do i = 1, num_chunks
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*${chunk}$ + 1
- call chunk_kernel_trans_${chunk}$(nz,data(:,ia(i)),ja(:,ia(i)),vec_x(rowidx:),vec_y)
+ associate(col => ja(1:${chunk}$,ia(i):ia(i)+nz-1), mat => data(1:${chunk}$,ia(i):ia(i)+nz-1), &
+ & x => vec_x(rowidx:rowidx+${chunk}$-1), y => vec_y )
+ do j = 1, nz
+ do k = 1, ${chunk}$
+ if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * mat(k,j) * x(k)
+ end do
+ end do
+ end associate
end do
#:endfor
end select
@@ -478,7 +495,14 @@ contains
i = num_chunks + 1
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*cs + 1
- call chunk_kernel_remainder_trans(nz,cs,rm,data(:,ia(i)),ja(:,ia(i)),vec_x(rowidx:),vec_y)
+ associate(col => ja(1:${chunk}$,ia(i):ia(i)+nz-1), mat => data(1:${chunk}$,ia(i):ia(i)+nz-1), &
+ & x => vec_x(rowidx:rowidx+rm-1), y => vec_y )
+ do j = 1, nz
+ do k = 1, rm
+ if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * mat(k,j) * x(k)
+ end do
+ end do
+ end associate
end if
else
print *, "error: sellc format for spmv operation not yet supported."
@@ -486,55 +510,6 @@ contains
end if
end associate
- contains
- #:for chunk in CHUNKS
- pure subroutine chunk_kernel_${chunk}$(n,a,col,x,y)
- integer, value :: n
- ${t1}$, intent(in) :: a(${chunk}$,n), x(*)
- integer(ilp), intent(in) :: col(${chunk}$,n)
- ${t1}$, intent(inout) :: y(${chunk}$)
- integer :: j
- do j = 1, n
- where(col(:,j) > 0) y = y + alpha_ * a(:,j) * x(col(:,j))
- end do
- end subroutine
- pure subroutine chunk_kernel_trans_${chunk}$(n,a,col,x,y)
- integer, value :: n
- ${t1}$, intent(in) :: a(${chunk}$,n), x(${chunk}$)
- integer(ilp), intent(in) :: col(${chunk}$,n)
- ${t1}$, intent(inout) :: y(*)
- integer :: j, k
- do j = 1, n
- do k = 1, ${chunk}$
- if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * a(k,j) * x(k)
- end do
- end do
- end subroutine
- #:endfor
-
- pure subroutine chunk_kernel_remainder(n,cs,rm,a,col,x,y)
- integer, value :: n, cs, rm
- ${t1}$, intent(in) :: a(cs,n), x(*)
- integer(ilp), intent(in) :: col(cs,n)
- ${t1}$, intent(inout) :: y(rm)
- integer :: j
- do j = 1, n
- where(col(1:rm,j) > 0) y = y + alpha_ * a(1:rm,j) * x(col(1:rm,j))
- end do
- end subroutine
- pure subroutine chunk_kernel_remainder_trans(n,cs,rm,a,col,x,y)
- integer, value :: n, cs, rm
- ${t1}$, intent(in) :: a(cs,n), x(rm)
- integer(ilp), intent(in) :: col(cs,n)
- ${t1}$, intent(inout) :: y(*)
- integer :: j, k
- do j = 1, n
- do k = 1, rm
- if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * a(k,j) * x(k)
- end do
- end do
- end subroutine
-
end subroutine
#:endfor
From 680d35dbfdff4e13936112966d28304af19d94f2 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Thu, 31 Oct 2024 20:08:45 +0100
Subject: [PATCH 76/78] fix out-of-bounds
---
src/stdlib_sparse_spmv.fypp | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index a56a51e9c..b3f636093 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -462,7 +462,7 @@ contains
i = num_chunks + 1
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*cs + 1
- associate(col => ja(1:${chunk}$,ia(i):ia(i)+nz-1), mat => data(1:${chunk}$,ia(i):ia(i)+nz-1), &
+ associate(col => ja(1:cs,ia(i):ia(i)+nz-1), mat => data(1:cs,ia(i):ia(i)+nz-1), &
& x => vec_x, y => vec_y(rowidx:rowidx+rm-1) )
do j = 1, nz
where(col(1:rm,j) > 0) y = y + alpha_ * mat(1:rm,j) * x(col(1:rm,j))
@@ -495,7 +495,7 @@ contains
i = num_chunks + 1
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*cs + 1
- associate(col => ja(1:${chunk}$,ia(i):ia(i)+nz-1), mat => data(1:${chunk}$,ia(i):ia(i)+nz-1), &
+ associate(col => ja(1:cs,ia(i):ia(i)+nz-1), mat => data(1:cs,ia(i):ia(i)+nz-1), &
& x => vec_x(rowidx:rowidx+rm-1), y => vec_y )
do j = 1, nz
do k = 1, rm
From 7e45901aa20b88d6c08df03e678325543e195e66 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Thu, 31 Oct 2024 21:26:55 +0100
Subject: [PATCH 77/78] sellc hermitian transpose
---
src/stdlib_sparse_spmv.fypp | 37 +++++++++++++++++++++++++++++++++++++
1 file changed, 37 insertions(+)
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index b3f636093..c9cdbcac9 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -504,6 +504,43 @@ contains
end do
end associate
end if
+
+ #:if t1.startswith('complex')
+ else if( storage == sparse_full .and. op_==sparse_op_hermitian ) then
+
+ select case(cs)
+ #:for chunk in CHUNKS
+ case(${chunk}$)
+ do i = 1, num_chunks
+ nz = ia(i+1) - ia(i)
+ rowidx = (i - 1)*${chunk}$ + 1
+ associate(col => ja(1:${chunk}$,ia(i):ia(i)+nz-1), mat => data(1:${chunk}$,ia(i):ia(i)+nz-1), &
+ & x => vec_x(rowidx:rowidx+${chunk}$-1), y => vec_y )
+ do j = 1, nz
+ do k = 1, ${chunk}$
+ if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * conjg(mat(k,j)) * x(k)
+ end do
+ end do
+ end associate
+ end do
+ #:endfor
+ end select
+
+ ! remainder
+ if(rm>0)then
+ i = num_chunks + 1
+ nz = ia(i+1) - ia(i)
+ rowidx = (i - 1)*cs + 1
+ associate(col => ja(1:cs,ia(i):ia(i)+nz-1), mat => data(1:cs,ia(i):ia(i)+nz-1), &
+ & x => vec_x(rowidx:rowidx+rm-1), y => vec_y )
+ do j = 1, nz
+ do k = 1, rm
+ if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * conjg(mat(k,j)) * x(k)
+ end do
+ end do
+ end associate
+ end if
+ #:endif
else
print *, "error: sellc format for spmv operation not yet supported."
return
From 22cd23e88d57007fa2dc24421c7bae21531f54d5 Mon Sep 17 00:00:00 2001
From: jalvesz <jose.alves@transvalor.com>
Date: Tue, 5 Nov 2024 22:12:37 +0100
Subject: [PATCH 78/78] sellc: rollback on local associates, use embedded chunk
kernels
---
src/stdlib_sparse_spmv.fypp | 129 +++++++++++++++++++++++-------------
1 file changed, 84 insertions(+), 45 deletions(-)
diff --git a/src/stdlib_sparse_spmv.fypp b/src/stdlib_sparse_spmv.fypp
index c9cdbcac9..2f2e4bb45 100644
--- a/src/stdlib_sparse_spmv.fypp
+++ b/src/stdlib_sparse_spmv.fypp
@@ -418,7 +418,7 @@ contains
character(1), intent(in), optional :: op
${t1}$ :: alpha_
character(1) :: op_
- integer(ilp) :: i, j, k, nz, rowidx, num_chunks, rm
+ integer(ilp) :: i, nz, rowidx, num_chunks, rm
op_ = sparse_op_none; if(present(op)) op_ = op
alpha_ = one_${s1}$
@@ -447,12 +447,7 @@ contains
do i = 1, num_chunks
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*${chunk}$ + 1
- associate(col => ja(1:${chunk}$,ia(i):ia(i)+nz-1), mat => data(1:${chunk}$,ia(i):ia(i)+nz-1), &
- & x => vec_x, y => vec_y(rowidx:rowidx+${chunk}$-1) )
- do j = 1, nz
- where(col(:,j) > 0) y = y + alpha_ * mat(:,j) * x(col(:,j))
- end do
- end associate
+ call chunk_kernel_${chunk}$(nz,data(:,ia(i)),ja(:,ia(i)),vec_x,vec_y(rowidx:))
end do
#:endfor
end select
@@ -462,12 +457,7 @@ contains
i = num_chunks + 1
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*cs + 1
- associate(col => ja(1:cs,ia(i):ia(i)+nz-1), mat => data(1:cs,ia(i):ia(i)+nz-1), &
- & x => vec_x, y => vec_y(rowidx:rowidx+rm-1) )
- do j = 1, nz
- where(col(1:rm,j) > 0) y = y + alpha_ * mat(1:rm,j) * x(col(1:rm,j))
- end do
- end associate
+ call chunk_kernel_rm(nz,cs,rm,data(:,ia(i)),ja(:,ia(i)),vec_x,vec_y(rowidx:))
end if
else if( storage == sparse_full .and. op_==sparse_op_transpose ) then
@@ -478,14 +468,7 @@ contains
do i = 1, num_chunks
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*${chunk}$ + 1
- associate(col => ja(1:${chunk}$,ia(i):ia(i)+nz-1), mat => data(1:${chunk}$,ia(i):ia(i)+nz-1), &
- & x => vec_x(rowidx:rowidx+${chunk}$-1), y => vec_y )
- do j = 1, nz
- do k = 1, ${chunk}$
- if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * mat(k,j) * x(k)
- end do
- end do
- end associate
+ call chunk_kernel_trans_${chunk}$(nz,data(:,ia(i)),ja(:,ia(i)),vec_x(rowidx:),vec_y)
end do
#:endfor
end select
@@ -495,14 +478,7 @@ contains
i = num_chunks + 1
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*cs + 1
- associate(col => ja(1:cs,ia(i):ia(i)+nz-1), mat => data(1:cs,ia(i):ia(i)+nz-1), &
- & x => vec_x(rowidx:rowidx+rm-1), y => vec_y )
- do j = 1, nz
- do k = 1, rm
- if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * mat(k,j) * x(k)
- end do
- end do
- end associate
+ call chunk_kernel_rm_trans(nz,cs,rm,data(:,ia(i)),ja(:,ia(i)),vec_x(rowidx:),vec_y)
end if
#:if t1.startswith('complex')
@@ -514,14 +490,7 @@ contains
do i = 1, num_chunks
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*${chunk}$ + 1
- associate(col => ja(1:${chunk}$,ia(i):ia(i)+nz-1), mat => data(1:${chunk}$,ia(i):ia(i)+nz-1), &
- & x => vec_x(rowidx:rowidx+${chunk}$-1), y => vec_y )
- do j = 1, nz
- do k = 1, ${chunk}$
- if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * conjg(mat(k,j)) * x(k)
- end do
- end do
- end associate
+ call chunk_kernel_herm_${chunk}$(nz,data(:,ia(i)),ja(:,ia(i)),vec_x(rowidx:),vec_y)
end do
#:endfor
end select
@@ -531,14 +500,7 @@ contains
i = num_chunks + 1
nz = ia(i+1) - ia(i)
rowidx = (i - 1)*cs + 1
- associate(col => ja(1:cs,ia(i):ia(i)+nz-1), mat => data(1:cs,ia(i):ia(i)+nz-1), &
- & x => vec_x(rowidx:rowidx+rm-1), y => vec_y )
- do j = 1, nz
- do k = 1, rm
- if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * conjg(mat(k,j)) * x(k)
- end do
- end do
- end associate
+ call chunk_kernel_rm_herm(nz,cs,rm,data(:,ia(i)),ja(:,ia(i)),vec_x(rowidx:),vec_y)
end if
#:endif
else
@@ -547,6 +509,83 @@ contains
end if
end associate
+ contains
+ #:for chunk in CHUNKS
+ pure subroutine chunk_kernel_${chunk}$(n,a,col,x,y)
+ integer, value :: n
+ ${t1}$, intent(in) :: a(${chunk}$,n), x(*)
+ integer(ilp), intent(in) :: col(${chunk}$,n)
+ ${t1}$, intent(inout) :: y(${chunk}$)
+ integer :: j
+ do j = 1, n
+ where(col(:,j) > 0) y = y + alpha_ * a(:,j) * x(col(:,j))
+ end do
+ end subroutine
+ pure subroutine chunk_kernel_trans_${chunk}$(n,a,col,x,y)
+ integer, value :: n
+ ${t1}$, intent(in) :: a(${chunk}$,n), x(${chunk}$)
+ integer(ilp), intent(in) :: col(${chunk}$,n)
+ ${t1}$, intent(inout) :: y(*)
+ integer :: j, k
+ do j = 1, n
+ do k = 1, ${chunk}$
+ if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * a(k,j) * x(k)
+ end do
+ end do
+ end subroutine
+ #:if t1.startswith('complex')
+ pure subroutine chunk_kernel_herm_${chunk}$(n,a,col,x,y)
+ integer, value :: n
+ ${t1}$, intent(in) :: a(${chunk}$,n), x(${chunk}$)
+ integer(ilp), intent(in) :: col(${chunk}$,n)
+ ${t1}$, intent(inout) :: y(*)
+ integer :: j, k
+ do j = 1, n
+ do k = 1, ${chunk}$
+ if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * conjg(a(k,j)) * x(k)
+ end do
+ end do
+ end subroutine
+ #:endif
+ #:endfor
+
+ pure subroutine chunk_kernel_rm(n,cs,r,a,col,x,y)
+ integer, value :: n, cs, r
+ ${t1}$, intent(in) :: a(cs,n), x(*)
+ integer(ilp), intent(in) :: col(cs,n)
+ ${t1}$, intent(inout) :: y(r)
+ integer :: j
+ do j = 1, n
+ where(col(1:r,j) > 0) y = y + alpha_ * a(1:r,j) * x(col(1:r,j))
+ end do
+ end subroutine
+ pure subroutine chunk_kernel_rm_trans(n,cs,r,a,col,x,y)
+ integer, value :: n, cs, r
+ ${t1}$, intent(in) :: a(cs,n), x(r)
+ integer(ilp), intent(in) :: col(cs,n)
+ ${t1}$, intent(inout) :: y(*)
+ integer :: j, k
+ do j = 1, n
+ do k = 1, r
+ if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * a(k,j) * x(k)
+ end do
+ end do
+ end subroutine
+ #:if t1.startswith('complex')
+ pure subroutine chunk_kernel_rm_herm(n,cs,r,a,col,x,y)
+ integer, value :: n, cs, r
+ ${t1}$, intent(in) :: a(cs,n), x(r)
+ integer(ilp), intent(in) :: col(cs,n)
+ ${t1}$, intent(inout) :: y(*)
+ integer :: j, k
+ do j = 1, n
+ do k = 1, r
+ if(col(k,j) > 0) y(col(k,j)) = y(col(k,j)) + alpha_ * conjg(a(k,j)) * x(k)
+ end do
+ end do
+ end subroutine
+ #:endif
+
end subroutine
#:endfor