mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-06 22:55:08 +00:00
Added routine to extract single element from sparse matrix
This commit is contained in:
@@ -444,6 +444,14 @@ Module psb_c_tools_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_) :: res
|
||||
end function
|
||||
function psb_c_getmatelem(a,rowindex,colindex,desc_a,info) result(res)
|
||||
import
|
||||
type(psb_cspmat_type), intent(inout) :: a
|
||||
integer(psb_lpk_), intent(in) :: rowindex, colindex
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_) :: res
|
||||
end function
|
||||
end interface
|
||||
|
||||
interface psb_remap
|
||||
|
||||
@@ -444,6 +444,14 @@ Module psb_d_tools_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_) :: res
|
||||
end function
|
||||
function psb_d_getmatelem(a,rowindex,colindex,desc_a,info) result(res)
|
||||
import
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer(psb_lpk_), intent(in) :: rowindex, colindex
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_) :: res
|
||||
end function
|
||||
end interface
|
||||
|
||||
interface psb_remap
|
||||
|
||||
@@ -444,6 +444,14 @@ Module psb_s_tools_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_) :: res
|
||||
end function
|
||||
function psb_s_getmatelem(a,rowindex,colindex,desc_a,info) result(res)
|
||||
import
|
||||
type(psb_sspmat_type), intent(inout) :: a
|
||||
integer(psb_lpk_), intent(in) :: rowindex, colindex
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_) :: res
|
||||
end function
|
||||
end interface
|
||||
|
||||
interface psb_remap
|
||||
|
||||
@@ -444,6 +444,14 @@ Module psb_z_tools_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_) :: res
|
||||
end function
|
||||
function psb_z_getmatelem(a,rowindex,colindex,desc_a,info) result(res)
|
||||
import
|
||||
type(psb_zspmat_type), intent(inout) :: a
|
||||
integer(psb_lpk_), intent(in) :: rowindex, colindex
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_) :: res
|
||||
end function
|
||||
end interface
|
||||
|
||||
interface psb_remap
|
||||
|
||||
@@ -108,3 +108,92 @@ function psb_c_getelem(x,index,desc_a,info) result(res)
|
||||
|
||||
end function
|
||||
|
||||
! Function: psb_c_getmatelem
|
||||
! Extract entries from a sparse matrix. Note: the row and column indices in index
|
||||
! are assumed to be in global numbering and are converted on the fly.
|
||||
!
|
||||
! Arguments:
|
||||
! a - type(psb_cspmat_type) The source matrix
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! rowindex - integer. Row index of x of the value to extract
|
||||
! colindex - integer. Column index of x of the value to extract
|
||||
! iam - integer. Index of the process requesting the value
|
||||
! info - integer. return code
|
||||
|
||||
|
||||
function psb_c_getmatelem(a,rowindex,colindex,desc_a,info) result(res)
|
||||
use psb_base_mod, psb_protect_name => psb_c_getmatelem
|
||||
use psi_mod
|
||||
implicit none
|
||||
|
||||
type(psb_cspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(in) :: rowindex, colindex
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_) :: res
|
||||
|
||||
!locals
|
||||
integer(psb_ipk_) :: localrowindex(1), localcolindex(1), jmin, jmax, imin, imax
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np, me, err_act
|
||||
integer(psb_lpk_) :: growindex(1), gcolindex(1)
|
||||
integer(psb_lpk_), allocatable :: myidx(:),mylocal(:)
|
||||
integer(psb_ipk_), allocatable, dimension(:) :: ia, ja
|
||||
integer(psb_ipk_) :: nz
|
||||
complex(psb_spk_), allocatable, dimension(:) :: val
|
||||
character(len=20) :: name
|
||||
logical, parameter :: debug = .false.
|
||||
|
||||
growindex(1) = rowindex
|
||||
gcolindex(1) = colindex
|
||||
res = czero
|
||||
if (psb_errstatus_fatal()) return
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
name = 'psb_c_getmatelem'
|
||||
|
||||
if (.not.desc_a%is_ok()) then
|
||||
info = psb_err_invalid_cd_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
ctxt = desc_a%get_context()
|
||||
|
||||
call psb_info(ctxt, me, np)
|
||||
if (np == -1) then
|
||||
info = psb_err_context_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call desc_a%indxmap%g2l(growindex,localrowindex,info,owned=.false.)
|
||||
call desc_a%indxmap%g2l(gcolindex,localcolindex,info,owned=.false.)
|
||||
imin = localrowindex(1)
|
||||
imax = localrowindex(1)
|
||||
jmin = localcolindex(1)
|
||||
jmax = localcolindex(1)
|
||||
if(debug.and.(localrowindex(1) < 1 .or. localcolindex(1) < 1)) then
|
||||
write(*,*)"Process ",me," owns ",desc_a%get_local_rows()," rows"," Global row index is ", &
|
||||
growindex,"Local row index is ",localrowindex
|
||||
write(*,*)"Process ",me," owns ",desc_a%get_local_cols()," cols"," Global col index is ", &
|
||||
gcolindex,"Local col index is ",localcolindex
|
||||
myidx = desc_a%get_global_indices(owned=.false.)
|
||||
mylocal = desc_a%get_global_indices(owned=.true.)
|
||||
write(*,*)"My (local+halo) indexes are: ",myidx
|
||||
write(*,*)"My (local) indexes are: ",mylocal
|
||||
end if
|
||||
if ( localrowindex(1) < 1 .or. localcolindex(1) < 1) then
|
||||
res = czero
|
||||
else
|
||||
call a%csget(imin, imax, nz, ia, ja, val, info, jmin=jmin, jmax=jmax)
|
||||
res = val(1)
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(ctxt,err_act)
|
||||
|
||||
return
|
||||
|
||||
end function
|
||||
|
||||
@@ -108,3 +108,92 @@ function psb_d_getelem(x,index,desc_a,info) result(res)
|
||||
|
||||
end function
|
||||
|
||||
! Function: psb_d_getmatelem
|
||||
! Extract entries from a sparse matrix. Note: the row and column indices in index
|
||||
! are assumed to be in global numbering and are converted on the fly.
|
||||
!
|
||||
! Arguments:
|
||||
! a - type(psb_dspmat_type) The source matrix
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! rowindex - integer. Row index of x of the value to extract
|
||||
! colindex - integer. Column index of x of the value to extract
|
||||
! iam - integer. Index of the process requesting the value
|
||||
! info - integer. return code
|
||||
|
||||
|
||||
function psb_d_getmatelem(a,rowindex,colindex,desc_a,info) result(res)
|
||||
use psb_base_mod, psb_protect_name => psb_d_getmatelem
|
||||
use psi_mod
|
||||
implicit none
|
||||
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(in) :: rowindex, colindex
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_) :: res
|
||||
|
||||
!locals
|
||||
integer(psb_ipk_) :: localrowindex(1), localcolindex(1), jmin, jmax, imin, imax
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np, me, err_act
|
||||
integer(psb_lpk_) :: growindex(1), gcolindex(1)
|
||||
integer(psb_lpk_), allocatable :: myidx(:),mylocal(:)
|
||||
integer(psb_ipk_), allocatable, dimension(:) :: ia, ja
|
||||
integer(psb_ipk_) :: nz
|
||||
real(psb_dpk_), allocatable, dimension(:) :: val
|
||||
character(len=20) :: name
|
||||
logical, parameter :: debug = .false.
|
||||
|
||||
growindex(1) = rowindex
|
||||
gcolindex(1) = colindex
|
||||
res = dzero
|
||||
if (psb_errstatus_fatal()) return
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
name = 'psb_d_getmatelem'
|
||||
|
||||
if (.not.desc_a%is_ok()) then
|
||||
info = psb_err_invalid_cd_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
ctxt = desc_a%get_context()
|
||||
|
||||
call psb_info(ctxt, me, np)
|
||||
if (np == -1) then
|
||||
info = psb_err_context_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call desc_a%indxmap%g2l(growindex,localrowindex,info,owned=.false.)
|
||||
call desc_a%indxmap%g2l(gcolindex,localcolindex,info,owned=.false.)
|
||||
imin = localrowindex(1)
|
||||
imax = localrowindex(1)
|
||||
jmin = localcolindex(1)
|
||||
jmax = localcolindex(1)
|
||||
if(debug.and.(localrowindex(1) < 1 .or. localcolindex(1) < 1)) then
|
||||
write(*,*)"Process ",me," owns ",desc_a%get_local_rows()," rows"," Global row index is ", &
|
||||
growindex,"Local row index is ",localrowindex
|
||||
write(*,*)"Process ",me," owns ",desc_a%get_local_cols()," cols"," Global col index is ", &
|
||||
gcolindex,"Local col index is ",localcolindex
|
||||
myidx = desc_a%get_global_indices(owned=.false.)
|
||||
mylocal = desc_a%get_global_indices(owned=.true.)
|
||||
write(*,*)"My (local+halo) indexes are: ",myidx
|
||||
write(*,*)"My (local) indexes are: ",mylocal
|
||||
end if
|
||||
if ( localrowindex(1) < 1 .or. localcolindex(1) < 1) then
|
||||
res = dzero
|
||||
else
|
||||
call a%csget(imin, imax, nz, ia, ja, val, info, jmin=jmin, jmax=jmax)
|
||||
res = val(1)
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(ctxt,err_act)
|
||||
|
||||
return
|
||||
|
||||
end function
|
||||
|
||||
@@ -108,3 +108,92 @@ function psb_s_getelem(x,index,desc_a,info) result(res)
|
||||
|
||||
end function
|
||||
|
||||
! Function: psb_s_getmatelem
|
||||
! Extract entries from a sparse matrix. Note: the row and column indices in index
|
||||
! are assumed to be in global numbering and are converted on the fly.
|
||||
!
|
||||
! Arguments:
|
||||
! a - type(psb_sspmat_type) The source matrix
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! rowindex - integer. Row index of x of the value to extract
|
||||
! colindex - integer. Column index of x of the value to extract
|
||||
! iam - integer. Index of the process requesting the value
|
||||
! info - integer. return code
|
||||
|
||||
|
||||
function psb_s_getmatelem(a,rowindex,colindex,desc_a,info) result(res)
|
||||
use psb_base_mod, psb_protect_name => psb_s_getmatelem
|
||||
use psi_mod
|
||||
implicit none
|
||||
|
||||
type(psb_sspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(in) :: rowindex, colindex
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_) :: res
|
||||
|
||||
!locals
|
||||
integer(psb_ipk_) :: localrowindex(1), localcolindex(1), jmin, jmax, imin, imax
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np, me, err_act
|
||||
integer(psb_lpk_) :: growindex(1), gcolindex(1)
|
||||
integer(psb_lpk_), allocatable :: myidx(:),mylocal(:)
|
||||
integer(psb_ipk_), allocatable, dimension(:) :: ia, ja
|
||||
integer(psb_ipk_) :: nz
|
||||
real(psb_spk_), allocatable, dimension(:) :: val
|
||||
character(len=20) :: name
|
||||
logical, parameter :: debug = .false.
|
||||
|
||||
growindex(1) = rowindex
|
||||
gcolindex(1) = colindex
|
||||
res = szero
|
||||
if (psb_errstatus_fatal()) return
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
name = 'psb_s_getmatelem'
|
||||
|
||||
if (.not.desc_a%is_ok()) then
|
||||
info = psb_err_invalid_cd_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
ctxt = desc_a%get_context()
|
||||
|
||||
call psb_info(ctxt, me, np)
|
||||
if (np == -1) then
|
||||
info = psb_err_context_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call desc_a%indxmap%g2l(growindex,localrowindex,info,owned=.false.)
|
||||
call desc_a%indxmap%g2l(gcolindex,localcolindex,info,owned=.false.)
|
||||
imin = localrowindex(1)
|
||||
imax = localrowindex(1)
|
||||
jmin = localcolindex(1)
|
||||
jmax = localcolindex(1)
|
||||
if(debug.and.(localrowindex(1) < 1 .or. localcolindex(1) < 1)) then
|
||||
write(*,*)"Process ",me," owns ",desc_a%get_local_rows()," rows"," Global row index is ", &
|
||||
growindex,"Local row index is ",localrowindex
|
||||
write(*,*)"Process ",me," owns ",desc_a%get_local_cols()," cols"," Global col index is ", &
|
||||
gcolindex,"Local col index is ",localcolindex
|
||||
myidx = desc_a%get_global_indices(owned=.false.)
|
||||
mylocal = desc_a%get_global_indices(owned=.true.)
|
||||
write(*,*)"My (local+halo) indexes are: ",myidx
|
||||
write(*,*)"My (local) indexes are: ",mylocal
|
||||
end if
|
||||
if ( localrowindex(1) < 1 .or. localcolindex(1) < 1) then
|
||||
res = szero
|
||||
else
|
||||
call a%csget(imin, imax, nz, ia, ja, val, info, jmin=jmin, jmax=jmax)
|
||||
res = val(1)
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(ctxt,err_act)
|
||||
|
||||
return
|
||||
|
||||
end function
|
||||
|
||||
@@ -108,3 +108,92 @@ function psb_z_getelem(x,index,desc_a,info) result(res)
|
||||
|
||||
end function
|
||||
|
||||
! Function: psb_z_getmatelem
|
||||
! Extract entries from a sparse matrix. Note: the row and column indices in index
|
||||
! are assumed to be in global numbering and are converted on the fly.
|
||||
!
|
||||
! Arguments:
|
||||
! a - type(psb_zspmat_type) The source matrix
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! rowindex - integer. Row index of x of the value to extract
|
||||
! colindex - integer. Column index of x of the value to extract
|
||||
! iam - integer. Index of the process requesting the value
|
||||
! info - integer. return code
|
||||
|
||||
|
||||
function psb_z_getmatelem(a,rowindex,colindex,desc_a,info) result(res)
|
||||
use psb_base_mod, psb_protect_name => psb_z_getmatelem
|
||||
use psi_mod
|
||||
implicit none
|
||||
|
||||
type(psb_zspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(in) :: rowindex, colindex
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_) :: res
|
||||
|
||||
!locals
|
||||
integer(psb_ipk_) :: localrowindex(1), localcolindex(1), jmin, jmax, imin, imax
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np, me, err_act
|
||||
integer(psb_lpk_) :: growindex(1), gcolindex(1)
|
||||
integer(psb_lpk_), allocatable :: myidx(:),mylocal(:)
|
||||
integer(psb_ipk_), allocatable, dimension(:) :: ia, ja
|
||||
integer(psb_ipk_) :: nz
|
||||
complex(psb_dpk_), allocatable, dimension(:) :: val
|
||||
character(len=20) :: name
|
||||
logical, parameter :: debug = .false.
|
||||
|
||||
growindex(1) = rowindex
|
||||
gcolindex(1) = colindex
|
||||
res = zzero
|
||||
if (psb_errstatus_fatal()) return
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
name = 'psb_z_getmatelem'
|
||||
|
||||
if (.not.desc_a%is_ok()) then
|
||||
info = psb_err_invalid_cd_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
ctxt = desc_a%get_context()
|
||||
|
||||
call psb_info(ctxt, me, np)
|
||||
if (np == -1) then
|
||||
info = psb_err_context_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call desc_a%indxmap%g2l(growindex,localrowindex,info,owned=.false.)
|
||||
call desc_a%indxmap%g2l(gcolindex,localcolindex,info,owned=.false.)
|
||||
imin = localrowindex(1)
|
||||
imax = localrowindex(1)
|
||||
jmin = localcolindex(1)
|
||||
jmax = localcolindex(1)
|
||||
if(debug.and.(localrowindex(1) < 1 .or. localcolindex(1) < 1)) then
|
||||
write(*,*)"Process ",me," owns ",desc_a%get_local_rows()," rows"," Global row index is ", &
|
||||
growindex,"Local row index is ",localrowindex
|
||||
write(*,*)"Process ",me," owns ",desc_a%get_local_cols()," cols"," Global col index is ", &
|
||||
gcolindex,"Local col index is ",localcolindex
|
||||
myidx = desc_a%get_global_indices(owned=.false.)
|
||||
mylocal = desc_a%get_global_indices(owned=.true.)
|
||||
write(*,*)"My (local+halo) indexes are: ",myidx
|
||||
write(*,*)"My (local) indexes are: ",mylocal
|
||||
end if
|
||||
if ( localrowindex(1) < 1 .or. localcolindex(1) < 1) then
|
||||
res = zzero
|
||||
else
|
||||
call a%csget(imin, imax, nz, ia, ja, val, info, jmin=jmin, jmax=jmax)
|
||||
res = val(1)
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(ctxt,err_act)
|
||||
|
||||
return
|
||||
|
||||
end function
|
||||
|
||||
@@ -39,6 +39,7 @@ psb_i_t psb_c_cgeasb_options_format(psb_c_cvector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t psb_c_cgefree(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgereinit(psb_c_cvector *xh, psb_c_descriptor *cdh, bool clear);
|
||||
psb_c_t psb_c_cgetelem(psb_c_cvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
psb_c_t psb_c_cmatgetelem(psb_c_cspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_cspmat* psb_c_new_cspmat();
|
||||
|
||||
@@ -39,6 +39,8 @@ psb_i_t psb_c_dgeasb_options_format(psb_c_dvector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t psb_c_dgefree(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgereinit(psb_c_dvector *xh, psb_c_descriptor *cdh, bool clear);
|
||||
psb_d_t psb_c_dgetelem(psb_c_dvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
psb_d_t psb_c_dmatgetelem(psb_c_dspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh);
|
||||
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_dspmat* psb_c_new_dspmat();
|
||||
|
||||
@@ -39,6 +39,8 @@ psb_i_t psb_c_sgeasb_options_format(psb_c_svector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t psb_c_sgefree(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgereinit(psb_c_svector *xh, psb_c_descriptor *cdh, bool clear);
|
||||
psb_s_t psb_c_sgetelem(psb_c_svector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
psb_s_t psb_c_smatgetelem(psb_c_sspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh);
|
||||
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_sspmat* psb_c_new_sspmat();
|
||||
|
||||
@@ -253,40 +253,6 @@ contains
|
||||
end function psb_c_cgefree
|
||||
|
||||
|
||||
function psb_c_cgereinit(xh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_cvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
logical(c_bool), value :: clear
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_c_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
logical :: fclear
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
fclear = clear
|
||||
call xp%reinit(info, clear=fclear)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_cgereinit
|
||||
|
||||
|
||||
function psb_c_cgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
@@ -688,4 +654,39 @@ contains
|
||||
|
||||
end function psb_c_cgetelem
|
||||
|
||||
function psb_c_cmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
type(psb_c_cspmat) :: ah
|
||||
integer(psb_c_lpk_), value :: rowindex, colindex
|
||||
type(psb_c_descriptor) :: cdh
|
||||
complex(c_float_complex) :: res
|
||||
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer(psb_c_ipk_) :: info, ixb
|
||||
|
||||
res = -1
|
||||
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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
res = psb_getelem(ap,rowindex,colindex,descp,info)
|
||||
else
|
||||
res = psb_getelem(ap,rowindex+(1-ixb),colindex+(1-ixb),descp,info)
|
||||
end if
|
||||
|
||||
return
|
||||
|
||||
end function psb_c_cmatgetelem
|
||||
|
||||
end module psb_c_tools_cbind_mod
|
||||
|
||||
@@ -39,6 +39,8 @@ psb_i_t psb_c_zgeasb_options_format(psb_c_zvector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t psb_c_zgefree(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgereinit(psb_c_zvector *xh, psb_c_descriptor *cdh, bool clear);
|
||||
psb_z_t psb_c_zgetelem(psb_c_zvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
psb_z_t psb_c_zmatgetelem(psb_c_zspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh);
|
||||
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_zspmat* psb_c_new_zspmat();
|
||||
|
||||
@@ -253,40 +253,6 @@ contains
|
||||
end function psb_c_dgefree
|
||||
|
||||
|
||||
function psb_c_dgereinit(xh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_dvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
logical(c_bool), value :: clear
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
logical :: fclear
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
fclear = clear
|
||||
call xp%reinit(info, clear=fclear)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_dgereinit
|
||||
|
||||
|
||||
function psb_c_dgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
@@ -698,4 +664,39 @@ contains
|
||||
|
||||
end function psb_c_dgetelem
|
||||
|
||||
function psb_c_dmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
type(psb_c_dspmat) :: ah
|
||||
integer(psb_c_lpk_), value :: rowindex, colindex
|
||||
type(psb_c_descriptor) :: cdh
|
||||
real(c_double) :: res
|
||||
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer(psb_c_ipk_) :: info, ixb
|
||||
|
||||
res = -1
|
||||
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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
res = psb_getelem(ap,rowindex,colindex,descp,info)
|
||||
else
|
||||
res = psb_getelem(ap,rowindex+(1-ixb),colindex+(1-ixb),descp,info)
|
||||
end if
|
||||
|
||||
return
|
||||
|
||||
end function psb_c_dmatgetelem
|
||||
|
||||
end module psb_d_tools_cbind_mod
|
||||
|
||||
@@ -253,40 +253,6 @@ contains
|
||||
end function psb_c_sgefree
|
||||
|
||||
|
||||
function psb_c_sgereinit(xh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_svector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
logical(c_bool), value :: clear
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_s_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
logical :: fclear
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
fclear = clear
|
||||
call xp%reinit(info, clear=fclear)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_sgereinit
|
||||
|
||||
|
||||
function psb_c_sgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
@@ -698,4 +664,39 @@ contains
|
||||
|
||||
end function psb_c_sgetelem
|
||||
|
||||
function psb_c_smatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
type(psb_c_sspmat) :: ah
|
||||
integer(psb_c_lpk_), value :: rowindex, colindex
|
||||
type(psb_c_descriptor) :: cdh
|
||||
real(c_float) :: res
|
||||
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer(psb_c_ipk_) :: info, ixb
|
||||
|
||||
res = -1
|
||||
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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
res = psb_getelem(ap,rowindex,colindex,descp,info)
|
||||
else
|
||||
res = psb_getelem(ap,rowindex+(1-ixb),colindex+(1-ixb),descp,info)
|
||||
end if
|
||||
|
||||
return
|
||||
|
||||
end function psb_c_smatgetelem
|
||||
|
||||
end module psb_s_tools_cbind_mod
|
||||
|
||||
@@ -253,40 +253,6 @@ contains
|
||||
end function psb_c_zgefree
|
||||
|
||||
|
||||
function psb_c_zgereinit(xh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_zvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
logical(c_bool), value :: clear
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_z_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
logical :: fclear
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
fclear = clear
|
||||
call xp%reinit(info, clear=fclear)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_zgereinit
|
||||
|
||||
|
||||
function psb_c_zgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
@@ -688,4 +654,39 @@ contains
|
||||
|
||||
end function psb_c_zgetelem
|
||||
|
||||
function psb_c_zmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
type(psb_c_zspmat) :: ah
|
||||
integer(psb_c_lpk_), value :: rowindex, colindex
|
||||
type(psb_c_descriptor) :: cdh
|
||||
complex(c_double_complex) :: res
|
||||
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer(psb_c_ipk_) :: info, ixb
|
||||
|
||||
res = -1
|
||||
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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
res = psb_getelem(ap,rowindex,colindex,descp,info)
|
||||
else
|
||||
res = psb_getelem(ap,rowindex+(1-ixb),colindex+(1-ixb),descp,info)
|
||||
end if
|
||||
|
||||
return
|
||||
|
||||
end function psb_c_zmatgetelem
|
||||
|
||||
end module psb_z_tools_cbind_mod
|
||||
|
||||
Reference in New Issue
Block a user