fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'PolySmooth' of github.com:sfilippone/amg4psblas into PolySmooth

Browse Source
PolySmooth
sfilippone 8 months ago
parent 3e3b343131 5790aa0cbd
commit 234071869d
19 changed files with 555 additions and 360 deletions
Show Stats Download Patch File Download Diff File

3
amgprec/amg_base_prec_type.F90
Unescape Escape View File

@ -326,6 +326,7 @@ module amg_base_prec_type
integer(psb_ipk_), parameter :: amg_poly_lottes_ = 0
integer(psb_ipk_), parameter :: amg_poly_lottes_beta_ = 1
integer(psb_ipk_), parameter :: amg_poly_new_ = 2
integer(psb_ipk_), parameter :: amg_poly_dbg_ = 8
integer(psb_ipk_), parameter :: amg_poly_rho_est_power_ = 0
@ -575,6 +576,8 @@ contains
val = amg_poly_lottes_beta_
case('POLY_NEW')
val = amg_poly_new_
case('POLY_DBG')
val = amg_poly_dbg_
case('POLY_RHO_EST_POWER')
val = amg_poly_rho_est_power_
case('A_NORMI')

3
amgprec/amg_c_onelev_mod.f90
Unescape Escape View File

@ -275,7 +275,7 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout, verbosity,prefix)
subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@ -287,6 +287,7 @@ module amg_c_onelev_mod
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_c_base_onelev_memory_use
end interface

3
amgprec/amg_c_prec_type.f90
Unescape Escape View File

@ -173,7 +173,7 @@ module amg_c_prec_type
interface amg_memory_use
subroutine amg_cfile_prec_memory_use(prec,info,iout,root,verbosity,prefix)
subroutine amg_cfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
import :: amg_cprec_type, psb_ipk_
implicit none
! Arguments
@ -183,6 +183,7 @@ module amg_c_prec_type
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_cfile_prec_memory_use
end interface

3
amgprec/amg_d_onelev_mod.f90
Unescape Escape View File

@ -276,7 +276,7 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout, verbosity,prefix)
subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@ -288,6 +288,7 @@ module amg_d_onelev_mod
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_d_base_onelev_memory_use
end interface

3
amgprec/amg_d_prec_type.f90
Unescape Escape View File

@ -173,7 +173,7 @@ module amg_d_prec_type
interface amg_memory_use
subroutine amg_dfile_prec_memory_use(prec,info,iout,root,verbosity,prefix)
subroutine amg_dfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
import :: amg_dprec_type, psb_ipk_
implicit none
! Arguments
@ -183,6 +183,7 @@ module amg_d_prec_type
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_dfile_prec_memory_use
end interface

3
amgprec/amg_s_onelev_mod.f90
Unescape Escape View File

@ -276,7 +276,7 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout, verbosity,prefix)
subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@ -288,6 +288,7 @@ module amg_s_onelev_mod
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_s_base_onelev_memory_use
end interface

3
amgprec/amg_s_prec_type.f90
Unescape Escape View File

@ -173,7 +173,7 @@ module amg_s_prec_type
interface amg_memory_use
subroutine amg_sfile_prec_memory_use(prec,info,iout,root,verbosity,prefix)
subroutine amg_sfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
import :: amg_sprec_type, psb_ipk_
implicit none
! Arguments
@ -183,6 +183,7 @@ module amg_s_prec_type
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_sfile_prec_memory_use
end interface

3
amgprec/amg_z_onelev_mod.f90
Unescape Escape View File

@ -275,7 +275,7 @@ module amg_z_onelev_mod
end interface
interface
subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout, verbosity,prefix)
subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@ -287,6 +287,7 @@ module amg_z_onelev_mod
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_z_base_onelev_memory_use
end interface

3
amgprec/amg_z_prec_type.f90
Unescape Escape View File

@ -173,7 +173,7 @@ module amg_z_prec_type
interface amg_memory_use
subroutine amg_zfile_prec_memory_use(prec,info,iout,root,verbosity,prefix)
subroutine amg_zfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
import :: amg_zprec_type, psb_ipk_
implicit none
! Arguments
@ -183,6 +183,7 @@ module amg_z_prec_type
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_zfile_prec_memory_use
end interface

35
amgprec/impl/amg_cfile_prec_memory_use.f90
Unescape Escape View File

