Line data Source code
1 : !!****m* ABINIT/m_spmat_coo
2 : !! NAME
3 : !! m_spmat_coo
4 : !!
5 : !! FUNCTION
6 : !! This module contains the a COO (coordinate) format of sparse matrix.
7 : !! The efficiency of mat vec multiplication is fine but not as good as CSR
8 : !! Datatypes:
9 : !! COO_mat_t: COO matrix
10 : !!
11 : !! Subroutines:
12 : !! TODO: add this when F2003 doc style is determined.
13 : !!
14 : !!
15 : !! COPYRIGHT
16 : !! Copyright (C) 2001-2026 ABINIT group (hexu)
17 : !! This file is distributed under the terms of the
18 : !! GNU General Public License, see ~abinit/COPYING
19 : !! or http://www.gnu.org/copyleft/gpl.txt .
20 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
21 : !!
22 : !! SOURCE
23 :
24 : #if defined HAVE_CONFIG_H
25 : #include "config.h"
26 : #endif
27 : #include "abi_common.h"
28 :
29 : module m_spmat_COO
30 : use defs_basis
31 : use m_xmpi
32 : use m_errors
33 : use m_abicore
34 : use m_spmat_base
35 : use m_spmat_ndcoo, only: ndcoo_mat_t
36 : implicit none
37 : private
38 : !!***
39 :
40 : !-----------------------------------------------------------------------
41 : !> @brief COO-sparse matrix
42 : !> it has nothing extra to the NDCOO matrix. only a check on whether it
43 : !> is 2D is made during initialization.
44 : !> and a matrix vector multiplication is implemented (mv)
45 : !-----------------------------------------------------------------------
46 : type, public, extends(ndcoo_mat_t) :: COO_mat_t
47 : contains
48 : procedure :: initialize
49 : procedure :: mv
50 : procedure :: mv_left
51 : procedure :: diag
52 : end type COO_mat_t
53 :
54 :
55 : contains
56 :
57 : !-----------------------------------------------------------------------
58 : !> @brief initialize
59 : !> @param [in] mshape: the shape of the matrix
60 : !-----------------------------------------------------------------------
61 7 : subroutine initialize(self, mshape)
62 : class(coo_mat_t), intent(inout) :: self
63 : integer, intent(in) :: mshape(:)
64 7 : if (size(mshape)/=2) then
65 0 : ABI_BUG(" COO matrix should be 2D (mshape should be of length 2).")
66 : end if
67 7 : call self%ndcoo_mat_t%initialize(mshape)
68 7 : end subroutine initialize
69 :
70 1 : subroutine diag(self, d)
71 : class(coo_mat_t), intent(inout) :: self
72 : real(dp), intent(out) :: d(:)
73 : integer :: ind, ind_i, ind_j
74 1025 : d(:)=0.0_dp
75 67585 : do ind=1, self%nnz
76 67584 : ind_i=self%ind%data(1, ind)
77 67584 : ind_j=self%ind%data(2, ind)
78 67585 : if (ind_i==ind_j) then
79 1024 : d(ind_i)=d(ind_i)+self%val%data(ind)
80 : endif
81 : end do
82 1 : end subroutine diag
83 :
84 : !subroutine get_block(self, irow_start, icol_start, nrow, ncol, blk)
85 : ! class(COO_mat_t), intent(in)::self
86 : ! integer, intent(in) :: nrow, irow_start, ncol, icol_start
87 : ! real(dp), intent(out) :: blk(nrow, ncol)
88 : ! integer :: ind, ind_i, ind_j
89 : ! blk(:, :)=0.0_dp
90 : ! do ind=1, self%nnz
91 : ! ind_i=self%ind%data(1, ind)
92 : ! ind_j=self%ind%data(2, ind)
93 : ! if (ind_i>=irow) then
94 : ! d(ind_i)=d(ind_i)+self%val%data(ind)
95 : ! endif
96 : ! end do
97 : !end subroutine diag
98 :
99 :
100 :
101 : !-----------------------------------------------------------------------
102 : !> @brief COO sparse matrix-vector multiplication. naive implementation.
103 : !> @param [in] x Mx=b
104 : !> @param [out] b Mx=b
105 : !-----------------------------------------------------------------------
106 12028 : subroutine mv(self, x, b)
107 : class(COO_mat_t), intent(in) :: self
108 : real(dp), intent(in) :: x(self%mshape(1))
109 : real(dp), intent(out) :: b(self%mshape(2))
110 : integer:: ind, ind_i, ind_j
111 38937148 : b(:)=0.0D0
112 : !!$OMP PARALLEL DO private(ind, ind_i, ind_j)
113 1486951612 : do ind = 1, self%nnz
114 1486939584 : ind_i=self%ind%data(1, ind)
115 1486939584 : ind_j=self%ind%data(2, ind)
116 1486951612 : b(ind_i)=b(ind_i)+self%val%data(ind)*x(ind_j)
117 : end do
118 : !!$OMP END PARALLEL DO
119 12028 : end subroutine mv
120 :
121 :
122 :
123 :
124 : !-----------------------------------------------------------------------
125 : !> @brief COO sparse matrix-vector multiplication. naive implementation.
126 : !> @param [in] x Mx=b
127 : !> @param [out] b Mx=b
128 : !-----------------------------------------------------------------------
129 : subroutine COO_mat_t_mv_mpi(self, x ,b)
130 : class(coo_mat_t), intent(in) :: self
131 : real(dp), intent(inout) :: x(:)
132 : real(dp), intent(out) :: b(:)
133 : !real(dp):: my_b(self%nrow)
134 : integer :: ierr
135 : call xmpi_bcast(x, 0, xmpi_world, ierr)
136 : b(:)=0.0_dp
137 : ABI_UNUSED_A(self)
138 :
139 : ! TODO implement.
140 : ABI_ERROR("mpi COO mv Not implemented yet")
141 : ! TODO : use gather instead of reduce.
142 : !call mpi_reduce(my_b, b, self%nrow, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr)
143 : call xmpi_sum_master(b, 0, xmpi_world, ierr )
144 : end subroutine COO_mat_t_mv_mpi
145 :
146 :
147 : !-----------------------------------------------------------------------
148 : !> @brief COO sparse matrix-vector left multiplication. naive implementation.
149 : !> @param [in] x xM=b
150 : !> @param [out] b xM=b
151 : !-----------------------------------------------------------------------
152 0 : subroutine mv_left(self, x, b)
153 : class(COO_mat_t), intent(in) :: self
154 : real(dp), intent(in) :: x(self%mshape(2))
155 : real(dp), intent(out) :: b(self%mshape(1))
156 : integer:: ind, ind_i, ind_j
157 0 : b(:)=0.0D0
158 : !$OMP PARALLEL DO private(ind, ind_i, ind_j)
159 0 : do ind = 1, self%nnz
160 0 : ind_i=self%ind%data(1, ind)
161 0 : ind_j=self%ind%data(2, ind)
162 0 : b(ind_j)=b(ind_j)+self%val%data(ind)*x(ind_i)
163 : end do
164 : !$OMP END PARALLEL DO
165 0 : end subroutine mv_left
166 :
167 :
168 :
169 :
170 : subroutine test_COO_mv()
171 : type(coo_mat_t) :: mat
172 : real(dp) :: x(3), b(3)
173 : x(:)=1.0
174 : call mat%initialize([3,3])
175 : call mat%add_entry([1,1], 3.0_dp)
176 : call mat%mv(x, b)
177 : end subroutine test_COO_mv
178 :
179 0 : end module m_spmat_COO
|
