Branch data 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
# # # # #
# # # #
# ]
|