@ -65,7 +65,7 @@
! 0: normal
! >1: increased details
!
subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,global)
use psb_base_mod
use amg_c_prec_mod, amg_protect_name => amg_cfile_prec_memory_use
use amg_c_inner_mod
@ -79,6 +79,7 @@ subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
! Local variables
@ -88,6 +89,7 @@ subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_memory_use'
integer(psb_ipk_) :: iout_, root_, verbosity_
logical :: global_
character(1024) :: prefix_
info = psb_success_
@ -103,17 +105,23 @@ subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
verbosity_ = 0
end if
if (verbosity_ < 0) goto 9998
ctxt = prec%ctxt
call psb_info(ctxt,me,np)
prefix_ = ""
if (verbosity_ == 0) then
if (present(prefix)) then
prefix_ = prefix
end if
else if (verbosity_ > 0) then
if (present(prefix)) then
write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': '
else
prefix_ = ""
write(prefix_,'(a,i5,a)') 'Process ',me,': '
end if
ctxt = prec%ctxt
if (allocated(prec%precv)) then
end if
call psb_info(ctxt,me,np)
if (present(root)) then
root_ = root
else
@ -121,29 +129,24 @@ subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
end if
if (root_ == -1) root_ = me
if (allocated(prec%precv)) then
if (verbosity_ >=0) then
!
! The preconditioner description is printed by processor psb_root_.
! This agrees with the fact that all the parameters defining the
! preconditioner have the same values on all the procs (this is
! ensured by amg_precbld).
!
if (me == root_) then
write(iout_,*)
write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage'
end if
nlev = size(prec%precv)
do ilev=1,nlev
call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, &
& iout=iout_,verbosity=verbosity,prefix=prefix)
& iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global)
end do
end if
end if
else
write(iout_,*) trim(name), &
& ': Error: no base preconditioner available, something is wrong!'
info = -2
return
endif
end if
9998 continue
end subroutine amg_cfile_prec_memory_use

35
amgprec/impl/amg_dfile_prec_memory_use.f90
Unescape Escape View File

@ -65,7 +65,7 @@
! 0: normal
! >1: increased details
!
subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,global)
use psb_base_mod
use amg_d_prec_mod, amg_protect_name => amg_dfile_prec_memory_use
use amg_d_inner_mod
@ -79,6 +79,7 @@ subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
! Local variables
@ -88,6 +89,7 @@ subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_memory_use'
integer(psb_ipk_) :: iout_, root_, verbosity_
logical :: global_
character(1024) :: prefix_
info = psb_success_
@ -103,17 +105,23 @@ subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
verbosity_ = 0
end if
if (verbosity_ < 0) goto 9998
ctxt = prec%ctxt
call psb_info(ctxt,me,np)
prefix_ = ""
if (verbosity_ == 0) then
if (present(prefix)) then
prefix_ = prefix
end if
else if (verbosity_ > 0) then
if (present(prefix)) then
write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': '
else
prefix_ = ""
write(prefix_,'(a,i5,a)') 'Process ',me,': '
end if
ctxt = prec%ctxt
if (allocated(prec%precv)) then
end if
call psb_info(ctxt,me,np)
if (present(root)) then
root_ = root
else
@ -121,29 +129,24 @@ subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
end if
if (root_ == -1) root_ = me
if (allocated(prec%precv)) then
if (verbosity_ >=0) then
!
! The preconditioner description is printed by processor psb_root_.
! This agrees with the fact that all the parameters defining the
! preconditioner have the same values on all the procs (this is
! ensured by amg_precbld).
!
if (me == root_) then
write(iout_,*)
write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage'
end if
nlev = size(prec%precv)
do ilev=1,nlev
call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, &
& iout=iout_,verbosity=verbosity,prefix=prefix)
& iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global)
end do
end if
end if
else
write(iout_,*) trim(name), &
& ': Error: no base preconditioner available, something is wrong!'
info = -2
return
endif
end if
9998 continue
end subroutine amg_dfile_prec_memory_use

35
amgprec/impl/amg_sfile_prec_memory_use.f90
Unescape Escape View File

