mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-07 07:04:57 +00:00
Added psb_gescal subroutine to entrywise scale distributed vector with C interface
This commit is contained in:
@@ -72,6 +72,7 @@ psb_i_t psb_c_cgeinv_check(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor
|
||||
psb_i_t psb_c_cgeabs(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_cvector *cdh);
|
||||
psb_i_t psb_c_cgecmp(psb_c_cvector *xh,psb_s_t ch,psb_c_cvector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeaddconst(psb_c_cvector *xh,psb_c_t bh,psb_c_cvector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgescal(psb_c_cvector *xh,psb_s_t ch,psb_c_cvector *zh,psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cgenrm2_weight(psb_c_cvector *xh,psb_c_cvector *wh,psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cgenrm2_weightmask(psb_c_cvector *xh,psb_c_cvector *wh,psb_c_cvector *idvh,psb_c_descriptor *cdh);
|
||||
#ifdef __cplusplus
|
||||
|
||||
@@ -72,6 +72,7 @@ psb_i_t psb_c_dgeinv_check(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor
|
||||
psb_i_t psb_c_dgeabs(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgecmp(psb_c_dvector *xh,psb_d_t ch,psb_c_dvector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeaddconst(psb_c_dvector *xh,psb_d_t bh,psb_c_dvector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgescal(psb_c_dvector *xh,psb_d_t ch,psb_c_dvector *zh,psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgenrm2_weight(psb_c_dvector *xh,psb_c_dvector *wh,psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgenrm2_weightmask(psb_c_dvector *xh,psb_c_dvector *wh,psb_c_dvector *idvh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dmask(psb_c_dvector *ch,psb_c_dvector *xh,psb_c_dvector *mh, bool t, psb_c_descriptor *cdh);
|
||||
|
||||
@@ -456,6 +456,42 @@ contains
|
||||
|
||||
end function psb_c_cgeaddconst
|
||||
|
||||
function psb_c_cgescal(xh,ch,zh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
type(psb_c_cvector) :: xh,zh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_c_vect_type), pointer :: xp,zp
|
||||
integer(psb_c_ipk_) :: info
|
||||
real(c_float_complex) :: ch
|
||||
|
||||
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
|
||||
if (c_associated(zh%item)) then
|
||||
call c_f_pointer(zh%item,zp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_gescal(xp,ch,zp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_cgescal
|
||||
|
||||
|
||||
function psb_c_cgenrm2(xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
@@ -72,6 +72,7 @@ psb_i_t psb_c_sgeinv_check(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor
|
||||
psb_i_t psb_c_sgeabs(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgecmp(psb_c_svector *xh,psb_s_t ch,psb_c_svector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeaddconst(psb_c_svector *xh,psb_s_t bh,psb_c_svector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgescal(psb_c_svector *xh,psb_s_t ch,psb_c_svector *zh,psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgenrm2_weight(psb_c_svector *xh,psb_c_svector *wh,psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgenrm2_weightmask(psb_c_svector *xh,psb_c_svector *wh,psb_c_svector *idvh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_smask(psb_c_svector *ch,psb_c_svector *xh,psb_c_svector *mh, bool t, psb_c_descriptor *cdh);
|
||||
|
||||
@@ -72,6 +72,7 @@ psb_i_t psb_c_zgeinv_check(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor
|
||||
psb_i_t psb_c_zgeabs(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgecmp(psb_c_zvector *xh,psb_d_t ch,psb_c_zvector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeaddconst(psb_c_zvector *xh,psb_z_t bh,psb_c_zvector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgescal(psb_c_zvector *xh,psb_d_t ch,psb_c_zvector *zh,psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zgenrm2_weight(psb_c_zvector *xh,psb_c_zvector *wh,psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zgenrm2_weightmask(psb_c_zvector *xh,psb_c_zvector *wh,psb_c_zvector *idvh,psb_c_descriptor *cdh);
|
||||
#ifdef __cplusplus
|
||||
|
||||
@@ -456,6 +456,42 @@ contains
|
||||
|
||||
end function psb_c_dgeaddconst
|
||||
|
||||
function psb_c_dgescal(xh,ch,zh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
type(psb_c_dvector) :: xh,zh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_vect_type), pointer :: xp,zp
|
||||
integer(psb_c_ipk_) :: info
|
||||
real(c_double) :: ch
|
||||
|
||||
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
|
||||
if (c_associated(zh%item)) then
|
||||
call c_f_pointer(zh%item,zp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_gescal(xp,ch,zp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_dgescal
|
||||
|
||||
function psb_c_dmask(ch,xh,mh,t,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
@@ -456,6 +456,42 @@ contains
|
||||
|
||||
end function psb_c_sgeaddconst
|
||||
|
||||
function psb_c_sgescal(xh,ch,zh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
type(psb_c_svector) :: xh,zh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_s_vect_type), pointer :: xp,zp
|
||||
integer(psb_c_ipk_) :: info
|
||||
real(c_float) :: ch
|
||||
|
||||
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
|
||||
if (c_associated(zh%item)) then
|
||||
call c_f_pointer(zh%item,zp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_gescal(xp,ch,zp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_sgescal
|
||||
|
||||
function psb_c_smask(ch,xh,mh,t,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
@@ -456,6 +456,42 @@ contains
|
||||
|
||||
end function psb_c_zgeaddconst
|
||||
|
||||
function psb_c_zgescal(xh,ch,zh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
type(psb_c_zvector) :: xh,zh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_z_vect_type), pointer :: xp,zp
|
||||
integer(psb_c_ipk_) :: info
|
||||
real(c_double_complex) :: ch
|
||||
|
||||
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
|
||||
if (c_associated(zh%item)) then
|
||||
call c_f_pointer(zh%item,zp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_gescal(xp,ch,zp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_zgescal
|
||||
|
||||
|
||||
function psb_c_zgenrm2(xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
Reference in New Issue
Block a user