Defined a new CNV method for wrkspace. Changed LV%BLD to call CNV method at end, so all relevant fields are taken care of. Fixed LV%BLD to handle all smoothers and wrkspace.

stopcriterion
Salvatore Filippone 7 years ago
parent 62a58d59cc
commit 4e88068e2a

@ -94,6 +94,7 @@ subroutine mld_c_base_onelev_build(lv,info,amold,vmold,imold)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
if (.false.) then
call lv%sm%build(lv%base_a,lv%base_desc,& call lv%sm%build(lv%base_a,lv%base_desc,&
& info,amold=amold,vmold=vmold,imold=imold) & info,amold=amold,vmold=vmold,imold=imold)
if (info == 0) then if (info == 0) then
@ -111,6 +112,26 @@ subroutine mld_c_base_onelev_build(lv,info,amold,vmold,imold)
& a_err='Smoother bld error') & a_err='Smoother bld error')
goto 9999 goto 9999
end if end if
else
call lv%sm%build(lv%base_a,lv%base_desc,info)
if (info == 0) then
if (allocated(lv%sm2a)) then
call lv%sm2a%build(lv%base_a,lv%base_desc,info)
lv%sm2 => lv%sm2a
else
lv%sm2 => lv%sm
end if
end if
if (info /=0 ) then
info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='Smoother bld error')
goto 9999
end if
if (any((/present(amold),present(vmold),present(imold)/))) &
& call lv%cnv(info,amold=amold,vmold=vmold,imold=imold)
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -54,10 +54,14 @@ subroutine mld_c_base_onelev_cnv(lv,info,amold,vmold,imold)
if (any((/present(amold),present(vmold),present(imold)/))) then if (any((/present(amold),present(vmold),present(imold)/))) then
if (allocated(lv%sm)) & if (allocated(lv%sm)) &
& call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold)
if (info == psb_success_ .and. allocated(lv%sm2a)) &
& call lv%sm2a%cnv(info,amold=amold,vmold=vmold,imold=imold)
if (info == psb_success_ .and. allocated(lv%wrk)) &
& call lv%wrk(vmold=vmold)
if (info == psb_success_.and. lv%ac%is_asb()) & if (info == psb_success_.and. lv%ac%is_asb()) &
& call lv%ac%cscnv(info,mold=amold) & call lv%ac%cscnv(info,mold=amold)
if (info == psb_success_ .and. lv%desc_ac%is_ok()) & if (info == psb_success_ .and. lv%desc_ac%is_ok() &
& call lv%desc_ac%cnv(imold) & .and. present(imold)) call lv%desc_ac%cnv(imold)
call lv%map%cnv(info,mold=amold,imold=imold) call lv%map%cnv(info,mold=amold,imold=imold)
end if end if
end subroutine mld_c_base_onelev_cnv end subroutine mld_c_base_onelev_cnv

@ -94,6 +94,7 @@ subroutine mld_d_base_onelev_build(lv,info,amold,vmold,imold)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
if (.false.) then
call lv%sm%build(lv%base_a,lv%base_desc,& call lv%sm%build(lv%base_a,lv%base_desc,&
& info,amold=amold,vmold=vmold,imold=imold) & info,amold=amold,vmold=vmold,imold=imold)
if (info == 0) then if (info == 0) then
@ -111,6 +112,26 @@ subroutine mld_d_base_onelev_build(lv,info,amold,vmold,imold)
& a_err='Smoother bld error') & a_err='Smoother bld error')
goto 9999 goto 9999
end if end if
else
call lv%sm%build(lv%base_a,lv%base_desc,info)
if (info == 0) then
if (allocated(lv%sm2a)) then
call lv%sm2a%build(lv%base_a,lv%base_desc,info)
lv%sm2 => lv%sm2a
else
lv%sm2 => lv%sm
end if
end if
if (info /=0 ) then
info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='Smoother bld error')
goto 9999
end if
if (any((/present(amold),present(vmold),present(imold)/))) &
& call lv%cnv(info,amold=amold,vmold=vmold,imold=imold)
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -54,10 +54,14 @@ subroutine mld_d_base_onelev_cnv(lv,info,amold,vmold,imold)
if (any((/present(amold),present(vmold),present(imold)/))) then if (any((/present(amold),present(vmold),present(imold)/))) then
if (allocated(lv%sm)) & if (allocated(lv%sm)) &
& call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold)
if (info == psb_success_ .and. allocated(lv%sm2a)) &
& call lv%sm2a%cnv(info,amold=amold,vmold=vmold,imold=imold)
if (info == psb_success_ .and. allocated(lv%wrk)) &
& call lv%wrk(vmold=vmold)
if (info == psb_success_.and. lv%ac%is_asb()) & if (info == psb_success_.and. lv%ac%is_asb()) &
& call lv%ac%cscnv(info,mold=amold) & call lv%ac%cscnv(info,mold=amold)
if (info == psb_success_ .and. lv%desc_ac%is_ok()) & if (info == psb_success_ .and. lv%desc_ac%is_ok() &
& call lv%desc_ac%cnv(imold) & .and. present(imold)) call lv%desc_ac%cnv(imold)
call lv%map%cnv(info,mold=amold,imold=imold) call lv%map%cnv(info,mold=amold,imold=imold)
end if end if
end subroutine mld_d_base_onelev_cnv end subroutine mld_d_base_onelev_cnv

