fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 14:44:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

Exposed prec%apply on the C interfaces

Browse Source
This commit is contained in:
fdurastante
2025-10-14 18:04:12 +02:00
parent daaa06e486
commit 7da64944b5
5 changed files with 288 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files
cbind/amgprec/amg_c_dprec.h
+2
View File
@@ -26,6 +26,8 @@ extern "C" {
psb_i_t amg_c_dprecbld(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph);
psb_i_t amg_c_dhierarchy_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph);
psb_i_t amg_c_dsmoothers_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph);
psb_i_t amg_c_dprecapply(amg_c_dprec *ph, psb_c_dvector *x, psb_c_dvector *b, psb_c_descriptor *cdh);
psb_i_t amg_c_dprecapply_opt(amg_c_dprec *ph, psb_c_dvector *x, psb_c_dvector *b, psb_c_descriptor *cdh, const char *ctrans);
psb_i_t amg_c_dprecfree(amg_c_dprec *ph);
psb_i_t amg_c_dprecbld_opt(psb_c_dspmat *ah, psb_c_descriptor *cdh,
amg_c_dprec *ph, const char *afmt);
cbind/amgprec/amg_c_zprec.h
+5 -3
View File
@@ -23,9 +23,11 @@ extern "C" {
psb_i_t amg_c_zprecseti(amg_c_zprec *ph, const char *what, psb_i_t val);
psb_i_t amg_c_zprecsetc(amg_c_zprec *ph, const char *what, const char *val);
psb_i_t amg_c_zprecsetr(amg_c_zprec *ph, const char *what, double val);
psb_i_t amg_c_zprecbld(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
psb_i_t amg_c_zhierarchy_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
psb_i_t amg_c_zsmoothers_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
psb_i_t amg_c_zprecbld(psb_c_zspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
psb_i_t amg_c_zhierarchy_build(psb_c_zspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
psb_i_t amg_c_zsmoothers_build(psb_c_zspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
psb_i_t amg_c_zprecapply(amg_c_zprec *ph, psb_c_zvector *x, psb_c_zvector *b, psb_c_descriptor *cdh);
psb_i_t amg_c_zprecapply_opt(amg_c_zprec *ph, psb_c_zvector *x, psb_c_zvector *b, psb_c_descriptor *cdh, const char *ctrans);
psb_i_t amg_c_zprecfree(amg_c_zprec *ph);
psb_i_t amg_c_zprecbld_opt(psb_c_zspmat *ah, psb_c_descriptor *cdh,
amg_c_zprec *ph, const char *afmt);
cbind/amgprec/amg_dprec_cbind_mod.F90
+106
View File
@@ -336,6 +336,112 @@ contains
end function amg_c_dkrylov_opt
function amg_c_dprecapply(ph,bc,xc,cdh) bind(c,name="amg_c_dprecapply") result(res)
use psb_base_mod
use psb_prec_mod
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph ! C handle to preconditioner
type(psb_c_object_type) :: bc ! C handle to rhs
type(psb_c_object_type) :: xc ! C handle to solution
type(psb_c_object_type) :: cdh ! C handle to descriptor
! Fortran containers for preconditioner, lhs, rhs and descriptor
type(amg_dprec_type), pointer :: precp
type(psb_d_vect_type), pointer :: xp, bp
type(psb_desc_type), pointer :: descp
integer(psb_ipk_) :: info
res = -1
! Check descriptor
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
! Check rhs and solution
if (c_associated(bc%item)) then
call c_f_pointer(bc%item,bp)
else
return
end if
if (c_associated(xc%item)) then
call c_f_pointer(xc%item,xp)
else
return
end if
! Check preconditioner
if (c_associated(ph%item)) then
call c_f_pointer(ph%item,precp)
else
return
end if
! Apply preconditioner
call precp%apply(bp,xp,descp,info)
! Error handling and return
res = MLDC_ERR_FILTER(info)
MLDC_ERR_HANDLE(res)
return
end function amg_c_dprecapply
function amg_c_dprecapply_opt(ph,bc,xc,cdh,ctrans) bind(c,name="amg_c_dprecapply_opt") result(res)
use psb_base_mod
use psb_prec_mod
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph ! C handle to preconditioner
type(psb_c_object_type) :: bc ! C handle to rhs
type(psb_c_object_type) :: xc ! C handle to solution
type(psb_c_object_type) :: cdh ! C handle to descriptor
character(c_char) :: ctrans(*) ! Tranpose flag as character
! Fortran containers for preconditioner, lhs, rhs and descriptor
type(amg_dprec_type), pointer :: precp
type(psb_d_vect_type), pointer :: xp, bp
type(psb_desc_type), pointer :: descp
character(len=10) :: ftrans
integer(psb_ipk_) :: info
res = -1
! Check descriptor
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
! Check rhs and solution
if (c_associated(bc%item)) then
call c_f_pointer(bc%item,bp)
else
return
end if
if (c_associated(xc%item)) then
call c_f_pointer(xc%item,xp)
else
return
end if
! Check preconditioner
if (c_associated(ph%item)) then
call c_f_pointer(ph%item,precp)
else
return
end if
! Convert transpose flag
call stringc2f(ctrans,ftrans)
! Apply preconditioner
call precp%apply(bp,xp,descp,info,trans=ftrans)
! Error handling and return
res = MLDC_ERR_FILTER(info)
MLDC_ERR_HANDLE(res)
return
end function amg_c_dprecapply_opt
function amg_c_dprecfree(ph) bind(c) result(res)
implicit none
cbind/amgprec/amg_zprec_cbind_mod.F90
+156
View File
@@ -332,6 +332,162 @@ contains
end function amg_c_zkrylov_opt
function amg_c_zprecapply(ph,bc,xc,cdh) bind(c,name="amg_c_zprecapply") result(res)
use psb_base_mod
use psb_prec_mod
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph ! C handle to preconditioner
type(psb_c_object_type) :: bc ! C handle to rhs
type(psb_c_object_type) :: xc ! C handle to solution
type(psb_c_object_type) :: cdh ! C handle to descriptor
! Fortran containers for preconditioner, lhs, rhs and descriptor
type(amg_zprec_type), pointer :: precp
type(psb_z_vect_type), pointer :: xp, bp
type(psb_desc_type), pointer :: descp
integer(psb_ipk_) :: info
res = -1
! Check descriptor
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
! Check rhs and solution
if (c_associated(bc%item)) then
call c_f_pointer(bc%item,bp)
else
return
end if
if (c_associated(xc%item)) then
call c_f_pointer(xc%item,xp)
else
return
end if
! Check preconditioner
if (c_associated(ph%item)) then
call c_f_pointer(ph%item,precp)
else
return
end if
! Apply preconditioner
call precp%apply(bp,xp,descp,info)
! Error handling and return
res = MLDC_ERR_FILTER(info)
MLDC_ERR_HANDLE(res)
return
end function amg_c_zprecapply
function amg_c_dprecapply(ph,bc,xc,cdh) bind(c,name="amg_c_dprecapply") result(res)
use psb_base_mod
use psb_prec_mod
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph ! C handle to preconditioner
type(psb_c_object_type) :: bc ! C handle to rhs
type(psb_c_object_type) :: xc ! C handle to solution
type(psb_c_object_type) :: cdh ! C handle to descriptor
! Fortran containers for preconditioner, lhs, rhs and descriptor
type(amg_dprec_type), pointer :: precp
type(psb_d_vect_type), pointer :: xp, bp
type(psb_desc_type), pointer :: descp
integer(psb_ipk_) :: info
res = -1
! Check descriptor
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
! Check rhs and solution
if (c_associated(bc%item)) then
call c_f_pointer(bc%item,bp)
else
return
end if
if (c_associated(xc%item)) then
call c_f_pointer(xc%item,xp)
else
return
end if
! Check preconditioner
if (c_associated(ph%item)) then
call c_f_pointer(ph%item,precp)
else
return
end if
! Apply preconditioner
call precp%apply(bp,xp,descp,info)
! Error handling and return
res = MLDC_ERR_FILTER(info)
MLDC_ERR_HANDLE(res)
return
end function amg_c_dprecapply
function amg_c_zprecapply_opt(ph,bc,xc,cdh,ctrans) bind(c,name="amg_c_zprecapply_opt") result(res)
use psb_base_mod
use psb_prec_mod
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph ! C handle to preconditioner
type(psb_c_object_type) :: bc ! C handle to rhs
type(psb_c_object_type) :: xc ! C handle to solution
type(psb_c_object_type) :: cdh ! C handle to descriptor
character(c_char) :: ctrans(:) ! Tranpose flag as character
! Fortran containers for preconditioner, lhs, rhs and descriptor
type(amg_zprec_type), pointer :: precp
type(psb_z_vect_type), pointer :: xp, bp
type(psb_desc_type), pointer :: descp
character(len=10) :: ftrans
integer(psb_ipk_) :: info
res = -1
! Check descriptor
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
! Check rhs and solution
if (c_associated(bc%item)) then
call c_f_pointer(bc%item,bp)
else
return
end if
if (c_associated(xc%item)) then
call c_f_pointer(xc%item,xp)
else
return
end if
! Check preconditioner
if (c_associated(ph%item)) then
call c_f_pointer(ph%item,precp)
else
return
end if
! Convert transpose flag
call stringc2f(ctrans,ftrans)
! Apply preconditioner
call precp%apply(bp,xp,descp,info,trans=ftrans)
! Error handling and return
res = MLDC_ERR_FILTER(info)
MLDC_ERR_HANDLE(res)
return
end function amg_c_zprecapply_opt
function amg_c_zprecfree(ph) bind(c) result(res)
implicit none
cbind/test/pargen/amgec.c
+19
View File
@@ -358,6 +358,25 @@ int main(int argc, char *argv[])
fprintf(stderr,"From smoothers_build: %d\n",ret);
psb_c_barrier(*cctxt);
/* Do a dry run of the preconditioner */
info = amg_c_dprecapply(ph,bh,xh,cdh);
if (info != 0) {
fprintf(stderr,"From dprec_apply: %d\nBailing out\n",info);
psb_c_abort(*cctxt);
}
/* Do a dry run of the preconditioner with the option routine */
info = amg_c_dprecapply_opt(ph,bh,xh,cdh,"N");
if (info != 0) {
fprintf(stderr,"From dprec_apply_opt: %d\nBailing out\n",info);
psb_c_abort(*cctxt);
}
/*
info = amg_c_dprecapply_opt(ph,bh,xh,cdh,"T");
if (info != 0) {
fprintf(stderr,"From dprec_apply_opt: %d\nBailing out\n",info);
psb_c_abort(*cctxt);
}
*/
/* Set up the solver options */
psb_c_DefaultSolverOptions(&options);
options.eps = 1.e-6;