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_c_onelev_mod.f90 b/amgprec/amg_c_onelev_mod.f90 index 3a980ff3..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, verbosity,prefix) + subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & psb_clinmap_type, psb_spk_, amg_c_onelev_type, & & psb_ipk_, psb_epk_, psb_desc_type @@ -287,6 +287,7 @@ module amg_c_onelev_mod integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: verbosity character(len=*), intent(in), optional :: prefix + logical, intent(in), optional :: global end subroutine amg_c_base_onelev_memory_use end interface 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..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, verbosity,prefix) + subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, & & psb_ipk_, psb_epk_, psb_desc_type @@ -288,6 +288,7 @@ module amg_d_onelev_mod integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: verbosity character(len=*), intent(in), optional :: prefix + logical, intent(in), optional :: global end subroutine amg_d_base_onelev_memory_use end interface 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..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, verbosity,prefix) + subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & psb_slinmap_type, psb_spk_, amg_s_onelev_type, & & psb_ipk_, psb_epk_, psb_desc_type @@ -288,6 +288,7 @@ module amg_s_onelev_mod integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: verbosity character(len=*), intent(in), optional :: prefix + logical, intent(in), optional :: global end subroutine amg_s_base_onelev_memory_use end interface 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..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, verbosity,prefix) + subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, & & psb_ipk_, psb_epk_, psb_desc_type @@ -287,6 +287,7 @@ module amg_z_onelev_mod integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: verbosity character(len=*), intent(in), optional :: prefix + logical, intent(in), optional :: global end subroutine amg_z_base_onelev_memory_use end interface 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..c578358c 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,47 +105,48 @@ 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 - - if (allocated(prec%precv)) then - - call psb_info(ctxt,me,np) - if (present(root)) then - root_ = root + 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 - root_ = psb_root_ + write(prefix_,'(a,i5,a)') 'Process ',me,': ' 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 - ! - ! The preconditioner description is printed by processor psb_root_. - ! This agrees with the fact that all the parameters defining the - ! preconditioner have the same values on all the procs (this is - ! ensured by amg_precbld). - ! if (me == root_) then - write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' - nlev = size(prec%precv) - do ilev=1,nlev - call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & - & iout=iout_,verbosity=verbosity,prefix=prefix) - end do end if - 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 9eb63c8b..d10cd5f3 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,47 +105,48 @@ 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 - - if (allocated(prec%precv)) then - - call psb_info(ctxt,me,np) - if (present(root)) then - root_ = root + 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 - root_ = psb_root_ + write(prefix_,'(a,i5,a)') 'Process ',me,': ' 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 - ! - ! The preconditioner description is printed by processor psb_root_. - ! This agrees with the fact that all the parameters defining the - ! preconditioner have the same values on all the procs (this is - ! ensured by amg_precbld). - ! if (me == root_) then - write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' - nlev = size(prec%precv) - do ilev=1,nlev - call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & - & iout=iout_,verbosity=verbosity,prefix=prefix) - end do end if - 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 49373233..bde5412a 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,47 +105,48 @@ 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 - - if (allocated(prec%precv)) then - - call psb_info(ctxt,me,np) - if (present(root)) then - root_ = root + 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 - root_ = psb_root_ + write(prefix_,'(a,i5,a)') 'Process ',me,': ' 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 - ! - ! The preconditioner description is printed by processor psb_root_. - ! This agrees with the fact that all the parameters defining the - ! preconditioner have the same values on all the procs (this is - ! ensured by amg_precbld). - ! if (me == root_) then - write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' - nlev = size(prec%precv) - do ilev=1,nlev - call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & - & iout=iout_,verbosity=verbosity,prefix=prefix) - end do end if - 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 3657e9a5..145ce044 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,47 +105,48 @@ 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 - - if (allocated(prec%precv)) then - - call psb_info(ctxt,me,np) - if (present(root)) then - root_ = root + 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 - root_ = psb_root_ + write(prefix_,'(a,i5,a)') 'Process ',me,': ' 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 - ! - ! The preconditioner description is printed by processor psb_root_. - ! This agrees with the fact that all the parameters defining the - ! preconditioner have the same values on all the procs (this is - ! ensured by amg_precbld). - ! if (me == root_) then - write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage' - nlev = size(prec%precv) - do ilev=1,nlev - call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, & - & iout=iout_,verbosity=verbosity,prefix=prefix) - end do end if - 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 517c3892..4b58000d 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,verbosity,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,26 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi integer(psb_ipk_), intent(in) :: il,nl,ilmin integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - integer(psb_ipk_), intent(in), optional :: verbosity character(len=*), intent(in), optional :: prefix + integer(psb_ipk_), intent(in), optional :: verbosity + logical, intent(in), optional :: global ! Local variables - integer(psb_ipk_) :: err_act + type(psb_ctxt_type) :: ctxt + integer(psb_ipk_) :: err_act ,me, np character(len=20), parameter :: name='amg_c_base_onelev_memory_use' integer(psb_ipk_) :: iout_, verbosity_ - logical :: coarse + logical :: coarse, global_ character(1024) :: prefix_ + integer(psb_epk_), allocatable :: sz(:) call psb_erractionsave(err_act) - + ctxt = lv%base_desc%get_ctxt() + call psb_info(ctxt,me,np) + coarse = (il==nl) if (present(iout)) then @@ -74,34 +79,67 @@ 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 else verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if + if (present(global)) then + global_ = global + else + global_ = .true. + end if - write(iout_,*) trim(prefix_) - - if (coarse) then - write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + if (present(prefix)) then + prefix_ = prefix else - write(iout_,*) trim(prefix_), ' Level ',il + prefix_ = "" 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() - + + write(iout_,*) trim(prefix_) + + + if (global_) then + allocate(sz(6)) + sz(:) = 0 + sz(1) = lv%base_a%sizeof() + sz(2) = lv%base_desc%sizeof() + if (il >1) sz(3) = lv%linmap%sizeof() + if (allocated(lv%sm)) sz(4) = lv%sm%sizeof() + if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof() + if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof() + call psb_sum(ctxt,sz) + if (me == 0) then + if (coarse) then + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + else + write(iout_,*) trim(prefix_), ' Level ',il + end if + write(iout_,*) trim(prefix_), ' Matrix:', sz(1) + write(iout_,*) trim(prefix_), ' Descriptor:', sz(2) + if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3) + if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4) + if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5) + if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6) + end if + + else + if ((me == 0).or.(verbosity_>0)) then + if (coarse) then + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + else + write(iout_,*) trim(prefix_), ' Level ',il + end if + write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof() + write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof() + if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof() + if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof() + if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof() + if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof() + end if + endif 9998 continue call psb_erractionrestore(err_act) 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..25534fd0 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,verbosity,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,26 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi integer(psb_ipk_), intent(in) :: il,nl,ilmin integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - integer(psb_ipk_), intent(in), optional :: verbosity character(len=*), intent(in), optional :: prefix + integer(psb_ipk_), intent(in), optional :: verbosity + logical, intent(in), optional :: global ! Local variables - integer(psb_ipk_) :: err_act + type(psb_ctxt_type) :: ctxt + integer(psb_ipk_) :: err_act ,me, np character(len=20), parameter :: name='amg_d_base_onelev_memory_use' integer(psb_ipk_) :: iout_, verbosity_ - logical :: coarse + logical :: coarse, global_ character(1024) :: prefix_ + integer(psb_epk_), allocatable :: sz(:) call psb_erractionsave(err_act) - + ctxt = lv%base_desc%get_ctxt() + call psb_info(ctxt,me,np) + coarse = (il==nl) if (present(iout)) then @@ -74,34 +79,67 @@ 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 else verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if + if (present(global)) then + global_ = global + else + global_ = .true. + end if - write(iout_,*) trim(prefix_) - - if (coarse) then - write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + if (present(prefix)) then + prefix_ = prefix else - write(iout_,*) trim(prefix_), ' Level ',il + prefix_ = "" 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() - + + write(iout_,*) trim(prefix_) + + + if (global_) then + allocate(sz(6)) + sz(:) = 0 + sz(1) = lv%base_a%sizeof() + sz(2) = lv%base_desc%sizeof() + if (il >1) sz(3) = lv%linmap%sizeof() + if (allocated(lv%sm)) sz(4) = lv%sm%sizeof() + if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof() + if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof() + call psb_sum(ctxt,sz) + if (me == 0) then + if (coarse) then + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + else + write(iout_,*) trim(prefix_), ' Level ',il + end if + write(iout_,*) trim(prefix_), ' Matrix:', sz(1) + write(iout_,*) trim(prefix_), ' Descriptor:', sz(2) + if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3) + if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4) + if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5) + if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6) + end if + + else + if ((me == 0).or.(verbosity_>0)) then + if (coarse) then + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + else + write(iout_,*) trim(prefix_), ' Level ',il + end if + write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof() + write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof() + if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof() + if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof() + if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof() + if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof() + end if + endif 9998 continue call psb_erractionrestore(err_act) 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..9709ba3e 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,verbosity,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,26 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi integer(psb_ipk_), intent(in) :: il,nl,ilmin integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - integer(psb_ipk_), intent(in), optional :: verbosity character(len=*), intent(in), optional :: prefix + integer(psb_ipk_), intent(in), optional :: verbosity + logical, intent(in), optional :: global ! Local variables - integer(psb_ipk_) :: err_act + type(psb_ctxt_type) :: ctxt + integer(psb_ipk_) :: err_act ,me, np character(len=20), parameter :: name='amg_s_base_onelev_memory_use' integer(psb_ipk_) :: iout_, verbosity_ - logical :: coarse + logical :: coarse, global_ character(1024) :: prefix_ + integer(psb_epk_), allocatable :: sz(:) call psb_erractionsave(err_act) - + ctxt = lv%base_desc%get_ctxt() + call psb_info(ctxt,me,np) + coarse = (il==nl) if (present(iout)) then @@ -74,34 +79,67 @@ 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 else verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if + if (present(global)) then + global_ = global + else + global_ = .true. + end if - write(iout_,*) trim(prefix_) - - if (coarse) then - write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + if (present(prefix)) then + prefix_ = prefix else - write(iout_,*) trim(prefix_), ' Level ',il + prefix_ = "" 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() - + + write(iout_,*) trim(prefix_) + + + if (global_) then + allocate(sz(6)) + sz(:) = 0 + sz(1) = lv%base_a%sizeof() + sz(2) = lv%base_desc%sizeof() + if (il >1) sz(3) = lv%linmap%sizeof() + if (allocated(lv%sm)) sz(4) = lv%sm%sizeof() + if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof() + if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof() + call psb_sum(ctxt,sz) + if (me == 0) then + if (coarse) then + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + else + write(iout_,*) trim(prefix_), ' Level ',il + end if + write(iout_,*) trim(prefix_), ' Matrix:', sz(1) + write(iout_,*) trim(prefix_), ' Descriptor:', sz(2) + if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3) + if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4) + if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5) + if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6) + end if + + else + if ((me == 0).or.(verbosity_>0)) then + if (coarse) then + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + else + write(iout_,*) trim(prefix_), ' Level ',il + end if + write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof() + write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof() + if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof() + if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof() + if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof() + if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof() + end if + endif 9998 continue call psb_erractionrestore(err_act) 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..0e12a6bc 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,verbosity,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,26 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi integer(psb_ipk_), intent(in) :: il,nl,ilmin integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - integer(psb_ipk_), intent(in), optional :: verbosity character(len=*), intent(in), optional :: prefix + integer(psb_ipk_), intent(in), optional :: verbosity + logical, intent(in), optional :: global ! Local variables - integer(psb_ipk_) :: err_act + type(psb_ctxt_type) :: ctxt + integer(psb_ipk_) :: err_act ,me, np character(len=20), parameter :: name='amg_z_base_onelev_memory_use' integer(psb_ipk_) :: iout_, verbosity_ - logical :: coarse + logical :: coarse, global_ character(1024) :: prefix_ + integer(psb_epk_), allocatable :: sz(:) call psb_erractionsave(err_act) - + ctxt = lv%base_desc%get_ctxt() + call psb_info(ctxt,me,np) + coarse = (il==nl) if (present(iout)) then @@ -74,34 +79,67 @@ 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 else verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 - if (present(prefix)) then - prefix_ = prefix - else - prefix_ = "" - end if + if (present(global)) then + global_ = global + else + global_ = .true. + end if - write(iout_,*) trim(prefix_) - - if (coarse) then - write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + if (present(prefix)) then + prefix_ = prefix else - write(iout_,*) trim(prefix_), ' Level ',il + prefix_ = "" 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() - + + write(iout_,*) trim(prefix_) + + + if (global_) then + allocate(sz(6)) + sz(:) = 0 + sz(1) = lv%base_a%sizeof() + sz(2) = lv%base_desc%sizeof() + if (il >1) sz(3) = lv%linmap%sizeof() + if (allocated(lv%sm)) sz(4) = lv%sm%sizeof() + if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof() + if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof() + call psb_sum(ctxt,sz) + if (me == 0) then + if (coarse) then + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + else + write(iout_,*) trim(prefix_), ' Level ',il + end if + write(iout_,*) trim(prefix_), ' Matrix:', sz(1) + write(iout_,*) trim(prefix_), ' Descriptor:', sz(2) + if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3) + if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4) + if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5) + if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6) + end if + + else + if ((me == 0).or.(verbosity_>0)) then + if (coarse) then + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' + else + write(iout_,*) trim(prefix_), ' Level ',il + end if + write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof() + write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof() + if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof() + if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof() + if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof() + if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof() + end if + endif 9998 continue call psb_erractionrestore(err_act) 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..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 @@ -92,7 +96,19 @@ 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)) & + & poly_2 = psb_get_timer_idx("POLY: OptChebychev4") + if ((do_timings).and.(poly_3==-1)) & + & poly_3 = psb_get_timer_idx("POLY: OptChebychev1") + if ((do_timings).and.(poly_mv==-1)) & + & poly_mv = psb_get_timer_idx("POLY: spMV") + if ((do_timings).and.(poly_vect==-1)) & + & poly_vect = psb_get_timer_idx("POLY: Vectors") + if ((do_timings).and.(poly_sv==-1)) & + & poly_sv = psb_get_timer_idx("POLY: solver") n_row = desc_data%get_local_rows() n_col = desc_data%get_local_cols() @@ -125,38 +141,39 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& select case(sm%variant) case(amg_poly_lottes_) + if (do_timings) call psb_tic(poly_1) block real(psb_dpk_) :: cz, cr ! b == x ! x == tx ! - do i=1, sm%pdegree + do i=1, sm%pdegree-1 ! B r_{k-1} - call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') + if (do_timings) call psb_tic(poly_sv) + call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r + if (do_timings) call psb_toc(poly_sv) cz = (2*i*done-3)/(2*i*done+done) cr = (8*i*done-4)/((2*i*done+done)*sm%rho_ba) - if (.false.) then - ! z_k = cz z_{k-1} + cr ty = cz z_{k-1} + cr Br_{k-1} - call psb_geaxpby(cr,ty,cz,tz,desc_data,info) - ! r_k = b-Ax_k = x -A tx - call psb_geaxpby(done,tz,done,tx,desc_data,info) - else - call psb_abgdxyz(cr,cz,done,done,ty,tz,tx,desc_data,info) - end if - if (.false.) then - call psb_geaxpby(done,x,dzero,r,desc_data,info) - call psb_spmm(-done,sm%pa,tx,done,r,desc_data,info,work=aux,trans=trans_) - else - 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 @@ -170,32 +187,30 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& sm%poly_beta(1:sm%pdegree) = amg_d_poly_beta_mat(1:sm%pdegree,sm%pdegree) end if - do i=1, sm%pdegree + do i=1, sm%pdegree-1 ! B r_{k-1} + if (do_timings) call psb_tic(poly_sv) call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') + if (do_timings) call psb_toc(poly_sv) cz = (2*i*done-3)/(2*i*done+done) cr = (8*i*done-4)/((2*i*done+done)*sm%rho_ba) - if (.false.) then - ! z_k = cz z_{k-1} + cr ty = cz z_{k-1} + cr Br_{k-1} - call psb_geaxpby(cr,ty,cz,tz,desc_data,info) - ! r_k = b-Ax_k = x -A tx - call psb_geaxpby(sm%poly_beta(i),tz,done,tx,desc_data,info) - else - 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 @@ -206,40 +221,35 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& delta = (done-sm%cf_a)/2 sigma = theta/delta rho_old = done/sigma + if (do_timings) call psb_tic(poly_sv) call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') + if (do_timings) call psb_toc(poly_sv) call psb_geaxpby((done/sm%rho_ba),ty,dzero,r,desc_data,info) - if (.false.) then - call psb_geaxpby((done/theta),r,dzero,tz,desc_data,info) - call psb_geaxpby(done,tz,done,tx,desc_data,info) - else - 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_) + if (do_timings) call psb_toc(poly_mv) + if (do_timings) call psb_tic(poly_sv) call sm%sv%apply(-(done/sm%rho_ba),ty,done,r,desc_data,trans_,aux,wv(5:),info,init='Z') - + if (do_timings) call psb_toc(poly_sv) ! ! d_{k+1} = (rho rho_old) d_k + 2(rho/delta) r_{k+1} rho = done/(2*sigma - rho_old) - if (.false.) then - call psb_geaxpby((2*rho/delta),r,(rho*rho_old),tz,desc_data,info) - call psb_geaxpby(done,tz,done,tx,desc_data,info) - else - call psb_abgdxyz((2*rho/delta),(rho*rho_old),done,done,r,tz,tx,desc_data,info) - end if -!!$ res = psb_genrm2(r,desc_data,info) -!!$ write(0,*) 'Polynomial smoother NEW ',i,res - ! x_k = x_{k-1} + z_k + if (do_timings) call psb_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) 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_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,&