@ -94,6 +94,7 @@ subroutine mld_s_base_onelev_build(lv,info,amold,vmold,imold)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
if (.false.) then
call lv%sm%build(lv%base_a,lv%base_desc,& call lv%sm%build(lv%base_a,lv%base_desc,&
& info,amold=amold,vmold=vmold,imold=imold) & info,amold=amold,vmold=vmold,imold=imold)
if (info == 0) then if (info == 0) then
@ -111,6 +112,26 @@ subroutine mld_s_base_onelev_build(lv,info,amold,vmold,imold)
& a_err='Smoother bld error') & a_err='Smoother bld error')
goto 9999 goto 9999
end if end if
else
call lv%sm%build(lv%base_a,lv%base_desc,info)
if (info == 0) then
if (allocated(lv%sm2a)) then
call lv%sm2a%build(lv%base_a,lv%base_desc,info)
lv%sm2 => lv%sm2a
else
lv%sm2 => lv%sm
end if
end if
if (info /=0 ) then
info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='Smoother bld error')
goto 9999
end if
if (any((/present(amold),present(vmold),present(imold)/))) &
& call lv%cnv(info,amold=amold,vmold=vmold,imold=imold)
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -54,10 +54,14 @@ subroutine mld_s_base_onelev_cnv(lv,info,amold,vmold,imold)
if (any((/present(amold),present(vmold),present(imold)/))) then if (any((/present(amold),present(vmold),present(imold)/))) then
if (allocated(lv%sm)) & if (allocated(lv%sm)) &
& call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold)
if (info == psb_success_ .and. allocated(lv%sm2a)) &
& call lv%sm2a%cnv(info,amold=amold,vmold=vmold,imold=imold)
if (info == psb_success_ .and. allocated(lv%wrk)) &
& call lv%wrk(vmold=vmold)
if (info == psb_success_.and. lv%ac%is_asb()) & if (info == psb_success_.and. lv%ac%is_asb()) &
& call lv%ac%cscnv(info,mold=amold) & call lv%ac%cscnv(info,mold=amold)
if (info == psb_success_ .and. lv%desc_ac%is_ok()) & if (info == psb_success_ .and. lv%desc_ac%is_ok() &
& call lv%desc_ac%cnv(imold) & .and. present(imold)) call lv%desc_ac%cnv(imold)
call lv%map%cnv(info,mold=amold,imold=imold) call lv%map%cnv(info,mold=amold,imold=imold)
end if end if
end subroutine mld_s_base_onelev_cnv end subroutine mld_s_base_onelev_cnv

