mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
Must call backfix from hierarchy_bld
This commit is contained in:
Salvatore Filippone
@@ -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' )
|
||||
|
||||
@@ -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' )
|
||||
|
||||
@@ -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' )
|
||||
|
||||
@@ -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' )
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user