@ -65,7 +65,7 @@
! 0: normal
! >1: increased details
!
subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,global)
use psb_base_mod
use amg_s_prec_mod, amg_protect_name => amg_sfile_prec_memory_use
use amg_s_inner_mod
@ -79,6 +79,7 @@ subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
! Local variables
@ -88,6 +89,7 @@ subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_memory_use'
integer(psb_ipk_) :: iout_, root_, verbosity_
logical :: global_
character(1024) :: prefix_
info = psb_success_
@ -103,17 +105,23 @@ subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
verbosity_ = 0
end if
if (verbosity_ < 0) goto 9998
ctxt = prec%ctxt
call psb_info(ctxt,me,np)
prefix_ = ""
if (verbosity_ == 0) then
if (present(prefix)) then
prefix_ = prefix
end if
else if (verbosity_ > 0) then
if (present(prefix)) then
write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': '
else
prefix_ = ""
write(prefix_,'(a,i5,a)') 'Process ',me,': '
end if
ctxt = prec%ctxt
if (allocated(prec%precv)) then
end if
call psb_info(ctxt,me,np)
if (present(root)) then
root_ = root
else
@ -121,29 +129,24 @@ subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
end if
if (root_ == -1) root_ = me
if (allocated(prec%precv)) then
if (verbosity_ >=0) then
!
! The preconditioner description is printed by processor psb_root_.
! This agrees with the fact that all the parameters defining the
! preconditioner have the same values on all the procs (this is
! ensured by amg_precbld).
!
if (me == root_) then
write(iout_,*)
write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage'
end if
nlev = size(prec%precv)
do ilev=1,nlev
call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, &
& iout=iout_,verbosity=verbosity,prefix=prefix)
& iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global)
end do
end if
end if
else
write(iout_,*) trim(name), &
& ': Error: no base preconditioner available, something is wrong!'
info = -2
return
endif
end if
9998 continue
end subroutine amg_sfile_prec_memory_use

35
amgprec/impl/amg_zfile_prec_memory_use.f90
Unescape Escape View File

@ -65,7 +65,7 @@
! 0: normal
! >1: increased details
!
subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,global)
use psb_base_mod
use amg_z_prec_mod, amg_protect_name => amg_zfile_prec_memory_use
use amg_z_inner_mod
@ -79,6 +79,7 @@ subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
! Local variables
@ -88,6 +89,7 @@ subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_memory_use'
integer(psb_ipk_) :: iout_, root_, verbosity_
logical :: global_
character(1024) :: prefix_
info = psb_success_
@ -103,17 +105,23 @@ subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
verbosity_ = 0
end if
if (verbosity_ < 0) goto 9998
ctxt = prec%ctxt
call psb_info(ctxt,me,np)
prefix_ = ""
if (verbosity_ == 0) then
if (present(prefix)) then
prefix_ = prefix
end if
else if (verbosity_ > 0) then
if (present(prefix)) then
write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': '
else
prefix_ = ""
write(prefix_,'(a,i5,a)') 'Process ',me,': '
end if
ctxt = prec%ctxt
if (allocated(prec%precv)) then
end if
call psb_info(ctxt,me,np)
if (present(root)) then
root_ = root
else
@ -121,29 +129,24 @@ subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix)
end if
if (root_ == -1) root_ = me
if (allocated(prec%precv)) then
if (verbosity_ >=0) then
!
! The preconditioner description is printed by processor psb_root_.
! This agrees with the fact that all the parameters defining the
! preconditioner have the same values on all the procs (this is
! ensured by amg_precbld).
!
if (me == root_) then
write(iout_,*)
write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage'
end if
nlev = size(prec%precv)
do ilev=1,nlev
call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, &
& iout=iout_,verbosity=verbosity,prefix=prefix)
& iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global)
end do
end if
end if
else
write(iout_,*) trim(name), &
& ': Error: no base preconditioner available, something is wrong!'
info = -2
return
endif
end if
9998 continue
end subroutine amg_zfile_prec_memory_use

48
amgprec/impl/level/amg_c_base_onelev_memory_use.f90
Unescape Escape View File

