fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-17 03:12:15 +00:00
Code Issues Packages Projects Releases Wiki Activity

Added interface (and C interface) to is_upd() for sparse matrices

Browse Source
This commit is contained in:
Cirdans-Home
2020-04-06 13:50:48 +02:00
parent a6db1b566c
commit c4cf78e7b8
16 changed files with 364 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psblas/psb_c_psblas_mod.F90
+11
View File
@@ -599,4 +599,15 @@ module psb_c_psblas_mod
end function
end interface
interface psb_is_matupd
function psb_c_is_matupd(a,desc_a,info) result(res)
import :: psb_desc_type, psb_cspmat_type, &
& psb_spk_, psb_ipk_
logical :: 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
base/modules/psblas/psb_d_psblas_mod.F90
+11
View File
@@ -634,4 +634,15 @@ module psb_d_psblas_mod
end function
end interface
interface psb_is_matupd
function psb_d_is_matupd(a,desc_a,info) result(res)
import :: psb_desc_type, psb_dspmat_type, &
& psb_dpk_, psb_ipk_
logical :: 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
base/modules/psblas/psb_s_psblas_mod.F90
+11
View File
@@ -634,4 +634,15 @@ module psb_s_psblas_mod
end function
end interface
interface psb_is_matupd
function psb_s_is_matupd(a,desc_a,info) result(res)
import :: psb_desc_type, psb_sspmat_type, &
& psb_spk_, psb_ipk_
logical :: 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
base/modules/psblas/psb_z_psblas_mod.F90
+11
View File
@@ -599,4 +599,15 @@ module psb_z_psblas_mod
end function
end interface
interface psb_is_matupd
function psb_z_is_matupd(a,desc_a,info) result(res)
import :: psb_desc_type, psb_zspmat_type, &
& psb_dpk_, psb_ipk_
logical :: 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
base/psblas/psb_cgetmatinfo.f90
+55 -1
View File
@@ -52,7 +52,7 @@ function psb_cget_nnz(a,desc_a,info) result(res)
integer(psb_lpk_) :: m,n,ia,ja,localnnz
character(len=20) :: name, ch_err
!
name='psb_cspmv'
name='psb_cget_nnz'
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
@@ -90,3 +90,57 @@ function psb_cget_nnz(a,desc_a,info) result(res)
return
end function
function psb_c_is_matupd(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_c_is_matupd
use psi_mod
implicit none
logical :: 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_cis_matupd'
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
res = a%is_upd()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end function
base/psblas/psb_dgetmatinfo.f90
+55 -1
View File
@@ -52,7 +52,7 @@ function psb_dget_nnz(a,desc_a,info) result(res)
integer(psb_lpk_) :: m,n,ia,ja,localnnz
character(len=20) :: name, ch_err
!
name='psb_dspmv'
name='psb_dget_nnz'
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
@@ -90,3 +90,57 @@ function psb_dget_nnz(a,desc_a,info) result(res)
return
end function
function psb_d_is_matupd(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_d_is_matupd
use psi_mod
implicit none
logical :: 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_dis_matupd'
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
res = a%is_upd()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end function
base/psblas/psb_sgetmatinfo.f90
+55 -1
View File
@@ -52,7 +52,7 @@ function psb_sget_nnz(a,desc_a,info) result(res)
integer(psb_lpk_) :: m,n,ia,ja,localnnz
character(len=20) :: name, ch_err
!
name='psb_sspmv'
name='psb_sget_nnz'
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
@@ -90,3 +90,57 @@ function psb_sget_nnz(a,desc_a,info) result(res)
return
end function
function psb_s_is_matupd(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_s_is_matupd
use psi_mod
implicit none
logical :: 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_sis_matupd'
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
res = a%is_upd()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end function
base/psblas/psb_zgetmatinfo.f90
+55 -1
View File
@@ -52,7 +52,7 @@ function psb_zget_nnz(a,desc_a,info) result(res)
integer(psb_lpk_) :: m,n,ia,ja,localnnz
character(len=20) :: name, ch_err
!
name='psb_zspmv'
name='psb_zget_nnz'
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
@@ -90,3 +90,57 @@ function psb_zget_nnz(a,desc_a,info) result(res)
return
end function
function psb_z_is_matupd(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_z_is_matupd
use psi_mod
implicit none
logical :: 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_zis_matupd'
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
res = a%is_upd()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end function
cbind/base/psb_c_cbase.h
+1
View File
@@ -41,6 +41,7 @@ psb_i_t psb_c_cspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
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);
bool psb_c_cis_matupd(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); */
cbind/base/psb_c_dbase.h
+1
View File
@@ -41,6 +41,7 @@ psb_i_t psb_c_dspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
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);
bool psb_c_dis_matupd(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); */
cbind/base/psb_c_psblas_cbind_mod.f90
+24
View File
@@ -897,5 +897,29 @@ contains
end function psb_c_cnnz
function psb_c_cis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical :: 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_is_matupd(ap,descp,info)
end function
end module psb_c_psblas_cbind_mod
cbind/base/psb_c_sbase.h
+1
View File
@@ -41,6 +41,7 @@ psb_i_t psb_c_sspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
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);
bool psb_c_sis_matupd(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); */
cbind/base/psb_c_zbase.h
+1
View File
@@ -41,6 +41,7 @@ psb_i_t psb_c_zspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
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);
bool psb_c_zis_matupd(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); */
cbind/base/psb_d_psblas_cbind_mod.f90
+24
View File
@@ -998,5 +998,29 @@ contains
end function psb_c_dnnz
function psb_c_dis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical :: 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_is_matupd(ap,descp,info)
end function
end module psb_d_psblas_cbind_mod
cbind/base/psb_s_psblas_cbind_mod.f90
+24
View File
@@ -998,5 +998,29 @@ contains
end function psb_c_snnz
function psb_c_sis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical :: 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_is_matupd(ap,descp,info)
end function
end module psb_s_psblas_cbind_mod
cbind/base/psb_z_psblas_cbind_mod.f90
+24
View File
@@ -897,5 +897,29 @@ contains
end function psb_c_znnz
function psb_c_zis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical :: 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_is_matupd(ap,descp,info)
end function
end module psb_z_psblas_cbind_mod