From 3671285c7a402dc578f04c5c3ca8087a16f412a6 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 16 Mar 2024 13:15:35 +0100 Subject: [PATCH 1/8] Modified memory_use impl with GLOBAL and VERBOSITY --- amgprec/amg_c_onelev_mod.f90 | 4 +- amgprec/amg_c_prec_type.f90 | 3 +- amgprec/amg_d_onelev_mod.f90 | 4 +- amgprec/amg_d_prec_type.f90 | 3 +- amgprec/amg_s_onelev_mod.f90 | 4 +- amgprec/amg_s_prec_type.f90 | 3 +- amgprec/amg_z_onelev_mod.f90 | 4 +- amgprec/amg_z_prec_type.f90 | 3 +- amgprec/impl/amg_cfile_prec_memory_use.f90 | 57 +++++++++----- amgprec/impl/amg_dfile_prec_memory_use.f90 | 57 +++++++++----- amgprec/impl/amg_sfile_prec_memory_use.f90 | 57 +++++++++----- amgprec/impl/amg_zfile_prec_memory_use.f90 | 57 +++++++++----- .../level/amg_c_base_onelev_memory_use.f90 | 76 ++++++++++++------- .../level/amg_d_base_onelev_memory_use.f90 | 76 ++++++++++++------- .../level/amg_s_base_onelev_memory_use.f90 | 76 ++++++++++++------- .../level/amg_z_base_onelev_memory_use.f90 | 76 ++++++++++++------- 16 files changed, 364 insertions(+), 196 deletions(-) diff --git a/amgprec/amg_c_onelev_mod.f90 b/amgprec/amg_c_onelev_mod.f90 index 3a980ff3..f5411e45 100644 --- a/amgprec/amg_c_onelev_mod.f90 +++ b/amgprec/amg_c_onelev_mod.f90 @@ -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, 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 @@ -285,8 +285,8 @@ module amg_c_onelev_mod 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 + logical, intent(in), optional :: global end subroutine amg_c_base_onelev_memory_use end interface diff --git a/amgprec/amg_c_prec_type.f90 b/amgprec/amg_c_prec_type.f90 index 1afdad53..2ce58807 100644 --- a/amgprec/amg_c_prec_type.f90 +++ b/amgprec/amg_c_prec_type.f90 @@ -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 diff --git a/amgprec/amg_d_onelev_mod.f90 b/amgprec/amg_d_onelev_mod.f90 index 3f21a2a6..f7e7f678 100644 --- a/amgprec/amg_d_onelev_mod.f90 +++ b/amgprec/amg_d_onelev_mod.f90 @@ -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, 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 @@ -286,8 +286,8 @@ module amg_d_onelev_mod 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 + logical, intent(in), optional :: global end subroutine amg_d_base_onelev_memory_use end interface diff --git a/amgprec/amg_d_prec_type.f90 b/amgprec/amg_d_prec_type.f90 index 90f5a2a8..e2c48cc2 100644 --- a/amgprec/amg_d_prec_type.f90 +++ b/amgprec/amg_d_prec_type.f90 @@ -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 diff --git a/amgprec/amg_s_onelev_mod.f90 b/amgprec/amg_s_onelev_mod.f90 index 9019c643..d6651396 100644 --- a/amgprec/amg_s_onelev_mod.f90 +++ b/amgprec/amg_s_onelev_mod.f90 @@ -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, 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 @@ -286,8 +286,8 @@ module amg_s_onelev_mod 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 + logical, intent(in), optional :: global end subroutine amg_s_base_onelev_memory_use end interface diff --git a/amgprec/amg_s_prec_type.f90 b/amgprec/amg_s_prec_type.f90 index 246e763c..e64703bc 100644 --- a/amgprec/amg_s_prec_type.f90 +++ b/amgprec/amg_s_prec_type.f90 @@ -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 diff --git a/amgprec/amg_z_onelev_mod.f90 b/amgprec/amg_z_onelev_mod.f90 index 538ea9fa..16d59e44 100644 --- a/amgprec/amg_z_onelev_mod.f90 +++ b/amgprec/amg_z_onelev_mod.f90 @@ -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, 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 @@ -285,8 +285,8 @@ module amg_z_onelev_mod 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 + logical, intent(in), optional :: global end subroutine amg_z_base_onelev_memory_use end interface diff --git a/amgprec/amg_z_prec_type.f90 b/amgprec/amg_z_prec_type.f90 index 1d1addc6..adeecf23 100644 --- a/amgprec/amg_z_prec_type.f90 +++ b/amgprec/amg_z_prec_type.f90 @@ -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 diff --git a/amgprec/impl/amg_cfile_prec_memory_use.f90 b/amgprec/impl/amg_cfile_prec_memory_use.f90 index b71cefe2..d92539f1 100644 --- a/amgprec/impl/amg_cfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_cfile_prec_memory_use.f90 @@ -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,24 @@ subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if - + 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 + write(prefix_,'(a,i5,a)') 'Process ',me,': ' + end if + + end if if (allocated(prec%precv)) then - call psb_info(ctxt,me,np) if (present(root)) then root_ = root else @@ -122,23 +131,31 @@ subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me 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 + if (verbosity_ == 0) then + ! + if (me == root_) then - write(iout_,*) - write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' + write(iout_,*) + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' + nlev = size(prec%precv) + do ilev=1,nlev + call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & + & iout=iout_,prefix=trim(prefix_),global=global) + end do + end if + else if (verbosity_ >0) then + + 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_,prefix=trim(prefix_),global=global) end do end if - end if + else write(iout_,*) trim(name), & & ': Error: no base preconditioner available, something is wrong!' diff --git a/amgprec/impl/amg_dfile_prec_memory_use.f90 b/amgprec/impl/amg_dfile_prec_memory_use.f90 index 9eb63c8b..20878ad0 100644 --- a/amgprec/impl/amg_dfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_dfile_prec_memory_use.f90 @@ -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,24 @@ subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if - + 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 + write(prefix_,'(a,i5,a)') 'Process ',me,': ' + end if + + end if if (allocated(prec%precv)) then - call psb_info(ctxt,me,np) if (present(root)) then root_ = root else @@ -122,23 +131,31 @@ subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me 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 + if (verbosity_ == 0) then + ! + if (me == root_) then - write(iout_,*) - write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' + write(iout_,*) + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' + nlev = size(prec%precv) + do ilev=1,nlev + call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & + & iout=iout_,prefix=trim(prefix_),global=global) + end do + end if + else if (verbosity_ >0) then + + 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_,prefix=trim(prefix_),global=global) end do end if - end if + else write(iout_,*) trim(name), & & ': Error: no base preconditioner available, something is wrong!' diff --git a/amgprec/impl/amg_sfile_prec_memory_use.f90 b/amgprec/impl/amg_sfile_prec_memory_use.f90 index 49373233..9a0622ce 100644 --- a/amgprec/impl/amg_sfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_sfile_prec_memory_use.f90 @@ -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,24 @@ subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if - + 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 + write(prefix_,'(a,i5,a)') 'Process ',me,': ' + end if + + end if if (allocated(prec%precv)) then - call psb_info(ctxt,me,np) if (present(root)) then root_ = root else @@ -122,23 +131,31 @@ subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me 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 + if (verbosity_ == 0) then + ! + if (me == root_) then - write(iout_,*) - write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' + write(iout_,*) + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' + nlev = size(prec%precv) + do ilev=1,nlev + call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & + & iout=iout_,prefix=trim(prefix_),global=global) + end do + end if + else if (verbosity_ >0) then + + 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_,prefix=trim(prefix_),global=global) end do end if - end if + else write(iout_,*) trim(name), & & ': Error: no base preconditioner available, something is wrong!' diff --git a/amgprec/impl/amg_zfile_prec_memory_use.f90 b/amgprec/impl/amg_zfile_prec_memory_use.f90 index 3657e9a5..c36635b4 100644 --- a/amgprec/impl/amg_zfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_zfile_prec_memory_use.f90 @@ -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,24 @@ subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if - + 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 + write(prefix_,'(a,i5,a)') 'Process ',me,': ' + end if + + end if if (allocated(prec%precv)) then - call psb_info(ctxt,me,np) if (present(root)) then root_ = root else @@ -122,23 +131,31 @@ subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me 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 + if (verbosity_ == 0) then + ! + if (me == root_) then - write(iout_,*) - write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' + write(iout_,*) + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' + nlev = size(prec%precv) + do ilev=1,nlev + call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & + & iout=iout_,prefix=trim(prefix_),global=global) + end do + end if + else if (verbosity_ >0) then + + 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_,prefix=trim(prefix_),global=global) end do end if - end if + else write(iout_,*) trim(name), & & ': Error: no base preconditioner available, something is wrong!' diff --git a/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 index 517c3892..5163a95a 100644 --- a/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 @@ -42,8 +42,8 @@ ! 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,prefix,global) + use psb_base_mod use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_memory_use Implicit None @@ -52,21 +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 + 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 + integer(psb_ipk_) :: iout_ + 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) if (present(iout)) then @@ -74,34 +78,54 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi else iout_ = psb_out_unit end if - - if (present(verbosity)) then - verbosity_ = verbosity + + if (present(global)) then + global_ = global else - verbosity_ = 0 + global_ = .false. + end if + + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" end if - if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if write(iout_,*) trim(prefix_) - + 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() - + + 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 + 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 + 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() + endif 9998 continue call psb_erractionrestore(err_act) diff --git a/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 index d339d3a9..d2103de2 100644 --- a/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 @@ -42,8 +42,8 @@ ! 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,prefix,global) + use psb_base_mod use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_memory_use Implicit None @@ -52,21 +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 + 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 + integer(psb_ipk_) :: iout_ + 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) if (present(iout)) then @@ -74,34 +78,54 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi else iout_ = psb_out_unit end if - - if (present(verbosity)) then - verbosity_ = verbosity + + if (present(global)) then + global_ = global else - verbosity_ = 0 + global_ = .false. + end if + + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" end if - if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if write(iout_,*) trim(prefix_) - + 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() - + + 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 + 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 + 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() + endif 9998 continue call psb_erractionrestore(err_act) diff --git a/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 index a8c130e6..759bdf1e 100644 --- a/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 @@ -42,8 +42,8 @@ ! 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,prefix,global) + use psb_base_mod use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_memory_use Implicit None @@ -52,21 +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 + 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 + integer(psb_ipk_) :: iout_ + 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) if (present(iout)) then @@ -74,34 +78,54 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi else iout_ = psb_out_unit end if - - if (present(verbosity)) then - verbosity_ = verbosity + + if (present(global)) then + global_ = global else - verbosity_ = 0 + global_ = .false. + end if + + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" end if - if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if write(iout_,*) trim(prefix_) - + 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() - + + 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 + 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 + 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() + endif 9998 continue call psb_erractionrestore(err_act) diff --git a/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 index db73ac0b..bb157814 100644 --- a/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 @@ -42,8 +42,8 @@ ! 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,prefix,global) + use psb_base_mod use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_memory_use Implicit None @@ -52,21 +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 + 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 + integer(psb_ipk_) :: iout_ + 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) if (present(iout)) then @@ -74,34 +78,54 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi else iout_ = psb_out_unit end if - - if (present(verbosity)) then - verbosity_ = verbosity + + if (present(global)) then + global_ = global else - verbosity_ = 0 + global_ = .false. + end if + + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" end if - if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if write(iout_,*) trim(prefix_) - + 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() - + + 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 + 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 + 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() + endif 9998 continue call psb_erractionrestore(err_act) From 678237cf29996dc8b896356b1b7d28553d1455e4 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 16 Mar 2024 13:31:47 +0100 Subject: [PATCH 2/8] Fixed implementation of GLOBAL vs VERBOSITY --- amgprec/amg_c_onelev_mod.f90 | 3 +- amgprec/amg_d_onelev_mod.f90 | 3 +- amgprec/amg_s_onelev_mod.f90 | 3 +- amgprec/amg_z_onelev_mod.f90 | 3 +- amgprec/impl/amg_cfile_prec_memory_use.f90 | 66 ++++++++----------- amgprec/impl/amg_dfile_prec_memory_use.f90 | 66 ++++++++----------- amgprec/impl/amg_sfile_prec_memory_use.f90 | 66 ++++++++----------- amgprec/impl/amg_zfile_prec_memory_use.f90 | 66 ++++++++----------- .../level/amg_c_base_onelev_memory_use.f90 | 25 ++++--- .../level/amg_d_base_onelev_memory_use.f90 | 25 ++++--- .../level/amg_s_base_onelev_memory_use.f90 | 25 ++++--- .../level/amg_z_base_onelev_memory_use.f90 | 25 ++++--- 12 files changed, 180 insertions(+), 196 deletions(-) diff --git a/amgprec/amg_c_onelev_mod.f90 b/amgprec/amg_c_onelev_mod.f90 index f5411e45..d926e2bf 100644 --- a/amgprec/amg_c_onelev_mod.f90 +++ b/amgprec/amg_c_onelev_mod.f90 @@ -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, prefix,global) + 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 @@ -285,6 +285,7 @@ module amg_c_onelev_mod 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 logical, intent(in), optional :: global end subroutine amg_c_base_onelev_memory_use diff --git a/amgprec/amg_d_onelev_mod.f90 b/amgprec/amg_d_onelev_mod.f90 index f7e7f678..51c482cb 100644 --- a/amgprec/amg_d_onelev_mod.f90 +++ b/amgprec/amg_d_onelev_mod.f90 @@ -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, prefix,global) + 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 @@ -286,6 +286,7 @@ module amg_d_onelev_mod 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 logical, intent(in), optional :: global end subroutine amg_d_base_onelev_memory_use diff --git a/amgprec/amg_s_onelev_mod.f90 b/amgprec/amg_s_onelev_mod.f90 index d6651396..f11b64ca 100644 --- a/amgprec/amg_s_onelev_mod.f90 +++ b/amgprec/amg_s_onelev_mod.f90 @@ -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, prefix,global) + 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 @@ -286,6 +286,7 @@ module amg_s_onelev_mod 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 logical, intent(in), optional :: global end subroutine amg_s_base_onelev_memory_use diff --git a/amgprec/amg_z_onelev_mod.f90 b/amgprec/amg_z_onelev_mod.f90 index 16d59e44..fffe88c0 100644 --- a/amgprec/amg_z_onelev_mod.f90 +++ b/amgprec/amg_z_onelev_mod.f90 @@ -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, prefix,global) + 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 @@ -285,6 +285,7 @@ module amg_z_onelev_mod 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 logical, intent(in), optional :: global end subroutine amg_z_base_onelev_memory_use diff --git a/amgprec/impl/amg_cfile_prec_memory_use.f90 b/amgprec/impl/amg_cfile_prec_memory_use.f90 index d92539f1..922f4087 100644 --- a/amgprec/impl/amg_cfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_cfile_prec_memory_use.f90 @@ -105,7 +105,7 @@ subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - + ctxt = prec%ctxt call psb_info(ctxt,me,np) prefix_ = "" @@ -119,48 +119,34 @@ subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa else write(prefix_,'(a,i5,a)') 'Process ',me,': ' end if - - end if - if (allocated(prec%precv)) then - if (present(root)) then - root_ = root - else - root_ = psb_root_ - end if - if (root_ == -1) root_ = me + end if + + if (present(root)) then + root_ = root + else + root_ = psb_root_ + end if + if (root_ == -1) root_ = me + if (allocated(prec%precv)) then if (verbosity_ >=0) then - if (verbosity_ == 0) then - ! - if (me == root_) then - - write(iout_,*) - write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' - nlev = size(prec%precv) - do ilev=1,nlev - call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & - & iout=iout_,prefix=trim(prefix_),global=global) - end do - end if - else if (verbosity_ >0) then - - 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_,prefix=trim(prefix_),global=global) - end do + if (me == root_) then + write(iout_,*) + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' end if - - else - write(iout_,*) trim(name), & - & ': Error: no base preconditioner available, something is wrong!' - info = -2 - return - endif + nlev = size(prec%precv) + do ilev=1,nlev + call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & + & iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global) + end do + + 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 diff --git a/amgprec/impl/amg_dfile_prec_memory_use.f90 b/amgprec/impl/amg_dfile_prec_memory_use.f90 index 20878ad0..9423498f 100644 --- a/amgprec/impl/amg_dfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_dfile_prec_memory_use.f90 @@ -105,7 +105,7 @@ subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - + ctxt = prec%ctxt call psb_info(ctxt,me,np) prefix_ = "" @@ -119,48 +119,34 @@ subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa else write(prefix_,'(a,i5,a)') 'Process ',me,': ' end if - - end if - if (allocated(prec%precv)) then - if (present(root)) then - root_ = root - else - root_ = psb_root_ - end if - if (root_ == -1) root_ = me + end if + + if (present(root)) then + root_ = root + else + root_ = psb_root_ + end if + if (root_ == -1) root_ = me + if (allocated(prec%precv)) then if (verbosity_ >=0) then - if (verbosity_ == 0) then - ! - if (me == root_) then - - write(iout_,*) - write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' - nlev = size(prec%precv) - do ilev=1,nlev - call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & - & iout=iout_,prefix=trim(prefix_),global=global) - end do - end if - else if (verbosity_ >0) then - - 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_,prefix=trim(prefix_),global=global) - end do + if (me == root_) then + write(iout_,*) + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' end if - - else - write(iout_,*) trim(name), & - & ': Error: no base preconditioner available, something is wrong!' - info = -2 - return - endif + nlev = size(prec%precv) + do ilev=1,nlev + call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & + & iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global) + end do + + 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 diff --git a/amgprec/impl/amg_sfile_prec_memory_use.f90 b/amgprec/impl/amg_sfile_prec_memory_use.f90 index 9a0622ce..ea776c2b 100644 --- a/amgprec/impl/amg_sfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_sfile_prec_memory_use.f90 @@ -105,7 +105,7 @@ subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - + ctxt = prec%ctxt call psb_info(ctxt,me,np) prefix_ = "" @@ -119,48 +119,34 @@ subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa else write(prefix_,'(a,i5,a)') 'Process ',me,': ' end if - - end if - if (allocated(prec%precv)) then - if (present(root)) then - root_ = root - else - root_ = psb_root_ - end if - if (root_ == -1) root_ = me + end if + + if (present(root)) then + root_ = root + else + root_ = psb_root_ + end if + if (root_ == -1) root_ = me + if (allocated(prec%precv)) then if (verbosity_ >=0) then - if (verbosity_ == 0) then - ! - if (me == root_) then - - write(iout_,*) - write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' - nlev = size(prec%precv) - do ilev=1,nlev - call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & - & iout=iout_,prefix=trim(prefix_),global=global) - end do - end if - else if (verbosity_ >0) then - - 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_,prefix=trim(prefix_),global=global) - end do + if (me == root_) then + write(iout_,*) + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' end if - - else - write(iout_,*) trim(name), & - & ': Error: no base preconditioner available, something is wrong!' - info = -2 - return - endif + nlev = size(prec%precv) + do ilev=1,nlev + call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & + & iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global) + end do + + 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 diff --git a/amgprec/impl/amg_zfile_prec_memory_use.f90 b/amgprec/impl/amg_zfile_prec_memory_use.f90 index c36635b4..e54b13ad 100644 --- a/amgprec/impl/amg_zfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_zfile_prec_memory_use.f90 @@ -105,7 +105,7 @@ subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - + ctxt = prec%ctxt call psb_info(ctxt,me,np) prefix_ = "" @@ -119,48 +119,34 @@ subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa else write(prefix_,'(a,i5,a)') 'Process ',me,': ' end if - - end if - if (allocated(prec%precv)) then - if (present(root)) then - root_ = root - else - root_ = psb_root_ - end if - if (root_ == -1) root_ = me + end if + + if (present(root)) then + root_ = root + else + root_ = psb_root_ + end if + if (root_ == -1) root_ = me + if (allocated(prec%precv)) then if (verbosity_ >=0) then - if (verbosity_ == 0) then - ! - if (me == root_) then - - write(iout_,*) - write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' - nlev = size(prec%precv) - do ilev=1,nlev - call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & - & iout=iout_,prefix=trim(prefix_),global=global) - end do - end if - else if (verbosity_ >0) then - - 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_,prefix=trim(prefix_),global=global) - end do + if (me == root_) then + write(iout_,*) + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' end if - - else - write(iout_,*) trim(name), & - & ': Error: no base preconditioner available, something is wrong!' - info = -2 - return - endif + nlev = size(prec%precv) + do ilev=1,nlev + call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & + & iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global) + end do + + 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 diff --git a/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 index 5163a95a..9cfc369e 100644 --- a/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) +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 @@ -53,6 +53,7 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout character(len=*), intent(in), optional :: prefix + integer(psb_ipk_), intent(in), optional :: verbosity logical, intent(in), optional :: global @@ -60,7 +61,7 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) 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_ + integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse, global_ character(1024) :: prefix_ integer(psb_epk_), allocatable :: sz(:) @@ -79,6 +80,12 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) iout_ = psb_out_unit end if + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 if (present(global)) then global_ = global else @@ -119,12 +126,14 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) end if else - 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() + if ((me == 0).or.(verbosity_>0)) then + 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 diff --git a/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 index d2103de2..1e9bb9a9 100644 --- a/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) +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 @@ -53,6 +53,7 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout character(len=*), intent(in), optional :: prefix + integer(psb_ipk_), intent(in), optional :: verbosity logical, intent(in), optional :: global @@ -60,7 +61,7 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) 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_ + integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse, global_ character(1024) :: prefix_ integer(psb_epk_), allocatable :: sz(:) @@ -79,6 +80,12 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) iout_ = psb_out_unit end if + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 if (present(global)) then global_ = global else @@ -119,12 +126,14 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) end if else - 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() + if ((me == 0).or.(verbosity_>0)) then + 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 diff --git a/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 index 759bdf1e..53be7406 100644 --- a/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) +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 @@ -53,6 +53,7 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout character(len=*), intent(in), optional :: prefix + integer(psb_ipk_), intent(in), optional :: verbosity logical, intent(in), optional :: global @@ -60,7 +61,7 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) 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_ + integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse, global_ character(1024) :: prefix_ integer(psb_epk_), allocatable :: sz(:) @@ -79,6 +80,12 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) iout_ = psb_out_unit end if + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 if (present(global)) then global_ = global else @@ -119,12 +126,14 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) end if else - 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() + if ((me == 0).or.(verbosity_>0)) then + 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 diff --git a/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 index bb157814..cf9ddcbe 100644 --- a/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) +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 @@ -53,6 +53,7 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout character(len=*), intent(in), optional :: prefix + integer(psb_ipk_), intent(in), optional :: verbosity logical, intent(in), optional :: global @@ -60,7 +61,7 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) 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_ + integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse, global_ character(1024) :: prefix_ integer(psb_epk_), allocatable :: sz(:) @@ -79,6 +80,12 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) iout_ = psb_out_unit end if + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 if (present(global)) then global_ = global else @@ -119,12 +126,14 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,prefix,global) end if else - 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() + if ((me == 0).or.(verbosity_>0)) then + 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 From af3fda96906816a3684dbbc63a4f218361e7881b Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 16 Mar 2024 14:26:19 +0100 Subject: [PATCH 3/8] Additional output fixes for memory_use --- amgprec/impl/amg_cfile_prec_memory_use.f90 | 4 ++-- amgprec/impl/amg_dfile_prec_memory_use.f90 | 4 ++-- amgprec/impl/amg_sfile_prec_memory_use.f90 | 4 ++-- amgprec/impl/amg_zfile_prec_memory_use.f90 | 4 ++-- .../impl/level/amg_c_base_onelev_memory_use.f90 | 15 ++++++++++----- .../impl/level/amg_d_base_onelev_memory_use.f90 | 15 ++++++++++----- .../impl/level/amg_s_base_onelev_memory_use.f90 | 15 ++++++++++----- .../impl/level/amg_z_base_onelev_memory_use.f90 | 15 ++++++++++----- 8 files changed, 48 insertions(+), 28 deletions(-) diff --git a/amgprec/impl/amg_cfile_prec_memory_use.f90 b/amgprec/impl/amg_cfile_prec_memory_use.f90 index 922f4087..c578358c 100644 --- a/amgprec/impl/amg_cfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_cfile_prec_memory_use.f90 @@ -109,11 +109,11 @@ subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa ctxt = prec%ctxt call psb_info(ctxt,me,np) prefix_ = "" - if (verbosity == 0) then + if (verbosity_ == 0) then if (present(prefix)) then prefix_ = prefix end if - else if (verbosity > 0) then + else if (verbosity_ > 0) then if (present(prefix)) then write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': ' else diff --git a/amgprec/impl/amg_dfile_prec_memory_use.f90 b/amgprec/impl/amg_dfile_prec_memory_use.f90 index 9423498f..d10cd5f3 100644 --- a/amgprec/impl/amg_dfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_dfile_prec_memory_use.f90 @@ -109,11 +109,11 @@ subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa ctxt = prec%ctxt call psb_info(ctxt,me,np) prefix_ = "" - if (verbosity == 0) then + if (verbosity_ == 0) then if (present(prefix)) then prefix_ = prefix end if - else if (verbosity > 0) then + else if (verbosity_ > 0) then if (present(prefix)) then write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': ' else diff --git a/amgprec/impl/amg_sfile_prec_memory_use.f90 b/amgprec/impl/amg_sfile_prec_memory_use.f90 index ea776c2b..bde5412a 100644 --- a/amgprec/impl/amg_sfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_sfile_prec_memory_use.f90 @@ -109,11 +109,11 @@ subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa ctxt = prec%ctxt call psb_info(ctxt,me,np) prefix_ = "" - if (verbosity == 0) then + if (verbosity_ == 0) then if (present(prefix)) then prefix_ = prefix end if - else if (verbosity > 0) then + else if (verbosity_ > 0) then if (present(prefix)) then write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': ' else diff --git a/amgprec/impl/amg_zfile_prec_memory_use.f90 b/amgprec/impl/amg_zfile_prec_memory_use.f90 index e54b13ad..145ce044 100644 --- a/amgprec/impl/amg_zfile_prec_memory_use.f90 +++ b/amgprec/impl/amg_zfile_prec_memory_use.f90 @@ -109,11 +109,11 @@ subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,globa ctxt = prec%ctxt call psb_info(ctxt,me,np) prefix_ = "" - if (verbosity == 0) then + if (verbosity_ == 0) then if (present(prefix)) then prefix_ = prefix end if - else if (verbosity > 0) then + else if (verbosity_ > 0) then if (present(prefix)) then write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': ' else diff --git a/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 index 9cfc369e..f4147bb3 100644 --- a/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 @@ -100,11 +100,6 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi write(iout_,*) trim(prefix_) - if (coarse) then - write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' - else - write(iout_,*) trim(prefix_), ' Level ',il - end if if (global_) then allocate(sz(6)) @@ -117,6 +112,11 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi 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) @@ -127,6 +127,11 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi 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() diff --git a/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 index 1e9bb9a9..0a5e2066 100644 --- a/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 @@ -100,11 +100,6 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi write(iout_,*) trim(prefix_) - if (coarse) then - write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' - else - write(iout_,*) trim(prefix_), ' Level ',il - end if if (global_) then allocate(sz(6)) @@ -117,6 +112,11 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi 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) @@ -127,6 +127,11 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi 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() diff --git a/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 index 53be7406..f59d8dd9 100644 --- a/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 @@ -100,11 +100,6 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi write(iout_,*) trim(prefix_) - if (coarse) then - write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' - else - write(iout_,*) trim(prefix_), ' Level ',il - end if if (global_) then allocate(sz(6)) @@ -117,6 +112,11 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi 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) @@ -127,6 +127,11 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi 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() diff --git a/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 index cf9ddcbe..4c1e3432 100644 --- a/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 @@ -100,11 +100,6 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi write(iout_,*) trim(prefix_) - if (coarse) then - write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' - else - write(iout_,*) trim(prefix_), ' Level ',il - end if if (global_) then allocate(sz(6)) @@ -117,6 +112,11 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi 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) @@ -127,6 +127,11 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi 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() From 83d435b49e36df11961cc58453e4f69db7b03ad6 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 16 Mar 2024 15:22:24 +0100 Subject: [PATCH 4/8] Default GLOBAL=.true. for MEMORY_USE --- amgprec/impl/level/amg_c_base_onelev_memory_use.f90 | 2 +- amgprec/impl/level/amg_d_base_onelev_memory_use.f90 | 2 +- amgprec/impl/level/amg_s_base_onelev_memory_use.f90 | 2 +- amgprec/impl/level/amg_z_base_onelev_memory_use.f90 | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 index f4147bb3..4b58000d 100644 --- a/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_c_base_onelev_memory_use.f90 @@ -89,7 +89,7 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi if (present(global)) then global_ = global else - global_ = .false. + global_ = .true. end if if (present(prefix)) then diff --git a/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 index 0a5e2066..25534fd0 100644 --- a/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_d_base_onelev_memory_use.f90 @@ -89,7 +89,7 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi if (present(global)) then global_ = global else - global_ = .false. + global_ = .true. end if if (present(prefix)) then diff --git a/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 index f59d8dd9..9709ba3e 100644 --- a/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_s_base_onelev_memory_use.f90 @@ -89,7 +89,7 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi if (present(global)) then global_ = global else - global_ = .false. + global_ = .true. end if if (present(prefix)) then diff --git a/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 b/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 index 4c1e3432..0e12a6bc 100644 --- a/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 +++ b/amgprec/impl/level/amg_z_base_onelev_memory_use.f90 @@ -89,7 +89,7 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi if (present(global)) then global_ = global else - global_ = .false. + global_ = .true. end if if (present(prefix)) then From e83bde6896431443f2d9f89c9ef1fbf0522996eb Mon Sep 17 00:00:00 2001 From: sfilippone Date: Wed, 17 Apr 2024 14:45:20 +0200 Subject: [PATCH 5/8] New timings --- amgprec/amg_base_prec_type.F90 | 3 + amgprec/amg_d_matchboxp_mod.f90 | 6 +- .../amg_d_parmatch_aggregator_tprol.F90 | 2 +- .../amg_d_parmatch_spmm_bld_inner.F90 | 2 +- amgprec/impl/aggregator/amg_d_ptap_bld.f90 | 2 +- .../impl/aggregator/amg_d_soc2_map_bld.F90 | 2 +- amgprec/impl/amg_dmlprec_aply.f90 | 34 +++++++++- .../amg_d_poly_smoother_apply_vect.f90 | 66 ++++++++++++++++++- .../impl/smoother/amg_d_poly_smoother_bld.f90 | 6 +- .../smoother/amg_d_poly_smoother_cseti.f90 | 2 +- 10 files changed, 112 insertions(+), 13 deletions(-) diff --git a/amgprec/amg_base_prec_type.F90 b/amgprec/amg_base_prec_type.F90 index 3434d675..60aacaec 100644 --- a/amgprec/amg_base_prec_type.F90 +++ b/amgprec/amg_base_prec_type.F90 @@ -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') diff --git a/amgprec/amg_d_matchboxp_mod.f90 b/amgprec/amg_d_matchboxp_mod.f90 index e19ce617..8b9c3bb6 100644 --- a/amgprec/amg_d_matchboxp_mod.f90 +++ b/amgprec/amg_d_matchboxp_mod.f90 @@ -145,7 +145,7 @@ contains logical, parameter :: dump=.false., debug=.false., dump_mate=.false., & & debug_ilaggr=.false., debug_sync=.false., debug_mate=.false. integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 - logical, parameter :: do_timings=.true. + logical, parameter :: do_timings=.false. integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2 ictxt = desc_a%get_ctxt() @@ -608,7 +608,7 @@ contains logical, parameter :: old_style=.false., sort_minp=.true. character(len=40) :: name='build_matching', fname integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1 - logical, parameter :: do_timings=.true. + logical, parameter :: do_timings=.false. ictxt = desc_a%get_ctxt() call psb_info(ictxt,iam,np) @@ -810,7 +810,7 @@ contains character(len=80) :: aname real(psb_dpk_), parameter :: eps=epsilon(1.d0) integer(psb_ipk_), save :: idx_glbt=-1, idx_phase1=-1, idx_phase2=-1 - logical, parameter :: do_timings=.true. + logical, parameter :: do_timings=.false. logical, parameter :: debug_symmetry = .false., check_size=.false. logical, parameter :: unroll_logtrans=.false. diff --git a/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 b/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 index f23869b7..3187aa70 100644 --- a/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 +++ b/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 @@ -88,7 +88,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,& type(psb_ldspmat_type) :: tmp_prol, tmp_pg, tmp_restr type(psb_desc_type) :: tmp_desc_ac, tmp_desc_ax, tmp_desc_p integer(psb_ipk_), save :: idx_mboxp=-1, idx_spmmbld=-1, idx_sweeps_mult=-1 - logical, parameter :: dump=.false., do_timings=.true., debug=.false., & + logical, parameter :: dump=.false., do_timings=.false., debug=.false., & & dump_prol_restr=.false. name='d_parmatch_tprol' diff --git a/amgprec/impl/aggregator/amg_d_parmatch_spmm_bld_inner.F90 b/amgprec/impl/aggregator/amg_d_parmatch_spmm_bld_inner.F90 index 04d89b2f..aa60fe20 100644 --- a/amgprec/impl/aggregator/amg_d_parmatch_spmm_bld_inner.F90 +++ b/amgprec/impl/aggregator/amg_d_parmatch_spmm_bld_inner.F90 @@ -131,7 +131,7 @@ subroutine amg_d_parmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,& & nzt, naggrm1, naggrp1, i, k integer(psb_lpk_), allocatable :: ia(:),ja(:) !integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave - logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. + logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false. integer(psb_ipk_), save :: idx_spspmm=-1, idx_prolcnv=-1, idx_proltrans=-1, idx_asb=-1 name='amg_parmatch_spmm_bld_inner' diff --git a/amgprec/impl/aggregator/amg_d_ptap_bld.f90 b/amgprec/impl/aggregator/amg_d_ptap_bld.f90 index 4006c04c..4ca7d444 100644 --- a/amgprec/impl/aggregator/amg_d_ptap_bld.f90 +++ b/amgprec/impl/aggregator/amg_d_ptap_bld.f90 @@ -486,7 +486,7 @@ subroutine amg_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nrl, nzl, ip, & & nzt, naggrm1, naggrp1, i, k integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza - logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. + logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false. integer(psb_ipk_), save :: idx_spspmm=-1 name='amg_ptap_bld' diff --git a/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 b/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 index 345cd1ad..82972fda 100644 --- a/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 @@ -104,7 +104,7 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in character(len=20) :: name, ch_err integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1 integer(psb_ipk_), save :: idx_soc2_p0=-1 - logical, parameter :: do_timings=.true. + logical, parameter :: do_timings=.false. info=psb_success_ name = 'amg_soc2_map_bld' diff --git a/amgprec/impl/amg_dmlprec_aply.f90 b/amgprec/impl/amg_dmlprec_aply.f90 index 983fb937..33a64c31 100644 --- a/amgprec/impl/amg_dmlprec_aply.f90 +++ b/amgprec/impl/amg_dmlprec_aply.f90 @@ -591,6 +591,8 @@ contains integer(psb_ipk_) :: nlev, ilev, sweeps logical :: pre, post character(len=20) :: name + logical, parameter :: do_timings=.true. + integer(psb_ipk_), save :: ml_mlt_smth=-1, ml_mlt_rp=-1, ml_mlt_rsd=-1 name = 'inner_inner_mult' info = psb_success_ @@ -608,6 +610,12 @@ contains if(debug_level > 1) then write(debug_unit,*) me,' inner_mult at level ',level end if + if ((do_timings).and.(ml_mlt_smth==-1)) & + & ml_mlt_smth = psb_get_timer_idx("ML-MLT: smoother ") + if ((do_timings).and.(ml_mlt_rp==-1)) & + & ml_mlt_rp = psb_get_timer_idx("ML-MLT: RestProl") + if ((do_timings).and.(ml_mlt_rsd==-1)) & + & ml_mlt_rsd = psb_get_timer_idx("ML-MLT: Residual") sweeps_post = p%precv(level)%parms%sweeps_post sweeps_pre = p%precv(level)%parms%sweeps_pre @@ -623,7 +631,7 @@ contains ! Apply the first smoother ! The residual has been prepared before the recursive call. ! - + if (do_timings) call psb_tic(ml_mlt_smth) if (pre) then if (me >=0) then !!$ write(0,*) me,'Applying smoother pre ', level @@ -646,10 +654,13 @@ contains end if end if endif + if (do_timings) call psb_toc(ml_mlt_smth) + ! ! Compute the residual for next level and call recursively ! if (pre) then + if (do_timings) call psb_tic(ml_mlt_rsd) call psb_geaxpby(done,vx2l,& & dzero,vty,& & base_desc,info) @@ -657,6 +668,9 @@ contains if (info == psb_success_) call psb_spmm(-done,base_a,& & vy2l,done,vty,& & base_desc,info,work=work,trans=trans) + if (do_timings) call psb_toc(ml_mlt_rsd) + if (do_timings) call psb_tic(ml_mlt_rp) + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Error during residue') @@ -671,7 +685,9 @@ contains & a_err='Error during restriction') goto 9999 end if + if (do_timings) call psb_toc(ml_mlt_rp) else + if (do_timings) call psb_tic(ml_mlt_rp) ! Shortcut: just transfer x2l. call p%precv(level+1)%map_rstr(done,vx2l,& & dzero,p%precv(level+1)%wrk%vx2l,& @@ -682,6 +698,7 @@ contains & a_err='Error during restriction') goto 9999 end if + if (do_timings) call psb_toc(ml_mlt_rp) endif call inner_ml_aply(level+1,p,trans,work,info) @@ -689,10 +706,12 @@ contains ! ! Apply the prolongator ! + if (do_timings) call psb_tic(ml_mlt_rp) call p%precv(level+1)%map_prol(done,& & p%precv(level+1)%wrk%vy2l,done,vy2l,& & info,work=work,& & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) + if (do_timings) call psb_toc(ml_mlt_rp) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Error during prolongation') @@ -700,7 +719,7 @@ contains end if if (p%precv(level)%parms%ml_cycle == amg_wcycle_ml_) then - + if (do_timings) call psb_tic(ml_mlt_rsd) if (me >=0) then call psb_geaxpby(done,vx2l, dzero,vty,& & base_desc,info) @@ -708,10 +727,13 @@ contains & vy2l,done,vty,& & base_desc,info,work=work,trans=trans) end if + if (do_timings) call psb_toc(ml_mlt_rsd) + if (do_timings) call psb_tic(ml_mlt_rp) if (info == psb_success_) & & call p%precv(level+1)%map_rstr(done,vty,& & dzero,p%precv(level+1)%wrk%vx2l,info,work=work,& & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) + if (do_timings) call psb_toc(ml_mlt_rp) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Error during W-cycle restriction') @@ -720,10 +742,12 @@ contains call inner_ml_aply(level+1,p,trans,work,info) + if (do_timings) call psb_tic(ml_mlt_rp) if (info == psb_success_) call p%precv(level+1)%map_prol(done, & & p%precv(level+1)%wrk%vy2l,done,vy2l,& & info,work=work,& & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) + if (do_timings) call psb_toc(ml_mlt_rp) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& @@ -736,6 +760,7 @@ contains if (post) then if (me >=0) then + if (do_timings) call psb_tic(ml_mlt_rsd) call psb_geaxpby(done,vx2l,& & dzero,vty,& & base_desc,info) @@ -747,7 +772,9 @@ contains & a_err='Error during residue') goto 9999 end if + if (do_timings) call psb_toc(ml_mlt_rsd) + if (do_timings) call psb_tic(ml_mlt_smth) ! ! Apply the second smoother ! @@ -762,6 +789,7 @@ contains & vty,done,vy2l, base_desc, trans,& & sweeps,work,wv,info,init='Z') end if + if (do_timings) call psb_toc(ml_mlt_smth) end if if (info /= psb_success_) then @@ -774,12 +802,14 @@ contains else if (level == nlev) then !!$ write(0,*) me,'Applying smoother at top level ',psb_errstatus_fatal() + if (do_timings) call psb_tic(ml_mlt_smth) if (me >=0) then sweeps = p%precv(level)%parms%sweeps_pre if (info == psb_success_) call p%precv(level)%sm%apply(done,& & vx2l,dzero,vy2l,base_desc, trans,& & sweeps,work,wv,info) end if + if (do_timings) call psb_toc(ml_mlt_smth) !!$ write(0,*) me,' Done applying smoother at top level ',psb_errstatus_fatal() else diff --git a/amgprec/impl/smoother/amg_d_poly_smoother_apply_vect.f90 b/amgprec/impl/smoother/amg_d_poly_smoother_apply_vect.f90 index 32926bd6..ac89c523 100644 --- a/amgprec/impl/smoother/amg_d_poly_smoother_apply_vect.f90 +++ b/amgprec/impl/smoother/amg_d_poly_smoother_apply_vect.f90 @@ -64,6 +64,9 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& character :: trans_, init_ real(psb_dpk_) :: res, resdenum character(len=20) :: name='d_poly_smoother_apply_v' + 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 call psb_erractionsave(err_act) @@ -93,6 +96,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,6 +140,7 @@ 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 @@ -154,8 +170,10 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& ! x_k = x_{k-1} + z_k end do 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 @@ -194,34 +212,51 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& ! x_k = x_{k-1} + z_k end do 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 ! x == tx ! - + sm%rho_ba = 1.12d0 + !write(0,*) 'Parameter: ',sm%cf_a,sm%rho_ba + theta = (done+sm%cf_a)/2 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) + if (do_timings) call psb_tic(poly_vect) call psb_geaxpby((done/sm%rho_ba),ty,dzero,r,desc_data,info) + !write(0,*) 'POLY_NEW Iteration',0,' :',psb_genrm2(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 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) + if (do_timings) call psb_tic(poly_vect) + + !write(0,*) 'POLY_NEW Iteration',i,' :',psb_genrm2(r,desc_data,info) ! ! d_{k+1} = (rho rho_old) d_k + 2(rho/delta) r_{k+1} @@ -236,9 +271,36 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& !!$ write(0,*) 'Polynomial smoother NEW ',i,res ! x_k = x_{k-1} + z_k rho_old = rho + if (do_timings) call psb_toc(poly_vect) + end do + end block + if (do_timings) call psb_toc(poly_3) + + case(amg_poly_dbg_) + block + real(psb_dpk_) :: sigma, theta, delta, rho_old, rho + ! b == x + ! x == tx + ! + write(0,*) 'Parameter: ',sm%cf_a + theta = (done+sm%cf_a)/2 + delta = (done-sm%cf_a)/2 + sigma = theta/delta + rho_old = done/sigma + call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') + call psb_geaxpby(done,ty,dzero,r,desc_data,info) + call psb_geaxpby(done/theta,r,dzero,tz,desc_data,info) + write(0,*) 'POLY_DBG Iteration',0,' :',psb_genrm2(r,desc_data,info) + do i=1, sm%pdegree + call psb_geaxpby(done,tz,done,tx,desc_data,info) + call psb_spmm(done,sm%pa,tz,dzero,ty,desc_data,info,work=aux,trans=trans_) + call sm%sv%apply(-(done),ty,done,r,desc_data,trans_,aux,wv(5:),info,init='Z') + write(0,*) 'POLY_DBG Iteration',i,' :',psb_genrm2(r,desc_data,info) + rho = done/(2*sigma - rho_old) + call psb_geaxpby((2*rho/delta),r,rho*rho_old,tz,desc_data,info) + rho_old = rho end do end block - case default info=psb_err_internal_error_ diff --git a/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 b/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 index dd156912..77b1aa3d 100644 --- a/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 +++ b/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 @@ -87,10 +87,14 @@ subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) & a_err='invalid sm%degree for poly_beta') goto 9999 end if - case(amg_poly_new_) + case(amg_poly_new_, amg_poly_dbg_) if ((1<=sm%pdegree).and.(sm%pdegree<=30)) then !Ok +!!$ write(0,*) 'Vector: ' +!!$ do i=1,size(amg_d_poly_a_vect) +!!$ write(0,*) i,amg_d_poly_a_vect(i) +!!$ end do sm%cf_a = amg_d_poly_a_vect(sm%pdegree) else info = psb_err_internal_error_ diff --git a/amgprec/impl/smoother/amg_d_poly_smoother_cseti.f90 b/amgprec/impl/smoother/amg_d_poly_smoother_cseti.f90 index 916fb5e6..5d8d1169 100644 --- a/amgprec/impl/smoother/amg_d_poly_smoother_cseti.f90 +++ b/amgprec/impl/smoother/amg_d_poly_smoother_cseti.f90 @@ -58,7 +58,7 @@ subroutine amg_d_poly_smoother_cseti(sm,what,val,info,idx) sm%pdegree = val case('POLY_VARIANT') select case(val) - case(amg_poly_lottes_,amg_poly_lottes_beta_,amg_poly_new_) + case(amg_poly_lottes_,amg_poly_lottes_beta_,amg_poly_new_,amg_poly_dbg_) sm%variant = val case default write(0,*) 'Invalid choice for POLY_VARIANT, defaulting to amg_poly_lottes_',val From 74dccb6c44c916bd7df9256aeda40914b6843829 Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Mon, 22 Apr 2024 07:52:14 +0000 Subject: [PATCH 6/8] Added timers and removed unuseful spmm --- amgprec/amg_d_matchboxp_mod.f90 | 6 +- .../amg_d_parmatch_aggregator_tprol.F90 | 2 +- .../amg_d_parmatch_spmm_bld_inner.F90 | 2 +- amgprec/impl/aggregator/amg_d_ptap_bld.f90 | 2 +- .../impl/aggregator/amg_d_soc2_map_bld.F90 | 2 +- amgprec/impl/amg_dmlprec_aply.f90 | 34 +---- .../amg_d_poly_smoother_apply_vect.f90 | 144 ++++++------------ .../impl/smoother/amg_d_poly_smoother_bld.f90 | 6 +- .../smoother/amg_d_poly_smoother_cseti.f90 | 2 +- .../amg_s_poly_smoother_apply_vect.f90 | 130 ++++++++-------- 10 files changed, 127 insertions(+), 203 deletions(-) diff --git a/amgprec/amg_d_matchboxp_mod.f90 b/amgprec/amg_d_matchboxp_mod.f90 index 8b9c3bb6..e19ce617 100644 --- a/amgprec/amg_d_matchboxp_mod.f90 +++ b/amgprec/amg_d_matchboxp_mod.f90 @@ -145,7 +145,7 @@ contains logical, parameter :: dump=.false., debug=.false., dump_mate=.false., & & debug_ilaggr=.false., debug_sync=.false., debug_mate=.false. integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 - logical, parameter :: do_timings=.false. + logical, parameter :: do_timings=.true. integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2 ictxt = desc_a%get_ctxt() @@ -608,7 +608,7 @@ contains logical, parameter :: old_style=.false., sort_minp=.true. character(len=40) :: name='build_matching', fname integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1 - logical, parameter :: do_timings=.false. + logical, parameter :: do_timings=.true. ictxt = desc_a%get_ctxt() call psb_info(ictxt,iam,np) @@ -810,7 +810,7 @@ contains character(len=80) :: aname real(psb_dpk_), parameter :: eps=epsilon(1.d0) integer(psb_ipk_), save :: idx_glbt=-1, idx_phase1=-1, idx_phase2=-1 - logical, parameter :: do_timings=.false. + logical, parameter :: do_timings=.true. logical, parameter :: debug_symmetry = .false., check_size=.false. logical, parameter :: unroll_logtrans=.false. diff --git a/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 b/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 index 3187aa70..f23869b7 100644 --- a/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 +++ b/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 @@ -88,7 +88,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,& type(psb_ldspmat_type) :: tmp_prol, tmp_pg, tmp_restr type(psb_desc_type) :: tmp_desc_ac, tmp_desc_ax, tmp_desc_p integer(psb_ipk_), save :: idx_mboxp=-1, idx_spmmbld=-1, idx_sweeps_mult=-1 - logical, parameter :: dump=.false., do_timings=.false., debug=.false., & + logical, parameter :: dump=.false., do_timings=.true., debug=.false., & & dump_prol_restr=.false. name='d_parmatch_tprol' diff --git a/amgprec/impl/aggregator/amg_d_parmatch_spmm_bld_inner.F90 b/amgprec/impl/aggregator/amg_d_parmatch_spmm_bld_inner.F90 index aa60fe20..04d89b2f 100644 --- a/amgprec/impl/aggregator/amg_d_parmatch_spmm_bld_inner.F90 +++ b/amgprec/impl/aggregator/amg_d_parmatch_spmm_bld_inner.F90 @@ -131,7 +131,7 @@ subroutine amg_d_parmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,& & nzt, naggrm1, naggrp1, i, k integer(psb_lpk_), allocatable :: ia(:),ja(:) !integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave - logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false. + logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. integer(psb_ipk_), save :: idx_spspmm=-1, idx_prolcnv=-1, idx_proltrans=-1, idx_asb=-1 name='amg_parmatch_spmm_bld_inner' diff --git a/amgprec/impl/aggregator/amg_d_ptap_bld.f90 b/amgprec/impl/aggregator/amg_d_ptap_bld.f90 index 4ca7d444..4006c04c 100644 --- a/amgprec/impl/aggregator/amg_d_ptap_bld.f90 +++ b/amgprec/impl/aggregator/amg_d_ptap_bld.f90 @@ -486,7 +486,7 @@ subroutine amg_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nrl, nzl, ip, & & nzt, naggrm1, naggrp1, i, k integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza - logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false. + logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. integer(psb_ipk_), save :: idx_spspmm=-1 name='amg_ptap_bld' diff --git a/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 b/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 index 82972fda..345cd1ad 100644 --- a/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 @@ -104,7 +104,7 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in character(len=20) :: name, ch_err integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1 integer(psb_ipk_), save :: idx_soc2_p0=-1 - logical, parameter :: do_timings=.false. + logical, parameter :: do_timings=.true. info=psb_success_ name = 'amg_soc2_map_bld' diff --git a/amgprec/impl/amg_dmlprec_aply.f90 b/amgprec/impl/amg_dmlprec_aply.f90 index 33a64c31..983fb937 100644 --- a/amgprec/impl/amg_dmlprec_aply.f90 +++ b/amgprec/impl/amg_dmlprec_aply.f90 @@ -591,8 +591,6 @@ contains integer(psb_ipk_) :: nlev, ilev, sweeps logical :: pre, post character(len=20) :: name - logical, parameter :: do_timings=.true. - integer(psb_ipk_), save :: ml_mlt_smth=-1, ml_mlt_rp=-1, ml_mlt_rsd=-1 name = 'inner_inner_mult' info = psb_success_ @@ -610,12 +608,6 @@ contains if(debug_level > 1) then write(debug_unit,*) me,' inner_mult at level ',level end if - if ((do_timings).and.(ml_mlt_smth==-1)) & - & ml_mlt_smth = psb_get_timer_idx("ML-MLT: smoother ") - if ((do_timings).and.(ml_mlt_rp==-1)) & - & ml_mlt_rp = psb_get_timer_idx("ML-MLT: RestProl") - if ((do_timings).and.(ml_mlt_rsd==-1)) & - & ml_mlt_rsd = psb_get_timer_idx("ML-MLT: Residual") sweeps_post = p%precv(level)%parms%sweeps_post sweeps_pre = p%precv(level)%parms%sweeps_pre @@ -631,7 +623,7 @@ contains ! Apply the first smoother ! The residual has been prepared before the recursive call. ! - if (do_timings) call psb_tic(ml_mlt_smth) + if (pre) then if (me >=0) then !!$ write(0,*) me,'Applying smoother pre ', level @@ -654,13 +646,10 @@ contains end if end if endif - if (do_timings) call psb_toc(ml_mlt_smth) - ! ! Compute the residual for next level and call recursively ! if (pre) then - if (do_timings) call psb_tic(ml_mlt_rsd) call psb_geaxpby(done,vx2l,& & dzero,vty,& & base_desc,info) @@ -668,9 +657,6 @@ contains if (info == psb_success_) call psb_spmm(-done,base_a,& & vy2l,done,vty,& & base_desc,info,work=work,trans=trans) - if (do_timings) call psb_toc(ml_mlt_rsd) - if (do_timings) call psb_tic(ml_mlt_rp) - if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Error during residue') @@ -685,9 +671,7 @@ contains & a_err='Error during restriction') goto 9999 end if - if (do_timings) call psb_toc(ml_mlt_rp) else - if (do_timings) call psb_tic(ml_mlt_rp) ! Shortcut: just transfer x2l. call p%precv(level+1)%map_rstr(done,vx2l,& & dzero,p%precv(level+1)%wrk%vx2l,& @@ -698,7 +682,6 @@ contains & a_err='Error during restriction') goto 9999 end if - if (do_timings) call psb_toc(ml_mlt_rp) endif call inner_ml_aply(level+1,p,trans,work,info) @@ -706,12 +689,10 @@ contains ! ! Apply the prolongator ! - if (do_timings) call psb_tic(ml_mlt_rp) call p%precv(level+1)%map_prol(done,& & p%precv(level+1)%wrk%vy2l,done,vy2l,& & info,work=work,& & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) - if (do_timings) call psb_toc(ml_mlt_rp) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Error during prolongation') @@ -719,7 +700,7 @@ contains end if if (p%precv(level)%parms%ml_cycle == amg_wcycle_ml_) then - if (do_timings) call psb_tic(ml_mlt_rsd) + if (me >=0) then call psb_geaxpby(done,vx2l, dzero,vty,& & base_desc,info) @@ -727,13 +708,10 @@ contains & vy2l,done,vty,& & base_desc,info,work=work,trans=trans) end if - if (do_timings) call psb_toc(ml_mlt_rsd) - if (do_timings) call psb_tic(ml_mlt_rp) if (info == psb_success_) & & call p%precv(level+1)%map_rstr(done,vty,& & dzero,p%precv(level+1)%wrk%vx2l,info,work=work,& & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) - if (do_timings) call psb_toc(ml_mlt_rp) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Error during W-cycle restriction') @@ -742,12 +720,10 @@ contains call inner_ml_aply(level+1,p,trans,work,info) - if (do_timings) call psb_tic(ml_mlt_rp) if (info == psb_success_) call p%precv(level+1)%map_prol(done, & & p%precv(level+1)%wrk%vy2l,done,vy2l,& & info,work=work,& & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) - if (do_timings) call psb_toc(ml_mlt_rp) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& @@ -760,7 +736,6 @@ contains if (post) then if (me >=0) then - if (do_timings) call psb_tic(ml_mlt_rsd) call psb_geaxpby(done,vx2l,& & dzero,vty,& & base_desc,info) @@ -772,9 +747,7 @@ contains & a_err='Error during residue') goto 9999 end if - if (do_timings) call psb_toc(ml_mlt_rsd) - if (do_timings) call psb_tic(ml_mlt_smth) ! ! Apply the second smoother ! @@ -789,7 +762,6 @@ contains & vty,done,vy2l, base_desc, trans,& & sweeps,work,wv,info,init='Z') end if - if (do_timings) call psb_toc(ml_mlt_smth) end if if (info /= psb_success_) then @@ -802,14 +774,12 @@ contains else if (level == nlev) then !!$ write(0,*) me,'Applying smoother at top level ',psb_errstatus_fatal() - if (do_timings) call psb_tic(ml_mlt_smth) if (me >=0) then sweeps = p%precv(level)%parms%sweeps_pre if (info == psb_success_) call p%precv(level)%sm%apply(done,& & vx2l,dzero,vy2l,base_desc, trans,& & sweeps,work,wv,info) end if - if (do_timings) call psb_toc(ml_mlt_smth) !!$ write(0,*) me,' Done applying smoother at top level ',psb_errstatus_fatal() else diff --git a/amgprec/impl/smoother/amg_d_poly_smoother_apply_vect.f90 b/amgprec/impl/smoother/amg_d_poly_smoother_apply_vect.f90 index ac89c523..3c181841 100644 --- a/amgprec/impl/smoother/amg_d_poly_smoother_apply_vect.f90 +++ b/amgprec/impl/smoother/amg_d_poly_smoother_apply_vect.f90 @@ -36,7 +36,7 @@ ! ! subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& - & sweeps,work,wv,info,init,initu) + & sweeps,work,wv,info,init,initu) use psb_base_mod use amg_d_diag_solver @@ -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 @@ -64,9 +68,6 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& character :: trans_, init_ real(psb_dpk_) :: res, resdenum character(len=20) :: name='d_poly_smoother_apply_v' - 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 call psb_erractionsave(err_act) @@ -95,7 +96,7 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& call psb_errpush(info,name) 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)) & @@ -146,35 +147,33 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& ! 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 - 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_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_) + 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 @@ -188,43 +187,36 @@ 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 - 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 - 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_tic(poly_vect) + call psb_abgdxyz(cr,cz,sm%poly_beta(i),done,ty,tz,tx,desc_data,info) + 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_) + 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 ! x == tx ! - sm%rho_ba = 1.12d0 - !write(0,*) 'Parameter: ',sm%cf_a,sm%rho_ba - + theta = (done+sm%cf_a)/2 delta = (done-sm%cf_a)/2 sigma = theta/delta @@ -232,21 +224,15 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& 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) - if (do_timings) call psb_tic(poly_vect) call psb_geaxpby((done/sm%rho_ba),ty,dzero,r,desc_data,info) - !write(0,*) 'POLY_NEW Iteration',0,' :',psb_genrm2(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 - call psb_abgdxyz((done/theta),dzero,done,done,r,tz,tx,desc_data,info) - end if + if (do_timings) call psb_tic(poly_vect) + call psb_abgdxyz((done/theta),dzero,done,done,r,tz,tx,desc_data,info) 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_) @@ -254,54 +240,16 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& 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) - if (do_timings) call psb_tic(poly_vect) - - !write(0,*) 'POLY_NEW Iteration',i,' :',psb_genrm2(r,desc_data,info) - ! ! 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 - 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 - rho_old = rho + 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) if (do_timings) call psb_toc(poly_vect) - end do - end block - if (do_timings) call psb_toc(poly_3) - - case(amg_poly_dbg_) - block - real(psb_dpk_) :: sigma, theta, delta, rho_old, rho - ! b == x - ! x == tx - ! - write(0,*) 'Parameter: ',sm%cf_a - theta = (done+sm%cf_a)/2 - delta = (done-sm%cf_a)/2 - sigma = theta/delta - rho_old = done/sigma - call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') - call psb_geaxpby(done,ty,dzero,r,desc_data,info) - call psb_geaxpby(done/theta,r,dzero,tz,desc_data,info) - write(0,*) 'POLY_DBG Iteration',0,' :',psb_genrm2(r,desc_data,info) - do i=1, sm%pdegree - call psb_geaxpby(done,tz,done,tx,desc_data,info) - call psb_spmm(done,sm%pa,tz,dzero,ty,desc_data,info,work=aux,trans=trans_) - call sm%sv%apply(-(done),ty,done,r,desc_data,trans_,aux,wv(5:),info,init='Z') - write(0,*) 'POLY_DBG Iteration',i,' :',psb_genrm2(r,desc_data,info) - rho = done/(2*sigma - rho_old) - call psb_geaxpby((2*rho/delta),r,rho*rho_old,tz,desc_data,info) 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,& diff --git a/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 b/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 index 77b1aa3d..dd156912 100644 --- a/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 +++ b/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 @@ -87,14 +87,10 @@ subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) & a_err='invalid sm%degree for poly_beta') goto 9999 end if - case(amg_poly_new_, amg_poly_dbg_) + case(amg_poly_new_) if ((1<=sm%pdegree).and.(sm%pdegree<=30)) then !Ok -!!$ write(0,*) 'Vector: ' -!!$ do i=1,size(amg_d_poly_a_vect) -!!$ write(0,*) i,amg_d_poly_a_vect(i) -!!$ end do sm%cf_a = amg_d_poly_a_vect(sm%pdegree) else info = psb_err_internal_error_ diff --git a/amgprec/impl/smoother/amg_d_poly_smoother_cseti.f90 b/amgprec/impl/smoother/amg_d_poly_smoother_cseti.f90 index 5d8d1169..916fb5e6 100644 --- a/amgprec/impl/smoother/amg_d_poly_smoother_cseti.f90 +++ b/amgprec/impl/smoother/amg_d_poly_smoother_cseti.f90 @@ -58,7 +58,7 @@ subroutine amg_d_poly_smoother_cseti(sm,what,val,info,idx) sm%pdegree = val case('POLY_VARIANT') select case(val) - case(amg_poly_lottes_,amg_poly_lottes_beta_,amg_poly_new_,amg_poly_dbg_) + case(amg_poly_lottes_,amg_poly_lottes_beta_,amg_poly_new_) sm%variant = val case default write(0,*) 'Invalid choice for POLY_VARIANT, defaulting to amg_poly_lottes_',val diff --git a/amgprec/impl/smoother/amg_s_poly_smoother_apply_vect.f90 b/amgprec/impl/smoother/amg_s_poly_smoother_apply_vect.f90 index fca259ff..de05bedb 100644 --- a/amgprec/impl/smoother/amg_s_poly_smoother_apply_vect.f90 +++ b/amgprec/impl/smoother/amg_s_poly_smoother_apply_vect.f90 @@ -36,7 +36,7 @@ ! ! subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& - & sweeps,work,wv,info,init,initu) + & sweeps,work,wv,info,init,initu) use psb_base_mod use amg_s_diag_solver @@ -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 @@ -92,7 +96,19 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& call psb_errpush(info,name) 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 - 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_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_) + 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 - 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 - 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_tic(poly_vect) + call psb_abgdxyz(cr,cz,sm%poly_beta(i),sone,ty,tz,tx,desc_data,info) + 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_) + 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 - call psb_abgdxyz((sone/theta),szero,sone,sone,r,tz,tx,desc_data,info) - end if + if (do_timings) call psb_tic(poly_vect) + call psb_abgdxyz((sone/theta),szero,sone,sone,r,tz,tx,desc_data,info) + 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 - 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_tic(poly_vect) + call psb_abgdxyz((2*rho/delta),(rho*rho_old),sone,sone,r,tz,tx,desc_data,info) + 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,& From a17f503486f6c1c00aea684132c74f89cf227ebb Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Fri, 26 Apr 2024 10:54:43 +0000 Subject: [PATCH 7/8] First hardcoded implementation of l1 smooth aggregation --- .../impl/aggregator/amg_daggrmat_smth_bld.f90 | 37 +++++++++++++++---- 1 file changed, 29 insertions(+), 8 deletions(-) diff --git a/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 b/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 index d365bf27..2b9b1ea7 100644 --- a/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 +++ b/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 @@ -112,11 +112,11 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& implicit none ! Arguments - type(psb_dspmat_type), intent(in) :: a + type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(amg_dml_parms), intent(inout) :: parms - type(psb_dspmat_type), intent(inout) :: op_prol,ac,op_restr + type(amg_dml_parms), intent(inout) :: parms + type(psb_dspmat_type), intent(inout) :: op_prol,ac,op_restr type(psb_ldspmat_type), intent(inout) :: t_prol type(psb_desc_type), intent(inout) :: desc_ac integer(psb_ipk_), intent(out) :: info @@ -132,7 +132,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& type(psb_d_coo_sparse_mat) :: coo_prol, coo_restr type(psb_d_csr_sparse_mat) :: acsr1, acsrf, csr_prol, acsr real(psb_dpk_), allocatable :: adiag(:) - real(psb_dpk_), allocatable :: arwsum(:) + real(psb_dpk_), allocatable :: arwsum(:),l1rwsum(:) integer(psb_ipk_) :: ierr(5) logical :: filter_mat integer(psb_ipk_) :: debug_level, debug_unit, err_act @@ -141,6 +141,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& logical, parameter :: debug_new=.false. character(len=80) :: filename logical, parameter :: do_timings=.false. + logical, parameter :: do_l1correction=.true. integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1 integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1 @@ -200,6 +201,21 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& if (info == psb_success_) & & call psb_halo(adiag,desc_a,info) if (info == psb_success_) call a%cp_to(acsr) + ! Get the l1-diagonal of D + if (do_l1correction) then + allocate(l1rwsum(nrow)) + call acsr%arwsum(l1rwsum) + if (info == psb_success_) & + & call psb_realloc(ncol,l1rwsum,info) + if (info == psb_success_) & + & call psb_halo(l1rwsum,desc_a,info) + ! \tilde{D}_{i,i} = \sum_{j \ne i} |a_{i,j}| + !$OMP parallel do private(i) schedule(static) + do i=1,size(adiag) + adiag(i) = adiag(i) + l1rwsum(i) - abs(adiag(i)) + end do + !$OMP end parallel do + end if if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag') @@ -230,7 +246,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& enddo if (jd == -1) then - write(0,*) 'Wrong input: we need the diagonal!!!!', i + if (.not.do_l1correction) write(0,*) 'Wrong input: we need the diagonal!!!!', i else acsrf%val(jd)=acsrf%val(jd)-tmp end if @@ -240,7 +256,6 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call acsrf%clean_zeros(info) end if - !$OMP parallel do private(i) schedule(static) do i=1,size(adiag) if (adiag(i) /= dzero) then @@ -249,7 +264,8 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& adiag(i) = done end if end do - !$OMP end parallel do + !$OMP end parallel do + if (parms%aggr_omega_alg == amg_eig_est_) then if (parms%aggr_eig == amg_max_norm_) then @@ -259,7 +275,9 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call psb_amx(ctxt,anorm) omega = 4.d0/(3.d0*anorm) parms%aggr_omega_val = omega - + else if (do_l1correction) then + ! For l1-Jacobi this can be estimated with 1 + parms%aggr_omega_val = done else info = psb_err_internal_error_ call psb_errpush(info,name,a_err='invalid amg_aggr_eig_') @@ -323,6 +341,9 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& & write(debug_unit,*) me,' ',trim(name),& & 'Done smooth_aggregate ' call psb_erractionrestore(err_act) + + if (allocated(l1rwsum)) deallocate(l1rwsum) + if (allocated(arwsum)) deallocate(arwsum) return 9999 continue From 5790aa0cbd5aa5235bbae6742f30f738ff77b687 Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Fri, 26 Apr 2024 10:55:47 +0000 Subject: [PATCH 8/8] Revert "First hardcoded implementation of l1 smooth aggregation" This reverts commit a17f503486f6c1c00aea684132c74f89cf227ebb. --- .../impl/aggregator/amg_daggrmat_smth_bld.f90 | 37 ++++--------------- 1 file changed, 8 insertions(+), 29 deletions(-) diff --git a/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 b/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 index 2b9b1ea7..d365bf27 100644 --- a/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 +++ b/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 @@ -112,11 +112,11 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& implicit none ! Arguments - type(psb_dspmat_type), intent(in) :: a + type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(amg_dml_parms), intent(inout) :: parms - type(psb_dspmat_type), intent(inout) :: op_prol,ac,op_restr + type(amg_dml_parms), intent(inout) :: parms + type(psb_dspmat_type), intent(inout) :: op_prol,ac,op_restr type(psb_ldspmat_type), intent(inout) :: t_prol type(psb_desc_type), intent(inout) :: desc_ac integer(psb_ipk_), intent(out) :: info @@ -132,7 +132,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& type(psb_d_coo_sparse_mat) :: coo_prol, coo_restr type(psb_d_csr_sparse_mat) :: acsr1, acsrf, csr_prol, acsr real(psb_dpk_), allocatable :: adiag(:) - real(psb_dpk_), allocatable :: arwsum(:),l1rwsum(:) + real(psb_dpk_), allocatable :: arwsum(:) integer(psb_ipk_) :: ierr(5) logical :: filter_mat integer(psb_ipk_) :: debug_level, debug_unit, err_act @@ -141,7 +141,6 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& logical, parameter :: debug_new=.false. character(len=80) :: filename logical, parameter :: do_timings=.false. - logical, parameter :: do_l1correction=.true. integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1 integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1 @@ -201,21 +200,6 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& if (info == psb_success_) & & call psb_halo(adiag,desc_a,info) if (info == psb_success_) call a%cp_to(acsr) - ! Get the l1-diagonal of D - if (do_l1correction) then - allocate(l1rwsum(nrow)) - call acsr%arwsum(l1rwsum) - if (info == psb_success_) & - & call psb_realloc(ncol,l1rwsum,info) - if (info == psb_success_) & - & call psb_halo(l1rwsum,desc_a,info) - ! \tilde{D}_{i,i} = \sum_{j \ne i} |a_{i,j}| - !$OMP parallel do private(i) schedule(static) - do i=1,size(adiag) - adiag(i) = adiag(i) + l1rwsum(i) - abs(adiag(i)) - end do - !$OMP end parallel do - end if if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag') @@ -246,7 +230,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& enddo if (jd == -1) then - if (.not.do_l1correction) write(0,*) 'Wrong input: we need the diagonal!!!!', i + write(0,*) 'Wrong input: we need the diagonal!!!!', i else acsrf%val(jd)=acsrf%val(jd)-tmp end if @@ -256,6 +240,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call acsrf%clean_zeros(info) end if + !$OMP parallel do private(i) schedule(static) do i=1,size(adiag) if (adiag(i) /= dzero) then @@ -264,8 +249,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& adiag(i) = done end if end do - !$OMP end parallel do - + !$OMP end parallel do if (parms%aggr_omega_alg == amg_eig_est_) then if (parms%aggr_eig == amg_max_norm_) then @@ -275,9 +259,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call psb_amx(ctxt,anorm) omega = 4.d0/(3.d0*anorm) parms%aggr_omega_val = omega - else if (do_l1correction) then - ! For l1-Jacobi this can be estimated with 1 - parms%aggr_omega_val = done + else info = psb_err_internal_error_ call psb_errpush(info,name,a_err='invalid amg_aggr_eig_') @@ -341,9 +323,6 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& & write(debug_unit,*) me,' ',trim(name),& & 'Done smooth_aggregate ' call psb_erractionrestore(err_act) - - if (allocated(l1rwsum)) deallocate(l1rwsum) - if (allocated(arwsum)) deallocate(arwsum) return 9999 continue