@ -42,7 +42,7 @@
! 0: normal
! >1: increased details
!
subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix)
subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix,global)
use psb_base_mod
use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_memory_use
@ -52,20 +52,25 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(in), optional :: verbosity
logical, intent(in), optional :: global
! Local variables
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: err_act ,me, np
character(len=20), parameter :: name='amg_c_base_onelev_memory_use'
integer(psb_ipk_) :: iout_, verbosity_
logical :: coarse
logical :: coarse, global_
character(1024) :: prefix_
integer(psb_epk_), allocatable :: sz(:)
call psb_erractionsave(err_act)
ctxt = lv%base_desc%get_ctxt()
call psb_info(ctxt,me,np)
coarse = (il==nl)
@ -81,6 +86,12 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
verbosity_ = 0
end if
if (verbosity_ < 0) goto 9998
if (present(global)) then
global_ = global
else
global_ = .true.
end if
if (present(prefix)) then
prefix_ = prefix
else
@ -89,19 +100,46 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
write(iout_,*) trim(prefix_)
if (global_) then
allocate(sz(6))
sz(:) = 0
sz(1) = lv%base_a%sizeof()
sz(2) = lv%base_desc%sizeof()
if (il >1) sz(3) = lv%linmap%sizeof()
if (allocated(lv%sm)) sz(4) = lv%sm%sizeof()
if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof()
if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof()
call psb_sum(ctxt,sz)
if (me == 0) then
if (coarse) then
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
else
write(iout_,*) trim(prefix_), ' Level ',il
end if
write(iout_,*) trim(prefix_), ' Matrix:', sz(1)
write(iout_,*) trim(prefix_), ' Descriptor:', sz(2)
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3)
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4)
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5)
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6)
end if
else
if ((me == 0).or.(verbosity_>0)) then
if (coarse) then
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
else
write(iout_,*) trim(prefix_), ' Level ',il
end if
write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof()
write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof()
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof()
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof()
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof()
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof()
end if
endif
9998 continue
call psb_erractionrestore(err_act)

48
amgprec/impl/level/amg_d_base_onelev_memory_use.f90
Unescape Escape View File

@ -42,7 +42,7 @@
! 0: normal
! >1: increased details
!
subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix)
subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix,global)
use psb_base_mod
use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_memory_use
@ -52,20 +52,25 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(in), optional :: verbosity
logical, intent(in), optional :: global
! Local variables
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: err_act ,me, np
character(len=20), parameter :: name='amg_d_base_onelev_memory_use'
integer(psb_ipk_) :: iout_, verbosity_
logical :: coarse
logical :: coarse, global_
character(1024) :: prefix_
integer(psb_epk_), allocatable :: sz(:)
call psb_erractionsave(err_act)
ctxt = lv%base_desc%get_ctxt()
call psb_info(ctxt,me,np)
coarse = (il==nl)
@ -81,6 +86,12 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
verbosity_ = 0
end if
if (verbosity_ < 0) goto 9998
if (present(global)) then
global_ = global
else
global_ = .true.
end if
if (present(prefix)) then
prefix_ = prefix
else
@ -89,19 +100,46 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
write(iout_,*) trim(prefix_)
if (global_) then
allocate(sz(6))
sz(:) = 0
sz(1) = lv%base_a%sizeof()
sz(2) = lv%base_desc%sizeof()
if (il >1) sz(3) = lv%linmap%sizeof()
if (allocated(lv%sm)) sz(4) = lv%sm%sizeof()
if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof()
if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof()
call psb_sum(ctxt,sz)
if (me == 0) then
if (coarse) then
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
else
write(iout_,*) trim(prefix_), ' Level ',il
end if
write(iout_,*) trim(prefix_), ' Matrix:', sz(1)
write(iout_,*) trim(prefix_), ' Descriptor:', sz(2)
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3)
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4)
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5)
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6)
end if
else
if ((me == 0).or.(verbosity_>0)) then
if (coarse) then
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
else
write(iout_,*) trim(prefix_), ' Level ',il
end if
write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof()
write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof()
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof()
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof()
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof()
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof()
end if
endif
9998 continue
call psb_erractionrestore(err_act)

48
amgprec/impl/level/amg_s_base_onelev_memory_use.f90
Unescape Escape View File

