From 177bc6ecb3facf443be5c9fdfae3298e3094af16 Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Thu, 26 Mar 2020 18:58:47 +0100 Subject: [PATCH] Added function psb_c_dvect_f_get_pnt to get pointer to vector data structure --- cbind/base/psb_c_cbase.h | 1 + cbind/base/psb_c_dbase.h | 1 + cbind/base/psb_c_sbase.h | 1 + cbind/base/psb_c_serial_cbind_mod.F90 | 79 ++++++++++++++++----------- cbind/base/psb_c_zbase.h | 1 + cbind/base/psb_d_serial_cbind_mod.F90 | 79 ++++++++++++++++----------- cbind/base/psb_s_serial_cbind_mod.F90 | 79 ++++++++++++++++----------- cbind/base/psb_z_serial_cbind_mod.F90 | 79 ++++++++++++++++----------- 8 files changed, 196 insertions(+), 124 deletions(-) diff --git a/cbind/base/psb_c_cbase.h b/cbind/base/psb_c_cbase.h index f0258419..b977a3fb 100644 --- a/cbind/base/psb_c_cbase.h +++ b/cbind/base/psb_c_cbase.h @@ -21,6 +21,7 @@ psb_i_t psb_c_cvect_get_nrows(psb_c_cvector *xh); psb_c_t *psb_c_cvect_get_cpy( psb_c_cvector *xh); psb_i_t psb_c_cvect_f_get_cpy(psb_c_t *v, psb_c_cvector *xh); psb_i_t psb_c_cvect_zero(psb_c_cvector *xh); +psb_i_t *psb_c_cvect_f_get_pnt(psb_c_cvector *xh); psb_i_t psb_c_cgeall(psb_c_cvector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_cgeins(psb_i_t nz, const psb_l_t *irw, const psb_c_t *val, diff --git a/cbind/base/psb_c_dbase.h b/cbind/base/psb_c_dbase.h index a3104107..4a1ee601 100644 --- a/cbind/base/psb_c_dbase.h +++ b/cbind/base/psb_c_dbase.h @@ -21,6 +21,7 @@ psb_i_t psb_c_dvect_get_nrows(psb_c_dvector *xh); 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_dgeins(psb_i_t nz, const psb_l_t *irw, const psb_d_t *val, diff --git a/cbind/base/psb_c_sbase.h b/cbind/base/psb_c_sbase.h index 55f6b0e8..bee92c65 100644 --- a/cbind/base/psb_c_sbase.h +++ b/cbind/base/psb_c_sbase.h @@ -21,6 +21,7 @@ psb_i_t psb_c_svect_get_nrows(psb_c_svector *xh); psb_s_t *psb_c_svect_get_cpy( psb_c_svector *xh); psb_i_t psb_c_svect_f_get_cpy(psb_s_t *v, psb_c_svector *xh); psb_i_t psb_c_svect_zero(psb_c_svector *xh); +psb_s_t *psb_c_svect_f_get_pnt( psb_c_svector *xh); psb_i_t psb_c_sgeall(psb_c_svector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_sgeins(psb_i_t nz, const psb_l_t *irw, const psb_s_t *val, diff --git a/cbind/base/psb_c_serial_cbind_mod.F90 b/cbind/base/psb_c_serial_cbind_mod.F90 index 5c05abd0..d46e776c 100644 --- a/cbind/base/psb_c_serial_cbind_mod.F90 +++ b/cbind/base/psb_c_serial_cbind_mod.F90 @@ -7,11 +7,11 @@ module psb_c_serial_cbind_mod contains - + function psb_c_cvect_get_nrows(xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res type(psb_c_cvector) :: xh type(psb_c_vect_type), pointer :: vp @@ -19,27 +19,27 @@ contains res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) res = vp%get_nrows() end if end function psb_c_cvect_get_nrows - + function psb_c_cvect_f_get_cpy(v,xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res complex(c_float_complex) :: v(*) type(psb_c_cvector) :: xh - + type(psb_c_vect_type), pointer :: vp complex(psb_spk_), allocatable :: fv(:) integer(psb_c_ipk_) :: info, sz res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) fv = vp%get_vect() sz = size(fv) @@ -48,31 +48,49 @@ contains end function psb_c_cvect_f_get_cpy - + function psb_c_cvect_zero(xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res type(psb_c_cvector) :: xh - + type(psb_c_vect_type), pointer :: vp integer(psb_c_ipk_) :: info res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) call vp%zero() end if end function psb_c_cvect_zero - + function psb_c_cvect_f_get_pnt(xh) bind(c) result(res) + implicit none + + type(c_ptr) :: res + type(psb_c_cvector) :: xh + + type(psb_c_vect_type), pointer :: vp + + res = c_null_ptr + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + if(vp%is_dev()) call vp%sync() + res = c_loc(vp%v%v) + end if + + end function psb_c_cvect_f_get_pnt + + function psb_c_cmat_get_nrows(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res type(psb_c_cspmat) :: mh @@ -80,22 +98,22 @@ contains integer(psb_c_ipk_) :: info res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if - + res = ap%get_nrows() end function psb_c_cmat_get_nrows - + function psb_c_cmat_get_ncols(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res type(psb_c_cspmat) :: mh @@ -103,22 +121,22 @@ contains integer(psb_c_ipk_) :: info res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if - + res = ap%get_ncols() end function psb_c_cmat_get_ncols - + function psb_c_cmat_name_print(mh,name) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res character(c_char) :: name(*) @@ -128,17 +146,16 @@ contains character(1024) :: fname res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if call stringc2f(name,fname) - + call ap%print(fname,head='PSBLAS Cbinding Interface') end function psb_c_cmat_name_print - -end module psb_c_serial_cbind_mod +end module psb_c_serial_cbind_mod diff --git a/cbind/base/psb_c_zbase.h b/cbind/base/psb_c_zbase.h index fadd23a9..29cb2d3f 100644 --- a/cbind/base/psb_c_zbase.h +++ b/cbind/base/psb_c_zbase.h @@ -21,6 +21,7 @@ psb_i_t psb_c_zvect_get_nrows(psb_c_zvector *xh); psb_z_t *psb_c_zvect_get_cpy( psb_c_zvector *xh); psb_i_t psb_c_zvect_f_get_cpy(psb_z_t *v, psb_c_zvector *xh); psb_i_t psb_c_zvect_zero(psb_c_zvector *xh); +psb_z_t *psb_c_zvect_f_get_pnt( psb_c_zvector *xh); psb_i_t psb_c_zgeall(psb_c_zvector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_zgeins(psb_i_t nz, const psb_l_t *irw, const psb_z_t *val, diff --git a/cbind/base/psb_d_serial_cbind_mod.F90 b/cbind/base/psb_d_serial_cbind_mod.F90 index d8c1e729..f8f742fc 100644 --- a/cbind/base/psb_d_serial_cbind_mod.F90 +++ b/cbind/base/psb_d_serial_cbind_mod.F90 @@ -7,11 +7,11 @@ module psb_d_serial_cbind_mod contains - + function psb_c_dvect_get_nrows(xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res type(psb_c_dvector) :: xh type(psb_d_vect_type), pointer :: vp @@ -19,27 +19,27 @@ contains res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) res = vp%get_nrows() end if end function psb_c_dvect_get_nrows - + function psb_c_dvect_f_get_cpy(v,xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res real(c_double) :: v(*) type(psb_c_dvector) :: xh - + type(psb_d_vect_type), pointer :: vp real(psb_dpk_), allocatable :: fv(:) integer(psb_c_ipk_) :: info, sz res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) fv = vp%get_vect() sz = size(fv) @@ -48,31 +48,49 @@ contains end function psb_c_dvect_f_get_cpy - + function psb_c_dvect_zero(xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res type(psb_c_dvector) :: xh - + type(psb_d_vect_type), pointer :: vp integer(psb_c_ipk_) :: info res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) call vp%zero() end if end function psb_c_dvect_zero - + function psb_c_dvect_f_get_pnt(xh) bind(c) result(res) + implicit none + + type(c_ptr) :: res + type(psb_c_dvector) :: xh + + type(psb_d_vect_type), pointer :: vp + + res = c_null_ptr + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + if(vp%is_dev()) call vp%sync() + res = c_loc(vp%v%v) + end if + + end function psb_c_dvect_f_get_pnt + + function psb_c_dmat_get_nrows(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res type(psb_c_dspmat) :: mh @@ -80,22 +98,22 @@ contains integer(psb_c_ipk_) :: info res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if - + res = ap%get_nrows() end function psb_c_dmat_get_nrows - + function psb_c_dmat_get_ncols(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res type(psb_c_dspmat) :: mh @@ -103,22 +121,22 @@ contains integer(psb_c_ipk_) :: info res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if - + res = ap%get_ncols() end function psb_c_dmat_get_ncols - + function psb_c_dmat_name_print(mh,name) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res character(c_char) :: name(*) @@ -128,17 +146,16 @@ contains character(1024) :: fname res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if call stringc2f(name,fname) - + call ap%print(fname,head='PSBLAS Cbinding Interface') end function psb_c_dmat_name_print - -end module psb_d_serial_cbind_mod +end module psb_d_serial_cbind_mod diff --git a/cbind/base/psb_s_serial_cbind_mod.F90 b/cbind/base/psb_s_serial_cbind_mod.F90 index 5df7ff89..65a0bae7 100644 --- a/cbind/base/psb_s_serial_cbind_mod.F90 +++ b/cbind/base/psb_s_serial_cbind_mod.F90 @@ -7,11 +7,11 @@ module psb_s_serial_cbind_mod contains - + function psb_c_svect_get_nrows(xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res type(psb_c_svector) :: xh type(psb_s_vect_type), pointer :: vp @@ -19,27 +19,27 @@ contains res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) res = vp%get_nrows() end if end function psb_c_svect_get_nrows - + function psb_c_svect_f_get_cpy(v,xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res real(c_float) :: v(*) type(psb_c_svector) :: xh - + type(psb_s_vect_type), pointer :: vp real(psb_spk_), allocatable :: fv(:) integer(psb_c_ipk_) :: info, sz res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) fv = vp%get_vect() sz = size(fv) @@ -48,31 +48,49 @@ contains end function psb_c_svect_f_get_cpy - + function psb_c_svect_zero(xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res type(psb_c_svector) :: xh - + type(psb_s_vect_type), pointer :: vp integer(psb_c_ipk_) :: info res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) call vp%zero() end if end function psb_c_svect_zero - + function psb_c_svect_f_get_pnt(xh) bind(c) result(res) + implicit none + + type(c_ptr) :: res + type(psb_c_svector) :: xh + + type(psb_s_vect_type), pointer :: vp + + res = c_null_ptr + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + if(vp%is_dev()) call vp%sync() + res = c_loc(vp%v%v) + end if + + end function psb_c_svect_f_get_pnt + + function psb_c_smat_get_nrows(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res type(psb_c_sspmat) :: mh @@ -80,22 +98,22 @@ contains integer(psb_c_ipk_) :: info res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if - + res = ap%get_nrows() end function psb_c_smat_get_nrows - + function psb_c_smat_get_ncols(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res type(psb_c_sspmat) :: mh @@ -103,22 +121,22 @@ contains integer(psb_c_ipk_) :: info res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if - + res = ap%get_ncols() end function psb_c_smat_get_ncols - + function psb_c_smat_name_print(mh,name) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res character(c_char) :: name(*) @@ -128,17 +146,16 @@ contains character(1024) :: fname res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if call stringc2f(name,fname) - + call ap%print(fname,head='PSBLAS Cbinding Interface') end function psb_c_smat_name_print - -end module psb_s_serial_cbind_mod +end module psb_s_serial_cbind_mod diff --git a/cbind/base/psb_z_serial_cbind_mod.F90 b/cbind/base/psb_z_serial_cbind_mod.F90 index 27cfa76a..01dfa018 100644 --- a/cbind/base/psb_z_serial_cbind_mod.F90 +++ b/cbind/base/psb_z_serial_cbind_mod.F90 @@ -7,11 +7,11 @@ module psb_z_serial_cbind_mod contains - + function psb_c_zvect_get_nrows(xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res type(psb_c_zvector) :: xh type(psb_z_vect_type), pointer :: vp @@ -19,27 +19,27 @@ contains res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) res = vp%get_nrows() end if end function psb_c_zvect_get_nrows - + function psb_c_zvect_f_get_cpy(v,xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res complex(c_double_complex) :: v(*) type(psb_c_zvector) :: xh - + type(psb_z_vect_type), pointer :: vp complex(psb_dpk_), allocatable :: fv(:) integer(psb_c_ipk_) :: info, sz res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) fv = vp%get_vect() sz = size(fv) @@ -48,31 +48,49 @@ contains end function psb_c_zvect_f_get_cpy - + function psb_c_zvect_zero(xh) bind(c) result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res type(psb_c_zvector) :: xh - + type(psb_z_vect_type), pointer :: vp integer(psb_c_ipk_) :: info res = -1 - if (c_associated(xh%item)) then + if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) call vp%zero() end if end function psb_c_zvect_zero - + function psb_c_zvect_f_get_pnt(xh) bind(c) result(res) + implicit none + + type(c_ptr) :: res + type(psb_c_zvector) :: xh + + type(psb_z_vect_type), pointer :: vp + + res = c_null_ptr + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + if(vp%is_dev()) call vp%sync() + res = c_loc(vp%v%v) + end if + + end function psb_c_zvect_f_get_pnt + + function psb_c_zmat_get_nrows(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res type(psb_c_zspmat) :: mh @@ -80,22 +98,22 @@ contains integer(psb_c_ipk_) :: info res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if - + res = ap%get_nrows() end function psb_c_zmat_get_nrows - + function psb_c_zmat_get_ncols(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res type(psb_c_zspmat) :: mh @@ -103,22 +121,22 @@ contains integer(psb_c_ipk_) :: info res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if - + res = ap%get_ncols() end function psb_c_zmat_get_ncols - + function psb_c_zmat_name_print(mh,name) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - implicit none + implicit none integer(psb_c_ipk_) :: res character(c_char) :: name(*) @@ -128,17 +146,16 @@ contains character(1024) :: fname res = 0 - if (c_associated(mh%item)) then + if (c_associated(mh%item)) then call c_f_pointer(mh%item,ap) else - return + return end if call stringc2f(name,fname) - + call ap%print(fname,head='PSBLAS Cbinding Interface') end function psb_c_zmat_name_print - -end module psb_z_serial_cbind_mod +end module psb_z_serial_cbind_mod