@ -94,6 +94,7 @@ subroutine mld_z_base_onelev_build(lv,info,amold,vmold,imold)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
if (.false.) then
call lv%sm%build(lv%base_a,lv%base_desc,& call lv%sm%build(lv%base_a,lv%base_desc,&
& info,amold=amold,vmold=vmold,imold=imold) & info,amold=amold,vmold=vmold,imold=imold)
if (info == 0) then if (info == 0) then
@ -111,6 +112,26 @@ subroutine mld_z_base_onelev_build(lv,info,amold,vmold,imold)
& a_err='Smoother bld error') & a_err='Smoother bld error')
goto 9999 goto 9999
end if end if
else
call lv%sm%build(lv%base_a,lv%base_desc,info)
if (info == 0) then
if (allocated(lv%sm2a)) then
call lv%sm2a%build(lv%base_a,lv%base_desc,info)
lv%sm2 => lv%sm2a
else
lv%sm2 => lv%sm
end if
end if
if (info /=0 ) then
info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='Smoother bld error')
goto 9999
end if
if (any((/present(amold),present(vmold),present(imold)/))) &
& call lv%cnv(info,amold=amold,vmold=vmold,imold=imold)
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -54,10 +54,14 @@ subroutine mld_z_base_onelev_cnv(lv,info,amold,vmold,imold)
if (any((/present(amold),present(vmold),present(imold)/))) then if (any((/present(amold),present(vmold),present(imold)/))) then
if (allocated(lv%sm)) & if (allocated(lv%sm)) &
& call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold)
if (info == psb_success_ .and. allocated(lv%sm2a)) &
& call lv%sm2a%cnv(info,amold=amold,vmold=vmold,imold=imold)
if (info == psb_success_ .and. allocated(lv%wrk)) &
& call lv%wrk(vmold=vmold)
if (info == psb_success_.and. lv%ac%is_asb()) & if (info == psb_success_.and. lv%ac%is_asb()) &
& call lv%ac%cscnv(info,mold=amold) & call lv%ac%cscnv(info,mold=amold)
if (info == psb_success_ .and. lv%desc_ac%is_ok()) & if (info == psb_success_ .and. lv%desc_ac%is_ok() &
& call lv%desc_ac%cnv(imold) & .and. present(imold)) call lv%desc_ac%cnv(imold)
call lv%map%cnv(info,mold=amold,imold=imold) call lv%map%cnv(info,mold=amold,imold=imold)
end if end if
end subroutine mld_z_base_onelev_cnv end subroutine mld_z_base_onelev_cnv