@ -42,7 +42,7 @@
! 0: normal
! >1: increased details
!
subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix)
subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix,global)
use psb_base_mod
use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_memory_use
@ -52,20 +52,25 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(in), optional :: verbosity
logical, intent(in), optional :: global
! Local variables
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: err_act ,me, np
character(len=20), parameter :: name='amg_s_base_onelev_memory_use'
integer(psb_ipk_) :: iout_, verbosity_
logical :: coarse
logical :: coarse, global_
character(1024) :: prefix_
integer(psb_epk_), allocatable :: sz(:)
call psb_erractionsave(err_act)
ctxt = lv%base_desc%get_ctxt()
call psb_info(ctxt,me,np)
coarse = (il==nl)
@ -81,6 +86,12 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
verbosity_ = 0
end if
if (verbosity_ < 0) goto 9998
if (present(global)) then
global_ = global
else
global_ = .true.
end if
if (present(prefix)) then
prefix_ = prefix
else
@ -89,19 +100,46 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
write(iout_,*) trim(prefix_)
if (global_) then
allocate(sz(6))
sz(:) = 0
sz(1) = lv%base_a%sizeof()
sz(2) = lv%base_desc%sizeof()
if (il >1) sz(3) = lv%linmap%sizeof()
if (allocated(lv%sm)) sz(4) = lv%sm%sizeof()
if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof()
if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof()
call psb_sum(ctxt,sz)
if (me == 0) then
if (coarse) then
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
else
write(iout_,*) trim(prefix_), ' Level ',il
end if
write(iout_,*) trim(prefix_), ' Matrix:', sz(1)
write(iout_,*) trim(prefix_), ' Descriptor:', sz(2)
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3)
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4)
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5)
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6)
end if
else
if ((me == 0).or.(verbosity_>0)) then
if (coarse) then
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
else
write(iout_,*) trim(prefix_), ' Level ',il
end if
write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof()
write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof()
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof()
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof()
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof()
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof()
end if
endif
9998 continue
call psb_erractionrestore(err_act)

48
amgprec/impl/level/amg_z_base_onelev_memory_use.f90
Unescape Escape View File

@ -42,7 +42,7 @@
! 0: normal
! >1: increased details
!
subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix)
subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix,global)
use psb_base_mod
use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_memory_use
@ -52,20 +52,25 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(in), optional :: verbosity
logical, intent(in), optional :: global
! Local variables
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: err_act ,me, np
character(len=20), parameter :: name='amg_z_base_onelev_memory_use'
integer(psb_ipk_) :: iout_, verbosity_
logical :: coarse
logical :: coarse, global_
character(1024) :: prefix_
integer(psb_epk_), allocatable :: sz(:)
call psb_erractionsave(err_act)
ctxt = lv%base_desc%get_ctxt()
call psb_info(ctxt,me,np)
coarse = (il==nl)
@ -81,6 +86,12 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
verbosity_ = 0
end if
if (verbosity_ < 0) goto 9998
if (present(global)) then
global_ = global
else
global_ = .true.
end if
if (present(prefix)) then
prefix_ = prefix
else
@ -89,19 +100,46 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
write(iout_,*) trim(prefix_)
if (global_) then
allocate(sz(6))
sz(:) = 0
sz(1) = lv%base_a%sizeof()
sz(2) = lv%base_desc%sizeof()
if (il >1) sz(3) = lv%linmap%sizeof()
if (allocated(lv%sm)) sz(4) = lv%sm%sizeof()
if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof()
if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof()
call psb_sum(ctxt,sz)
if (me == 0) then
if (coarse) then
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
else
write(iout_,*) trim(prefix_), ' Level ',il
end if
write(iout_,*) trim(prefix_), ' Matrix:', sz(1)
write(iout_,*) trim(prefix_), ' Descriptor:', sz(2)
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3)
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4)
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5)
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6)
end if
else
if ((me == 0).or.(verbosity_>0)) then
if (coarse) then
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
else
write(iout_,*) trim(prefix_), ' Level ',il
end if
write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof()
write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof()
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof()
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof()
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof()
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof()
end if
endif
9998 continue
call psb_erractionrestore(err_act)

114
amgprec/impl/smoother/amg_d_poly_smoother_apply_vect.f90
Unescape Escape View File

