From a6db1b566c83195d225f03b950915828f6cf595c Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Mon, 6 Apr 2020 12:49:41 +0200 Subject: [PATCH] Added Interface (and C Interface) for nnz of a sparse matrix --- base/modules/psblas/psb_c_psblas_mod.F90 | 13 +++- base/modules/psblas/psb_d_psblas_mod.F90 | 13 +++- base/modules/psblas/psb_s_psblas_mod.F90 | 13 +++- base/modules/psblas/psb_z_psblas_mod.F90 | 13 +++- base/psblas/Makefile | 3 +- base/psblas/psb_cgetmatinfo.f90 | 92 ++++++++++++++++++++++++ base/psblas/psb_dgetmatinfo.f90 | 92 ++++++++++++++++++++++++ base/psblas/psb_sgetmatinfo.f90 | 92 ++++++++++++++++++++++++ base/psblas/psb_zgetmatinfo.f90 | 92 ++++++++++++++++++++++++ cbind/base/psb_c_cbase.h | 1 + cbind/base/psb_c_dbase.h | 1 + cbind/base/psb_c_psblas_cbind_mod.f90 | 26 +++++++ cbind/base/psb_c_sbase.h | 1 + cbind/base/psb_c_zbase.h | 1 + cbind/base/psb_d_psblas_cbind_mod.f90 | 26 +++++++ cbind/base/psb_s_psblas_cbind_mod.f90 | 26 +++++++ cbind/base/psb_z_psblas_cbind_mod.f90 | 26 +++++++ 17 files changed, 526 insertions(+), 5 deletions(-) create mode 100644 base/psblas/psb_cgetmatinfo.f90 create mode 100644 base/psblas/psb_dgetmatinfo.f90 create mode 100644 base/psblas/psb_sgetmatinfo.f90 create mode 100644 base/psblas/psb_zgetmatinfo.f90 diff --git a/base/modules/psblas/psb_c_psblas_mod.F90 b/base/modules/psblas/psb_c_psblas_mod.F90 index ad52858e..56ea620a 100644 --- a/base/modules/psblas/psb_c_psblas_mod.F90 +++ b/base/modules/psblas/psb_c_psblas_mod.F90 @@ -30,7 +30,7 @@ ! ! module psb_c_psblas_mod - use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_ + use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_ use psb_c_vect_mod, only : psb_c_vect_type use psb_c_mat_mod, only : psb_cspmat_type @@ -588,4 +588,15 @@ module psb_c_psblas_mod end interface + interface psb_nnz + function psb_cget_nnz(a,desc_a,info) result(res) + import :: psb_desc_type, psb_ipk_, psb_lpk_, & + & psb_cspmat_type, psb_spk_ + integer(psb_lpk_) :: res + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent (in) :: desc_a + integer(psb_ipk_), intent(out) :: info + end function + end interface + end module psb_c_psblas_mod diff --git a/base/modules/psblas/psb_d_psblas_mod.F90 b/base/modules/psblas/psb_d_psblas_mod.F90 index 57055e73..2c0ea438 100644 --- a/base/modules/psblas/psb_d_psblas_mod.F90 +++ b/base/modules/psblas/psb_d_psblas_mod.F90 @@ -30,7 +30,7 @@ ! ! module psb_d_psblas_mod - use psb_desc_mod, only : psb_desc_type, psb_dpk_, psb_ipk_ + use psb_desc_mod, only : psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_ use psb_d_vect_mod, only : psb_d_vect_type use psb_d_mat_mod, only : psb_dspmat_type @@ -623,4 +623,15 @@ module psb_d_psblas_mod end function end interface + interface psb_nnz + function psb_dget_nnz(a,desc_a,info) result(res) + import :: psb_desc_type, psb_ipk_, psb_lpk_, & + & psb_dspmat_type, psb_dpk_ + integer(psb_lpk_) :: res + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent (in) :: desc_a + integer(psb_ipk_), intent(out) :: info + end function + end interface + end module psb_d_psblas_mod diff --git a/base/modules/psblas/psb_s_psblas_mod.F90 b/base/modules/psblas/psb_s_psblas_mod.F90 index 5dc5e642..8b9a21c0 100644 --- a/base/modules/psblas/psb_s_psblas_mod.F90 +++ b/base/modules/psblas/psb_s_psblas_mod.F90 @@ -30,7 +30,7 @@ ! ! module psb_s_psblas_mod - use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_ + use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_ use psb_s_vect_mod, only : psb_s_vect_type use psb_s_mat_mod, only : psb_sspmat_type @@ -623,4 +623,15 @@ module psb_s_psblas_mod end function end interface + interface psb_nnz + function psb_sget_nnz(a,desc_a,info) result(res) + import :: psb_desc_type, psb_ipk_, psb_lpk_, & + & psb_sspmat_type, psb_spk_ + integer(psb_lpk_) :: res + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent (in) :: desc_a + integer(psb_ipk_), intent(out) :: info + end function + end interface + end module psb_s_psblas_mod diff --git a/base/modules/psblas/psb_z_psblas_mod.F90 b/base/modules/psblas/psb_z_psblas_mod.F90 index 02a45e03..279c28ba 100644 --- a/base/modules/psblas/psb_z_psblas_mod.F90 +++ b/base/modules/psblas/psb_z_psblas_mod.F90 @@ -30,7 +30,7 @@ ! ! module psb_z_psblas_mod - use psb_desc_mod, only : psb_desc_type, psb_dpk_, psb_ipk_ + use psb_desc_mod, only : psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_ use psb_z_vect_mod, only : psb_z_vect_type use psb_z_mat_mod, only : psb_zspmat_type @@ -588,4 +588,15 @@ module psb_z_psblas_mod end interface + interface psb_nnz + function psb_zget_nnz(a,desc_a,info) result(res) + import :: psb_desc_type, psb_ipk_, psb_lpk_, & + & psb_zspmat_type, psb_dpk_ + integer(psb_lpk_) :: res + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent (in) :: desc_a + integer(psb_ipk_), intent(out) :: info + end function + end interface + end module psb_z_psblas_mod diff --git a/base/psblas/Makefile b/base/psblas/Makefile index 1c54aaa5..a16ab35c 100644 --- a/base/psblas/Makefile +++ b/base/psblas/Makefile @@ -15,7 +15,8 @@ OBJS= psb_ddot.o psb_damax.o psb_dasum.o psb_daxpby.o\ psb_cinv_vect.o psb_dinv_vect.o psb_zinv_vect.o psb_sinv_vect.o\ psb_dcmp_vect.o psb_scmp_vect.o psb_ccmp_vect.o psb_zcmp_vect.o\ psb_cabs_vect.o psb_dabs_vect.o psb_sabs_vect.o \ - psb_zabs_vect.o + psb_zabs_vect.o psb_cgetmatinfo.o psb_dgetmatinfo.o psb_sgetmatinfo.o \ + psb_zgetmatinfo.o LIBDIR=.. INCDIR=.. diff --git a/base/psblas/psb_cgetmatinfo.f90 b/base/psblas/psb_cgetmatinfo.f90 new file mode 100644 index 00000000..43bd7ea5 --- /dev/null +++ b/base/psblas/psb_cgetmatinfo.f90 @@ -0,0 +1,92 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +! File: psb_cgetmatinfo.f90 +! +! This function containts the implementation for obtaining information on the +! paralle sparse matrix +! +function psb_cget_nnz(a,desc_a,info) result(res) + use psb_base_mod, psb_protect_name => psb_cget_nnz + use psi_mod + use mpi + + implicit none + + integer(psb_lpk_) :: res + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent (in) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! locals + integer(psb_ipk_) :: ictxt, np, me,& + & err_act, iia, jja + integer(psb_lpk_) :: m,n,ia,ja,localnnz + character(len=20) :: name, ch_err + ! + name='psb_cspmv' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + + ! Check for matrix correctness + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkmat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + localnnz = a%get_nzeros() + + call MPI_ALLREDUCE(localnnz, res, 1, MPI_LONG, MPI_SUM, ictxt, info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end function diff --git a/base/psblas/psb_dgetmatinfo.f90 b/base/psblas/psb_dgetmatinfo.f90 new file mode 100644 index 00000000..39f4e539 --- /dev/null +++ b/base/psblas/psb_dgetmatinfo.f90 @@ -0,0 +1,92 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +! File: psb_dgetmatinfo.f90 +! +! This function containts the implementation for obtaining information on the +! paralle sparse matrix +! +function psb_dget_nnz(a,desc_a,info) result(res) + use psb_base_mod, psb_protect_name => psb_dget_nnz + use psi_mod + use mpi + + implicit none + + integer(psb_lpk_) :: res + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent (in) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! locals + integer(psb_ipk_) :: ictxt, np, me,& + & err_act, iia, jja + integer(psb_lpk_) :: m,n,ia,ja,localnnz + character(len=20) :: name, ch_err + ! + name='psb_dspmv' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + + ! Check for matrix correctness + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkmat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + localnnz = a%get_nzeros() + + call MPI_ALLREDUCE(localnnz, res, 1, MPI_LONG, MPI_SUM, ictxt, info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end function diff --git a/base/psblas/psb_sgetmatinfo.f90 b/base/psblas/psb_sgetmatinfo.f90 new file mode 100644 index 00000000..f5593eaa --- /dev/null +++ b/base/psblas/psb_sgetmatinfo.f90 @@ -0,0 +1,92 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +! File: psb_sgetmatinfo.f90 +! +! This function containts the implementation for obtaining information on the +! paralle sparse matrix +! +function psb_sget_nnz(a,desc_a,info) result(res) + use psb_base_mod, psb_protect_name => psb_sget_nnz + use psi_mod + use mpi + + implicit none + + integer(psb_lpk_) :: res + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent (in) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! locals + integer(psb_ipk_) :: ictxt, np, me,& + & err_act, iia, jja + integer(psb_lpk_) :: m,n,ia,ja,localnnz + character(len=20) :: name, ch_err + ! + name='psb_sspmv' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + + ! Check for matrix correctness + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkmat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + localnnz = a%get_nzeros() + + call MPI_ALLREDUCE(localnnz, res, 1, MPI_LONG, MPI_SUM, ictxt, info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end function diff --git a/base/psblas/psb_zgetmatinfo.f90 b/base/psblas/psb_zgetmatinfo.f90 new file mode 100644 index 00000000..76904239 --- /dev/null +++ b/base/psblas/psb_zgetmatinfo.f90 @@ -0,0 +1,92 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +! File: psb_zgetmatinfo.f90 +! +! This function containts the implementation for obtaining information on the +! paralle sparse matrix +! +function psb_zget_nnz(a,desc_a,info) result(res) + use psb_base_mod, psb_protect_name => psb_zget_nnz + use psi_mod + use mpi + + implicit none + + integer(psb_lpk_) :: res + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent (in) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! locals + integer(psb_ipk_) :: ictxt, np, me,& + & err_act, iia, jja + integer(psb_lpk_) :: m,n,ia,ja,localnnz + character(len=20) :: name, ch_err + ! + name='psb_zspmv' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + + ! Check for matrix correctness + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkmat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + localnnz = a%get_nzeros() + + call MPI_ALLREDUCE(localnnz, res, 1, MPI_LONG, MPI_SUM, ictxt, info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end function diff --git a/cbind/base/psb_c_cbase.h b/cbind/base/psb_c_cbase.h index e5e568d2..4f4e5bb3 100644 --- a/cbind/base/psb_c_cbase.h +++ b/cbind/base/psb_c_cbase.h @@ -40,6 +40,7 @@ psb_i_t psb_c_cspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl, const psb_c_t *val, psb_c_cspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_cmat_get_nrows(psb_c_cspmat *mh); psb_i_t psb_c_cmat_get_ncols(psb_c_cspmat *mh); +psb_l_t psb_c_cnnz(psb_c_cspmat *mh,psb_c_descriptor *cdh); /* psb_i_t psb_c_cspasb_opt(psb_c_cspmat *mh, psb_c_descriptor *cdh, */ /* const char *afmt, psb_i_t upd, psb_i_t dupl); */ diff --git a/cbind/base/psb_c_dbase.h b/cbind/base/psb_c_dbase.h index 2c11045e..15a5ab15 100644 --- a/cbind/base/psb_c_dbase.h +++ b/cbind/base/psb_c_dbase.h @@ -40,6 +40,7 @@ psb_i_t psb_c_dspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl, const psb_d_t *val, psb_c_dspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_dmat_get_nrows(psb_c_dspmat *mh); psb_i_t psb_c_dmat_get_ncols(psb_c_dspmat *mh); +psb_l_t psb_c_dnnz(psb_c_dspmat *mh,psb_c_descriptor *cdh); /* psb_i_t psb_c_dspasb_opt(psb_c_dspmat *mh, psb_c_descriptor *cdh, */ /* const char *afmt, psb_i_t upd, psb_i_t dupl); */ diff --git a/cbind/base/psb_c_psblas_cbind_mod.f90 b/cbind/base/psb_c_psblas_cbind_mod.f90 index 9215abe3..d52d4140 100644 --- a/cbind/base/psb_c_psblas_cbind_mod.f90 +++ b/cbind/base/psb_c_psblas_cbind_mod.f90 @@ -871,5 +871,31 @@ contains end function psb_c_cspsm + function psb_c_cnnz(ah,cdh) bind(c) result(res) + implicit none + integer(psb_c_ipk_) :: res + + type(psb_c_cspmat) :: ah + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_cspmat_type), pointer :: ap + integer(psb_c_ipk_) :: info + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + res = psb_nnz(ap,descp,info) + + end function psb_c_cnnz + end module psb_c_psblas_cbind_mod diff --git a/cbind/base/psb_c_sbase.h b/cbind/base/psb_c_sbase.h index 664761f7..e9827fec 100644 --- a/cbind/base/psb_c_sbase.h +++ b/cbind/base/psb_c_sbase.h @@ -40,6 +40,7 @@ psb_i_t psb_c_sspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl, const psb_s_t *val, psb_c_sspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_smat_get_nrows(psb_c_sspmat *mh); psb_i_t psb_c_smat_get_ncols(psb_c_sspmat *mh); +psb_l_t psb_c_snnz(psb_c_sspmat *mh,psb_c_descriptor *cdh); /* psb_i_t psb_c_sspasb_opt(psb_c_sspmat *mh, psb_c_descriptor *cdh, */ /* const char *afmt, psb_i_t upd, psb_i_t dupl); */ diff --git a/cbind/base/psb_c_zbase.h b/cbind/base/psb_c_zbase.h index 738cd9d8..090e2544 100644 --- a/cbind/base/psb_c_zbase.h +++ b/cbind/base/psb_c_zbase.h @@ -40,6 +40,7 @@ psb_i_t psb_c_zspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl, const psb_z_t *val, psb_c_zspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_zmat_get_nrows(psb_c_zspmat *mh); psb_i_t psb_c_zmat_get_ncols(psb_c_zspmat *mh); +psb_l_t psb_c_znnz(psb_c_zspmat *mh,psb_c_descriptor *cdh); /* psb_i_t psb_c_zspasb_opt(psb_c_zspmat *mh, psb_c_descriptor *cdh, */ /* const char *afmt, psb_i_t upd, psb_i_t dupl); */ diff --git a/cbind/base/psb_d_psblas_cbind_mod.f90 b/cbind/base/psb_d_psblas_cbind_mod.f90 index efe1620f..49ef0278 100644 --- a/cbind/base/psb_d_psblas_cbind_mod.f90 +++ b/cbind/base/psb_d_psblas_cbind_mod.f90 @@ -972,5 +972,31 @@ contains end function psb_c_dspsm + function psb_c_dnnz(ah,cdh) bind(c) result(res) + implicit none + integer(psb_c_ipk_) :: res + + type(psb_c_dspmat) :: ah + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_dspmat_type), pointer :: ap + integer(psb_c_ipk_) :: info + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + res = psb_nnz(ap,descp,info) + + end function psb_c_dnnz + end module psb_d_psblas_cbind_mod diff --git a/cbind/base/psb_s_psblas_cbind_mod.f90 b/cbind/base/psb_s_psblas_cbind_mod.f90 index 3d55041c..76f85010 100644 --- a/cbind/base/psb_s_psblas_cbind_mod.f90 +++ b/cbind/base/psb_s_psblas_cbind_mod.f90 @@ -972,5 +972,31 @@ contains end function psb_c_sspsm + function psb_c_snnz(ah,cdh) bind(c) result(res) + implicit none + integer(psb_c_ipk_) :: res + + type(psb_c_sspmat) :: ah + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_sspmat_type), pointer :: ap + integer(psb_c_ipk_) :: info + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + res = psb_nnz(ap,descp,info) + + end function psb_c_snnz + end module psb_s_psblas_cbind_mod diff --git a/cbind/base/psb_z_psblas_cbind_mod.f90 b/cbind/base/psb_z_psblas_cbind_mod.f90 index 8ff526c9..91ca0f55 100644 --- a/cbind/base/psb_z_psblas_cbind_mod.f90 +++ b/cbind/base/psb_z_psblas_cbind_mod.f90 @@ -871,5 +871,31 @@ contains end function psb_c_zspsm + function psb_c_znnz(ah,cdh) bind(c) result(res) + implicit none + integer(psb_c_ipk_) :: res + + type(psb_c_zspmat) :: ah + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_zspmat_type), pointer :: ap + integer(psb_c_ipk_) :: info + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + res = psb_nnz(ap,descp,info) + + end function psb_c_znnz + end module psb_z_psblas_cbind_mod