From 7da64944b58ee17924abc7e8e51b59c29522753b Mon Sep 17 00:00:00 2001 From: Fabio Durastante Date: Tue, 14 Oct 2025 18:04:12 +0200 Subject: [PATCH] Exposed prec%apply on the C interfaces --- cbind/amgprec/amg_c_dprec.h | 2 + cbind/amgprec/amg_c_zprec.h | 8 +- cbind/amgprec/amg_dprec_cbind_mod.F90 | 106 +++++++++++++++++ cbind/amgprec/amg_zprec_cbind_mod.F90 | 156 ++++++++++++++++++++++++++ cbind/test/pargen/amgec.c | 19 ++++ 5 files changed, 288 insertions(+), 3 deletions(-) diff --git a/cbind/amgprec/amg_c_dprec.h b/cbind/amgprec/amg_c_dprec.h index c097ca69..2a373f91 100644 --- a/cbind/amgprec/amg_c_dprec.h +++ b/cbind/amgprec/amg_c_dprec.h @@ -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); diff --git a/cbind/amgprec/amg_c_zprec.h b/cbind/amgprec/amg_c_zprec.h index 0e331e61..94dc2542 100644 --- a/cbind/amgprec/amg_c_zprec.h +++ b/cbind/amgprec/amg_c_zprec.h @@ -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); diff --git a/cbind/amgprec/amg_dprec_cbind_mod.F90 b/cbind/amgprec/amg_dprec_cbind_mod.F90 index eddbef41..b4e87492 100644 --- a/cbind/amgprec/amg_dprec_cbind_mod.F90 +++ b/cbind/amgprec/amg_dprec_cbind_mod.F90 @@ -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 diff --git a/cbind/amgprec/amg_zprec_cbind_mod.F90 b/cbind/amgprec/amg_zprec_cbind_mod.F90 index 2e8a8b94..e60eefb6 100644 --- a/cbind/amgprec/amg_zprec_cbind_mod.F90 +++ b/cbind/amgprec/amg_zprec_cbind_mod.F90 @@ -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 diff --git a/cbind/test/pargen/amgec.c b/cbind/test/pargen/amgec.c index 329b0649..92b5e8da 100644 --- a/cbind/test/pargen/amgec.c +++ b/cbind/test/pargen/amgec.c @@ -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;