@ -55,6 +55,10 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
! Timers
logical, parameter :: do_timings=.true.
integer(psb_ipk_), save :: poly_1=-1, poly_2=-1, poly_3=-1
integer(psb_ipk_), save :: poly_mv=-1, poly_sv=-1, poly_vect=-1
!
integer(psb_ipk_) :: n_row,n_col
type(psb_d_vect_type) :: tx, ty, tz, r
@ -93,6 +97,18 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
goto 9999
end if
if ((do_timings).and.(poly_1==-1)) &
& poly_1 = psb_get_timer_idx("POLY: Chebychev4")
if ((do_timings).and.(poly_2==-1)) &
& poly_2 = psb_get_timer_idx("POLY: OptChebychev4")
if ((do_timings).and.(poly_3==-1)) &
& poly_3 = psb_get_timer_idx("POLY: OptChebychev1")
if ((do_timings).and.(poly_mv==-1)) &
& poly_mv = psb_get_timer_idx("POLY: spMV")
if ((do_timings).and.(poly_vect==-1)) &
& poly_vect = psb_get_timer_idx("POLY: Vectors")
if ((do_timings).and.(poly_sv==-1)) &
& poly_sv = psb_get_timer_idx("POLY: solver")
n_row = desc_data%get_local_rows()
n_col = desc_data%get_local_cols()
@ -125,38 +141,39 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case(sm%variant)
case(amg_poly_lottes_)
if (do_timings) call psb_tic(poly_1)
block
real(psb_dpk_) :: cz, cr
! b == x
! x == tx
!
do i=1, sm%pdegree
do i=1, sm%pdegree-1
! B r_{k-1}
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
if (do_timings) call psb_toc(poly_sv)
cz = (2*i*done-3)/(2*i*done+done)
cr = (8*i*done-4)/((2*i*done+done)*sm%rho_ba)
if (.false.) then
! z_k = cz z_{k-1} + cr ty = cz z_{k-1} + cr Br_{k-1}
call psb_geaxpby(cr,ty,cz,tz,desc_data,info)
! r_k = b-Ax_k = x -A tx
call psb_geaxpby(done,tz,done,tx,desc_data,info)
else
call psb_abgdxyz(cr,cz,done,done,ty,tz,tx,desc_data,info)
end if
if (.false.) then
call psb_geaxpby(done,x,dzero,r,desc_data,info)
call psb_spmm(-done,sm%pa,tx,done,r,desc_data,info,work=aux,trans=trans_)
else
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,done,done,ty,tz,tx,desc_data,info) ! zk = cz * zk-1 + cr * rk-1
if (do_timings) call psb_toc(poly_vect)
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(-done,sm%pa,tz,done,r,desc_data,info,work=aux,trans=trans_)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother LOTTES',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_toc(poly_mv)
end do
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
if (do_timings) call psb_toc(poly_sv)
cz = (2*sm%pdegree*done-3)/(2*sm%pdegree*done+done)
cr = (8*sm%pdegree*done-4)/((2*sm%pdegree*done+done)*sm%rho_ba)
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,done,done,ty,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
end block
if (do_timings) call psb_toc(poly_1)
case(amg_poly_lottes_beta_)
if (do_timings) call psb_tic(poly_2)
block
real(psb_dpk_) :: cz, cr
! b == x
@ -170,32 +187,30 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
sm%poly_beta(1:sm%pdegree) = amg_d_poly_beta_mat(1:sm%pdegree,sm%pdegree)
end if
do i=1, sm%pdegree
do i=1, sm%pdegree-1
! B r_{k-1}
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
cz = (2*i*done-3)/(2*i*done+done)
cr = (8*i*done-4)/((2*i*done+done)*sm%rho_ba)
if (.false.) then
! z_k = cz z_{k-1} + cr ty = cz z_{k-1} + cr Br_{k-1}
call psb_geaxpby(cr,ty,cz,tz,desc_data,info)
! r_k = b-Ax_k = x -A tx
call psb_geaxpby(sm%poly_beta(i),tz,done,tx,desc_data,info)
else
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sm%poly_beta(i),done,ty,tz,tx,desc_data,info)
end if
if (.false.) then
call psb_geaxpby(done,x,dzero,r,desc_data,info)
call psb_spmm(-done,sm%pa,tx,done,r,desc_data,info,work=aux,trans=trans_)
else
if (do_timings) call psb_toc(poly_vect)
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(-done,sm%pa,tz,done,r,desc_data,info,work=aux,trans=trans_)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother LOTTES_BETA',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_toc(poly_mv)
end do
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
cz = (2*sm%pdegree*done-3)/(2*sm%pdegree*done+done)
cr = (8*sm%pdegree*done-4)/((2*sm%pdegree*done+done)*sm%rho_ba)
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sm%poly_beta(sm%pdegree),done,ty,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
end block
if (do_timings) call psb_toc(poly_2)
case(amg_poly_new_)
if (do_timings) call psb_tic(poly_3)
block
real(psb_dpk_) :: sigma, theta, delta, rho_old, rho
! b == x
@ -206,40 +221,35 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
delta = (done-sm%cf_a)/2
sigma = theta/delta
rho_old = done/sigma
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
call psb_geaxpby((done/sm%rho_ba),ty,dzero,r,desc_data,info)
if (.false.) then
call psb_geaxpby((done/theta),r,dzero,tz,desc_data,info)
call psb_geaxpby(done,tz,done,tx,desc_data,info)
else
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz((done/theta),dzero,done,done,r,tz,tx,desc_data,info)
end if
if (do_timings) call psb_toc(poly_vect)
! tz == d
do i=1, sm%pdegree-1
!
!
! r_{k-1} = r_k - (1/rho(BA)) B A d_k
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(done,sm%pa,tz,dzero,ty,desc_data,info,work=aux,trans=trans_)
if (do_timings) call psb_toc(poly_mv)
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(-(done/sm%rho_ba),ty,done,r,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
!
! d_{k+1} = (rho rho_old) d_k + 2(rho/delta) r_{k+1}
rho = done/(2*sigma - rho_old)
if (.false.) then
call psb_geaxpby((2*rho/delta),r,(rho*rho_old),tz,desc_data,info)
call psb_geaxpby(done,tz,done,tx,desc_data,info)
else
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz((2*rho/delta),(rho*rho_old),done,done,r,tz,tx,desc_data,info)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother NEW ',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_toc(poly_vect)
rho_old = rho
end do
end block
if (do_timings) call psb_toc(poly_3)
case default
info=psb_err_internal_error_
call psb_errpush(info,name,&

114
amgprec/impl/smoother/amg_s_poly_smoother_apply_vect.f90
Unescape Escape View File

@ -55,6 +55,10 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu
! Timers
logical, parameter :: do_timings=.true.
integer(psb_ipk_), save :: poly_1=-1, poly_2=-1, poly_3=-1
integer(psb_ipk_), save :: poly_mv=-1, poly_sv=-1, poly_vect=-1
!
integer(psb_ipk_) :: n_row,n_col
type(psb_s_vect_type) :: tx, ty, tz, r
@ -93,6 +97,18 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
goto 9999
end if
if ((do_timings).and.(poly_1==-1)) &
& poly_1 = psb_get_timer_idx("POLY: Chebychev4")
if ((do_timings).and.(poly_2==-1)) &
& poly_2 = psb_get_timer_idx("POLY: OptChebychev4")
if ((do_timings).and.(poly_3==-1)) &
& poly_3 = psb_get_timer_idx("POLY: OptChebychev1")
if ((do_timings).and.(poly_mv==-1)) &
& poly_mv = psb_get_timer_idx("POLY: spMV")
if ((do_timings).and.(poly_vect==-1)) &
& poly_vect = psb_get_timer_idx("POLY: Vectors")
if ((do_timings).and.(poly_sv==-1)) &
& poly_sv = psb_get_timer_idx("POLY: solver")
n_row = desc_data%get_local_rows()
n_col = desc_data%get_local_cols()
@ -125,38 +141,39 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case(sm%variant)
case(amg_poly_lottes_)
if (do_timings) call psb_tic(poly_1)
block
real(psb_spk_) :: cz, cr
! b == x
! x == tx
!
do i=1, sm%pdegree
do i=1, sm%pdegree-1
! B r_{k-1}
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
if (do_timings) call psb_toc(poly_sv)
cz = (2*i*sone-3)/(2*i*sone+sone)
cr = (8*i*sone-4)/((2*i*sone+sone)*sm%rho_ba)
if (.false.) then
! z_k = cz z_{k-1} + cr ty = cz z_{k-1} + cr Br_{k-1}
call psb_geaxpby(cr,ty,cz,tz,desc_data,info)
! r_k = b-Ax_k = x -A tx
call psb_geaxpby(sone,tz,sone,tx,desc_data,info)
else
call psb_abgdxyz(cr,cz,sone,sone,ty,tz,tx,desc_data,info)
end if
if (.false.) then
call psb_geaxpby(sone,x,szero,r,desc_data,info)
call psb_spmm(-sone,sm%pa,tx,sone,r,desc_data,info,work=aux,trans=trans_)
else
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sone,sone,ty,tz,tx,desc_data,info) ! zk = cz * zk-1 + cr * rk-1
if (do_timings) call psb_toc(poly_vect)
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(-sone,sm%pa,tz,sone,r,desc_data,info,work=aux,trans=trans_)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother LOTTES',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_toc(poly_mv)
end do
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
if (do_timings) call psb_toc(poly_sv)
cz = (2*sm%pdegree*sone-3)/(2*sm%pdegree*sone+sone)
cr = (8*sm%pdegree*sone-4)/((2*sm%pdegree*sone+sone)*sm%rho_ba)
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sone,sone,ty,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
end block
if (do_timings) call psb_toc(poly_1)
case(amg_poly_lottes_beta_)
if (do_timings) call psb_tic(poly_2)
block
real(psb_spk_) :: cz, cr
! b == x
@ -170,32 +187,30 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
sm%poly_beta(1:sm%pdegree) = amg_d_poly_beta_mat(1:sm%pdegree,sm%pdegree)
end if
do i=1, sm%pdegree
do i=1, sm%pdegree-1
! B r_{k-1}
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
cz = (2*i*sone-3)/(2*i*sone+sone)
cr = (8*i*sone-4)/((2*i*sone+sone)*sm%rho_ba)
if (.false.) then
! z_k = cz z_{k-1} + cr ty = cz z_{k-1} + cr Br_{k-1}
call psb_geaxpby(cr,ty,cz,tz,desc_data,info)
! r_k = b-Ax_k = x -A tx
call psb_geaxpby(sm%poly_beta(i),tz,sone,tx,desc_data,info)
else
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sm%poly_beta(i),sone,ty,tz,tx,desc_data,info)
end if
if (.false.) then
call psb_geaxpby(sone,x,szero,r,desc_data,info)
call psb_spmm(-sone,sm%pa,tx,sone,r,desc_data,info,work=aux,trans=trans_)
else
if (do_timings) call psb_toc(poly_vect)
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(-sone,sm%pa,tz,sone,r,desc_data,info,work=aux,trans=trans_)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother LOTTES_BETA',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_toc(poly_mv)
end do
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
cz = (2*sm%pdegree*sone-3)/(2*sm%pdegree*sone+sone)
cr = (8*sm%pdegree*sone-4)/((2*sm%pdegree*sone+sone)*sm%rho_ba)
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sm%poly_beta(sm%pdegree),sone,ty,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
end block
if (do_timings) call psb_toc(poly_2)
case(amg_poly_new_)
if (do_timings) call psb_tic(poly_3)
block
real(psb_spk_) :: sigma, theta, delta, rho_old, rho
! b == x
@ -206,40 +221,35 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
delta = (sone-sm%cf_a)/2
sigma = theta/delta
rho_old = sone/sigma
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
call psb_geaxpby((sone/sm%rho_ba),ty,szero,r,desc_data,info)
if (.false.) then
call psb_geaxpby((sone/theta),r,szero,tz,desc_data,info)
call psb_geaxpby(sone,tz,sone,tx,desc_data,info)
else
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz((sone/theta),szero,sone,sone,r,tz,tx,desc_data,info)
end if
if (do_timings) call psb_toc(poly_vect)
! tz == d
do i=1, sm%pdegree-1
!
!
! r_{k-1} = r_k - (1/rho(BA)) B A d_k
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(sone,sm%pa,tz,szero,ty,desc_data,info,work=aux,trans=trans_)
if (do_timings) call psb_toc(poly_mv)
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(-(sone/sm%rho_ba),ty,sone,r,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
!
! d_{k+1} = (rho rho_old) d_k + 2(rho/delta) r_{k+1}
rho = sone/(2*sigma - rho_old)
if (.false.) then
call psb_geaxpby((2*rho/delta),r,(rho*rho_old),tz,desc_data,info)
call psb_geaxpby(sone,tz,sone,tx,desc_data,info)
else
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz((2*rho/delta),(rho*rho_old),sone,sone,r,tz,tx,desc_data,info)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother NEW ',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_toc(poly_vect)
rho_old = rho
end do
end block
if (do_timings) call psb_toc(poly_3)
case default
info=psb_err_internal_error_
call psb_errpush(info,name,&

Write Preview
Loading…
Cancel
Save