From 6541e3a95c727f86cf71a2370e888d1f30555cb3 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 18 Feb 2021 15:05:19 +0100 Subject: [PATCH] Change interface to descr with verbosity level --- amgprec/amg_c_onelev_mod.f90 | 11 +- amgprec/amg_c_prec_type.f90 | 3 +- amgprec/amg_d_onelev_mod.f90 | 11 +- amgprec/amg_d_prec_type.f90 | 3 +- amgprec/amg_s_onelev_mod.f90 | 11 +- amgprec/amg_s_prec_type.f90 | 3 +- amgprec/amg_z_onelev_mod.f90 | 11 +- amgprec/amg_z_prec_type.f90 | 3 +- amgprec/impl/amg_cfile_prec_descr.f90 | 178 ++++++++++-------- amgprec/impl/amg_dfile_prec_descr.f90 | 178 ++++++++++-------- amgprec/impl/amg_sfile_prec_descr.f90 | 178 ++++++++++-------- amgprec/impl/amg_zfile_prec_descr.f90 | 178 ++++++++++-------- .../impl/level/amg_c_base_onelev_descr.f90 | 45 ++++- .../impl/level/amg_d_base_onelev_descr.f90 | 45 ++++- .../impl/level/amg_s_base_onelev_descr.f90 | 45 ++++- .../impl/level/amg_z_base_onelev_descr.f90 | 45 ++++- 16 files changed, 564 insertions(+), 384 deletions(-) diff --git a/amgprec/amg_c_onelev_mod.f90 b/amgprec/amg_c_onelev_mod.f90 index 66e3632f..0c43ad6d 100644 --- a/amgprec/amg_c_onelev_mod.f90 +++ b/amgprec/amg_c_onelev_mod.f90 @@ -256,16 +256,17 @@ module amg_c_onelev_mod end interface interface - subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout) + subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) 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 Implicit None ! Arguments - class(amg_c_onelev_type), intent(in) :: lv - integer(psb_ipk_), intent(in) :: il,nl,ilmin - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout + class(amg_c_onelev_type), intent(in) :: lv + 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 end subroutine amg_c_base_onelev_descr end interface diff --git a/amgprec/amg_c_prec_type.f90 b/amgprec/amg_c_prec_type.f90 index dc116f5d..8899c2ac 100644 --- a/amgprec/amg_c_prec_type.f90 +++ b/amgprec/amg_c_prec_type.f90 @@ -155,13 +155,14 @@ module amg_c_prec_type interface amg_precdescr - subroutine amg_cfile_prec_descr(prec,iout,root) + subroutine amg_cfile_prec_descr(prec,iout,root,verbosity) import :: amg_cprec_type, psb_ipk_ implicit none ! Arguments class(amg_cprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: verbosity end subroutine amg_cfile_prec_descr end interface diff --git a/amgprec/amg_d_onelev_mod.f90 b/amgprec/amg_d_onelev_mod.f90 index b0a92419..6fa188da 100644 --- a/amgprec/amg_d_onelev_mod.f90 +++ b/amgprec/amg_d_onelev_mod.f90 @@ -256,16 +256,17 @@ module amg_d_onelev_mod end interface interface - subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout) + subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) 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 Implicit None ! Arguments - class(amg_d_onelev_type), intent(in) :: lv - integer(psb_ipk_), intent(in) :: il,nl,ilmin - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout + class(amg_d_onelev_type), intent(in) :: lv + 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 end subroutine amg_d_base_onelev_descr end interface diff --git a/amgprec/amg_d_prec_type.f90 b/amgprec/amg_d_prec_type.f90 index ca0dd5cc..ee2533b6 100644 --- a/amgprec/amg_d_prec_type.f90 +++ b/amgprec/amg_d_prec_type.f90 @@ -155,13 +155,14 @@ module amg_d_prec_type interface amg_precdescr - subroutine amg_dfile_prec_descr(prec,iout,root) + subroutine amg_dfile_prec_descr(prec,iout,root,verbosity) import :: amg_dprec_type, psb_ipk_ implicit none ! Arguments class(amg_dprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: verbosity end subroutine amg_dfile_prec_descr end interface diff --git a/amgprec/amg_s_onelev_mod.f90 b/amgprec/amg_s_onelev_mod.f90 index 8c606fca..9aa87b63 100644 --- a/amgprec/amg_s_onelev_mod.f90 +++ b/amgprec/amg_s_onelev_mod.f90 @@ -256,16 +256,17 @@ module amg_s_onelev_mod end interface interface - subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout) + subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) 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 Implicit None ! Arguments - class(amg_s_onelev_type), intent(in) :: lv - integer(psb_ipk_), intent(in) :: il,nl,ilmin - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout + class(amg_s_onelev_type), intent(in) :: lv + 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 end subroutine amg_s_base_onelev_descr end interface diff --git a/amgprec/amg_s_prec_type.f90 b/amgprec/amg_s_prec_type.f90 index 696cb448..d41a9395 100644 --- a/amgprec/amg_s_prec_type.f90 +++ b/amgprec/amg_s_prec_type.f90 @@ -155,13 +155,14 @@ module amg_s_prec_type interface amg_precdescr - subroutine amg_sfile_prec_descr(prec,iout,root) + subroutine amg_sfile_prec_descr(prec,iout,root,verbosity) import :: amg_sprec_type, psb_ipk_ implicit none ! Arguments class(amg_sprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: verbosity end subroutine amg_sfile_prec_descr end interface diff --git a/amgprec/amg_z_onelev_mod.f90 b/amgprec/amg_z_onelev_mod.f90 index 811c757d..fb488eb1 100644 --- a/amgprec/amg_z_onelev_mod.f90 +++ b/amgprec/amg_z_onelev_mod.f90 @@ -256,16 +256,17 @@ module amg_z_onelev_mod end interface interface - subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout) + subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) 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 Implicit None ! Arguments - class(amg_z_onelev_type), intent(in) :: lv - integer(psb_ipk_), intent(in) :: il,nl,ilmin - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout + class(amg_z_onelev_type), intent(in) :: lv + 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 end subroutine amg_z_base_onelev_descr end interface diff --git a/amgprec/amg_z_prec_type.f90 b/amgprec/amg_z_prec_type.f90 index e9ea6620..c74b51e7 100644 --- a/amgprec/amg_z_prec_type.f90 +++ b/amgprec/amg_z_prec_type.f90 @@ -155,13 +155,14 @@ module amg_z_prec_type interface amg_precdescr - subroutine amg_zfile_prec_descr(prec,iout,root) + subroutine amg_zfile_prec_descr(prec,iout,root,verbosity) import :: amg_zprec_type, psb_ipk_ implicit none ! Arguments class(amg_zprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: verbosity end subroutine amg_zfile_prec_descr end interface diff --git a/amgprec/impl/amg_cfile_prec_descr.f90 b/amgprec/impl/amg_cfile_prec_descr.f90 index a087584d..bab983c3 100644 --- a/amgprec/impl/amg_cfile_prec_descr.f90 +++ b/amgprec/impl/amg_cfile_prec_descr.f90 @@ -58,17 +58,26 @@ ! The id of the process printing the message; -1 acts as a wildcard. ! Default is psb_root_ ! -subroutine amg_cfile_prec_descr(prec,iout,root) +! +! +! verbosity: +! <0: suppress all messages +! 0: normal +! >1: increased details +! +subroutine amg_cfile_prec_descr(prec,iout,root, verbosity) use psb_base_mod use amg_c_prec_mod, amg_protect_name => amg_cfile_prec_descr use amg_c_inner_mod use amg_c_gs_solver - + implicit none ! Arguments class(amg_cprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: verbosity + ! Local variables integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps @@ -76,8 +85,7 @@ subroutine amg_cfile_prec_descr(prec,iout,root) integer(psb_ipk_) :: me, np logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' - integer(psb_ipk_) :: iout_ - integer(psb_ipk_) :: root_ + integer(psb_ipk_) :: iout_, root_, verbosity_ info = psb_success_ if (present(iout)) then @@ -86,6 +94,12 @@ subroutine amg_cfile_prec_descr(prec,iout,root) iout_ = psb_out_unit end if if (iout_ < 0) iout_ = psb_out_unit + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 ctxt = prec%ctxt @@ -99,102 +113,104 @@ subroutine amg_cfile_prec_descr(prec,iout,root) end if if (root_ == -1) root_ = me - ! - ! 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 - nlev = size(prec%precv) - do ilev = 1, nlev - if (.not.allocated(prec%precv(ilev)%sm)) then - info = 3111 - write(iout_,*) ' ',name,& - & ': error: inconsistent MLPREC part, should call amg_PRECINIT' - return - endif - end do + 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 + nlev = size(prec%precv) + do ilev = 1, nlev + if (.not.allocated(prec%precv(ilev)%sm)) then + info = 3111 + write(iout_,*) ' ',name,& + & ': error: inconsistent MLPREC part, should call amg_PRECINIT' + return + endif + end do - write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,*) + write(iout_,'(a)') 'Preconditioner description' - if (nlev == 1) then - ! - ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. - ! Will need rethinking... - ! - if (allocated(prec%precv(1)%sm2a)) then - is_symgs = .false. - select type(sv2 => prec%precv(1)%sm2a%sv) - class is (amg_c_bwgs_solver_type) - select type(sv1 => prec%precv(1)%sm%sv) - class is (amg_c_gs_solver_type) - is_symgs = .true. + if (nlev == 1) then + ! + ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. + ! Will need rethinking... + ! + if (allocated(prec%precv(1)%sm2a)) then + is_symgs = .false. + select type(sv2 => prec%precv(1)%sm2a%sv) + class is (amg_c_bwgs_solver_type) + select type(sv1 => prec%precv(1)%sm%sv) + class is (amg_c_gs_solver_type) + is_symgs = .true. + end select end select - end select - if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + if (is_symgs) then + write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + else + write(iout_,*) 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_) + end if + nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) + else + call prec%precv(1)%sm%descr(info,iout=iout_) + nswps = prec%precv(1)%parms%sweeps_pre + end if + if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps + write(iout_,*) + + else if (nlev > 1) then + ! + ! Print description of base preconditioner + ! + write(iout_,*) 'Multilevel Preconditioner' + write(iout_,*) 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) + if (allocated(prec%precv(1)%sm2a)) then write(iout_,*) 'Pre Smoother: ' call prec%precv(1)%sm%descr(info,iout=iout_) write(iout_,*) 'Post smoother:' call prec%precv(1)%sm2a%descr(info,iout=iout_) + else + write(iout_,*) 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_) end if - nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) + ! + ! Print multilevel details + ! + write(iout_,*) + write(iout_,*) 'Multilevel hierarchy: ' + write(iout_,*) ' Number of levels : ',nlev + write(iout_,*) ' Operator complexity: ',prec%get_complexity() + write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() + ilmin = 2 + if (nlev == 2) ilmin=1 + do ilev=ilmin,nlev + call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, & + & iout=iout_,verbosity=verbosity) + end do + write(iout_,*) else - call prec%precv(1)%sm%descr(info,iout=iout_) - nswps = prec%precv(1)%parms%sweeps_pre - end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(name), & + & ': invalid preconditioner array size ?',nlev + info = -2 + return - else if (nlev > 1) then - ! - ! Print description of base preconditioner - ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) - if (allocated(prec%precv(1)%sm2a)) then - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) - else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) end if - ! - ! Print multilevel details - ! - write(iout_,*) - write(iout_,*) 'Multilevel hierarchy: ' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() - ilmin = 2 - if (nlev == 2) ilmin=1 - do ilev=ilmin,nlev - call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) - end do - write(iout_,*) - - else - write(iout_,*) trim(name), & - & ': invalid preconditioner array size ?',nlev - info = -2 - return - end if end if - else write(iout_,*) trim(name), & & ': Error: no base preconditioner available, something is wrong!' info = -2 return endif - +9998 continue end subroutine amg_cfile_prec_descr diff --git a/amgprec/impl/amg_dfile_prec_descr.f90 b/amgprec/impl/amg_dfile_prec_descr.f90 index e3f7c662..d1a42f16 100644 --- a/amgprec/impl/amg_dfile_prec_descr.f90 +++ b/amgprec/impl/amg_dfile_prec_descr.f90 @@ -58,17 +58,26 @@ ! The id of the process printing the message; -1 acts as a wildcard. ! Default is psb_root_ ! -subroutine amg_dfile_prec_descr(prec,iout,root) +! +! +! verbosity: +! <0: suppress all messages +! 0: normal +! >1: increased details +! +subroutine amg_dfile_prec_descr(prec,iout,root, verbosity) use psb_base_mod use amg_d_prec_mod, amg_protect_name => amg_dfile_prec_descr use amg_d_inner_mod use amg_d_gs_solver - + implicit none ! Arguments class(amg_dprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: verbosity + ! Local variables integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps @@ -76,8 +85,7 @@ subroutine amg_dfile_prec_descr(prec,iout,root) integer(psb_ipk_) :: me, np logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' - integer(psb_ipk_) :: iout_ - integer(psb_ipk_) :: root_ + integer(psb_ipk_) :: iout_, root_, verbosity_ info = psb_success_ if (present(iout)) then @@ -86,6 +94,12 @@ subroutine amg_dfile_prec_descr(prec,iout,root) iout_ = psb_out_unit end if if (iout_ < 0) iout_ = psb_out_unit + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 ctxt = prec%ctxt @@ -99,102 +113,104 @@ subroutine amg_dfile_prec_descr(prec,iout,root) end if if (root_ == -1) root_ = me - ! - ! 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 - nlev = size(prec%precv) - do ilev = 1, nlev - if (.not.allocated(prec%precv(ilev)%sm)) then - info = 3111 - write(iout_,*) ' ',name,& - & ': error: inconsistent MLPREC part, should call amg_PRECINIT' - return - endif - end do + 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 + nlev = size(prec%precv) + do ilev = 1, nlev + if (.not.allocated(prec%precv(ilev)%sm)) then + info = 3111 + write(iout_,*) ' ',name,& + & ': error: inconsistent MLPREC part, should call amg_PRECINIT' + return + endif + end do - write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,*) + write(iout_,'(a)') 'Preconditioner description' - if (nlev == 1) then - ! - ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. - ! Will need rethinking... - ! - if (allocated(prec%precv(1)%sm2a)) then - is_symgs = .false. - select type(sv2 => prec%precv(1)%sm2a%sv) - class is (amg_d_bwgs_solver_type) - select type(sv1 => prec%precv(1)%sm%sv) - class is (amg_d_gs_solver_type) - is_symgs = .true. + if (nlev == 1) then + ! + ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. + ! Will need rethinking... + ! + if (allocated(prec%precv(1)%sm2a)) then + is_symgs = .false. + select type(sv2 => prec%precv(1)%sm2a%sv) + class is (amg_d_bwgs_solver_type) + select type(sv1 => prec%precv(1)%sm%sv) + class is (amg_d_gs_solver_type) + is_symgs = .true. + end select end select - end select - if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + if (is_symgs) then + write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + else + write(iout_,*) 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_) + end if + nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) + else + call prec%precv(1)%sm%descr(info,iout=iout_) + nswps = prec%precv(1)%parms%sweeps_pre + end if + if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps + write(iout_,*) + + else if (nlev > 1) then + ! + ! Print description of base preconditioner + ! + write(iout_,*) 'Multilevel Preconditioner' + write(iout_,*) 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) + if (allocated(prec%precv(1)%sm2a)) then write(iout_,*) 'Pre Smoother: ' call prec%precv(1)%sm%descr(info,iout=iout_) write(iout_,*) 'Post smoother:' call prec%precv(1)%sm2a%descr(info,iout=iout_) + else + write(iout_,*) 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_) end if - nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) + ! + ! Print multilevel details + ! + write(iout_,*) + write(iout_,*) 'Multilevel hierarchy: ' + write(iout_,*) ' Number of levels : ',nlev + write(iout_,*) ' Operator complexity: ',prec%get_complexity() + write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() + ilmin = 2 + if (nlev == 2) ilmin=1 + do ilev=ilmin,nlev + call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, & + & iout=iout_,verbosity=verbosity) + end do + write(iout_,*) else - call prec%precv(1)%sm%descr(info,iout=iout_) - nswps = prec%precv(1)%parms%sweeps_pre - end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(name), & + & ': invalid preconditioner array size ?',nlev + info = -2 + return - else if (nlev > 1) then - ! - ! Print description of base preconditioner - ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) - if (allocated(prec%precv(1)%sm2a)) then - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) - else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) end if - ! - ! Print multilevel details - ! - write(iout_,*) - write(iout_,*) 'Multilevel hierarchy: ' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() - ilmin = 2 - if (nlev == 2) ilmin=1 - do ilev=ilmin,nlev - call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) - end do - write(iout_,*) - - else - write(iout_,*) trim(name), & - & ': invalid preconditioner array size ?',nlev - info = -2 - return - end if end if - else write(iout_,*) trim(name), & & ': Error: no base preconditioner available, something is wrong!' info = -2 return endif - +9998 continue end subroutine amg_dfile_prec_descr diff --git a/amgprec/impl/amg_sfile_prec_descr.f90 b/amgprec/impl/amg_sfile_prec_descr.f90 index 08eda380..becd6403 100644 --- a/amgprec/impl/amg_sfile_prec_descr.f90 +++ b/amgprec/impl/amg_sfile_prec_descr.f90 @@ -58,17 +58,26 @@ ! The id of the process printing the message; -1 acts as a wildcard. ! Default is psb_root_ ! -subroutine amg_sfile_prec_descr(prec,iout,root) +! +! +! verbosity: +! <0: suppress all messages +! 0: normal +! >1: increased details +! +subroutine amg_sfile_prec_descr(prec,iout,root, verbosity) use psb_base_mod use amg_s_prec_mod, amg_protect_name => amg_sfile_prec_descr use amg_s_inner_mod use amg_s_gs_solver - + implicit none ! Arguments class(amg_sprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: verbosity + ! Local variables integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps @@ -76,8 +85,7 @@ subroutine amg_sfile_prec_descr(prec,iout,root) integer(psb_ipk_) :: me, np logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' - integer(psb_ipk_) :: iout_ - integer(psb_ipk_) :: root_ + integer(psb_ipk_) :: iout_, root_, verbosity_ info = psb_success_ if (present(iout)) then @@ -86,6 +94,12 @@ subroutine amg_sfile_prec_descr(prec,iout,root) iout_ = psb_out_unit end if if (iout_ < 0) iout_ = psb_out_unit + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 ctxt = prec%ctxt @@ -99,102 +113,104 @@ subroutine amg_sfile_prec_descr(prec,iout,root) end if if (root_ == -1) root_ = me - ! - ! 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 - nlev = size(prec%precv) - do ilev = 1, nlev - if (.not.allocated(prec%precv(ilev)%sm)) then - info = 3111 - write(iout_,*) ' ',name,& - & ': error: inconsistent MLPREC part, should call amg_PRECINIT' - return - endif - end do + 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 + nlev = size(prec%precv) + do ilev = 1, nlev + if (.not.allocated(prec%precv(ilev)%sm)) then + info = 3111 + write(iout_,*) ' ',name,& + & ': error: inconsistent MLPREC part, should call amg_PRECINIT' + return + endif + end do - write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,*) + write(iout_,'(a)') 'Preconditioner description' - if (nlev == 1) then - ! - ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. - ! Will need rethinking... - ! - if (allocated(prec%precv(1)%sm2a)) then - is_symgs = .false. - select type(sv2 => prec%precv(1)%sm2a%sv) - class is (amg_s_bwgs_solver_type) - select type(sv1 => prec%precv(1)%sm%sv) - class is (amg_s_gs_solver_type) - is_symgs = .true. + if (nlev == 1) then + ! + ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. + ! Will need rethinking... + ! + if (allocated(prec%precv(1)%sm2a)) then + is_symgs = .false. + select type(sv2 => prec%precv(1)%sm2a%sv) + class is (amg_s_bwgs_solver_type) + select type(sv1 => prec%precv(1)%sm%sv) + class is (amg_s_gs_solver_type) + is_symgs = .true. + end select end select - end select - if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + if (is_symgs) then + write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + else + write(iout_,*) 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_) + end if + nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) + else + call prec%precv(1)%sm%descr(info,iout=iout_) + nswps = prec%precv(1)%parms%sweeps_pre + end if + if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps + write(iout_,*) + + else if (nlev > 1) then + ! + ! Print description of base preconditioner + ! + write(iout_,*) 'Multilevel Preconditioner' + write(iout_,*) 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) + if (allocated(prec%precv(1)%sm2a)) then write(iout_,*) 'Pre Smoother: ' call prec%precv(1)%sm%descr(info,iout=iout_) write(iout_,*) 'Post smoother:' call prec%precv(1)%sm2a%descr(info,iout=iout_) + else + write(iout_,*) 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_) end if - nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) + ! + ! Print multilevel details + ! + write(iout_,*) + write(iout_,*) 'Multilevel hierarchy: ' + write(iout_,*) ' Number of levels : ',nlev + write(iout_,*) ' Operator complexity: ',prec%get_complexity() + write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() + ilmin = 2 + if (nlev == 2) ilmin=1 + do ilev=ilmin,nlev + call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, & + & iout=iout_,verbosity=verbosity) + end do + write(iout_,*) else - call prec%precv(1)%sm%descr(info,iout=iout_) - nswps = prec%precv(1)%parms%sweeps_pre - end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(name), & + & ': invalid preconditioner array size ?',nlev + info = -2 + return - else if (nlev > 1) then - ! - ! Print description of base preconditioner - ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) - if (allocated(prec%precv(1)%sm2a)) then - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) - else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) end if - ! - ! Print multilevel details - ! - write(iout_,*) - write(iout_,*) 'Multilevel hierarchy: ' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() - ilmin = 2 - if (nlev == 2) ilmin=1 - do ilev=ilmin,nlev - call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) - end do - write(iout_,*) - - else - write(iout_,*) trim(name), & - & ': invalid preconditioner array size ?',nlev - info = -2 - return - end if end if - else write(iout_,*) trim(name), & & ': Error: no base preconditioner available, something is wrong!' info = -2 return endif - +9998 continue end subroutine amg_sfile_prec_descr diff --git a/amgprec/impl/amg_zfile_prec_descr.f90 b/amgprec/impl/amg_zfile_prec_descr.f90 index b6807a66..cd8b687f 100644 --- a/amgprec/impl/amg_zfile_prec_descr.f90 +++ b/amgprec/impl/amg_zfile_prec_descr.f90 @@ -58,17 +58,26 @@ ! The id of the process printing the message; -1 acts as a wildcard. ! Default is psb_root_ ! -subroutine amg_zfile_prec_descr(prec,iout,root) +! +! +! verbosity: +! <0: suppress all messages +! 0: normal +! >1: increased details +! +subroutine amg_zfile_prec_descr(prec,iout,root, verbosity) use psb_base_mod use amg_z_prec_mod, amg_protect_name => amg_zfile_prec_descr use amg_z_inner_mod use amg_z_gs_solver - + implicit none ! Arguments class(amg_zprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: verbosity + ! Local variables integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps @@ -76,8 +85,7 @@ subroutine amg_zfile_prec_descr(prec,iout,root) integer(psb_ipk_) :: me, np logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' - integer(psb_ipk_) :: iout_ - integer(psb_ipk_) :: root_ + integer(psb_ipk_) :: iout_, root_, verbosity_ info = psb_success_ if (present(iout)) then @@ -86,6 +94,12 @@ subroutine amg_zfile_prec_descr(prec,iout,root) iout_ = psb_out_unit end if if (iout_ < 0) iout_ = psb_out_unit + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 ctxt = prec%ctxt @@ -99,102 +113,104 @@ subroutine amg_zfile_prec_descr(prec,iout,root) end if if (root_ == -1) root_ = me - ! - ! 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 - nlev = size(prec%precv) - do ilev = 1, nlev - if (.not.allocated(prec%precv(ilev)%sm)) then - info = 3111 - write(iout_,*) ' ',name,& - & ': error: inconsistent MLPREC part, should call amg_PRECINIT' - return - endif - end do + 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 + nlev = size(prec%precv) + do ilev = 1, nlev + if (.not.allocated(prec%precv(ilev)%sm)) then + info = 3111 + write(iout_,*) ' ',name,& + & ': error: inconsistent MLPREC part, should call amg_PRECINIT' + return + endif + end do - write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,*) + write(iout_,'(a)') 'Preconditioner description' - if (nlev == 1) then - ! - ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. - ! Will need rethinking... - ! - if (allocated(prec%precv(1)%sm2a)) then - is_symgs = .false. - select type(sv2 => prec%precv(1)%sm2a%sv) - class is (amg_z_bwgs_solver_type) - select type(sv1 => prec%precv(1)%sm%sv) - class is (amg_z_gs_solver_type) - is_symgs = .true. + if (nlev == 1) then + ! + ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. + ! Will need rethinking... + ! + if (allocated(prec%precv(1)%sm2a)) then + is_symgs = .false. + select type(sv2 => prec%precv(1)%sm2a%sv) + class is (amg_z_bwgs_solver_type) + select type(sv1 => prec%precv(1)%sm%sv) + class is (amg_z_gs_solver_type) + is_symgs = .true. + end select end select - end select - if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + if (is_symgs) then + write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + else + write(iout_,*) 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_) + end if + nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) + else + call prec%precv(1)%sm%descr(info,iout=iout_) + nswps = prec%precv(1)%parms%sweeps_pre + end if + if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps + write(iout_,*) + + else if (nlev > 1) then + ! + ! Print description of base preconditioner + ! + write(iout_,*) 'Multilevel Preconditioner' + write(iout_,*) 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) + if (allocated(prec%precv(1)%sm2a)) then write(iout_,*) 'Pre Smoother: ' call prec%precv(1)%sm%descr(info,iout=iout_) write(iout_,*) 'Post smoother:' call prec%precv(1)%sm2a%descr(info,iout=iout_) + else + write(iout_,*) 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_) end if - nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) + ! + ! Print multilevel details + ! + write(iout_,*) + write(iout_,*) 'Multilevel hierarchy: ' + write(iout_,*) ' Number of levels : ',nlev + write(iout_,*) ' Operator complexity: ',prec%get_complexity() + write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() + ilmin = 2 + if (nlev == 2) ilmin=1 + do ilev=ilmin,nlev + call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, & + & iout=iout_,verbosity=verbosity) + end do + write(iout_,*) else - call prec%precv(1)%sm%descr(info,iout=iout_) - nswps = prec%precv(1)%parms%sweeps_pre - end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(name), & + & ': invalid preconditioner array size ?',nlev + info = -2 + return - else if (nlev > 1) then - ! - ! Print description of base preconditioner - ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) - if (allocated(prec%precv(1)%sm2a)) then - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) - else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) end if - ! - ! Print multilevel details - ! - write(iout_,*) - write(iout_,*) 'Multilevel hierarchy: ' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() - ilmin = 2 - if (nlev == 2) ilmin=1 - do ilev=ilmin,nlev - call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) - end do - write(iout_,*) - - else - write(iout_,*) trim(name), & - & ': invalid preconditioner array size ?',nlev - info = -2 - return - end if end if - else write(iout_,*) trim(name), & & ': Error: no base preconditioner available, something is wrong!' info = -2 return endif - +9998 continue end subroutine amg_zfile_prec_descr diff --git a/amgprec/impl/level/amg_c_base_onelev_descr.f90 b/amgprec/impl/level/amg_c_base_onelev_descr.f90 index 1438d788..79554457 100644 --- a/amgprec/impl/level/amg_c_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_c_base_onelev_descr.f90 @@ -35,21 +35,30 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout) +! +! +! verbosity: +! <0: suppress all messages +! 0: normal +! >1: increased details +! +subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) use psb_base_mod use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_descr Implicit None ! Arguments - class(amg_c_onelev_type), intent(in) :: lv + class(amg_c_onelev_type), intent(in) :: lv 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 + ! Local variables - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_base_onelev_descr' - integer(psb_ipk_) :: iout_ + integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse @@ -63,6 +72,13 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout) else iout_ = psb_out_unit end if + + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 write(iout_,*) if (il == ilmin) then @@ -91,10 +107,20 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout) if (nl > 1) then if (allocated(lv%linmap%naggr)) then write(iout_,*) ' Coarse Matrix: Global size: ', & - & sum((1_psb_lpk_*lv%linmap%naggr(:))),' Nonzeros: ',lv%ac_nz_tot - write(iout_,*) ' Local matrix sizes: ', & - & lv%linmap%naggr(:) - write(iout_,*) ' Aggregation ratio: ', & + & lv%linmap%nagtot + write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + if (verbosity_>0) then + write(iout_,*) ' Local matrix sizes: ', & + & lv%linmap%naggr(:) + else + write(iout_,'(2(a,1x,i12))') & + & ' Local matrix sizes: min:', & + & lv%linmap%nagmin,' max:', lv%linmap%nagmax + write(iout_,'(a,1x,f14.1)') & + & ' avg:', & + & lv%linmap%nagavg + end if + write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & & lv%szratio end if end if @@ -102,7 +128,8 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout) if (coarse.and.allocated(lv%sm)) & & call lv%sm%descr(info,iout=iout_,coarse=coarse) end if - + +9998 continue call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/level/amg_d_base_onelev_descr.f90 b/amgprec/impl/level/amg_d_base_onelev_descr.f90 index 26530ed7..6eb62019 100644 --- a/amgprec/impl/level/amg_d_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_d_base_onelev_descr.f90 @@ -35,21 +35,30 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout) +! +! +! verbosity: +! <0: suppress all messages +! 0: normal +! >1: increased details +! +subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) use psb_base_mod use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_descr Implicit None ! Arguments - class(amg_d_onelev_type), intent(in) :: lv + class(amg_d_onelev_type), intent(in) :: lv 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 + ! Local variables - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_base_onelev_descr' - integer(psb_ipk_) :: iout_ + integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse @@ -63,6 +72,13 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout) else iout_ = psb_out_unit end if + + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 write(iout_,*) if (il == ilmin) then @@ -91,10 +107,20 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout) if (nl > 1) then if (allocated(lv%linmap%naggr)) then write(iout_,*) ' Coarse Matrix: Global size: ', & - & sum((1_psb_lpk_*lv%linmap%naggr(:))),' Nonzeros: ',lv%ac_nz_tot - write(iout_,*) ' Local matrix sizes: ', & - & lv%linmap%naggr(:) - write(iout_,*) ' Aggregation ratio: ', & + & lv%linmap%nagtot + write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + if (verbosity_>0) then + write(iout_,*) ' Local matrix sizes: ', & + & lv%linmap%naggr(:) + else + write(iout_,'(2(a,1x,i12))') & + & ' Local matrix sizes: min:', & + & lv%linmap%nagmin,' max:', lv%linmap%nagmax + write(iout_,'(a,1x,f14.1)') & + & ' avg:', & + & lv%linmap%nagavg + end if + write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & & lv%szratio end if end if @@ -102,7 +128,8 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout) if (coarse.and.allocated(lv%sm)) & & call lv%sm%descr(info,iout=iout_,coarse=coarse) end if - + +9998 continue call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/level/amg_s_base_onelev_descr.f90 b/amgprec/impl/level/amg_s_base_onelev_descr.f90 index f3f556f7..1a72e1d1 100644 --- a/amgprec/impl/level/amg_s_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_s_base_onelev_descr.f90 @@ -35,21 +35,30 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout) +! +! +! verbosity: +! <0: suppress all messages +! 0: normal +! >1: increased details +! +subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) use psb_base_mod use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_descr Implicit None ! Arguments - class(amg_s_onelev_type), intent(in) :: lv + class(amg_s_onelev_type), intent(in) :: lv 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 + ! Local variables - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_base_onelev_descr' - integer(psb_ipk_) :: iout_ + integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse @@ -63,6 +72,13 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout) else iout_ = psb_out_unit end if + + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 write(iout_,*) if (il == ilmin) then @@ -91,10 +107,20 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout) if (nl > 1) then if (allocated(lv%linmap%naggr)) then write(iout_,*) ' Coarse Matrix: Global size: ', & - & sum((1_psb_lpk_*lv%linmap%naggr(:))),' Nonzeros: ',lv%ac_nz_tot - write(iout_,*) ' Local matrix sizes: ', & - & lv%linmap%naggr(:) - write(iout_,*) ' Aggregation ratio: ', & + & lv%linmap%nagtot + write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + if (verbosity_>0) then + write(iout_,*) ' Local matrix sizes: ', & + & lv%linmap%naggr(:) + else + write(iout_,'(2(a,1x,i12))') & + & ' Local matrix sizes: min:', & + & lv%linmap%nagmin,' max:', lv%linmap%nagmax + write(iout_,'(a,1x,f14.1)') & + & ' avg:', & + & lv%linmap%nagavg + end if + write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & & lv%szratio end if end if @@ -102,7 +128,8 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout) if (coarse.and.allocated(lv%sm)) & & call lv%sm%descr(info,iout=iout_,coarse=coarse) end if - + +9998 continue call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/level/amg_z_base_onelev_descr.f90 b/amgprec/impl/level/amg_z_base_onelev_descr.f90 index a20a1355..271389d3 100644 --- a/amgprec/impl/level/amg_z_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_z_base_onelev_descr.f90 @@ -35,21 +35,30 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout) +! +! +! verbosity: +! <0: suppress all messages +! 0: normal +! >1: increased details +! +subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) use psb_base_mod use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_descr Implicit None ! Arguments - class(amg_z_onelev_type), intent(in) :: lv + class(amg_z_onelev_type), intent(in) :: lv 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 + ! Local variables - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_base_onelev_descr' - integer(psb_ipk_) :: iout_ + integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse @@ -63,6 +72,13 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout) else iout_ = psb_out_unit end if + + if (present(verbosity)) then + verbosity_ = verbosity + else + verbosity_ = 0 + end if + if (verbosity_ < 0) goto 9998 write(iout_,*) if (il == ilmin) then @@ -91,10 +107,20 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout) if (nl > 1) then if (allocated(lv%linmap%naggr)) then write(iout_,*) ' Coarse Matrix: Global size: ', & - & sum((1_psb_lpk_*lv%linmap%naggr(:))),' Nonzeros: ',lv%ac_nz_tot - write(iout_,*) ' Local matrix sizes: ', & - & lv%linmap%naggr(:) - write(iout_,*) ' Aggregation ratio: ', & + & lv%linmap%nagtot + write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + if (verbosity_>0) then + write(iout_,*) ' Local matrix sizes: ', & + & lv%linmap%naggr(:) + else + write(iout_,'(2(a,1x,i12))') & + & ' Local matrix sizes: min:', & + & lv%linmap%nagmin,' max:', lv%linmap%nagmax + write(iout_,'(a,1x,f14.1)') & + & ' avg:', & + & lv%linmap%nagavg + end if + write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & & lv%szratio end if end if @@ -102,7 +128,8 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout) if (coarse.and.allocated(lv%sm)) & & call lv%sm%descr(info,iout=iout_,coarse=coarse) end if - + +9998 continue call psb_erractionrestore(err_act) return