From 8588c0e5c61f781dda8cffdadbd2b5464bbbfdc8 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 10 Oct 2019 15:51:29 +0100 Subject: [PATCH] Must call backfix from hierarchy_bld --- mlprec/impl/mld_c_hierarchy_bld.f90 | 5 +++ mlprec/impl/mld_d_hierarchy_bld.f90 | 5 +++ mlprec/impl/mld_s_hierarchy_bld.f90 | 5 +++ mlprec/impl/mld_z_hierarchy_bld.f90 | 5 +++ mlprec/mld_c_onelev_mod.f90 | 47 ++++++++++++++++++++++++++--- mlprec/mld_d_onelev_mod.f90 | 47 ++++++++++++++++++++++++++--- mlprec/mld_s_onelev_mod.f90 | 47 ++++++++++++++++++++++++++--- mlprec/mld_z_onelev_mod.f90 | 47 ++++++++++++++++++++++++++--- 8 files changed, 192 insertions(+), 16 deletions(-) diff --git a/mlprec/impl/mld_c_hierarchy_bld.f90 b/mlprec/impl/mld_c_hierarchy_bld.f90 index bbe76cbd..03b607e5 100644 --- a/mlprec/impl/mld_c_hierarchy_bld.f90 +++ b/mlprec/impl/mld_c_hierarchy_bld.f90 @@ -446,6 +446,11 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) end do end if + ! Does the coarsening need backfix on descriptors? + do i=2, iszv + if (info == psb_success_) call prec%precv(i)%backfix(prec%precv(i-1),info) + end do + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Internal hierarchy build' ) diff --git a/mlprec/impl/mld_d_hierarchy_bld.f90 b/mlprec/impl/mld_d_hierarchy_bld.f90 index 5de53b30..079a3e27 100644 --- a/mlprec/impl/mld_d_hierarchy_bld.f90 +++ b/mlprec/impl/mld_d_hierarchy_bld.f90 @@ -446,6 +446,11 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) end do end if + ! Does the coarsening need backfix on descriptors? + do i=2, iszv + if (info == psb_success_) call prec%precv(i)%backfix(prec%precv(i-1),info) + end do + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Internal hierarchy build' ) diff --git a/mlprec/impl/mld_s_hierarchy_bld.f90 b/mlprec/impl/mld_s_hierarchy_bld.f90 index d54271f4..99af4165 100644 --- a/mlprec/impl/mld_s_hierarchy_bld.f90 +++ b/mlprec/impl/mld_s_hierarchy_bld.f90 @@ -446,6 +446,11 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) end do end if + ! Does the coarsening need backfix on descriptors? + do i=2, iszv + if (info == psb_success_) call prec%precv(i)%backfix(prec%precv(i-1),info) + end do + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Internal hierarchy build' ) diff --git a/mlprec/impl/mld_z_hierarchy_bld.f90 b/mlprec/impl/mld_z_hierarchy_bld.f90 index 3d6cb52a..13ac9816 100644 --- a/mlprec/impl/mld_z_hierarchy_bld.f90 +++ b/mlprec/impl/mld_z_hierarchy_bld.f90 @@ -446,6 +446,11 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) end do end if + ! Does the coarsening need backfix on descriptors? + do i=2, iszv + if (info == psb_success_) call prec%precv(i)%backfix(prec%precv(i-1),info) + end do + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Internal hierarchy build' ) diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index e8223d2b..1bcb979f 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -149,9 +149,10 @@ module mld_c_onelev_mod procedure, pass(wk) :: clone => c_wrk_clone procedure, pass(wk) :: move_alloc => c_wrk_move_alloc procedure, pass(wk) :: cnv => c_wrk_cnv + procedure, pass(wk) :: sizeof => c_wrk_sizeof end type mld_cmlprec_wrk_type private :: c_wrk_alloc, c_wrk_free, & - & c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv + & c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv, c_wrk_sizeof type mld_c_onelev_type class(mld_c_base_smoother_type), allocatable :: sm, sm2a @@ -171,6 +172,7 @@ module mld_c_onelev_mod contains procedure, pass(lv) :: bld_tprol => c_base_onelev_bld_tprol procedure, pass(lv) :: mat_asb => mld_c_base_onelev_mat_asb + procedure, pass(lv) :: backfix => c_base_onelev_backfix procedure, pass(lv) :: update_aggr => c_base_onelev_update_aggr procedure, pass(lv) :: bld => mld_c_base_onelev_build procedure, pass(lv) :: clone => c_base_onelev_clone @@ -423,8 +425,10 @@ contains val = val + lv%ac%sizeof() val = val + lv%tprol%sizeof() val = val + lv%map%sizeof() - if (allocated(lv%sm)) val = val + lv%sm%sizeof() - if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof() + if (allocated(lv%sm)) val = val + lv%sm%sizeof() + if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof() + if (allocated(lv%aggr)) val = val + lv%aggr%sizeof() + if (allocated(lv%wrk)) val = val + lv%wrk%sizeof() end function c_base_onelev_sizeof @@ -510,6 +514,19 @@ contains end subroutine c_base_onelev_update_aggr + subroutine c_base_onelev_backfix(lv,lvprev,info) + implicit none + class(mld_c_onelev_type), intent(inout), target :: lv, lvprev + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + if (lv%aggr%xt_desc()) then + call lv%aggr%backfix(lvprev%base_a,lvprev%ac,& + & lvprev%base_desc,lvprev%desc_ac,info) + end if + + end subroutine c_base_onelev_backfix + subroutine c_base_onelev_clone(lv,lvout,info) @@ -796,5 +813,27 @@ contains end if end if end subroutine c_wrk_cnv - + + function c_wrk_sizeof(wk) result(val) + use psb_realloc_mod + implicit none + class(mld_cmlprec_wrk_type), intent(in) :: wk + integer(psb_epk_) :: val + integer :: i + val = 0 + val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%tx) + val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%ty) + val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%x2l) + val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%y2l) + val = val + wk%vtx%sizeof() + val = val + wk%vty%sizeof() + val = val + wk%vx2l%sizeof() + val = val + wk%vy2l%sizeof() + if (allocated(wk%wv)) then + do i=1, size(wk%wv) + val = val + wk%wv(i)%sizeof() + end do + end if + end function c_wrk_sizeof + end module mld_c_onelev_mod diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index a12609ca..8a6280bc 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -149,9 +149,10 @@ module mld_d_onelev_mod procedure, pass(wk) :: clone => d_wrk_clone procedure, pass(wk) :: move_alloc => d_wrk_move_alloc procedure, pass(wk) :: cnv => d_wrk_cnv + procedure, pass(wk) :: sizeof => d_wrk_sizeof end type mld_dmlprec_wrk_type private :: d_wrk_alloc, d_wrk_free, & - & d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv + & d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv, d_wrk_sizeof type mld_d_onelev_type class(mld_d_base_smoother_type), allocatable :: sm, sm2a @@ -171,6 +172,7 @@ module mld_d_onelev_mod contains procedure, pass(lv) :: bld_tprol => d_base_onelev_bld_tprol procedure, pass(lv) :: mat_asb => mld_d_base_onelev_mat_asb + procedure, pass(lv) :: backfix => d_base_onelev_backfix procedure, pass(lv) :: update_aggr => d_base_onelev_update_aggr procedure, pass(lv) :: bld => mld_d_base_onelev_build procedure, pass(lv) :: clone => d_base_onelev_clone @@ -423,8 +425,10 @@ contains val = val + lv%ac%sizeof() val = val + lv%tprol%sizeof() val = val + lv%map%sizeof() - if (allocated(lv%sm)) val = val + lv%sm%sizeof() - if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof() + if (allocated(lv%sm)) val = val + lv%sm%sizeof() + if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof() + if (allocated(lv%aggr)) val = val + lv%aggr%sizeof() + if (allocated(lv%wrk)) val = val + lv%wrk%sizeof() end function d_base_onelev_sizeof @@ -510,6 +514,19 @@ contains end subroutine d_base_onelev_update_aggr + subroutine d_base_onelev_backfix(lv,lvprev,info) + implicit none + class(mld_d_onelev_type), intent(inout), target :: lv, lvprev + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + if (lv%aggr%xt_desc()) then + call lv%aggr%backfix(lvprev%base_a,lvprev%ac,& + & lvprev%base_desc,lvprev%desc_ac,info) + end if + + end subroutine d_base_onelev_backfix + subroutine d_base_onelev_clone(lv,lvout,info) @@ -796,5 +813,27 @@ contains end if end if end subroutine d_wrk_cnv - + + function d_wrk_sizeof(wk) result(val) + use psb_realloc_mod + implicit none + class(mld_dmlprec_wrk_type), intent(in) :: wk + integer(psb_epk_) :: val + integer :: i + val = 0 + val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%tx) + val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%ty) + val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%x2l) + val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%y2l) + val = val + wk%vtx%sizeof() + val = val + wk%vty%sizeof() + val = val + wk%vx2l%sizeof() + val = val + wk%vy2l%sizeof() + if (allocated(wk%wv)) then + do i=1, size(wk%wv) + val = val + wk%wv(i)%sizeof() + end do + end if + end function d_wrk_sizeof + end module mld_d_onelev_mod diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index 52d5376c..d2f8ea30 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -149,9 +149,10 @@ module mld_s_onelev_mod procedure, pass(wk) :: clone => s_wrk_clone procedure, pass(wk) :: move_alloc => s_wrk_move_alloc procedure, pass(wk) :: cnv => s_wrk_cnv + procedure, pass(wk) :: sizeof => s_wrk_sizeof end type mld_smlprec_wrk_type private :: s_wrk_alloc, s_wrk_free, & - & s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv + & s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv, s_wrk_sizeof type mld_s_onelev_type class(mld_s_base_smoother_type), allocatable :: sm, sm2a @@ -171,6 +172,7 @@ module mld_s_onelev_mod contains procedure, pass(lv) :: bld_tprol => s_base_onelev_bld_tprol procedure, pass(lv) :: mat_asb => mld_s_base_onelev_mat_asb + procedure, pass(lv) :: backfix => s_base_onelev_backfix procedure, pass(lv) :: update_aggr => s_base_onelev_update_aggr procedure, pass(lv) :: bld => mld_s_base_onelev_build procedure, pass(lv) :: clone => s_base_onelev_clone @@ -423,8 +425,10 @@ contains val = val + lv%ac%sizeof() val = val + lv%tprol%sizeof() val = val + lv%map%sizeof() - if (allocated(lv%sm)) val = val + lv%sm%sizeof() - if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof() + if (allocated(lv%sm)) val = val + lv%sm%sizeof() + if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof() + if (allocated(lv%aggr)) val = val + lv%aggr%sizeof() + if (allocated(lv%wrk)) val = val + lv%wrk%sizeof() end function s_base_onelev_sizeof @@ -510,6 +514,19 @@ contains end subroutine s_base_onelev_update_aggr + subroutine s_base_onelev_backfix(lv,lvprev,info) + implicit none + class(mld_s_onelev_type), intent(inout), target :: lv, lvprev + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + if (lv%aggr%xt_desc()) then + call lv%aggr%backfix(lvprev%base_a,lvprev%ac,& + & lvprev%base_desc,lvprev%desc_ac,info) + end if + + end subroutine s_base_onelev_backfix + subroutine s_base_onelev_clone(lv,lvout,info) @@ -796,5 +813,27 @@ contains end if end if end subroutine s_wrk_cnv - + + function s_wrk_sizeof(wk) result(val) + use psb_realloc_mod + implicit none + class(mld_smlprec_wrk_type), intent(in) :: wk + integer(psb_epk_) :: val + integer :: i + val = 0 + val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%tx) + val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%ty) + val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%x2l) + val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%y2l) + val = val + wk%vtx%sizeof() + val = val + wk%vty%sizeof() + val = val + wk%vx2l%sizeof() + val = val + wk%vy2l%sizeof() + if (allocated(wk%wv)) then + do i=1, size(wk%wv) + val = val + wk%wv(i)%sizeof() + end do + end if + end function s_wrk_sizeof + end module mld_s_onelev_mod diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index 4b8ec326..ad41897a 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -149,9 +149,10 @@ module mld_z_onelev_mod procedure, pass(wk) :: clone => z_wrk_clone procedure, pass(wk) :: move_alloc => z_wrk_move_alloc procedure, pass(wk) :: cnv => z_wrk_cnv + procedure, pass(wk) :: sizeof => z_wrk_sizeof end type mld_zmlprec_wrk_type private :: z_wrk_alloc, z_wrk_free, & - & z_wrk_clone, z_wrk_move_alloc, z_wrk_cnv + & z_wrk_clone, z_wrk_move_alloc, z_wrk_cnv, z_wrk_sizeof type mld_z_onelev_type class(mld_z_base_smoother_type), allocatable :: sm, sm2a @@ -171,6 +172,7 @@ module mld_z_onelev_mod contains procedure, pass(lv) :: bld_tprol => z_base_onelev_bld_tprol procedure, pass(lv) :: mat_asb => mld_z_base_onelev_mat_asb + procedure, pass(lv) :: backfix => z_base_onelev_backfix procedure, pass(lv) :: update_aggr => z_base_onelev_update_aggr procedure, pass(lv) :: bld => mld_z_base_onelev_build procedure, pass(lv) :: clone => z_base_onelev_clone @@ -423,8 +425,10 @@ contains val = val + lv%ac%sizeof() val = val + lv%tprol%sizeof() val = val + lv%map%sizeof() - if (allocated(lv%sm)) val = val + lv%sm%sizeof() - if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof() + if (allocated(lv%sm)) val = val + lv%sm%sizeof() + if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof() + if (allocated(lv%aggr)) val = val + lv%aggr%sizeof() + if (allocated(lv%wrk)) val = val + lv%wrk%sizeof() end function z_base_onelev_sizeof @@ -510,6 +514,19 @@ contains end subroutine z_base_onelev_update_aggr + subroutine z_base_onelev_backfix(lv,lvprev,info) + implicit none + class(mld_z_onelev_type), intent(inout), target :: lv, lvprev + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + if (lv%aggr%xt_desc()) then + call lv%aggr%backfix(lvprev%base_a,lvprev%ac,& + & lvprev%base_desc,lvprev%desc_ac,info) + end if + + end subroutine z_base_onelev_backfix + subroutine z_base_onelev_clone(lv,lvout,info) @@ -796,5 +813,27 @@ contains end if end if end subroutine z_wrk_cnv - + + function z_wrk_sizeof(wk) result(val) + use psb_realloc_mod + implicit none + class(mld_zmlprec_wrk_type), intent(in) :: wk + integer(psb_epk_) :: val + integer :: i + val = 0 + val = val + (1_psb_epk_ * (2*psb_sizeof_dp)) * psb_size(wk%tx) + val = val + (1_psb_epk_ * (2*psb_sizeof_dp)) * psb_size(wk%ty) + val = val + (1_psb_epk_ * (2*psb_sizeof_dp)) * psb_size(wk%x2l) + val = val + (1_psb_epk_ * (2*psb_sizeof_dp)) * psb_size(wk%y2l) + val = val + wk%vtx%sizeof() + val = val + wk%vty%sizeof() + val = val + wk%vx2l%sizeof() + val = val + wk%vy2l%sizeof() + if (allocated(wk%wv)) then + do i=1, size(wk%wv) + val = val + wk%wv(i)%sizeof() + end do + end if + end function z_wrk_sizeof + end module mld_z_onelev_mod