mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-16 10:52:08 +00:00
Fixes for PARFLOW interfacing
This commit is contained in:
@@ -129,6 +129,7 @@ module psb_c_base_vect_mod
|
||||
procedure, pass(x) :: set_vect => c_base_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: get_entry=> c_base_get_entry
|
||||
procedure, pass(x) :: set_entry=> c_base_set_entry
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
@@ -903,14 +904,30 @@ contains
|
||||
!
|
||||
function c_base_get_entry(x, index) result(res)
|
||||
implicit none
|
||||
class(psb_c_base_vect_type), intent(in) :: x
|
||||
class(psb_c_base_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
complex(psb_spk_) :: res
|
||||
|
||||
res = 0
|
||||
if (allocated(x%v)) res = x%v(index)
|
||||
res = czero
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
res = x%v(index)
|
||||
end if
|
||||
|
||||
end function c_base_get_entry
|
||||
|
||||
subroutine c_base_set_entry(x, index, val)
|
||||
implicit none
|
||||
class(psb_c_base_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
complex(psb_spk_) :: val
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v(index) = val
|
||||
call x%set_host()
|
||||
end if
|
||||
end subroutine c_base_set_entry
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
|
||||
@@ -93,6 +93,7 @@ module psb_c_vect_mod
|
||||
procedure, pass(x) :: set_sync => c_vect_set_sync
|
||||
|
||||
procedure, pass(x) :: get_entry => c_vect_get_entry
|
||||
procedure, pass(x) :: set_entry => c_vect_set_entry
|
||||
|
||||
procedure, pass(x) :: dot_v => c_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => c_vect_dot_a
|
||||
@@ -680,13 +681,22 @@ contains
|
||||
|
||||
function c_vect_get_entry(x,index) result(res)
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(in) :: x
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
complex(psb_spk_) :: res
|
||||
res = 0
|
||||
res = czero
|
||||
if (allocated(x%v)) res = x%v%get_entry(index)
|
||||
end function c_vect_get_entry
|
||||
|
||||
subroutine c_vect_set_entry(x,index,val)
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
complex(psb_spk_) :: val
|
||||
|
||||
if (allocated(x%v)) call x%v%set_entry(index,val)
|
||||
end subroutine c_vect_set_entry
|
||||
|
||||
function c_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x, y
|
||||
|
||||
@@ -129,6 +129,7 @@ module psb_d_base_vect_mod
|
||||
procedure, pass(x) :: set_vect => d_base_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: get_entry=> d_base_get_entry
|
||||
procedure, pass(x) :: set_entry=> d_base_set_entry
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
@@ -910,14 +911,30 @@ contains
|
||||
!
|
||||
function d_base_get_entry(x, index) result(res)
|
||||
implicit none
|
||||
class(psb_d_base_vect_type), intent(in) :: x
|
||||
class(psb_d_base_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
real(psb_dpk_) :: res
|
||||
|
||||
res = 0
|
||||
if (allocated(x%v)) res = x%v(index)
|
||||
res = dzero
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
res = x%v(index)
|
||||
end if
|
||||
|
||||
end function d_base_get_entry
|
||||
|
||||
subroutine d_base_set_entry(x, index, val)
|
||||
implicit none
|
||||
class(psb_d_base_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
real(psb_dpk_) :: val
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v(index) = val
|
||||
call x%set_host()
|
||||
end if
|
||||
end subroutine d_base_set_entry
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
@@ -1810,8 +1827,8 @@ contains
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
if (x%is_dev()) call x%sync()
|
||||
#if defined(PSB_OPENMP)
|
||||
res = HUGE(done)
|
||||
#if defined(PSB_OPENMP)
|
||||
!$omp parallel do private(i) reduction(min: res)
|
||||
do i=1, n
|
||||
res = min(res,abs(x%v(i)))
|
||||
|
||||
@@ -93,6 +93,7 @@ module psb_d_vect_mod
|
||||
procedure, pass(x) :: set_sync => d_vect_set_sync
|
||||
|
||||
procedure, pass(x) :: get_entry => d_vect_get_entry
|
||||
procedure, pass(x) :: set_entry => d_vect_set_entry
|
||||
|
||||
procedure, pass(x) :: dot_v => d_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => d_vect_dot_a
|
||||
@@ -687,13 +688,22 @@ contains
|
||||
|
||||
function d_vect_get_entry(x,index) result(res)
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(in) :: x
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
real(psb_dpk_) :: res
|
||||
res = 0
|
||||
res = dzero
|
||||
if (allocated(x%v)) res = x%v%get_entry(index)
|
||||
end function d_vect_get_entry
|
||||
|
||||
subroutine d_vect_set_entry(x,index,val)
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
real(psb_dpk_) :: val
|
||||
|
||||
if (allocated(x%v)) call x%v%set_entry(index,val)
|
||||
end subroutine d_vect_set_entry
|
||||
|
||||
function d_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x, y
|
||||
@@ -1255,7 +1265,7 @@ contains
|
||||
if (allocated(x%v)) then
|
||||
res = x%v%minreal(n)
|
||||
else
|
||||
res = dzero
|
||||
res = HUGE(dzero)
|
||||
end if
|
||||
|
||||
end function d_vect_min
|
||||
|
||||
@@ -129,6 +129,7 @@ module psb_s_base_vect_mod
|
||||
procedure, pass(x) :: set_vect => s_base_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: get_entry=> s_base_get_entry
|
||||
procedure, pass(x) :: set_entry=> s_base_set_entry
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
@@ -910,14 +911,30 @@ contains
|
||||
!
|
||||
function s_base_get_entry(x, index) result(res)
|
||||
implicit none
|
||||
class(psb_s_base_vect_type), intent(in) :: x
|
||||
class(psb_s_base_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
real(psb_spk_) :: res
|
||||
|
||||
res = 0
|
||||
if (allocated(x%v)) res = x%v(index)
|
||||
res = szero
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
res = x%v(index)
|
||||
end if
|
||||
|
||||
end function s_base_get_entry
|
||||
|
||||
subroutine s_base_set_entry(x, index, val)
|
||||
implicit none
|
||||
class(psb_s_base_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
real(psb_spk_) :: val
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v(index) = val
|
||||
call x%set_host()
|
||||
end if
|
||||
end subroutine s_base_set_entry
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
@@ -1810,8 +1827,8 @@ contains
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
if (x%is_dev()) call x%sync()
|
||||
#if defined(PSB_OPENMP)
|
||||
res = HUGE(sone)
|
||||
#if defined(PSB_OPENMP)
|
||||
!$omp parallel do private(i) reduction(min: res)
|
||||
do i=1, n
|
||||
res = min(res,abs(x%v(i)))
|
||||
|
||||
@@ -93,6 +93,7 @@ module psb_s_vect_mod
|
||||
procedure, pass(x) :: set_sync => s_vect_set_sync
|
||||
|
||||
procedure, pass(x) :: get_entry => s_vect_get_entry
|
||||
procedure, pass(x) :: set_entry => s_vect_set_entry
|
||||
|
||||
procedure, pass(x) :: dot_v => s_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => s_vect_dot_a
|
||||
@@ -687,13 +688,22 @@ contains
|
||||
|
||||
function s_vect_get_entry(x,index) result(res)
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(in) :: x
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
real(psb_spk_) :: res
|
||||
res = 0
|
||||
res = szero
|
||||
if (allocated(x%v)) res = x%v%get_entry(index)
|
||||
end function s_vect_get_entry
|
||||
|
||||
subroutine s_vect_set_entry(x,index,val)
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
real(psb_spk_) :: val
|
||||
|
||||
if (allocated(x%v)) call x%v%set_entry(index,val)
|
||||
end subroutine s_vect_set_entry
|
||||
|
||||
function s_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x, y
|
||||
@@ -1255,7 +1265,7 @@ contains
|
||||
if (allocated(x%v)) then
|
||||
res = x%v%minreal(n)
|
||||
else
|
||||
res = szero
|
||||
res = HUGE(szero)
|
||||
end if
|
||||
|
||||
end function s_vect_min
|
||||
|
||||
@@ -129,6 +129,7 @@ module psb_z_base_vect_mod
|
||||
procedure, pass(x) :: set_vect => z_base_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: get_entry=> z_base_get_entry
|
||||
procedure, pass(x) :: set_entry=> z_base_set_entry
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
@@ -903,14 +904,30 @@ contains
|
||||
!
|
||||
function z_base_get_entry(x, index) result(res)
|
||||
implicit none
|
||||
class(psb_z_base_vect_type), intent(in) :: x
|
||||
class(psb_z_base_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
complex(psb_dpk_) :: res
|
||||
|
||||
res = 0
|
||||
if (allocated(x%v)) res = x%v(index)
|
||||
res = zzero
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
res = x%v(index)
|
||||
end if
|
||||
|
||||
end function z_base_get_entry
|
||||
|
||||
subroutine z_base_set_entry(x, index, val)
|
||||
implicit none
|
||||
class(psb_z_base_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
complex(psb_dpk_) :: val
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v(index) = val
|
||||
call x%set_host()
|
||||
end if
|
||||
end subroutine z_base_set_entry
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
|
||||
@@ -93,6 +93,7 @@ module psb_z_vect_mod
|
||||
procedure, pass(x) :: set_sync => z_vect_set_sync
|
||||
|
||||
procedure, pass(x) :: get_entry => z_vect_get_entry
|
||||
procedure, pass(x) :: set_entry => z_vect_set_entry
|
||||
|
||||
procedure, pass(x) :: dot_v => z_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => z_vect_dot_a
|
||||
@@ -680,13 +681,22 @@ contains
|
||||
|
||||
function z_vect_get_entry(x,index) result(res)
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(in) :: x
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
complex(psb_dpk_) :: res
|
||||
res = 0
|
||||
res = zzero
|
||||
if (allocated(x%v)) res = x%v%get_entry(index)
|
||||
end function z_vect_get_entry
|
||||
|
||||
subroutine z_vect_set_entry(x,index,val)
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: index
|
||||
complex(psb_dpk_) :: val
|
||||
|
||||
if (allocated(x%v)) call x%v%set_entry(index,val)
|
||||
end subroutine z_vect_set_entry
|
||||
|
||||
function z_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x, y
|
||||
|
||||
@@ -443,6 +443,17 @@ Module psb_c_tools_mod
|
||||
end function
|
||||
end interface
|
||||
|
||||
interface psb_setelem
|
||||
subroutine psb_c_setelem(index,val,x,desc_a,info)
|
||||
import
|
||||
type(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_lpk_), intent(in) :: index
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_) ::val
|
||||
end subroutine psb_c_setelem
|
||||
end interface
|
||||
|
||||
interface psb_remap
|
||||
subroutine psb_c_remap(np_remap, desc_in, a_in, &
|
||||
& ipd, isrc, nrsrc, naggr, desc_out, a_out, info)
|
||||
|
||||
@@ -443,6 +443,17 @@ Module psb_d_tools_mod
|
||||
end function
|
||||
end interface
|
||||
|
||||
interface psb_setelem
|
||||
subroutine psb_d_setelem(index,val,x,desc_a,info)
|
||||
import
|
||||
type(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_lpk_), intent(in) :: index
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_) ::val
|
||||
end subroutine psb_d_setelem
|
||||
end interface
|
||||
|
||||
interface psb_remap
|
||||
subroutine psb_d_remap(np_remap, desc_in, a_in, &
|
||||
& ipd, isrc, nrsrc, naggr, desc_out, a_out, info)
|
||||
|
||||
@@ -443,6 +443,17 @@ Module psb_s_tools_mod
|
||||
end function
|
||||
end interface
|
||||
|
||||
interface psb_setelem
|
||||
subroutine psb_s_setelem(index,val,x,desc_a,info)
|
||||
import
|
||||
type(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_lpk_), intent(in) :: index
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_) ::val
|
||||
end subroutine psb_s_setelem
|
||||
end interface
|
||||
|
||||
interface psb_remap
|
||||
subroutine psb_s_remap(np_remap, desc_in, a_in, &
|
||||
& ipd, isrc, nrsrc, naggr, desc_out, a_out, info)
|
||||
|
||||
@@ -443,6 +443,17 @@ Module psb_z_tools_mod
|
||||
end function
|
||||
end interface
|
||||
|
||||
interface psb_setelem
|
||||
subroutine psb_z_setelem(index,val,x,desc_a,info)
|
||||
import
|
||||
type(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_lpk_), intent(in) :: index
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_) ::val
|
||||
end subroutine psb_z_setelem
|
||||
end interface
|
||||
|
||||
interface psb_remap
|
||||
subroutine psb_z_remap(np_remap, desc_in, a_in, &
|
||||
& ipd, isrc, nrsrc, naggr, desc_out, a_out, info)
|
||||
|
||||
+2
-1
@@ -27,7 +27,8 @@ FOBJS = psb_cdall.o psb_cdals.o psb_cdalv.o psb_cd_inloc.o psb_cdins.o psb_cdprt
|
||||
psb_s_map.o psb_d_map.o psb_c_map.o psb_z_map.o \
|
||||
psb_s_par_csr_spspmm.o psb_d_par_csr_spspmm.o psb_c_par_csr_spspmm.o psb_z_par_csr_spspmm.o \
|
||||
psb_s_glob_transpose.o psb_d_glob_transpose.o psb_c_glob_transpose.o psb_z_glob_transpose.o \
|
||||
psb_cgetelem.o psb_dgetelem.o psb_sgetelem.o psb_zgetelem.o
|
||||
psb_cgetelem.o psb_dgetelem.o psb_sgetelem.o psb_zgetelem.o \
|
||||
psb_csetelem.o psb_dsetelem.o psb_ssetelem.o psb_zsetelem.o
|
||||
|
||||
MPFOBJS = psb_icdasb.o psb_ssphalo.o psb_dsphalo.o psb_csphalo.o psb_zsphalo.o \
|
||||
psb_dcdbldext.o psb_zcdbldext.o psb_scdbldext.o psb_ccdbldext.o \
|
||||
|
||||
@@ -1,6 +1,10 @@
|
||||
module psb_base_cbind_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_cpenv_mod
|
||||
use psb_s_serial_cbind_mod
|
||||
use psb_d_serial_cbind_mod
|
||||
use psb_c_serial_cbind_mod
|
||||
use psb_z_serial_cbind_mod
|
||||
use psb_base_tools_cbind_mod
|
||||
use psb_s_tools_cbind_mod
|
||||
use psb_d_tools_cbind_mod
|
||||
|
||||
@@ -32,6 +32,8 @@ psb_i_t psb_c_cgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_c_t *val,
|
||||
psb_i_t psb_c_cgeasb(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgefree(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_c_t psb_c_cgetelem(psb_c_cvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_csetelem(psb_l_t index, psb_c_t val,
|
||||
psb_c_cvector *xh, psb_c_descriptor *cd);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_cspmat* psb_c_new_cspmat();
|
||||
@@ -58,6 +60,8 @@ psb_i_t psb_c_csprn(psb_c_cspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_cmat_name_print(psb_c_cspmat *mh, char *name);
|
||||
psb_i_t psb_c_cvect_set_scal(psb_c_cvector *xh, psb_c_t val);
|
||||
psb_i_t psb_c_cvect_set_vect(psb_c_cvector *xh, psb_c_t *val, psb_i_t n);
|
||||
psb_c_t psb_c_cvect_get_entry(psb_c_cvector *xh, psb_i_t index);
|
||||
psb_i_t psb_c_cvect_set_entry(psb_c_cvector *xh, psb_i_t index, psb_c_t val);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_c_t psb_c_cgedot(psb_c_cvector *xh, psb_c_cvector *yh, psb_c_descriptor *cdh);
|
||||
|
||||
@@ -22,7 +22,7 @@ psb_d_t *psb_c_dvect_get_cpy( psb_c_dvector *xh);
|
||||
psb_i_t psb_c_dvect_f_get_cpy(psb_d_t *v, psb_c_dvector *xh);
|
||||
psb_i_t psb_c_dvect_zero(psb_c_dvector *xh);
|
||||
psb_d_t *psb_c_dvect_f_get_pnt( psb_c_dvector *xh);
|
||||
|
||||
|
||||
psb_i_t psb_c_dgeall(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeall_remote(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeins(psb_i_t nz, const psb_l_t *irw, const psb_d_t *val,
|
||||
@@ -31,7 +31,9 @@ psb_i_t psb_c_dgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_d_t *val,
|
||||
psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeasb(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgefree(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgetelem(psb_c_dvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
psb_d_t psb_c_dgetelem(psb_c_dvector *xh, psb_l_t index,psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_dsetelem(psb_l_t index, psb_d_t val,
|
||||
psb_c_dvector *xh, psb_c_descriptor *cd);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_dspmat* psb_c_new_dspmat();
|
||||
@@ -58,6 +60,8 @@ psb_i_t psb_c_dsprn(psb_c_dspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_dmat_name_print(psb_c_dspmat *mh, char *name);
|
||||
psb_i_t psb_c_dvect_set_scal(psb_c_dvector *xh, psb_d_t val);
|
||||
psb_i_t psb_c_dvect_set_vect(psb_c_dvector *xh, psb_d_t *val, psb_i_t n);
|
||||
psb_d_t psb_c_dvect_get_entry(psb_c_dvector *xh, psb_i_t index);
|
||||
psb_i_t psb_c_dvect_set_entry(psb_c_dvector *xh, psb_i_t index, psb_d_t val);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_d_t psb_c_dgedot(psb_c_dvector *xh, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
|
||||
@@ -32,6 +32,8 @@ psb_i_t psb_c_sgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_s_t *val,
|
||||
psb_i_t psb_c_sgeasb(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgefree(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgetelem(psb_c_svector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_ssetelem(psb_l_t index, psb_s_t val,
|
||||
psb_c_svector *xh, psb_c_descriptor *cd);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_sspmat* psb_c_new_sspmat();
|
||||
@@ -58,6 +60,8 @@ psb_i_t psb_c_ssprn(psb_c_sspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_smat_name_print(psb_c_sspmat *mh, char *name);
|
||||
psb_i_t psb_c_svect_set_scal(psb_c_svector *xh, psb_s_t val);
|
||||
psb_i_t psb_c_svect_set_vect(psb_c_svector *xh, psb_s_t *val, psb_i_t n);
|
||||
psb_s_t psb_c_svect_get_entry(psb_c_svector *xh, psb_i_t index);
|
||||
psb_i_t psb_c_svect_set_entry(psb_c_svector *xh, psb_i_t index, psb_s_t val);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_s_t psb_c_sgedot(psb_c_svector *xh, psb_c_svector *yh, psb_c_descriptor *cdh);
|
||||
|
||||
@@ -205,4 +205,49 @@ contains
|
||||
end function psb_c_cvect_set_vect
|
||||
|
||||
|
||||
function psb_c_cvect_set_entry(x,index,val) bind(c) result(info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
type(psb_c_cvector) :: x
|
||||
type(psb_c_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
integer(psb_c_ipk_), value :: index
|
||||
complex(c_float_complex), value :: val
|
||||
integer(psb_c_ipk_) :: ixb
|
||||
|
||||
info = -1;
|
||||
|
||||
if (c_associated(x%item)) then
|
||||
call c_f_pointer(x%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
call xp%set_entry((index+(1-ixb)),val)
|
||||
info = 0
|
||||
|
||||
end function psb_c_cvect_set_entry
|
||||
|
||||
function psb_c_cvect_get_entry(x,index) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
type(psb_c_cvector) :: x
|
||||
type(psb_c_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_), value :: index
|
||||
complex(c_float_complex) :: res
|
||||
integer(psb_c_ipk_) :: ixb
|
||||
|
||||
if (c_associated(x%item)) then
|
||||
call c_f_pointer(x%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
res = xp%get_entry((index+(1-ixb)))
|
||||
end function psb_c_cvect_get_entry
|
||||
|
||||
end module psb_c_serial_cbind_mod
|
||||
|
||||
@@ -452,4 +452,40 @@ contains
|
||||
|
||||
end function psb_c_cgetelem
|
||||
|
||||
function psb_c_csetelem(index,val,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
type(psb_c_cvector) :: xh
|
||||
integer(psb_c_lpk_), value :: index
|
||||
type(psb_c_descriptor) :: cdh
|
||||
complex(c_float_complex), value :: val
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
type(psb_c_vect_type), pointer :: xp
|
||||
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(xh%item)) then
|
||||
call c_f_pointer(xh%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_setelem(index,val,xp,descp,info)
|
||||
else
|
||||
call psb_setelem(index+(1-ixb),val,xp,descp,info)
|
||||
end if
|
||||
res=info
|
||||
return
|
||||
|
||||
end function psb_c_csetelem
|
||||
|
||||
end module psb_c_tools_cbind_mod
|
||||
|
||||
@@ -32,6 +32,8 @@ psb_i_t psb_c_zgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_z_t *val,
|
||||
psb_i_t psb_c_zgeasb(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgefree(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_z_t psb_c_zgetelem(psb_c_zvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_zsetelem(psb_l_t index, psb_z_t val,
|
||||
psb_c_zvector *xh, psb_c_descriptor *cd);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_zspmat* psb_c_new_zspmat();
|
||||
@@ -59,6 +61,8 @@ psb_i_t psb_c_zsprn(psb_c_zspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_zmat_name_print(psb_c_zspmat *mh, char *name);
|
||||
psb_i_t psb_c_zvect_set_scal(psb_c_zvector *xh, psb_z_t val);
|
||||
psb_i_t psb_c_zvect_set_vect(psb_c_zvector *xh, psb_z_t *val, psb_i_t n);
|
||||
psb_z_t psb_c_zvect_get_entry(psb_c_zvector *xh, psb_i_t index);
|
||||
psb_i_t psb_c_zvect_set_entry(psb_c_zvector *xh, psb_i_t index, psb_z_t val);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_z_t psb_c_zgedot(psb_c_zvector *xh, psb_c_zvector *yh, psb_c_descriptor *cdh);
|
||||
|
||||
@@ -205,4 +205,49 @@ contains
|
||||
end function psb_c_dvect_set_vect
|
||||
|
||||
|
||||
function psb_c_dvect_set_entry(x,index,val) bind(c) result(info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
type(psb_c_dvector) :: x
|
||||
type(psb_d_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
integer(psb_c_ipk_), value :: index
|
||||
real(c_double), value :: val
|
||||
integer(psb_c_ipk_) :: ixb
|
||||
|
||||
info = -1;
|
||||
|
||||
if (c_associated(x%item)) then
|
||||
call c_f_pointer(x%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
call xp%set_entry((index+(1-ixb)),val)
|
||||
info = 0
|
||||
|
||||
end function psb_c_dvect_set_entry
|
||||
|
||||
function psb_c_dvect_get_entry(x,index) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
type(psb_c_dvector) :: x
|
||||
type(psb_d_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_), value :: index
|
||||
real(c_double) :: res
|
||||
integer(psb_c_ipk_) :: ixb
|
||||
|
||||
if (c_associated(x%item)) then
|
||||
call c_f_pointer(x%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
res = xp%get_entry((index+(1-ixb)))
|
||||
end function psb_c_dvect_get_entry
|
||||
|
||||
end module psb_d_serial_cbind_mod
|
||||
|
||||
@@ -452,4 +452,40 @@ contains
|
||||
|
||||
end function psb_c_dgetelem
|
||||
|
||||
function psb_c_dsetelem(index,val,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
type(psb_c_dvector) :: xh
|
||||
integer(psb_c_lpk_), value :: index
|
||||
type(psb_c_descriptor) :: cdh
|
||||
real(c_double), value :: val
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
type(psb_d_vect_type), pointer :: xp
|
||||
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(xh%item)) then
|
||||
call c_f_pointer(xh%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_setelem(index,val,xp,descp,info)
|
||||
else
|
||||
call psb_setelem(index+(1-ixb),val,xp,descp,info)
|
||||
end if
|
||||
res=info
|
||||
return
|
||||
|
||||
end function psb_c_dsetelem
|
||||
|
||||
end module psb_d_tools_cbind_mod
|
||||
|
||||
@@ -205,4 +205,49 @@ contains
|
||||
end function psb_c_svect_set_vect
|
||||
|
||||
|
||||
function psb_c_svect_set_entry(x,index,val) bind(c) result(info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
type(psb_c_svector) :: x
|
||||
type(psb_s_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
integer(psb_c_ipk_), value :: index
|
||||
real(c_float), value :: val
|
||||
integer(psb_c_ipk_) :: ixb
|
||||
|
||||
info = -1;
|
||||
|
||||
if (c_associated(x%item)) then
|
||||
call c_f_pointer(x%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
call xp%set_entry((index+(1-ixb)),val)
|
||||
info = 0
|
||||
|
||||
end function psb_c_svect_set_entry
|
||||
|
||||
function psb_c_svect_get_entry(x,index) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
type(psb_c_svector) :: x
|
||||
type(psb_s_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_), value :: index
|
||||
real(c_float) :: res
|
||||
integer(psb_c_ipk_) :: ixb
|
||||
|
||||
if (c_associated(x%item)) then
|
||||
call c_f_pointer(x%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
res = xp%get_entry((index+(1-ixb)))
|
||||
end function psb_c_svect_get_entry
|
||||
|
||||
end module psb_s_serial_cbind_mod
|
||||
|
||||
@@ -452,4 +452,40 @@ contains
|
||||
|
||||
end function psb_c_sgetelem
|
||||
|
||||
function psb_c_ssetelem(index,val,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
type(psb_c_svector) :: xh
|
||||
integer(psb_c_lpk_), value :: index
|
||||
type(psb_c_descriptor) :: cdh
|
||||
real(c_float), value :: val
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
type(psb_s_vect_type), pointer :: xp
|
||||
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(xh%item)) then
|
||||
call c_f_pointer(xh%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_setelem(index,val,xp,descp,info)
|
||||
else
|
||||
call psb_setelem(index+(1-ixb),val,xp,descp,info)
|
||||
end if
|
||||
res=info
|
||||
return
|
||||
|
||||
end function psb_c_ssetelem
|
||||
|
||||
end module psb_s_tools_cbind_mod
|
||||
|
||||
@@ -205,4 +205,49 @@ contains
|
||||
end function psb_c_zvect_set_vect
|
||||
|
||||
|
||||
function psb_c_zvect_set_entry(x,index,val) bind(c) result(info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
type(psb_c_zvector) :: x
|
||||
type(psb_z_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
integer(psb_c_ipk_), value :: index
|
||||
complex(c_double_complex), value :: val
|
||||
integer(psb_c_ipk_) :: ixb
|
||||
|
||||
info = -1;
|
||||
|
||||
if (c_associated(x%item)) then
|
||||
call c_f_pointer(x%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
call xp%set_entry((index+(1-ixb)),val)
|
||||
info = 0
|
||||
|
||||
end function psb_c_zvect_set_entry
|
||||
|
||||
function psb_c_zvect_get_entry(x,index) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
type(psb_c_zvector) :: x
|
||||
type(psb_z_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_), value :: index
|
||||
complex(c_double_complex) :: res
|
||||
integer(psb_c_ipk_) :: ixb
|
||||
|
||||
if (c_associated(x%item)) then
|
||||
call c_f_pointer(x%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
res = xp%get_entry((index+(1-ixb)))
|
||||
end function psb_c_zvect_get_entry
|
||||
|
||||
end module psb_z_serial_cbind_mod
|
||||
|
||||
@@ -452,4 +452,40 @@ contains
|
||||
|
||||
end function psb_c_zgetelem
|
||||
|
||||
function psb_c_zsetelem(index,val,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
type(psb_c_zvector) :: xh
|
||||
integer(psb_c_lpk_), value :: index
|
||||
type(psb_c_descriptor) :: cdh
|
||||
complex(c_double_complex), value :: val
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
type(psb_z_vect_type), pointer :: xp
|
||||
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(xh%item)) then
|
||||
call c_f_pointer(xh%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_setelem(index,val,xp,descp,info)
|
||||
else
|
||||
call psb_setelem(index+(1-ixb),val,xp,descp,info)
|
||||
end if
|
||||
res=info
|
||||
return
|
||||
|
||||
end function psb_c_zsetelem
|
||||
|
||||
end module psb_z_tools_cbind_mod
|
||||
|
||||
@@ -15,7 +15,6 @@ contains
|
||||
implicit none
|
||||
type(solveroptions) :: options
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
options%itmax = 1000
|
||||
options%itrace = 0
|
||||
options%istop = 2
|
||||
@@ -24,6 +23,21 @@ contains
|
||||
|
||||
res = 0
|
||||
end function psb_c_DefaultSolverOptions
|
||||
|
||||
function psb_c_PrintSolverOptions(options)&
|
||||
& bind(c,name='psb_c_PrintSolverOptions') result(res)
|
||||
implicit none
|
||||
type(solveroptions) :: options
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
write(*,*) 'PSBLAS C Interface Solver Options '
|
||||
write(*,*) ' Maximum number of iterations :', options%itmax
|
||||
write(*,*) ' Tracing :', options%itrace
|
||||
write(*,*) ' Stopping Criterion :', options%istop
|
||||
write(*,*) ' Restart :', options%irst
|
||||
write(*,*) ' EPS (tolerance) :', options%eps
|
||||
res = 0
|
||||
end function psb_c_PrintSolverOptions
|
||||
|
||||
|
||||
end module psb_base_linsolve_cbind_mod
|
||||
|
||||
@@ -25,6 +25,7 @@ typedef struct psb_c_solveroptions {
|
||||
} psb_c_SolverOptions;
|
||||
|
||||
int psb_c_DefaultSolverOptions(psb_c_SolverOptions *opt);
|
||||
int psb_c_PrintSolverOptions(psb_c_SolverOptions *opt);
|
||||
|
||||
int psb_c_skrylov(const char *method, psb_c_sspmat *ah, psb_c_sprec *ph,
|
||||
psb_c_svector *bh, psb_c_svector *xh,
|
||||
|
||||
Reference in New Issue
Block a user