@ -130,9 +130,10 @@ module mld_c_onelev_mod
procedure, pass(wk) :: free => c_wrk_free procedure, pass(wk) :: free => c_wrk_free
procedure, pass(wk) :: clone => c_wrk_clone procedure, pass(wk) :: clone => c_wrk_clone
procedure, pass(wk) :: move_alloc => c_wrk_move_alloc procedure, pass(wk) :: move_alloc => c_wrk_move_alloc
procedure, pass(wk) :: cnv => c_wrk_cnv
end type mld_cmlprec_wrk_type end type mld_cmlprec_wrk_type
private :: c_wrk_alloc, c_wrk_free, & private :: c_wrk_alloc, c_wrk_free, &
& c_wrk_clone, c_wrk_move_alloc & c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv
type mld_c_onelev_type type mld_c_onelev_type
class(mld_c_base_smoother_type), allocatable :: sm, sm2a class(mld_c_base_smoother_type), allocatable :: sm, sm2a
@ -730,4 +731,30 @@ contains
end subroutine c_wrk_move_alloc end subroutine c_wrk_move_alloc
subroutine c_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(mld_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
info = psb_success_
if (present(vmold)) then
call wk%vtx%cnv(vmold)
call wk%vty%cnv(vmold)
call wk%vx2l%cnv(vmold)
call wk%vy2l%cnv(vmold)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%cnv(vmold)
end do
end if
end if
end subroutine c_wrk_cnv
end module mld_c_onelev_mod end module mld_c_onelev_mod

@ -130,9 +130,10 @@ module mld_d_onelev_mod
procedure, pass(wk) :: free => d_wrk_free procedure, pass(wk) :: free => d_wrk_free
procedure, pass(wk) :: clone => d_wrk_clone procedure, pass(wk) :: clone => d_wrk_clone
procedure, pass(wk) :: move_alloc => d_wrk_move_alloc procedure, pass(wk) :: move_alloc => d_wrk_move_alloc
procedure, pass(wk) :: cnv => d_wrk_cnv
end type mld_dmlprec_wrk_type end type mld_dmlprec_wrk_type
private :: d_wrk_alloc, d_wrk_free, & private :: d_wrk_alloc, d_wrk_free, &
& d_wrk_clone, d_wrk_move_alloc & d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv
type mld_d_onelev_type type mld_d_onelev_type
class(mld_d_base_smoother_type), allocatable :: sm, sm2a class(mld_d_base_smoother_type), allocatable :: sm, sm2a
@ -730,4 +731,30 @@ contains
end subroutine d_wrk_move_alloc end subroutine d_wrk_move_alloc
subroutine d_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(mld_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
info = psb_success_
if (present(vmold)) then
call wk%vtx%cnv(vmold)
call wk%vty%cnv(vmold)
call wk%vx2l%cnv(vmold)
call wk%vy2l%cnv(vmold)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%cnv(vmold)
end do
end if
end if
end subroutine d_wrk_cnv
end module mld_d_onelev_mod end module mld_d_onelev_mod

@ -130,9 +130,10 @@ module mld_s_onelev_mod
procedure, pass(wk) :: free => s_wrk_free procedure, pass(wk) :: free => s_wrk_free
procedure, pass(wk) :: clone => s_wrk_clone procedure, pass(wk) :: clone => s_wrk_clone
procedure, pass(wk) :: move_alloc => s_wrk_move_alloc procedure, pass(wk) :: move_alloc => s_wrk_move_alloc
procedure, pass(wk) :: cnv => s_wrk_cnv
end type mld_smlprec_wrk_type end type mld_smlprec_wrk_type
private :: s_wrk_alloc, s_wrk_free, & private :: s_wrk_alloc, s_wrk_free, &
& s_wrk_clone, s_wrk_move_alloc & s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv
type mld_s_onelev_type type mld_s_onelev_type
class(mld_s_base_smoother_type), allocatable :: sm, sm2a class(mld_s_base_smoother_type), allocatable :: sm, sm2a
@ -730,4 +731,30 @@ contains
end subroutine s_wrk_move_alloc end subroutine s_wrk_move_alloc
subroutine s_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(mld_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
info = psb_success_
if (present(vmold)) then
call wk%vtx%cnv(vmold)
call wk%vty%cnv(vmold)
call wk%vx2l%cnv(vmold)
call wk%vy2l%cnv(vmold)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%cnv(vmold)
end do
end if
end if
end subroutine s_wrk_cnv
end module mld_s_onelev_mod end module mld_s_onelev_mod

@ -130,9 +130,10 @@ module mld_z_onelev_mod
procedure, pass(wk) :: free => z_wrk_free procedure, pass(wk) :: free => z_wrk_free
procedure, pass(wk) :: clone => z_wrk_clone procedure, pass(wk) :: clone => z_wrk_clone
procedure, pass(wk) :: move_alloc => z_wrk_move_alloc procedure, pass(wk) :: move_alloc => z_wrk_move_alloc
procedure, pass(wk) :: cnv => z_wrk_cnv
end type mld_zmlprec_wrk_type end type mld_zmlprec_wrk_type
private :: z_wrk_alloc, z_wrk_free, & private :: z_wrk_alloc, z_wrk_free, &
& z_wrk_clone, z_wrk_move_alloc & z_wrk_clone, z_wrk_move_alloc, z_wrk_cnv
type mld_z_onelev_type type mld_z_onelev_type
class(mld_z_base_smoother_type), allocatable :: sm, sm2a class(mld_z_base_smoother_type), allocatable :: sm, sm2a
@ -730,4 +731,30 @@ contains
end subroutine z_wrk_move_alloc end subroutine z_wrk_move_alloc
subroutine z_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(mld_zmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
info = psb_success_
if (present(vmold)) then
call wk%vtx%cnv(vmold)
call wk%vty%cnv(vmold)
call wk%vx2l%cnv(vmold)
call wk%vy2l%cnv(vmold)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%cnv(vmold)
end do
end if
end if
end subroutine z_wrk_cnv
end module mld_z_onelev_mod end module mld_z_onelev_mod

Loading…
Cancel
Save