diff --git a/cbind/amgprec/amg_c_dprec.h b/cbind/amgprec/amg_c_dprec.h index 577add44..d1297a80 100644 --- a/cbind/amgprec/amg_c_dprec.h +++ b/cbind/amgprec/amg_c_dprec.h @@ -32,6 +32,7 @@ extern "C" { psb_i_t amg_c_dprecbld_opt(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph, const char *afmt); psb_i_t amg_c_ddescr(amg_c_dprec *ph); + psb_i_t amg_c_dallocate_wrk(amg_c_dprec *ph, const char *chfmt); psb_i_t amg_c_dkrylov(const char *method, psb_c_dspmat *ah, amg_c_dprec *ph, psb_c_dvector *bh, psb_c_dvector *xh, diff --git a/cbind/amgprec/amg_c_zprec.h b/cbind/amgprec/amg_c_zprec.h index b9916c31..d3882484 100644 --- a/cbind/amgprec/amg_c_zprec.h +++ b/cbind/amgprec/amg_c_zprec.h @@ -33,6 +33,7 @@ extern "C" { amg_c_zprec *ph, const char *afmt); psb_i_t amg_c_zdescr(amg_c_zprec *ph); + psb_i_t amg_c_zallocate_wrk(amg_c_zprec *ph, const char *chfmt); psb_i_t amg_c_zkrylov(const char *method, psb_c_zspmat *ah, amg_c_zprec *ph, psb_c_zvector *bh, psb_c_zvector *xh, diff --git a/cbind/amgprec/amg_dprec_cbind_mod.F90 b/cbind/amgprec/amg_dprec_cbind_mod.F90 index c373dee3..b2fe6a0a 100644 --- a/cbind/amgprec/amg_dprec_cbind_mod.F90 +++ b/cbind/amgprec/amg_dprec_cbind_mod.F90 @@ -491,4 +491,55 @@ end function amg_c_dprecapply_opt return end function amg_c_ddescr + function amg_c_dallocate_wrk(ph,chfmt) bind(c, name="amg_c_dallocate_wrk") result(res) +#if defined (PSB_HAVE_CUDA) + use psb_cuda_mod +#endif + implicit none + + integer(psb_c_ipk_) :: res + type(psb_c_object_type) :: ph + character(c_char) :: chfmt(*) + integer(psb_ipk_) :: iret + type(amg_dprec_type), pointer :: precp + character(len=6) :: fchfmt +! Local variable + integer(psb_ipk_) :: info +! Local mold variables +#if defined (PSB_HAVE_CUDA) + type(psb_d_vect_cuda), target :: dvgpu +#endif + type(psb_d_base_vect_type), target :: dvhost + class(psb_d_base_vect_type), pointer :: vmold + + res = -1 + if (c_associated(ph%item)) then + call c_f_pointer(ph%item,precp) + else + return + end if + + call psb_stringc2f(chfmt,fchfmt) + select case (psb_toupper(fchfmt)) + case('HOST','CPU') + vmold => dvhost +#if defined (PSB_HAVE_CUDA) + case('GPU','DEVICE') + vmold => dvgpu +#endif + case default + write(psb_err_unit,'(A)') 'amg_c_dallocate_wrk: Unknown format ', fchfmt, ' defaulting to HOST/CPU' + vmold => dvhost + end select + + call precp%allocate_wrk(info,vmold=vmold) + + iret = info + + res = MLDC_ERR_FILTER(iret) + MLDC_ERR_HANDLE(res) + return + + end function amg_c_dallocate_wrk + end module amg_dprec_cbind_mod diff --git a/cbind/amgprec/amg_zprec_cbind_mod.F90 b/cbind/amgprec/amg_zprec_cbind_mod.F90 index fa686a84..33edca8d 100644 --- a/cbind/amgprec/amg_zprec_cbind_mod.F90 +++ b/cbind/amgprec/amg_zprec_cbind_mod.F90 @@ -487,4 +487,55 @@ contains return end function amg_c_zdescr + function amg_c_zallocate_wrk(ph,chfmt) bind(c, name="amg_c_zallocate_wrk") result(res) +#if defined (PSB_HAVE_CUDA) + use psb_cuda_mod +#endif + implicit none + + integer(psb_c_ipk_) :: res + type(psb_c_object_type) :: ph + character(c_char) :: chfmt(*) + integer(psb_ipk_) :: iret + type(amg_zprec_type), pointer :: precp + character(len=6) :: fchfmt +! Local variable + integer(psb_ipk_) :: info +! Local mold variables +#if defined (PSB_HAVE_CUDA) + type(psb_z_vect_cuda), target :: zvgpu +#endif + type(psb_z_base_vect_type), target :: zvhost + class(psb_z_base_vect_type), pointer :: vmold + + res = -1 + if (c_associated(ph%item)) then + call c_f_pointer(ph%item,precp) + else + return + end if + + call psb_stringc2f(chfmt,fchfmt) + select case (psb_toupper(fchfmt)) + case('HOST','CPU') + vmold => zvhost +#if defined (PSB_HAVE_CUDA) + case('GPU','DEVICE') + vmold => zvgpu +#endif + case default + write(psb_err_unit,'(A)') 'amg_c_zallocate_wrk: Unknown format ', fchfmt, ' defaulting to HOST/CPU' + vmold => zvhost + end select + + call precp%allocate_wrk(info,vmold=vmold) + + iret = info + + res = MLDC_ERR_FILTER(iret) + MLDC_ERR_HANDLE(res) + return + + end function amg_c_zallocate_wrk + end module amg_zprec_cbind_mod