From 1355765d14187cca9deaef16243ba7470e9ec240 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 24 May 2022 12:29:21 +0200 Subject: [PATCH] Fix PREFIX in PREC%DESCR --- amgprec/amg_base_prec_type.F90 | 147 +++++++++++------- amgprec/amg_c_ainv_solver.F90 | 4 +- amgprec/amg_c_as_smoother.f90 | 25 +-- amgprec/amg_c_base_aggregator_mod.f90 | 13 +- amgprec/amg_c_base_smoother_mod.f90 | 3 +- amgprec/amg_c_base_solver_mod.f90 | 4 +- amgprec/amg_c_dec_aggregator_mod.f90 | 15 +- amgprec/amg_c_diag_solver.f90 | 26 +++- amgprec/amg_c_gs_solver.f90 | 38 +++-- amgprec/amg_c_id_solver.f90 | 13 +- amgprec/amg_c_ilu_solver.f90 | 21 ++- amgprec/amg_c_invk_solver.f90 | 4 +- amgprec/amg_c_invt_solver.f90 | 9 +- amgprec/amg_c_jac_smoother.f90 | 14 +- amgprec/amg_c_krm_solver.f90 | 25 +-- amgprec/amg_c_mumps_solver.F90 | 19 ++- amgprec/amg_c_onelev_mod.f90 | 3 +- amgprec/amg_c_prec_type.f90 | 7 +- amgprec/amg_c_slu_solver.F90 | 17 +- amgprec/amg_c_symdec_aggregator_mod.f90 | 17 +- amgprec/amg_d_ainv_solver.F90 | 4 +- amgprec/amg_d_as_smoother.f90 | 25 +-- amgprec/amg_d_base_aggregator_mod.f90 | 13 +- amgprec/amg_d_base_smoother_mod.f90 | 3 +- amgprec/amg_d_base_solver_mod.f90 | 4 +- amgprec/amg_d_dec_aggregator_mod.f90 | 15 +- amgprec/amg_d_diag_solver.f90 | 26 +++- amgprec/amg_d_gs_solver.f90 | 38 +++-- amgprec/amg_d_id_solver.f90 | 13 +- amgprec/amg_d_ilu_solver.f90 | 21 ++- amgprec/amg_d_invk_solver.f90 | 4 +- amgprec/amg_d_invt_solver.f90 | 9 +- amgprec/amg_d_jac_smoother.f90 | 14 +- amgprec/amg_d_krm_solver.f90 | 25 +-- amgprec/amg_d_matchboxp_mod.f90 | 10 +- amgprec/amg_d_mumps_solver.F90 | 19 ++- amgprec/amg_d_onelev_mod.f90 | 3 +- amgprec/amg_d_parmatch_aggregator_mod.F90 | 19 ++- amgprec/amg_d_prec_type.f90 | 7 +- amgprec/amg_d_slu_solver.F90 | 17 +- amgprec/amg_d_sludist_solver.F90 | 17 +- amgprec/amg_d_symdec_aggregator_mod.f90 | 17 +- amgprec/amg_d_umf_solver.F90 | 17 +- amgprec/amg_s_ainv_solver.F90 | 4 +- amgprec/amg_s_as_smoother.f90 | 25 +-- amgprec/amg_s_base_aggregator_mod.f90 | 13 +- amgprec/amg_s_base_smoother_mod.f90 | 3 +- amgprec/amg_s_base_solver_mod.f90 | 4 +- amgprec/amg_s_dec_aggregator_mod.f90 | 15 +- amgprec/amg_s_diag_solver.f90 | 26 +++- amgprec/amg_s_gs_solver.f90 | 38 +++-- amgprec/amg_s_id_solver.f90 | 13 +- amgprec/amg_s_ilu_solver.f90 | 21 ++- amgprec/amg_s_invk_solver.f90 | 4 +- amgprec/amg_s_invt_solver.f90 | 9 +- amgprec/amg_s_jac_smoother.f90 | 14 +- amgprec/amg_s_krm_solver.f90 | 25 +-- amgprec/amg_s_mumps_solver.F90 | 19 ++- amgprec/amg_s_onelev_mod.f90 | 3 +- amgprec/amg_s_parmatch_aggregator_mod.F90 | 19 ++- amgprec/amg_s_prec_type.f90 | 7 +- amgprec/amg_s_slu_solver.F90 | 17 +- amgprec/amg_s_symdec_aggregator_mod.f90 | 17 +- amgprec/amg_z_ainv_solver.F90 | 4 +- amgprec/amg_z_as_smoother.f90 | 25 +-- amgprec/amg_z_base_aggregator_mod.f90 | 13 +- amgprec/amg_z_base_smoother_mod.f90 | 3 +- amgprec/amg_z_base_solver_mod.f90 | 4 +- amgprec/amg_z_dec_aggregator_mod.f90 | 15 +- amgprec/amg_z_diag_solver.f90 | 26 +++- amgprec/amg_z_gs_solver.f90 | 38 +++-- amgprec/amg_z_id_solver.f90 | 13 +- amgprec/amg_z_ilu_solver.f90 | 21 ++- amgprec/amg_z_invk_solver.f90 | 4 +- amgprec/amg_z_invt_solver.f90 | 9 +- amgprec/amg_z_jac_smoother.f90 | 14 +- amgprec/amg_z_krm_solver.f90 | 25 +-- amgprec/amg_z_mumps_solver.F90 | 19 ++- amgprec/amg_z_onelev_mod.f90 | 3 +- amgprec/amg_z_prec_type.f90 | 7 +- amgprec/amg_z_slu_solver.F90 | 17 +- amgprec/amg_z_sludist_solver.F90 | 17 +- amgprec/amg_z_symdec_aggregator_mod.f90 | 17 +- amgprec/amg_z_umf_solver.F90 | 17 +- amgprec/impl/amg_cfile_prec_descr.f90 | 65 ++++---- amgprec/impl/amg_dfile_prec_descr.f90 | 65 ++++---- amgprec/impl/amg_sfile_prec_descr.f90 | 65 ++++---- amgprec/impl/amg_zfile_prec_descr.f90 | 65 ++++---- .../impl/level/amg_c_base_onelev_descr.f90 | 38 +++-- .../impl/level/amg_d_base_onelev_descr.f90 | 38 +++-- .../impl/level/amg_s_base_onelev_descr.f90 | 38 +++-- .../impl/level/amg_z_base_onelev_descr.f90 | 38 +++-- .../smoother/amg_c_base_smoother_descr.f90 | 19 ++- .../smoother/amg_c_jac_smoother_descr.f90 | 29 ++-- .../smoother/amg_c_l1_jac_smoother_descr.f90 | 31 ++-- .../smoother/amg_d_base_smoother_descr.f90 | 19 ++- .../smoother/amg_d_jac_smoother_descr.f90 | 29 ++-- .../smoother/amg_d_l1_jac_smoother_descr.f90 | 31 ++-- .../smoother/amg_s_base_smoother_descr.f90 | 19 ++- .../smoother/amg_s_jac_smoother_descr.f90 | 29 ++-- .../smoother/amg_s_l1_jac_smoother_descr.f90 | 31 ++-- .../smoother/amg_z_base_smoother_descr.f90 | 19 ++- .../smoother/amg_z_jac_smoother_descr.f90 | 29 ++-- .../smoother/amg_z_l1_jac_smoother_descr.f90 | 31 ++-- .../impl/solver/amg_c_ainv_solver_descr.f90 | 17 +- .../impl/solver/amg_c_base_solver_descr.f90 | 3 +- .../impl/solver/amg_c_invk_solver_descr.f90 | 15 +- .../impl/solver/amg_c_invt_solver_descr.f90 | 20 ++- .../impl/solver/amg_d_ainv_solver_descr.f90 | 17 +- .../impl/solver/amg_d_base_solver_descr.f90 | 3 +- .../impl/solver/amg_d_invk_solver_descr.f90 | 15 +- .../impl/solver/amg_d_invt_solver_descr.f90 | 20 ++- .../impl/solver/amg_s_ainv_solver_descr.f90 | 17 +- .../impl/solver/amg_s_base_solver_descr.f90 | 3 +- .../impl/solver/amg_s_invk_solver_descr.f90 | 15 +- .../impl/solver/amg_s_invt_solver_descr.f90 | 20 ++- .../impl/solver/amg_z_ainv_solver_descr.f90 | 17 +- .../impl/solver/amg_z_base_solver_descr.f90 | 3 +- .../impl/solver/amg_z_invk_solver_descr.f90 | 15 +- .../impl/solver/amg_z_invt_solver_descr.f90 | 20 ++- 120 files changed, 1513 insertions(+), 806 deletions(-) diff --git a/amgprec/amg_base_prec_type.F90 b/amgprec/amg_base_prec_type.F90 index 0fa19671..6284bb90 100644 --- a/amgprec/amg_base_prec_type.F90 +++ b/amgprec/amg_base_prec_type.F90 @@ -649,43 +649,52 @@ contains end if end subroutine ml_parms_mlcycledsc - subroutine ml_parms_mldescr(pm,iout,info) + subroutine ml_parms_mldescr(pm,iout,info,prefix) Implicit None ! Arguments - class(amg_ml_parms), intent(in) :: pm - integer(psb_ipk_), intent(in) :: iout - integer(psb_ipk_), intent(out) :: info + class(amg_ml_parms), intent(in) :: pm + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + + character(1024) :: prefix_ info = psb_success_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then - write(iout,*) ' Parallel aggregation algorithm: ',& + write(iout,*) trim(prefix),' Parallel aggregation algorithm: ',& & par_aggr_alg_names(pm%par_aggr_alg) - if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',& + if (pm%aggr_type>0) write(iout,*) trim(prefix),' Aggregation type: ',& & aggr_type_names(pm%aggr_type) !if (pm%par_aggr_alg /= amg_ext_aggr_) then if ( pm%aggr_ord /= amg_aggr_ord_nat_) & - & write(iout,*) ' with initial ordering: ',& + & write(iout,*) trim(prefix),' with initial ordering: ',& & ord_names(pm%aggr_ord) - write(iout,*) ' Aggregation prolongator: ', & + write(iout,*) trim(prefix),' Aggregation prolongator: ', & & aggr_prols(pm%aggr_prol) if (pm%aggr_prol /= amg_no_smooth_) then - write(iout,*) ' with: ', aggr_filters(pm%aggr_filter) + write(iout,*) trim(prefix),' with: ', aggr_filters(pm%aggr_filter) if (pm%aggr_omega_alg == amg_eig_est_) then - write(iout,*) ' Damping omega computation: spectral radius estimate' - write(iout,*) ' Spectral radius estimate: ', & + write(iout,*) trim(prefix),' Damping omega computation: spectral radius estimate' + write(iout,*) trim(prefix),' Spectral radius estimate: ', & & eigen_estimates(pm%aggr_eig) else if (pm%aggr_omega_alg == amg_user_choice_) then - write(iout,*) ' Damping omega computation: user defined value.' + write(iout,*) trim(prefix),' Damping omega computation: user defined value.' else - write(iout,*) ' Damping omega computation: unknown value in iprcparm!!' + write(iout,*) trim(prefix),' Damping omega computation: unknown value in iprcparm!!' end if end if !end if else - write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',& + write(iout,*) trim(prefix),' Multilevel type: Unkonwn value. Something is amiss....',& & pm%ml_cycle end if @@ -693,15 +702,16 @@ contains end subroutine ml_parms_mldescr - subroutine ml_parms_descr(pm,iout,info,coarse) + subroutine ml_parms_descr(pm,iout,info,coarse,prefix) Implicit None ! Arguments - class(amg_ml_parms), intent(in) :: pm - integer(psb_ipk_), intent(in) :: iout - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: coarse + class(amg_ml_parms), intent(in) :: pm + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix logical :: coarse_ info = psb_success_ @@ -712,7 +722,7 @@ contains end if if (coarse_) then - call pm%coarsedescr(iout,info) + call pm%coarsedescr(iout,info,prefix=prefix) end if return @@ -720,101 +730,126 @@ contains end subroutine ml_parms_descr - subroutine ml_parms_coarsedescr(pm,iout,info) + subroutine ml_parms_coarsedescr(pm,iout,info,prefix) Implicit None ! Arguments - class(amg_ml_parms), intent(in) :: pm - integer(psb_ipk_), intent(in) :: iout - integer(psb_ipk_), intent(out) :: info + class(amg_ml_parms), intent(in) :: pm + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + + character(1024) :: prefix_ info = psb_success_ - write(iout,*) ' Coarse matrix: ',& + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout,*) trim(prefix),' Coarse matrix: ',& & matrix_names(pm%coarse_mat) select case(pm%coarse_solve) case (amg_bjac_,amg_as_) - write(iout,*) ' Coarse solver: ',& + write(iout,*) trim(prefix),' Coarse solver: ',& & 'Block Jacobi' - write(iout,*) ' Number of sweeps : ',& + write(iout,*) trim(prefix),' Number of sweeps : ',& & pm%sweeps_pre case (amg_l1_bjac_) - write(iout,*) ' Coarse solver: ',& + write(iout,*) trim(prefix),' Coarse solver: ',& & 'L1-Block Jacobi' - write(iout,*) ' Number of sweeps : ',& + write(iout,*) trim(prefix),' Number of sweeps : ',& & pm%sweeps_pre case (amg_jac_) - write(iout,*) ' Coarse solver: ',& + write(iout,*) trim(prefix),' Coarse solver: ',& & 'Point Jacobi' - write(iout,*) ' Number of sweeps : ',& + write(iout,*) trim(prefix),' Number of sweeps : ',& & pm%sweeps_pre case (amg_l1_jac_) - write(iout,*) ' Coarse solver: ',& + write(iout,*) trim(prefix),' Coarse solver: ',& & 'L1-Jacobi' - write(iout,*) ' Number of sweeps : ',& + write(iout,*) trim(prefix),' Number of sweeps : ',& & pm%sweeps_pre case (amg_l1_fbgs_) - write(iout,*) ' Coarse solver: ',& + write(iout,*) trim(prefix),' Coarse solver: ',& & 'L1 Forward-Backward Gauss-Seidel (Hybrid)' - write(iout,*) ' Number of sweeps : ',& + write(iout,*) trim(prefix),' Number of sweeps : ',& & pm%sweeps_pre case (amg_l1_gs_) - write(iout,*) ' Coarse solver: ',& + write(iout,*) trim(prefix),' Coarse solver: ',& & 'L1 Gauss-Seidel (Hybrid)' - write(iout,*) ' Number of sweeps : ',& + write(iout,*) trim(prefix),' Number of sweeps : ',& & pm%sweeps_pre case (amg_fbgs_) - write(iout,*) ' Coarse solver: ',& + write(iout,*) trim(prefix),' Coarse solver: ',& & 'Forward-Backward Gauss-Seidel (Hybrid)' - write(iout,*) ' Number of sweeps : ',& + write(iout,*) trim(prefix),' Number of sweeps : ',& & pm%sweeps_pre case default - write(iout,*) ' Coarse solver: ',& + write(iout,*) trim(prefix),' Coarse solver: ',& & amg_fact_names(pm%coarse_solve) end select end subroutine ml_parms_coarsedescr - subroutine s_ml_parms_descr(pm,iout,info,coarse) + subroutine s_ml_parms_descr(pm,iout,info,coarse,prefix) Implicit None ! Arguments - class(amg_sml_parms), intent(in) :: pm - integer(psb_ipk_), intent(in) :: iout - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: coarse + class(amg_sml_parms), intent(in) :: pm + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix + + character(1024) :: prefix_ info = psb_success_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - call pm%amg_ml_parms%descr(iout,info,coarse) + call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix) if (pm%aggr_prol /= amg_no_smooth_) then - write(iout,*) ' Damping omega value :',pm%aggr_omega_val + write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val end if - write(iout,*) ' Aggregation threshold:',pm%aggr_thresh + write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh return end subroutine s_ml_parms_descr - subroutine d_ml_parms_descr(pm,iout,info,coarse) + subroutine d_ml_parms_descr(pm,iout,info,coarse,prefix) Implicit None ! Arguments - class(amg_dml_parms), intent(in) :: pm - integer(psb_ipk_), intent(in) :: iout - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: coarse + class(amg_dml_parms), intent(in) :: pm + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix + + character(1024) :: prefix_ info = psb_success_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - call pm%amg_ml_parms%descr(iout,info,coarse) + call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix) if (pm%aggr_prol /= amg_no_smooth_) then - write(iout,*) ' Damping omega value :',pm%aggr_omega_val + write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val end if - write(iout,*) ' Aggregation threshold:',pm%aggr_thresh + write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh return diff --git a/amgprec/amg_c_ainv_solver.F90 b/amgprec/amg_c_ainv_solver.F90 index e250a193..5d24179a 100644 --- a/amgprec/amg_c_ainv_solver.F90 +++ b/amgprec/amg_c_ainv_solver.F90 @@ -198,7 +198,7 @@ module amg_c_ainv_solver !!$ end interface interface - subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse) + subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_ Implicit None @@ -208,7 +208,7 @@ module amg_c_ainv_solver integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_c_ainv_solver_descr end interface diff --git a/amgprec/amg_c_as_smoother.f90 b/amgprec/amg_c_as_smoother.f90 index 0858d4a0..27c39e71 100644 --- a/amgprec/amg_c_as_smoother.f90 +++ b/amgprec/amg_c_as_smoother.f90 @@ -396,21 +396,23 @@ contains end subroutine c_as_smoother_default - subroutine c_as_smoother_descr(sm,info,iout,coarse) + subroutine c_as_smoother_descr(sm,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_c_as_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_as_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -424,16 +426,21 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then - write(iout_,*) ' Additive Schwarz with ',& + write(iout_,*) trim(prefix_), ' Additive Schwarz with ',& & sm%novr, ' overlap layers.' - write(iout_,*) ' Restrictor: ',restrict_names(sm%restr) - write(iout_,*) ' Prolongator: ',prolong_names(sm%prol) - write(iout_,*) ' Local solver:' + write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr) + write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol) + write(iout_,*) trim(prefix_), ' Local solver:' endif if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if call psb_erractionrestore(err_act) diff --git a/amgprec/amg_c_base_aggregator_mod.f90 b/amgprec/amg_c_base_aggregator_mod.f90 index 93250ba5..69cee02f 100644 --- a/amgprec/amg_c_base_aggregator_mod.f90 +++ b/amgprec/amg_c_base_aggregator_mod.f90 @@ -275,15 +275,22 @@ contains val = .false. end function amg_c_base_aggregator_xt_desc - subroutine amg_c_base_aggregator_descr(ag,parms,iout,info) + subroutine amg_c_base_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_c_base_aggregator_type), intent(in) :: ag type(amg_sml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + character(1024) :: prefix_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_c_base_aggregator_descr diff --git a/amgprec/amg_c_base_smoother_mod.f90 b/amgprec/amg_c_base_smoother_mod.f90 index 37e60879..3004c616 100644 --- a/amgprec/amg_c_base_smoother_mod.f90 +++ b/amgprec/amg_c_base_smoother_mod.f90 @@ -272,7 +272,7 @@ module amg_c_base_smoother_mod end interface interface - subroutine amg_c_base_smoother_descr(sm,info,iout,coarse) + subroutine amg_c_base_smoother_descr(sm,info,iout,coarse,prefix) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & amg_c_base_smoother_type, psb_ipk_ @@ -281,6 +281,7 @@ module amg_c_base_smoother_mod integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_c_base_smoother_descr end interface diff --git a/amgprec/amg_c_base_solver_mod.f90 b/amgprec/amg_c_base_solver_mod.f90 index 5c75bc8c..a113774b 100644 --- a/amgprec/amg_c_base_solver_mod.f90 +++ b/amgprec/amg_c_base_solver_mod.f90 @@ -270,7 +270,7 @@ module amg_c_base_solver_mod end interface interface - subroutine amg_c_base_solver_descr(sv,info,iout,coarse) + subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & amg_c_base_solver_type, psb_ipk_ @@ -281,7 +281,7 @@ module amg_c_base_solver_mod integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_c_base_solver_descr end interface diff --git a/amgprec/amg_c_dec_aggregator_mod.f90 b/amgprec/amg_c_dec_aggregator_mod.f90 index 5763287e..175fcf97 100644 --- a/amgprec/amg_c_dec_aggregator_mod.f90 +++ b/amgprec/amg_c_dec_aggregator_mod.f90 @@ -184,16 +184,23 @@ contains val = "Decoupled aggregation" end function amg_c_dec_aggregator_fmt - subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info) + subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_c_dec_aggregator_type), intent(in) :: ag type(amg_sml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + character(1024) :: prefix_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout,*) 'Decoupled Aggregator' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ','Decoupled Aggregator' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_c_dec_aggregator_descr diff --git a/amgprec/amg_c_diag_solver.f90 b/amgprec/amg_c_diag_solver.f90 index 7a3be71c..ccf86bf2 100644 --- a/amgprec/amg_c_diag_solver.f90 +++ b/amgprec/amg_c_diag_solver.f90 @@ -219,7 +219,7 @@ contains end subroutine c_diag_solver_free - subroutine c_diag_solver_descr(sv,info,iout,coarse) + subroutine c_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -228,11 +228,13 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_diag_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -240,8 +242,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' Diagonal local solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' Diagonal local solver ' return @@ -352,7 +359,7 @@ module amg_c_l1_diag_solver contains - subroutine c_l1_diag_solver_descr(sv,info,iout,coarse) + subroutine c_l1_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -361,11 +368,13 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_l1_diag_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -373,8 +382,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' L1 Diagonal solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' L1 Diagonal solver ' return diff --git a/amgprec/amg_c_gs_solver.f90 b/amgprec/amg_c_gs_solver.f90 index 0155cd5c..39c0fa10 100644 --- a/amgprec/amg_c_gs_solver.f90 +++ b/amgprec/amg_c_gs_solver.f90 @@ -433,20 +433,22 @@ contains return end subroutine c_gs_solver_free - subroutine c_gs_solver_descr(sv,info,iout,coarse) + subroutine c_gs_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_c_gs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_gs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -455,12 +457,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if @@ -526,20 +533,22 @@ contains val = .true. end function c_gs_solver_is_iterative - subroutine c_bwgs_solver_descr(sv,info,iout,coarse) + subroutine c_bwgs_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_c_bwgs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_bwgs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -548,12 +557,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if diff --git a/amgprec/amg_c_id_solver.f90 b/amgprec/amg_c_id_solver.f90 index 112df716..1b277a07 100644 --- a/amgprec/amg_c_id_solver.f90 +++ b/amgprec/amg_c_id_solver.f90 @@ -157,7 +157,7 @@ contains return end subroutine c_id_solver_free - subroutine c_id_solver_descr(sv,info,iout,coarse) + subroutine c_id_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -165,12 +165,14 @@ contains class(amg_c_id_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_id_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -178,8 +180,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Identity local solver ' + write(iout_,*) trim(prefix_), ' Identity local solver ' return diff --git a/amgprec/amg_c_ilu_solver.f90 b/amgprec/amg_c_ilu_solver.f90 index f6ab6088..7a269d85 100644 --- a/amgprec/amg_c_ilu_solver.f90 +++ b/amgprec/amg_c_ilu_solver.f90 @@ -406,7 +406,7 @@ contains return end subroutine c_ilu_solver_free - subroutine c_ilu_solver_descr(sv,info,iout,coarse) + subroutine c_ilu_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -414,12 +414,14 @@ contains class(amg_c_ilu_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_ilu_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -428,15 +430,20 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Incomplete factorization solver: ',& + write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',& & amg_fact_names(sv%fact_type) select case(sv%fact_type) case(psb_ilu_n_,psb_milu_n_) - write(iout_,*) ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in case(psb_ilu_t_) - write(iout_,*) ' Fill level:',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh end select call psb_erractionrestore(err_act) diff --git a/amgprec/amg_c_invk_solver.f90 b/amgprec/amg_c_invk_solver.f90 index c8a6765d..f757a04f 100644 --- a/amgprec/amg_c_invk_solver.f90 +++ b/amgprec/amg_c_invk_solver.f90 @@ -123,7 +123,7 @@ module amg_c_invk_solver end interface interface - subroutine amg_c_invk_solver_descr(sv,info,iout,coarse) + subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix) import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_ Implicit None @@ -133,7 +133,7 @@ module amg_c_invk_solver integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_c_invk_solver_descr end interface diff --git a/amgprec/amg_c_invt_solver.f90 b/amgprec/amg_c_invt_solver.f90 index f1569000..420b90c9 100644 --- a/amgprec/amg_c_invt_solver.f90 +++ b/amgprec/amg_c_invt_solver.f90 @@ -134,16 +134,17 @@ module amg_c_invt_solver end interface interface - subroutine amg_c_invt_solver_descr(sv,info,iout,coarse) + subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix) import :: psb_spk_, amg_c_invt_solver_type, psb_ipk_ Implicit None ! Arguments class(amg_c_invt_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_c_invt_solver_descr end interface diff --git a/amgprec/amg_c_jac_smoother.f90 b/amgprec/amg_c_jac_smoother.f90 index 1f7d7e20..70aba712 100644 --- a/amgprec/amg_c_jac_smoother.f90 +++ b/amgprec/amg_c_jac_smoother.f90 @@ -219,12 +219,13 @@ module amg_c_jac_smoother end interface interface - subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse,prefix) import :: amg_c_jac_smoother_type, psb_ipk_ class(amg_c_jac_smoother_type), intent(in) :: sm integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_c_jac_smoother_descr end interface @@ -313,12 +314,13 @@ module amg_c_jac_smoother end interface interface - subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) import :: amg_c_l1_jac_smoother_type, psb_ipk_ class(amg_c_l1_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_c_l1_jac_smoother_descr end interface diff --git a/amgprec/amg_c_krm_solver.f90 b/amgprec/amg_c_krm_solver.f90 index 01c9f236..645e10bd 100644 --- a/amgprec/amg_c_krm_solver.f90 +++ b/amgprec/amg_c_krm_solver.f90 @@ -436,7 +436,7 @@ contains val = "KRM solver" end function c_krm_solver_get_fmt - subroutine c_krm_solver_descr(sv,info,iout,coarse) + subroutine c_krm_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -444,12 +444,14 @@ contains class(amg_c_krm_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_krm_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -458,17 +460,22 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%global) then - write(iout_,*) ' Krylov solver (global)' + write(iout_,*) trim(prefix_), ' Krylov solver (global)' else - write(iout_,*) ' Krylov solver (local) ' + write(iout_,*) trim(prefix_), ' Krylov solver (local) ' end if - write(iout_,*) ' method: ',sv%method - write(iout_,*) ' kprec: ',sv%kprec - call sv%prec%descr(iout_,info) - write(iout_,*) ' itmax: ',sv%itmax - write(iout_,*) ' eps: ',sv%eps + write(iout_,*) trim(prefix_), ' method: ',sv%method + write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec + call sv%prec%descr(iout_,info,prefix='KRM : '//prefix_) + write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax + write(iout_,*) trim(prefix_), ' eps: ',sv%eps call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_c_mumps_solver.F90 b/amgprec/amg_c_mumps_solver.F90 index 486fbdc6..6a7acb70 100644 --- a/amgprec/amg_c_mumps_solver.F90 +++ b/amgprec/amg_c_mumps_solver.F90 @@ -313,22 +313,24 @@ subroutine c_mumps_solver_finalize(sv) end subroutine c_mumps_solver_finalize -subroutine c_mumps_solver_descr(sv,info,iout,coarse) +subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_c_mumps_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np character(len=20), parameter :: name='amg_z_mumps_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -337,8 +339,13 @@ subroutine c_mumps_solver_descr(sv,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' MUMPS Solver. ' + write(iout_,*) trim(prefix_), ' MUMPS Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_c_onelev_mod.f90 b/amgprec/amg_c_onelev_mod.f90 index f93fb8df..7cb87bf4 100644 --- a/amgprec/amg_c_onelev_mod.f90 +++ b/amgprec/amg_c_onelev_mod.f90 @@ -257,7 +257,7 @@ module amg_c_onelev_mod end interface interface - subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) + subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix) 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 @@ -268,6 +268,7 @@ module amg_c_onelev_mod 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 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 cc176861..cb9e3f31 100644 --- a/amgprec/amg_c_prec_type.f90 +++ b/amgprec/amg_c_prec_type.f90 @@ -155,15 +155,16 @@ module amg_c_prec_type interface amg_precdescr - subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity) + subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity,prefix) import :: amg_cprec_type, psb_ipk_ implicit none ! Arguments - class(amg_cprec_type), intent(in) :: prec - integer(psb_ipk_), intent(out) :: info + class(amg_cprec_type), intent(in) :: prec + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix end subroutine amg_cfile_prec_descr end interface diff --git a/amgprec/amg_c_slu_solver.F90 b/amgprec/amg_c_slu_solver.F90 index 774a0c61..5d9e1db9 100644 --- a/amgprec/amg_c_slu_solver.F90 +++ b/amgprec/amg_c_slu_solver.F90 @@ -385,20 +385,22 @@ contains end subroutine c_slu_solver_finalize - subroutine c_slu_solver_descr(sv,info,iout,coarse) + subroutine c_slu_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_c_slu_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer :: err_act character(len=20), parameter :: name='amg_c_slu_solver_descr' integer :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -407,8 +409,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_c_symdec_aggregator_mod.f90 b/amgprec/amg_c_symdec_aggregator_mod.f90 index 03928ab6..d820a762 100644 --- a/amgprec/amg_c_symdec_aggregator_mod.f90 +++ b/amgprec/amg_c_symdec_aggregator_mod.f90 @@ -88,16 +88,25 @@ contains val = "Symmetric Decoupled aggregation" end function amg_c_symdec_aggregator_fmt - subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info) + subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_c_symdec_aggregator_type), intent(in) :: ag type(amg_sml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix - write(iout,*) 'Decoupled Aggregator locally-symmetrized' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + character(1024) :: prefix_ + + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_c_symdec_aggregator_descr diff --git a/amgprec/amg_d_ainv_solver.F90 b/amgprec/amg_d_ainv_solver.F90 index 5e99027e..8d264d8f 100644 --- a/amgprec/amg_d_ainv_solver.F90 +++ b/amgprec/amg_d_ainv_solver.F90 @@ -198,7 +198,7 @@ module amg_d_ainv_solver !!$ end interface interface - subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse) + subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_ Implicit None @@ -208,7 +208,7 @@ module amg_d_ainv_solver integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_d_ainv_solver_descr end interface diff --git a/amgprec/amg_d_as_smoother.f90 b/amgprec/amg_d_as_smoother.f90 index 309b75b2..6e411de4 100644 --- a/amgprec/amg_d_as_smoother.f90 +++ b/amgprec/amg_d_as_smoother.f90 @@ -396,21 +396,23 @@ contains end subroutine d_as_smoother_default - subroutine d_as_smoother_descr(sm,info,iout,coarse) + subroutine d_as_smoother_descr(sm,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_d_as_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_as_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -424,16 +426,21 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then - write(iout_,*) ' Additive Schwarz with ',& + write(iout_,*) trim(prefix_), ' Additive Schwarz with ',& & sm%novr, ' overlap layers.' - write(iout_,*) ' Restrictor: ',restrict_names(sm%restr) - write(iout_,*) ' Prolongator: ',prolong_names(sm%prol) - write(iout_,*) ' Local solver:' + write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr) + write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol) + write(iout_,*) trim(prefix_), ' Local solver:' endif if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if call psb_erractionrestore(err_act) diff --git a/amgprec/amg_d_base_aggregator_mod.f90 b/amgprec/amg_d_base_aggregator_mod.f90 index 14e2cd64..7aed1885 100644 --- a/amgprec/amg_d_base_aggregator_mod.f90 +++ b/amgprec/amg_d_base_aggregator_mod.f90 @@ -275,15 +275,22 @@ contains val = .false. end function amg_d_base_aggregator_xt_desc - subroutine amg_d_base_aggregator_descr(ag,parms,iout,info) + subroutine amg_d_base_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_d_base_aggregator_type), intent(in) :: ag type(amg_dml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + character(1024) :: prefix_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_d_base_aggregator_descr diff --git a/amgprec/amg_d_base_smoother_mod.f90 b/amgprec/amg_d_base_smoother_mod.f90 index 809c0b84..52e52a4d 100644 --- a/amgprec/amg_d_base_smoother_mod.f90 +++ b/amgprec/amg_d_base_smoother_mod.f90 @@ -272,7 +272,7 @@ module amg_d_base_smoother_mod end interface interface - subroutine amg_d_base_smoother_descr(sm,info,iout,coarse) + subroutine amg_d_base_smoother_descr(sm,info,iout,coarse,prefix) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & amg_d_base_smoother_type, psb_ipk_ @@ -281,6 +281,7 @@ module amg_d_base_smoother_mod integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_d_base_smoother_descr end interface diff --git a/amgprec/amg_d_base_solver_mod.f90 b/amgprec/amg_d_base_solver_mod.f90 index 07a28b9a..f29e4340 100644 --- a/amgprec/amg_d_base_solver_mod.f90 +++ b/amgprec/amg_d_base_solver_mod.f90 @@ -270,7 +270,7 @@ module amg_d_base_solver_mod end interface interface - subroutine amg_d_base_solver_descr(sv,info,iout,coarse) + subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & amg_d_base_solver_type, psb_ipk_ @@ -281,7 +281,7 @@ module amg_d_base_solver_mod integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_d_base_solver_descr end interface diff --git a/amgprec/amg_d_dec_aggregator_mod.f90 b/amgprec/amg_d_dec_aggregator_mod.f90 index 2f378068..eced25bd 100644 --- a/amgprec/amg_d_dec_aggregator_mod.f90 +++ b/amgprec/amg_d_dec_aggregator_mod.f90 @@ -184,16 +184,23 @@ contains val = "Decoupled aggregation" end function amg_d_dec_aggregator_fmt - subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info) + subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_d_dec_aggregator_type), intent(in) :: ag type(amg_dml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + character(1024) :: prefix_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout,*) 'Decoupled Aggregator' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ','Decoupled Aggregator' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_d_dec_aggregator_descr diff --git a/amgprec/amg_d_diag_solver.f90 b/amgprec/amg_d_diag_solver.f90 index 06c7887f..1bc32a8b 100644 --- a/amgprec/amg_d_diag_solver.f90 +++ b/amgprec/amg_d_diag_solver.f90 @@ -219,7 +219,7 @@ contains end subroutine d_diag_solver_free - subroutine d_diag_solver_descr(sv,info,iout,coarse) + subroutine d_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -228,11 +228,13 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_diag_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -240,8 +242,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' Diagonal local solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' Diagonal local solver ' return @@ -352,7 +359,7 @@ module amg_d_l1_diag_solver contains - subroutine d_l1_diag_solver_descr(sv,info,iout,coarse) + subroutine d_l1_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -361,11 +368,13 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_l1_diag_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -373,8 +382,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' L1 Diagonal solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' L1 Diagonal solver ' return diff --git a/amgprec/amg_d_gs_solver.f90 b/amgprec/amg_d_gs_solver.f90 index 1a530853..22ed4fad 100644 --- a/amgprec/amg_d_gs_solver.f90 +++ b/amgprec/amg_d_gs_solver.f90 @@ -433,20 +433,22 @@ contains return end subroutine d_gs_solver_free - subroutine d_gs_solver_descr(sv,info,iout,coarse) + subroutine d_gs_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_d_gs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_gs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -455,12 +457,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if @@ -526,20 +533,22 @@ contains val = .true. end function d_gs_solver_is_iterative - subroutine d_bwgs_solver_descr(sv,info,iout,coarse) + subroutine d_bwgs_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_d_bwgs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_bwgs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -548,12 +557,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if diff --git a/amgprec/amg_d_id_solver.f90 b/amgprec/amg_d_id_solver.f90 index d94debe1..5f3d183b 100644 --- a/amgprec/amg_d_id_solver.f90 +++ b/amgprec/amg_d_id_solver.f90 @@ -157,7 +157,7 @@ contains return end subroutine d_id_solver_free - subroutine d_id_solver_descr(sv,info,iout,coarse) + subroutine d_id_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -165,12 +165,14 @@ contains class(amg_d_id_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_id_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -178,8 +180,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Identity local solver ' + write(iout_,*) trim(prefix_), ' Identity local solver ' return diff --git a/amgprec/amg_d_ilu_solver.f90 b/amgprec/amg_d_ilu_solver.f90 index 8c77cc87..00733655 100644 --- a/amgprec/amg_d_ilu_solver.f90 +++ b/amgprec/amg_d_ilu_solver.f90 @@ -406,7 +406,7 @@ contains return end subroutine d_ilu_solver_free - subroutine d_ilu_solver_descr(sv,info,iout,coarse) + subroutine d_ilu_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -414,12 +414,14 @@ contains class(amg_d_ilu_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_ilu_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -428,15 +430,20 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Incomplete factorization solver: ',& + write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',& & amg_fact_names(sv%fact_type) select case(sv%fact_type) case(psb_ilu_n_,psb_milu_n_) - write(iout_,*) ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in case(psb_ilu_t_) - write(iout_,*) ' Fill level:',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh end select call psb_erractionrestore(err_act) diff --git a/amgprec/amg_d_invk_solver.f90 b/amgprec/amg_d_invk_solver.f90 index b402d1de..08838fbb 100644 --- a/amgprec/amg_d_invk_solver.f90 +++ b/amgprec/amg_d_invk_solver.f90 @@ -123,7 +123,7 @@ module amg_d_invk_solver end interface interface - subroutine amg_d_invk_solver_descr(sv,info,iout,coarse) + subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_ Implicit None @@ -133,7 +133,7 @@ module amg_d_invk_solver integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_d_invk_solver_descr end interface diff --git a/amgprec/amg_d_invt_solver.f90 b/amgprec/amg_d_invt_solver.f90 index 5e27d6f0..a83ed1b2 100644 --- a/amgprec/amg_d_invt_solver.f90 +++ b/amgprec/amg_d_invt_solver.f90 @@ -134,16 +134,17 @@ module amg_d_invt_solver end interface interface - subroutine amg_d_invt_solver_descr(sv,info,iout,coarse) + subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_d_invt_solver_type, psb_ipk_ Implicit None ! Arguments class(amg_d_invt_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_d_invt_solver_descr end interface diff --git a/amgprec/amg_d_jac_smoother.f90 b/amgprec/amg_d_jac_smoother.f90 index aadefc0a..8f3845a0 100644 --- a/amgprec/amg_d_jac_smoother.f90 +++ b/amgprec/amg_d_jac_smoother.f90 @@ -219,12 +219,13 @@ module amg_d_jac_smoother end interface interface - subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse,prefix) import :: amg_d_jac_smoother_type, psb_ipk_ class(amg_d_jac_smoother_type), intent(in) :: sm integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_d_jac_smoother_descr end interface @@ -313,12 +314,13 @@ module amg_d_jac_smoother end interface interface - subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) import :: amg_d_l1_jac_smoother_type, psb_ipk_ class(amg_d_l1_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_d_l1_jac_smoother_descr end interface diff --git a/amgprec/amg_d_krm_solver.f90 b/amgprec/amg_d_krm_solver.f90 index 3be9df09..eaa92f09 100644 --- a/amgprec/amg_d_krm_solver.f90 +++ b/amgprec/amg_d_krm_solver.f90 @@ -436,7 +436,7 @@ contains val = "KRM solver" end function d_krm_solver_get_fmt - subroutine d_krm_solver_descr(sv,info,iout,coarse) + subroutine d_krm_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -444,12 +444,14 @@ contains class(amg_d_krm_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_krm_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -458,17 +460,22 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%global) then - write(iout_,*) ' Krylov solver (global)' + write(iout_,*) trim(prefix_), ' Krylov solver (global)' else - write(iout_,*) ' Krylov solver (local) ' + write(iout_,*) trim(prefix_), ' Krylov solver (local) ' end if - write(iout_,*) ' method: ',sv%method - write(iout_,*) ' kprec: ',sv%kprec - call sv%prec%descr(iout_,info) - write(iout_,*) ' itmax: ',sv%itmax - write(iout_,*) ' eps: ',sv%eps + write(iout_,*) trim(prefix_), ' method: ',sv%method + write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec + call sv%prec%descr(iout_,info,prefix='KRM : '//prefix_) + write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax + write(iout_,*) trim(prefix_), ' eps: ',sv%eps call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_d_matchboxp_mod.f90 b/amgprec/amg_d_matchboxp_mod.f90 index a18d62d6..383abd71 100644 --- a/amgprec/amg_d_matchboxp_mod.f90 +++ b/amgprec/amg_d_matchboxp_mod.f90 @@ -145,6 +145,7 @@ contains logical, parameter :: dump=.false., debug=.false., dump_mate=.false., & & debug_ilaggr=.false., debug_sync=.false. integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 + integer(psb_ipk_), save :: idx_phase21=-1, idx_phase31=-1 logical, parameter :: do_timings=.true. ictxt = desc_a%get_ctxt() @@ -158,7 +159,11 @@ contains & idx_phase2 = psb_get_timer_idx("MBP_BLDP: phase2 ") if ((do_timings).and.(idx_phase3==-1)) & & idx_phase3 = psb_get_timer_idx("MBP_BLDP: phase3 ") - + if ((do_timings).and.(idx_phase21==-1)) & + & idx_phase21 = psb_get_timer_idx("MBP_BLDP: phase2_1 ") + if ((do_timings).and.(idx_phase31==-1)) & + & idx_phase31 = psb_get_timer_idx("MBP_BLDP: phase3_1 ") + if (do_timings) call psb_tic(idx_phase1) if (present(display_out)) then @@ -330,6 +335,7 @@ contains end do if (do_timings) call psb_toc(idx_phase2) if (do_timings) call psb_tic(idx_phase3) + if (do_timings) call psb_tic(idx_phase31) ! Ok, now compute offsets, gather halo and fix non-local ! aggregates (those where ilaggr == -2) @@ -450,7 +456,7 @@ contains end do end block end if - + if (do_timings) call psb_toc(idx_phase31) ! Dirty trick: allocate tmpcoo with local ! number of aggregates, then change to ntaggr. ! Just to make sure the allocation is not global diff --git a/amgprec/amg_d_mumps_solver.F90 b/amgprec/amg_d_mumps_solver.F90 index 5329dea8..0e8375be 100644 --- a/amgprec/amg_d_mumps_solver.F90 +++ b/amgprec/amg_d_mumps_solver.F90 @@ -313,22 +313,24 @@ subroutine d_mumps_solver_finalize(sv) end subroutine d_mumps_solver_finalize -subroutine d_mumps_solver_descr(sv,info,iout,coarse) +subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_d_mumps_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np character(len=20), parameter :: name='amg_z_mumps_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -337,8 +339,13 @@ subroutine d_mumps_solver_descr(sv,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' MUMPS Solver. ' + write(iout_,*) trim(prefix_), ' MUMPS Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_d_onelev_mod.f90 b/amgprec/amg_d_onelev_mod.f90 index e924eb97..1bf30847 100644 --- a/amgprec/amg_d_onelev_mod.f90 +++ b/amgprec/amg_d_onelev_mod.f90 @@ -258,7 +258,7 @@ module amg_d_onelev_mod end interface interface - subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) + subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix) 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 @@ -269,6 +269,7 @@ module amg_d_onelev_mod 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 end subroutine amg_d_base_onelev_descr end interface diff --git a/amgprec/amg_d_parmatch_aggregator_mod.F90 b/amgprec/amg_d_parmatch_aggregator_mod.F90 index d50280d3..525bb0c3 100644 --- a/amgprec/amg_d_parmatch_aggregator_mod.F90 +++ b/amgprec/amg_d_parmatch_aggregator_mod.F90 @@ -390,18 +390,25 @@ contains end function amg_d_parmatch_aggregator_sizeof - subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info) + subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_d_parmatch_aggregator_type), intent(in) :: ag type(amg_dml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + character(1024) :: prefix_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout,*) 'Parallel Matching Aggregator' - write(iout,*) ' Number of matching sweeps: ',ag%n_sweeps - write(iout,*) ' Matching algorithm : MatchBoxP (PREIS)' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator' + write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps + write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_d_parmatch_aggregator_descr diff --git a/amgprec/amg_d_prec_type.f90 b/amgprec/amg_d_prec_type.f90 index b41243ec..0774d0ad 100644 --- a/amgprec/amg_d_prec_type.f90 +++ b/amgprec/amg_d_prec_type.f90 @@ -155,15 +155,16 @@ module amg_d_prec_type interface amg_precdescr - subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity) + subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity,prefix) import :: amg_dprec_type, psb_ipk_ implicit none ! Arguments - class(amg_dprec_type), intent(in) :: prec - integer(psb_ipk_), intent(out) :: info + class(amg_dprec_type), intent(in) :: prec + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix end subroutine amg_dfile_prec_descr end interface diff --git a/amgprec/amg_d_slu_solver.F90 b/amgprec/amg_d_slu_solver.F90 index 35f1f8c5..69983efe 100644 --- a/amgprec/amg_d_slu_solver.F90 +++ b/amgprec/amg_d_slu_solver.F90 @@ -385,20 +385,22 @@ contains end subroutine d_slu_solver_finalize - subroutine d_slu_solver_descr(sv,info,iout,coarse) + subroutine d_slu_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_d_slu_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer :: err_act character(len=20), parameter :: name='amg_d_slu_solver_descr' integer :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -407,8 +409,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_d_sludist_solver.F90 b/amgprec/amg_d_sludist_solver.F90 index a196bbfa..daa1f792 100644 --- a/amgprec/amg_d_sludist_solver.F90 +++ b/amgprec/amg_d_sludist_solver.F90 @@ -403,15 +403,16 @@ contains end subroutine d_sludist_solver_finalize - subroutine d_sludist_solver_descr(sv,info,iout,coarse) + subroutine d_sludist_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_d_sludist_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer :: err_act @@ -419,6 +420,7 @@ contains integer :: me, np character(len=20), parameter :: name='amg_d_sludist_solver_descr' integer :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -427,8 +429,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU_Dist Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU_Dist Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_d_symdec_aggregator_mod.f90 b/amgprec/amg_d_symdec_aggregator_mod.f90 index e5a2c89f..c74a6053 100644 --- a/amgprec/amg_d_symdec_aggregator_mod.f90 +++ b/amgprec/amg_d_symdec_aggregator_mod.f90 @@ -88,16 +88,25 @@ contains val = "Symmetric Decoupled aggregation" end function amg_d_symdec_aggregator_fmt - subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info) + subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_d_symdec_aggregator_type), intent(in) :: ag type(amg_dml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix - write(iout,*) 'Decoupled Aggregator locally-symmetrized' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + character(1024) :: prefix_ + + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_d_symdec_aggregator_descr diff --git a/amgprec/amg_d_umf_solver.F90 b/amgprec/amg_d_umf_solver.F90 index 586447e3..7a34ff3f 100644 --- a/amgprec/amg_d_umf_solver.F90 +++ b/amgprec/amg_d_umf_solver.F90 @@ -390,20 +390,22 @@ contains end subroutine d_umf_solver_finalize - subroutine d_umf_solver_descr(sv,info,iout,coarse) + subroutine d_umf_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_d_umf_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer :: err_act character(len=20), parameter :: name='amg_d_umf_solver_descr' integer :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -412,8 +414,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' UMFPACK Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_s_ainv_solver.F90 b/amgprec/amg_s_ainv_solver.F90 index f1a23716..8bf41b9a 100644 --- a/amgprec/amg_s_ainv_solver.F90 +++ b/amgprec/amg_s_ainv_solver.F90 @@ -198,7 +198,7 @@ module amg_s_ainv_solver !!$ end interface interface - subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse) + subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_ Implicit None @@ -208,7 +208,7 @@ module amg_s_ainv_solver integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_s_ainv_solver_descr end interface diff --git a/amgprec/amg_s_as_smoother.f90 b/amgprec/amg_s_as_smoother.f90 index 7ddaead6..84a7ba8c 100644 --- a/amgprec/amg_s_as_smoother.f90 +++ b/amgprec/amg_s_as_smoother.f90 @@ -396,21 +396,23 @@ contains end subroutine s_as_smoother_default - subroutine s_as_smoother_descr(sm,info,iout,coarse) + subroutine s_as_smoother_descr(sm,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_s_as_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_as_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -424,16 +426,21 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then - write(iout_,*) ' Additive Schwarz with ',& + write(iout_,*) trim(prefix_), ' Additive Schwarz with ',& & sm%novr, ' overlap layers.' - write(iout_,*) ' Restrictor: ',restrict_names(sm%restr) - write(iout_,*) ' Prolongator: ',prolong_names(sm%prol) - write(iout_,*) ' Local solver:' + write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr) + write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol) + write(iout_,*) trim(prefix_), ' Local solver:' endif if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if call psb_erractionrestore(err_act) diff --git a/amgprec/amg_s_base_aggregator_mod.f90 b/amgprec/amg_s_base_aggregator_mod.f90 index 2c07fc4a..4d97c06d 100644 --- a/amgprec/amg_s_base_aggregator_mod.f90 +++ b/amgprec/amg_s_base_aggregator_mod.f90 @@ -275,15 +275,22 @@ contains val = .false. end function amg_s_base_aggregator_xt_desc - subroutine amg_s_base_aggregator_descr(ag,parms,iout,info) + subroutine amg_s_base_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_s_base_aggregator_type), intent(in) :: ag type(amg_sml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + character(1024) :: prefix_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_s_base_aggregator_descr diff --git a/amgprec/amg_s_base_smoother_mod.f90 b/amgprec/amg_s_base_smoother_mod.f90 index d4493f32..39d367f8 100644 --- a/amgprec/amg_s_base_smoother_mod.f90 +++ b/amgprec/amg_s_base_smoother_mod.f90 @@ -272,7 +272,7 @@ module amg_s_base_smoother_mod end interface interface - subroutine amg_s_base_smoother_descr(sm,info,iout,coarse) + subroutine amg_s_base_smoother_descr(sm,info,iout,coarse,prefix) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & amg_s_base_smoother_type, psb_ipk_ @@ -281,6 +281,7 @@ module amg_s_base_smoother_mod integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_s_base_smoother_descr end interface diff --git a/amgprec/amg_s_base_solver_mod.f90 b/amgprec/amg_s_base_solver_mod.f90 index 07c8ee08..ad701e41 100644 --- a/amgprec/amg_s_base_solver_mod.f90 +++ b/amgprec/amg_s_base_solver_mod.f90 @@ -270,7 +270,7 @@ module amg_s_base_solver_mod end interface interface - subroutine amg_s_base_solver_descr(sv,info,iout,coarse) + subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & amg_s_base_solver_type, psb_ipk_ @@ -281,7 +281,7 @@ module amg_s_base_solver_mod integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_s_base_solver_descr end interface diff --git a/amgprec/amg_s_dec_aggregator_mod.f90 b/amgprec/amg_s_dec_aggregator_mod.f90 index 240dfaa8..2b5592c6 100644 --- a/amgprec/amg_s_dec_aggregator_mod.f90 +++ b/amgprec/amg_s_dec_aggregator_mod.f90 @@ -184,16 +184,23 @@ contains val = "Decoupled aggregation" end function amg_s_dec_aggregator_fmt - subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info) + subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_s_dec_aggregator_type), intent(in) :: ag type(amg_sml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + character(1024) :: prefix_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout,*) 'Decoupled Aggregator' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ','Decoupled Aggregator' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_s_dec_aggregator_descr diff --git a/amgprec/amg_s_diag_solver.f90 b/amgprec/amg_s_diag_solver.f90 index 39f8dbdb..ae0f9aef 100644 --- a/amgprec/amg_s_diag_solver.f90 +++ b/amgprec/amg_s_diag_solver.f90 @@ -219,7 +219,7 @@ contains end subroutine s_diag_solver_free - subroutine s_diag_solver_descr(sv,info,iout,coarse) + subroutine s_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -228,11 +228,13 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_diag_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -240,8 +242,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' Diagonal local solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' Diagonal local solver ' return @@ -352,7 +359,7 @@ module amg_s_l1_diag_solver contains - subroutine s_l1_diag_solver_descr(sv,info,iout,coarse) + subroutine s_l1_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -361,11 +368,13 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_l1_diag_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -373,8 +382,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' L1 Diagonal solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' L1 Diagonal solver ' return diff --git a/amgprec/amg_s_gs_solver.f90 b/amgprec/amg_s_gs_solver.f90 index 10950382..80ee821e 100644 --- a/amgprec/amg_s_gs_solver.f90 +++ b/amgprec/amg_s_gs_solver.f90 @@ -433,20 +433,22 @@ contains return end subroutine s_gs_solver_free - subroutine s_gs_solver_descr(sv,info,iout,coarse) + subroutine s_gs_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_s_gs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_gs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -455,12 +457,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if @@ -526,20 +533,22 @@ contains val = .true. end function s_gs_solver_is_iterative - subroutine s_bwgs_solver_descr(sv,info,iout,coarse) + subroutine s_bwgs_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_s_bwgs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_bwgs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -548,12 +557,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if diff --git a/amgprec/amg_s_id_solver.f90 b/amgprec/amg_s_id_solver.f90 index 2d565e09..d88aebca 100644 --- a/amgprec/amg_s_id_solver.f90 +++ b/amgprec/amg_s_id_solver.f90 @@ -157,7 +157,7 @@ contains return end subroutine s_id_solver_free - subroutine s_id_solver_descr(sv,info,iout,coarse) + subroutine s_id_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -165,12 +165,14 @@ contains class(amg_s_id_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_id_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -178,8 +180,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Identity local solver ' + write(iout_,*) trim(prefix_), ' Identity local solver ' return diff --git a/amgprec/amg_s_ilu_solver.f90 b/amgprec/amg_s_ilu_solver.f90 index 45e848c5..dd642746 100644 --- a/amgprec/amg_s_ilu_solver.f90 +++ b/amgprec/amg_s_ilu_solver.f90 @@ -406,7 +406,7 @@ contains return end subroutine s_ilu_solver_free - subroutine s_ilu_solver_descr(sv,info,iout,coarse) + subroutine s_ilu_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -414,12 +414,14 @@ contains class(amg_s_ilu_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_ilu_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -428,15 +430,20 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Incomplete factorization solver: ',& + write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',& & amg_fact_names(sv%fact_type) select case(sv%fact_type) case(psb_ilu_n_,psb_milu_n_) - write(iout_,*) ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in case(psb_ilu_t_) - write(iout_,*) ' Fill level:',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh end select call psb_erractionrestore(err_act) diff --git a/amgprec/amg_s_invk_solver.f90 b/amgprec/amg_s_invk_solver.f90 index c99b2184..bf288dda 100644 --- a/amgprec/amg_s_invk_solver.f90 +++ b/amgprec/amg_s_invk_solver.f90 @@ -123,7 +123,7 @@ module amg_s_invk_solver end interface interface - subroutine amg_s_invk_solver_descr(sv,info,iout,coarse) + subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix) import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_ Implicit None @@ -133,7 +133,7 @@ module amg_s_invk_solver integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_s_invk_solver_descr end interface diff --git a/amgprec/amg_s_invt_solver.f90 b/amgprec/amg_s_invt_solver.f90 index b54e738f..1096335e 100644 --- a/amgprec/amg_s_invt_solver.f90 +++ b/amgprec/amg_s_invt_solver.f90 @@ -134,16 +134,17 @@ module amg_s_invt_solver end interface interface - subroutine amg_s_invt_solver_descr(sv,info,iout,coarse) + subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix) import :: psb_spk_, amg_s_invt_solver_type, psb_ipk_ Implicit None ! Arguments class(amg_s_invt_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_s_invt_solver_descr end interface diff --git a/amgprec/amg_s_jac_smoother.f90 b/amgprec/amg_s_jac_smoother.f90 index adeeb853..6d4ded83 100644 --- a/amgprec/amg_s_jac_smoother.f90 +++ b/amgprec/amg_s_jac_smoother.f90 @@ -219,12 +219,13 @@ module amg_s_jac_smoother end interface interface - subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse,prefix) import :: amg_s_jac_smoother_type, psb_ipk_ class(amg_s_jac_smoother_type), intent(in) :: sm integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_s_jac_smoother_descr end interface @@ -313,12 +314,13 @@ module amg_s_jac_smoother end interface interface - subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) import :: amg_s_l1_jac_smoother_type, psb_ipk_ class(amg_s_l1_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_s_l1_jac_smoother_descr end interface diff --git a/amgprec/amg_s_krm_solver.f90 b/amgprec/amg_s_krm_solver.f90 index a289476e..22a09885 100644 --- a/amgprec/amg_s_krm_solver.f90 +++ b/amgprec/amg_s_krm_solver.f90 @@ -436,7 +436,7 @@ contains val = "KRM solver" end function s_krm_solver_get_fmt - subroutine s_krm_solver_descr(sv,info,iout,coarse) + subroutine s_krm_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -444,12 +444,14 @@ contains class(amg_s_krm_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_krm_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -458,17 +460,22 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%global) then - write(iout_,*) ' Krylov solver (global)' + write(iout_,*) trim(prefix_), ' Krylov solver (global)' else - write(iout_,*) ' Krylov solver (local) ' + write(iout_,*) trim(prefix_), ' Krylov solver (local) ' end if - write(iout_,*) ' method: ',sv%method - write(iout_,*) ' kprec: ',sv%kprec - call sv%prec%descr(iout_,info) - write(iout_,*) ' itmax: ',sv%itmax - write(iout_,*) ' eps: ',sv%eps + write(iout_,*) trim(prefix_), ' method: ',sv%method + write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec + call sv%prec%descr(iout_,info,prefix='KRM : '//prefix_) + write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax + write(iout_,*) trim(prefix_), ' eps: ',sv%eps call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_s_mumps_solver.F90 b/amgprec/amg_s_mumps_solver.F90 index b8363b4a..af918fcf 100644 --- a/amgprec/amg_s_mumps_solver.F90 +++ b/amgprec/amg_s_mumps_solver.F90 @@ -313,22 +313,24 @@ subroutine s_mumps_solver_finalize(sv) end subroutine s_mumps_solver_finalize -subroutine s_mumps_solver_descr(sv,info,iout,coarse) +subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_s_mumps_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np character(len=20), parameter :: name='amg_z_mumps_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -337,8 +339,13 @@ subroutine s_mumps_solver_descr(sv,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' MUMPS Solver. ' + write(iout_,*) trim(prefix_), ' MUMPS Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_s_onelev_mod.f90 b/amgprec/amg_s_onelev_mod.f90 index 4f6d293b..bd02b83b 100644 --- a/amgprec/amg_s_onelev_mod.f90 +++ b/amgprec/amg_s_onelev_mod.f90 @@ -258,7 +258,7 @@ module amg_s_onelev_mod end interface interface - subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) + subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix) 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 @@ -269,6 +269,7 @@ module amg_s_onelev_mod 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 end subroutine amg_s_base_onelev_descr end interface diff --git a/amgprec/amg_s_parmatch_aggregator_mod.F90 b/amgprec/amg_s_parmatch_aggregator_mod.F90 index d5b3b04f..d58bd750 100644 --- a/amgprec/amg_s_parmatch_aggregator_mod.F90 +++ b/amgprec/amg_s_parmatch_aggregator_mod.F90 @@ -390,18 +390,25 @@ contains end function amg_s_parmatch_aggregator_sizeof - subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info) + subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_s_parmatch_aggregator_type), intent(in) :: ag type(amg_sml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + character(1024) :: prefix_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout,*) 'Parallel Matching Aggregator' - write(iout,*) ' Number of matching sweeps: ',ag%n_sweeps - write(iout,*) ' Matching algorithm : MatchBoxP (PREIS)' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator' + write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps + write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_s_parmatch_aggregator_descr diff --git a/amgprec/amg_s_prec_type.f90 b/amgprec/amg_s_prec_type.f90 index e8dfeae4..11a789b1 100644 --- a/amgprec/amg_s_prec_type.f90 +++ b/amgprec/amg_s_prec_type.f90 @@ -155,15 +155,16 @@ module amg_s_prec_type interface amg_precdescr - subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity) + subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity,prefix) import :: amg_sprec_type, psb_ipk_ implicit none ! Arguments - class(amg_sprec_type), intent(in) :: prec - integer(psb_ipk_), intent(out) :: info + class(amg_sprec_type), intent(in) :: prec + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix end subroutine amg_sfile_prec_descr end interface diff --git a/amgprec/amg_s_slu_solver.F90 b/amgprec/amg_s_slu_solver.F90 index 3c062fd6..89cbfc5a 100644 --- a/amgprec/amg_s_slu_solver.F90 +++ b/amgprec/amg_s_slu_solver.F90 @@ -385,20 +385,22 @@ contains end subroutine s_slu_solver_finalize - subroutine s_slu_solver_descr(sv,info,iout,coarse) + subroutine s_slu_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_s_slu_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer :: err_act character(len=20), parameter :: name='amg_s_slu_solver_descr' integer :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -407,8 +409,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_s_symdec_aggregator_mod.f90 b/amgprec/amg_s_symdec_aggregator_mod.f90 index fc5553ec..6adba836 100644 --- a/amgprec/amg_s_symdec_aggregator_mod.f90 +++ b/amgprec/amg_s_symdec_aggregator_mod.f90 @@ -88,16 +88,25 @@ contains val = "Symmetric Decoupled aggregation" end function amg_s_symdec_aggregator_fmt - subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info) + subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_s_symdec_aggregator_type), intent(in) :: ag type(amg_sml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix - write(iout,*) 'Decoupled Aggregator locally-symmetrized' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + character(1024) :: prefix_ + + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_s_symdec_aggregator_descr diff --git a/amgprec/amg_z_ainv_solver.F90 b/amgprec/amg_z_ainv_solver.F90 index 9b3a22a0..cdb9a784 100644 --- a/amgprec/amg_z_ainv_solver.F90 +++ b/amgprec/amg_z_ainv_solver.F90 @@ -198,7 +198,7 @@ module amg_z_ainv_solver !!$ end interface interface - subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse) + subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_ Implicit None @@ -208,7 +208,7 @@ module amg_z_ainv_solver integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_z_ainv_solver_descr end interface diff --git a/amgprec/amg_z_as_smoother.f90 b/amgprec/amg_z_as_smoother.f90 index d79a75f0..619ee2a9 100644 --- a/amgprec/amg_z_as_smoother.f90 +++ b/amgprec/amg_z_as_smoother.f90 @@ -396,21 +396,23 @@ contains end subroutine z_as_smoother_default - subroutine z_as_smoother_descr(sm,info,iout,coarse) + subroutine z_as_smoother_descr(sm,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_z_as_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_as_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -424,16 +426,21 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then - write(iout_,*) ' Additive Schwarz with ',& + write(iout_,*) trim(prefix_), ' Additive Schwarz with ',& & sm%novr, ' overlap layers.' - write(iout_,*) ' Restrictor: ',restrict_names(sm%restr) - write(iout_,*) ' Prolongator: ',prolong_names(sm%prol) - write(iout_,*) ' Local solver:' + write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr) + write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol) + write(iout_,*) trim(prefix_), ' Local solver:' endif if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if call psb_erractionrestore(err_act) diff --git a/amgprec/amg_z_base_aggregator_mod.f90 b/amgprec/amg_z_base_aggregator_mod.f90 index 81858fb7..6b6a33be 100644 --- a/amgprec/amg_z_base_aggregator_mod.f90 +++ b/amgprec/amg_z_base_aggregator_mod.f90 @@ -275,15 +275,22 @@ contains val = .false. end function amg_z_base_aggregator_xt_desc - subroutine amg_z_base_aggregator_descr(ag,parms,iout,info) + subroutine amg_z_base_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_z_base_aggregator_type), intent(in) :: ag type(amg_dml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + character(1024) :: prefix_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_z_base_aggregator_descr diff --git a/amgprec/amg_z_base_smoother_mod.f90 b/amgprec/amg_z_base_smoother_mod.f90 index d697275a..548571c9 100644 --- a/amgprec/amg_z_base_smoother_mod.f90 +++ b/amgprec/amg_z_base_smoother_mod.f90 @@ -272,7 +272,7 @@ module amg_z_base_smoother_mod end interface interface - subroutine amg_z_base_smoother_descr(sm,info,iout,coarse) + subroutine amg_z_base_smoother_descr(sm,info,iout,coarse,prefix) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & amg_z_base_smoother_type, psb_ipk_ @@ -281,6 +281,7 @@ module amg_z_base_smoother_mod integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_z_base_smoother_descr end interface diff --git a/amgprec/amg_z_base_solver_mod.f90 b/amgprec/amg_z_base_solver_mod.f90 index 549aa0e5..7c017459 100644 --- a/amgprec/amg_z_base_solver_mod.f90 +++ b/amgprec/amg_z_base_solver_mod.f90 @@ -270,7 +270,7 @@ module amg_z_base_solver_mod end interface interface - subroutine amg_z_base_solver_descr(sv,info,iout,coarse) + subroutine amg_z_base_solver_descr(sv,info,iout,coarse,prefix) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & amg_z_base_solver_type, psb_ipk_ @@ -281,7 +281,7 @@ module amg_z_base_solver_mod integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_z_base_solver_descr end interface diff --git a/amgprec/amg_z_dec_aggregator_mod.f90 b/amgprec/amg_z_dec_aggregator_mod.f90 index 90339f11..c42f220c 100644 --- a/amgprec/amg_z_dec_aggregator_mod.f90 +++ b/amgprec/amg_z_dec_aggregator_mod.f90 @@ -184,16 +184,23 @@ contains val = "Decoupled aggregation" end function amg_z_dec_aggregator_fmt - subroutine amg_z_dec_aggregator_descr(ag,parms,iout,info) + subroutine amg_z_dec_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_z_dec_aggregator_type), intent(in) :: ag type(amg_dml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix + character(1024) :: prefix_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout,*) 'Decoupled Aggregator' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ','Decoupled Aggregator' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_z_dec_aggregator_descr diff --git a/amgprec/amg_z_diag_solver.f90 b/amgprec/amg_z_diag_solver.f90 index a24b48b7..4d3746d9 100644 --- a/amgprec/amg_z_diag_solver.f90 +++ b/amgprec/amg_z_diag_solver.f90 @@ -219,7 +219,7 @@ contains end subroutine z_diag_solver_free - subroutine z_diag_solver_descr(sv,info,iout,coarse) + subroutine z_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -228,11 +228,13 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_diag_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -240,8 +242,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' Diagonal local solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' Diagonal local solver ' return @@ -352,7 +359,7 @@ module amg_z_l1_diag_solver contains - subroutine z_l1_diag_solver_descr(sv,info,iout,coarse) + subroutine z_l1_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -361,11 +368,13 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_l1_diag_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -373,8 +382,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' L1 Diagonal solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' L1 Diagonal solver ' return diff --git a/amgprec/amg_z_gs_solver.f90 b/amgprec/amg_z_gs_solver.f90 index 7e32d258..1ac665b3 100644 --- a/amgprec/amg_z_gs_solver.f90 +++ b/amgprec/amg_z_gs_solver.f90 @@ -433,20 +433,22 @@ contains return end subroutine z_gs_solver_free - subroutine z_gs_solver_descr(sv,info,iout,coarse) + subroutine z_gs_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_z_gs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_gs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -455,12 +457,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if @@ -526,20 +533,22 @@ contains val = .true. end function z_gs_solver_is_iterative - subroutine z_bwgs_solver_descr(sv,info,iout,coarse) + subroutine z_bwgs_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_z_bwgs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_bwgs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -548,12 +557,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if diff --git a/amgprec/amg_z_id_solver.f90 b/amgprec/amg_z_id_solver.f90 index 0712061c..6a1a3afb 100644 --- a/amgprec/amg_z_id_solver.f90 +++ b/amgprec/amg_z_id_solver.f90 @@ -157,7 +157,7 @@ contains return end subroutine z_id_solver_free - subroutine z_id_solver_descr(sv,info,iout,coarse) + subroutine z_id_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -165,12 +165,14 @@ contains class(amg_z_id_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_id_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -178,8 +180,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Identity local solver ' + write(iout_,*) trim(prefix_), ' Identity local solver ' return diff --git a/amgprec/amg_z_ilu_solver.f90 b/amgprec/amg_z_ilu_solver.f90 index f6f97c21..48b5ff1f 100644 --- a/amgprec/amg_z_ilu_solver.f90 +++ b/amgprec/amg_z_ilu_solver.f90 @@ -406,7 +406,7 @@ contains return end subroutine z_ilu_solver_free - subroutine z_ilu_solver_descr(sv,info,iout,coarse) + subroutine z_ilu_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -414,12 +414,14 @@ contains class(amg_z_ilu_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_ilu_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -428,15 +430,20 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Incomplete factorization solver: ',& + write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',& & amg_fact_names(sv%fact_type) select case(sv%fact_type) case(psb_ilu_n_,psb_milu_n_) - write(iout_,*) ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in case(psb_ilu_t_) - write(iout_,*) ' Fill level:',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh end select call psb_erractionrestore(err_act) diff --git a/amgprec/amg_z_invk_solver.f90 b/amgprec/amg_z_invk_solver.f90 index 2348d7a6..6f9e8c20 100644 --- a/amgprec/amg_z_invk_solver.f90 +++ b/amgprec/amg_z_invk_solver.f90 @@ -123,7 +123,7 @@ module amg_z_invk_solver end interface interface - subroutine amg_z_invk_solver_descr(sv,info,iout,coarse) + subroutine amg_z_invk_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_z_invk_solver_type, psb_ipk_ Implicit None @@ -133,7 +133,7 @@ module amg_z_invk_solver integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix end subroutine amg_z_invk_solver_descr end interface diff --git a/amgprec/amg_z_invt_solver.f90 b/amgprec/amg_z_invt_solver.f90 index c9ec2549..f6a4c808 100644 --- a/amgprec/amg_z_invt_solver.f90 +++ b/amgprec/amg_z_invt_solver.f90 @@ -134,16 +134,17 @@ module amg_z_invt_solver end interface interface - subroutine amg_z_invt_solver_descr(sv,info,iout,coarse) + subroutine amg_z_invt_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_z_invt_solver_type, psb_ipk_ Implicit None ! Arguments class(amg_z_invt_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_z_invt_solver_descr end interface diff --git a/amgprec/amg_z_jac_smoother.f90 b/amgprec/amg_z_jac_smoother.f90 index 9420fce3..bfe83949 100644 --- a/amgprec/amg_z_jac_smoother.f90 +++ b/amgprec/amg_z_jac_smoother.f90 @@ -219,12 +219,13 @@ module amg_z_jac_smoother end interface interface - subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse,prefix) import :: amg_z_jac_smoother_type, psb_ipk_ class(amg_z_jac_smoother_type), intent(in) :: sm integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_z_jac_smoother_descr end interface @@ -313,12 +314,13 @@ module amg_z_jac_smoother end interface interface - subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) import :: amg_z_l1_jac_smoother_type, psb_ipk_ class(amg_z_l1_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_z_l1_jac_smoother_descr end interface diff --git a/amgprec/amg_z_krm_solver.f90 b/amgprec/amg_z_krm_solver.f90 index d557ca41..83bc2074 100644 --- a/amgprec/amg_z_krm_solver.f90 +++ b/amgprec/amg_z_krm_solver.f90 @@ -436,7 +436,7 @@ contains val = "KRM solver" end function z_krm_solver_get_fmt - subroutine z_krm_solver_descr(sv,info,iout,coarse) + subroutine z_krm_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -444,12 +444,14 @@ contains class(amg_z_krm_solver_type), intent(in) :: sv integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_krm_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -458,17 +460,22 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%global) then - write(iout_,*) ' Krylov solver (global)' + write(iout_,*) trim(prefix_), ' Krylov solver (global)' else - write(iout_,*) ' Krylov solver (local) ' + write(iout_,*) trim(prefix_), ' Krylov solver (local) ' end if - write(iout_,*) ' method: ',sv%method - write(iout_,*) ' kprec: ',sv%kprec - call sv%prec%descr(iout_,info) - write(iout_,*) ' itmax: ',sv%itmax - write(iout_,*) ' eps: ',sv%eps + write(iout_,*) trim(prefix_), ' method: ',sv%method + write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec + call sv%prec%descr(iout_,info,prefix='KRM : '//prefix_) + write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax + write(iout_,*) trim(prefix_), ' eps: ',sv%eps call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_z_mumps_solver.F90 b/amgprec/amg_z_mumps_solver.F90 index 2b0b8c0d..3ab54345 100644 --- a/amgprec/amg_z_mumps_solver.F90 +++ b/amgprec/amg_z_mumps_solver.F90 @@ -313,22 +313,24 @@ subroutine z_mumps_solver_finalize(sv) end subroutine z_mumps_solver_finalize -subroutine z_mumps_solver_descr(sv,info,iout,coarse) +subroutine z_mumps_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_z_mumps_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np character(len=20), parameter :: name='amg_z_mumps_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -337,8 +339,13 @@ subroutine z_mumps_solver_descr(sv,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' MUMPS Solver. ' + write(iout_,*) trim(prefix_), ' MUMPS Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_z_onelev_mod.f90 b/amgprec/amg_z_onelev_mod.f90 index 0105f358..648ede75 100644 --- a/amgprec/amg_z_onelev_mod.f90 +++ b/amgprec/amg_z_onelev_mod.f90 @@ -257,7 +257,7 @@ module amg_z_onelev_mod end interface interface - subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) + subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix) 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 @@ -268,6 +268,7 @@ module amg_z_onelev_mod 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 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 98a7aa1f..33c9324a 100644 --- a/amgprec/amg_z_prec_type.f90 +++ b/amgprec/amg_z_prec_type.f90 @@ -155,15 +155,16 @@ module amg_z_prec_type interface amg_precdescr - subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity) + subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity,prefix) import :: amg_zprec_type, psb_ipk_ implicit none ! Arguments - class(amg_zprec_type), intent(in) :: prec - integer(psb_ipk_), intent(out) :: info + class(amg_zprec_type), intent(in) :: prec + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix end subroutine amg_zfile_prec_descr end interface diff --git a/amgprec/amg_z_slu_solver.F90 b/amgprec/amg_z_slu_solver.F90 index 7be34e44..54957513 100644 --- a/amgprec/amg_z_slu_solver.F90 +++ b/amgprec/amg_z_slu_solver.F90 @@ -385,20 +385,22 @@ contains end subroutine z_slu_solver_finalize - subroutine z_slu_solver_descr(sv,info,iout,coarse) + subroutine z_slu_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_z_slu_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer :: err_act character(len=20), parameter :: name='amg_z_slu_solver_descr' integer :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -407,8 +409,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_z_sludist_solver.F90 b/amgprec/amg_z_sludist_solver.F90 index 50cd39b4..f3571a2c 100644 --- a/amgprec/amg_z_sludist_solver.F90 +++ b/amgprec/amg_z_sludist_solver.F90 @@ -403,15 +403,16 @@ contains end subroutine z_sludist_solver_finalize - subroutine z_sludist_solver_descr(sv,info,iout,coarse) + subroutine z_sludist_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_z_sludist_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer :: err_act @@ -419,6 +420,7 @@ contains integer :: me, np character(len=20), parameter :: name='amg_z_sludist_solver_descr' integer :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -427,8 +429,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU_Dist Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU_Dist Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_z_symdec_aggregator_mod.f90 b/amgprec/amg_z_symdec_aggregator_mod.f90 index 820367a8..bad271d9 100644 --- a/amgprec/amg_z_symdec_aggregator_mod.f90 +++ b/amgprec/amg_z_symdec_aggregator_mod.f90 @@ -88,16 +88,25 @@ contains val = "Symmetric Decoupled aggregation" end function amg_z_symdec_aggregator_fmt - subroutine amg_z_symdec_aggregator_descr(ag,parms,iout,info) + subroutine amg_z_symdec_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_z_symdec_aggregator_type), intent(in) :: ag type(amg_dml_parms), intent(in) :: parms integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix - write(iout,*) 'Decoupled Aggregator locally-symmetrized' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + character(1024) :: prefix_ + + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_z_symdec_aggregator_descr diff --git a/amgprec/amg_z_umf_solver.F90 b/amgprec/amg_z_umf_solver.F90 index 88641a97..549da100 100644 --- a/amgprec/amg_z_umf_solver.F90 +++ b/amgprec/amg_z_umf_solver.F90 @@ -390,20 +390,22 @@ contains end subroutine z_umf_solver_finalize - subroutine z_umf_solver_descr(sv,info,iout,coarse) + subroutine z_umf_solver_descr(sv,info,iout,coarse,prefix) Implicit None ! Arguments class(amg_z_umf_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer :: err_act character(len=20), parameter :: name='amg_z_umf_solver_descr' integer :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -412,8 +414,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' UMFPACK Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/amg_cfile_prec_descr.f90 b/amgprec/impl/amg_cfile_prec_descr.f90 index 6ce27bf2..396a9467 100644 --- a/amgprec/impl/amg_cfile_prec_descr.f90 +++ b/amgprec/impl/amg_cfile_prec_descr.f90 @@ -65,7 +65,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) +subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix) use psb_base_mod use amg_c_prec_mod, amg_protect_name => amg_cfile_prec_descr use amg_c_inner_mod @@ -73,11 +73,12 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) implicit none ! Arguments - class(amg_cprec_type), intent(in) :: prec - integer(psb_ipk_), intent(out) :: info + class(amg_cprec_type), intent(in) :: prec + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root - integer(psb_ipk_), intent(in), optional :: verbosity + integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix ! Local variables @@ -87,6 +88,7 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -101,6 +103,11 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if ctxt = prec%ctxt @@ -133,7 +140,7 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) end do write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' if (nlev == 1) then ! @@ -150,53 +157,53 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) end select end select if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + write(iout_,*) trim(prefix_), ' 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_) + write(iout_,*) trim(prefix_), 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_), 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) 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_) + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) nswps = prec%precv(1)%parms%sweeps_pre end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(prefix_), ' Number of sweeps : ',nswps + write(iout_,*) trim(prefix_) else if (nlev > 1) then ! ! Print description of base preconditioner ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) + write(iout_,*) trim(prefix_),' ', 'Multilevel Preconditioner' + write(iout_,*) trim(prefix_),' ', 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) trim(prefix_) 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_) + write(iout_,*) trim(prefix_),' ', 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_),' ', 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) 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() + write(iout_,*) trim(prefix_) + write(iout_,*) trim(prefix_),' ', 'Multilevel hierarchy: ' + write(iout_,*) trim(prefix_),' ', ' Number of levels : ',nlev + write(iout_,*) trim(prefix_),' ', ' Operator complexity: ',prec%get_complexity() + write(iout_,*) trim(prefix_),' ', ' 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) + & iout=iout_,verbosity=verbosity,prefix=prefix) end do - write(iout_,*) + write(iout_,*) trim(prefix_) else write(iout_,*) trim(name), & diff --git a/amgprec/impl/amg_dfile_prec_descr.f90 b/amgprec/impl/amg_dfile_prec_descr.f90 index ed2fd2fb..3213df29 100644 --- a/amgprec/impl/amg_dfile_prec_descr.f90 +++ b/amgprec/impl/amg_dfile_prec_descr.f90 @@ -65,7 +65,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) +subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix) use psb_base_mod use amg_d_prec_mod, amg_protect_name => amg_dfile_prec_descr use amg_d_inner_mod @@ -73,11 +73,12 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) implicit none ! Arguments - class(amg_dprec_type), intent(in) :: prec - integer(psb_ipk_), intent(out) :: info + class(amg_dprec_type), intent(in) :: prec + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root - integer(psb_ipk_), intent(in), optional :: verbosity + integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix ! Local variables @@ -87,6 +88,7 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -101,6 +103,11 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if ctxt = prec%ctxt @@ -133,7 +140,7 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) end do write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' if (nlev == 1) then ! @@ -150,53 +157,53 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) end select end select if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + write(iout_,*) trim(prefix_), ' 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_) + write(iout_,*) trim(prefix_), 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_), 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) 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_) + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) nswps = prec%precv(1)%parms%sweeps_pre end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(prefix_), ' Number of sweeps : ',nswps + write(iout_,*) trim(prefix_) else if (nlev > 1) then ! ! Print description of base preconditioner ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) + write(iout_,*) trim(prefix_),' ', 'Multilevel Preconditioner' + write(iout_,*) trim(prefix_),' ', 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) trim(prefix_) 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_) + write(iout_,*) trim(prefix_),' ', 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_),' ', 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) 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() + write(iout_,*) trim(prefix_) + write(iout_,*) trim(prefix_),' ', 'Multilevel hierarchy: ' + write(iout_,*) trim(prefix_),' ', ' Number of levels : ',nlev + write(iout_,*) trim(prefix_),' ', ' Operator complexity: ',prec%get_complexity() + write(iout_,*) trim(prefix_),' ', ' 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) + & iout=iout_,verbosity=verbosity,prefix=prefix) end do - write(iout_,*) + write(iout_,*) trim(prefix_) else write(iout_,*) trim(name), & diff --git a/amgprec/impl/amg_sfile_prec_descr.f90 b/amgprec/impl/amg_sfile_prec_descr.f90 index 61cc1ae4..5996e2a1 100644 --- a/amgprec/impl/amg_sfile_prec_descr.f90 +++ b/amgprec/impl/amg_sfile_prec_descr.f90 @@ -65,7 +65,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) +subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity,prefix) use psb_base_mod use amg_s_prec_mod, amg_protect_name => amg_sfile_prec_descr use amg_s_inner_mod @@ -73,11 +73,12 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) implicit none ! Arguments - class(amg_sprec_type), intent(in) :: prec - integer(psb_ipk_), intent(out) :: info + class(amg_sprec_type), intent(in) :: prec + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root - integer(psb_ipk_), intent(in), optional :: verbosity + integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix ! Local variables @@ -87,6 +88,7 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -101,6 +103,11 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if ctxt = prec%ctxt @@ -133,7 +140,7 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) end do write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' if (nlev == 1) then ! @@ -150,53 +157,53 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) end select end select if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + write(iout_,*) trim(prefix_), ' 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_) + write(iout_,*) trim(prefix_), 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_), 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) 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_) + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) nswps = prec%precv(1)%parms%sweeps_pre end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(prefix_), ' Number of sweeps : ',nswps + write(iout_,*) trim(prefix_) else if (nlev > 1) then ! ! Print description of base preconditioner ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) + write(iout_,*) trim(prefix_),' ', 'Multilevel Preconditioner' + write(iout_,*) trim(prefix_),' ', 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) trim(prefix_) 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_) + write(iout_,*) trim(prefix_),' ', 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_),' ', 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) 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() + write(iout_,*) trim(prefix_) + write(iout_,*) trim(prefix_),' ', 'Multilevel hierarchy: ' + write(iout_,*) trim(prefix_),' ', ' Number of levels : ',nlev + write(iout_,*) trim(prefix_),' ', ' Operator complexity: ',prec%get_complexity() + write(iout_,*) trim(prefix_),' ', ' 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) + & iout=iout_,verbosity=verbosity,prefix=prefix) end do - write(iout_,*) + write(iout_,*) trim(prefix_) else write(iout_,*) trim(name), & diff --git a/amgprec/impl/amg_zfile_prec_descr.f90 b/amgprec/impl/amg_zfile_prec_descr.f90 index fa7afe24..f3002cfd 100644 --- a/amgprec/impl/amg_zfile_prec_descr.f90 +++ b/amgprec/impl/amg_zfile_prec_descr.f90 @@ -65,7 +65,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) +subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity,prefix) use psb_base_mod use amg_z_prec_mod, amg_protect_name => amg_zfile_prec_descr use amg_z_inner_mod @@ -73,11 +73,12 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) implicit none ! Arguments - class(amg_zprec_type), intent(in) :: prec - integer(psb_ipk_), intent(out) :: info + class(amg_zprec_type), intent(in) :: prec + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: root - integer(psb_ipk_), intent(in), optional :: verbosity + integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix ! Local variables @@ -87,6 +88,7 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -101,6 +103,11 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if ctxt = prec%ctxt @@ -133,7 +140,7 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) end do write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' if (nlev == 1) then ! @@ -150,53 +157,53 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) end select end select if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + write(iout_,*) trim(prefix_), ' 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_) + write(iout_,*) trim(prefix_), 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_), 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) 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_) + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) nswps = prec%precv(1)%parms%sweeps_pre end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(prefix_), ' Number of sweeps : ',nswps + write(iout_,*) trim(prefix_) else if (nlev > 1) then ! ! Print description of base preconditioner ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) + write(iout_,*) trim(prefix_),' ', 'Multilevel Preconditioner' + write(iout_,*) trim(prefix_),' ', 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) trim(prefix_) 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_) + write(iout_,*) trim(prefix_),' ', 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_),' ', 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) 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() + write(iout_,*) trim(prefix_) + write(iout_,*) trim(prefix_),' ', 'Multilevel hierarchy: ' + write(iout_,*) trim(prefix_),' ', ' Number of levels : ',nlev + write(iout_,*) trim(prefix_),' ', ' Operator complexity: ',prec%get_complexity() + write(iout_,*) trim(prefix_),' ', ' 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) + & iout=iout_,verbosity=verbosity,prefix=prefix) end do - write(iout_,*) + write(iout_,*) trim(prefix_) else write(iout_,*) trim(name), & diff --git a/amgprec/impl/level/amg_c_base_onelev_descr.f90 b/amgprec/impl/level/amg_c_base_onelev_descr.f90 index 41a0f0c0..8c3b1e5b 100644 --- a/amgprec/impl/level/amg_c_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_c_base_onelev_descr.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) +subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity,prefix) use psb_base_mod use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_descr @@ -53,6 +53,7 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) 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 ! Local variables @@ -60,6 +61,7 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) character(len=20), parameter :: name='amg_c_base_onelev_descr' integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -79,56 +81,62 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) + write(iout_,*) trim(prefix_) if (il == ilmin) then call lv%parms%mlcycledsc(iout_,info) end if if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then if (allocated(lv%aggr)) then - call lv%aggr%descr(lv%parms,iout_,info) + call lv%aggr%descr(lv%parms,iout_,info,prefix=prefix) else - write(iout_,*) 'Internal error: unallocated aggregator object' + write(iout_,*) trim(prefix_),' ', 'Internal error: unallocated aggregator object' info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 end if - write(iout_,*) + write(iout_,*) trim(prefix_) end if if (il > 1) then if (coarse) then - write(iout_,*) ' Level ',il,' (coarse)' + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' else - write(iout_,*) ' Level ',il + write(iout_,*) trim(prefix_), ' Level ',il end if - call lv%parms%descr(iout_,info,coarse=coarse) + call lv%parms%descr(iout_,info,coarse=coarse,prefix=prefix) if (nl > 1) then if (allocated(lv%linmap%naggr)) then - write(iout_,*) ' Coarse Matrix: Global size: ', & + write(iout_,*) trim(prefix_), ' Coarse Matrix: Global size: ', & & lv%linmap%nagtot - write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + write(iout_,*) trim(prefix_), ' Nonzeros: ',lv%ac_nz_tot if (verbosity_>0) then - write(iout_,*) ' Local matrix sizes: ', & + write(iout_,*) trim(prefix_), ' Local matrix sizes: ', & & lv%linmap%naggr(:) else - write(iout_,'(2(a,1x,i12))') & + write(iout_,'(a,1x,2(a,1x,i12))') trim(prefix_),& & ' Local matrix sizes: min:', & & lv%linmap%nagmin,' max:', lv%linmap%nagmax - write(iout_,'(a,1x,f14.1)') & + write(iout_,'(a,1x,a,1x,f14.1)') trim(prefix_),& & ' avg:', & & lv%linmap%nagavg end if - write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & + write(iout_,'(a,1xa,1x,f14.2)') trim(prefix_),& + & ' Aggregation ratio: ', & & lv%szratio end if end if if (coarse.and.allocated(lv%sm)) & - & call lv%sm%descr(info,iout=iout_,coarse=coarse) + & call lv%sm%descr(info,iout=iout_,coarse=coarse,prefix=prefix) end if 9998 continue diff --git a/amgprec/impl/level/amg_d_base_onelev_descr.f90 b/amgprec/impl/level/amg_d_base_onelev_descr.f90 index 60e49464..cefa6ece 100644 --- a/amgprec/impl/level/amg_d_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_d_base_onelev_descr.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) +subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity,prefix) use psb_base_mod use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_descr @@ -53,6 +53,7 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) 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 ! Local variables @@ -60,6 +61,7 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) character(len=20), parameter :: name='amg_d_base_onelev_descr' integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -79,56 +81,62 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) + write(iout_,*) trim(prefix_) if (il == ilmin) then call lv%parms%mlcycledsc(iout_,info) end if if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then if (allocated(lv%aggr)) then - call lv%aggr%descr(lv%parms,iout_,info) + call lv%aggr%descr(lv%parms,iout_,info,prefix=prefix) else - write(iout_,*) 'Internal error: unallocated aggregator object' + write(iout_,*) trim(prefix_),' ', 'Internal error: unallocated aggregator object' info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 end if - write(iout_,*) + write(iout_,*) trim(prefix_) end if if (il > 1) then if (coarse) then - write(iout_,*) ' Level ',il,' (coarse)' + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' else - write(iout_,*) ' Level ',il + write(iout_,*) trim(prefix_), ' Level ',il end if - call lv%parms%descr(iout_,info,coarse=coarse) + call lv%parms%descr(iout_,info,coarse=coarse,prefix=prefix) if (nl > 1) then if (allocated(lv%linmap%naggr)) then - write(iout_,*) ' Coarse Matrix: Global size: ', & + write(iout_,*) trim(prefix_), ' Coarse Matrix: Global size: ', & & lv%linmap%nagtot - write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + write(iout_,*) trim(prefix_), ' Nonzeros: ',lv%ac_nz_tot if (verbosity_>0) then - write(iout_,*) ' Local matrix sizes: ', & + write(iout_,*) trim(prefix_), ' Local matrix sizes: ', & & lv%linmap%naggr(:) else - write(iout_,'(2(a,1x,i12))') & + write(iout_,'(a,1x,2(a,1x,i12))') trim(prefix_),& & ' Local matrix sizes: min:', & & lv%linmap%nagmin,' max:', lv%linmap%nagmax - write(iout_,'(a,1x,f14.1)') & + write(iout_,'(a,1x,a,1x,f14.1)') trim(prefix_),& & ' avg:', & & lv%linmap%nagavg end if - write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & + write(iout_,'(a,1xa,1x,f14.2)') trim(prefix_),& + & ' Aggregation ratio: ', & & lv%szratio end if end if if (coarse.and.allocated(lv%sm)) & - & call lv%sm%descr(info,iout=iout_,coarse=coarse) + & call lv%sm%descr(info,iout=iout_,coarse=coarse,prefix=prefix) end if 9998 continue diff --git a/amgprec/impl/level/amg_s_base_onelev_descr.f90 b/amgprec/impl/level/amg_s_base_onelev_descr.f90 index b96c005b..9de05c6e 100644 --- a/amgprec/impl/level/amg_s_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_s_base_onelev_descr.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) +subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity,prefix) use psb_base_mod use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_descr @@ -53,6 +53,7 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) 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 ! Local variables @@ -60,6 +61,7 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) character(len=20), parameter :: name='amg_s_base_onelev_descr' integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -79,56 +81,62 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) + write(iout_,*) trim(prefix_) if (il == ilmin) then call lv%parms%mlcycledsc(iout_,info) end if if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then if (allocated(lv%aggr)) then - call lv%aggr%descr(lv%parms,iout_,info) + call lv%aggr%descr(lv%parms,iout_,info,prefix=prefix) else - write(iout_,*) 'Internal error: unallocated aggregator object' + write(iout_,*) trim(prefix_),' ', 'Internal error: unallocated aggregator object' info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 end if - write(iout_,*) + write(iout_,*) trim(prefix_) end if if (il > 1) then if (coarse) then - write(iout_,*) ' Level ',il,' (coarse)' + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' else - write(iout_,*) ' Level ',il + write(iout_,*) trim(prefix_), ' Level ',il end if - call lv%parms%descr(iout_,info,coarse=coarse) + call lv%parms%descr(iout_,info,coarse=coarse,prefix=prefix) if (nl > 1) then if (allocated(lv%linmap%naggr)) then - write(iout_,*) ' Coarse Matrix: Global size: ', & + write(iout_,*) trim(prefix_), ' Coarse Matrix: Global size: ', & & lv%linmap%nagtot - write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + write(iout_,*) trim(prefix_), ' Nonzeros: ',lv%ac_nz_tot if (verbosity_>0) then - write(iout_,*) ' Local matrix sizes: ', & + write(iout_,*) trim(prefix_), ' Local matrix sizes: ', & & lv%linmap%naggr(:) else - write(iout_,'(2(a,1x,i12))') & + write(iout_,'(a,1x,2(a,1x,i12))') trim(prefix_),& & ' Local matrix sizes: min:', & & lv%linmap%nagmin,' max:', lv%linmap%nagmax - write(iout_,'(a,1x,f14.1)') & + write(iout_,'(a,1x,a,1x,f14.1)') trim(prefix_),& & ' avg:', & & lv%linmap%nagavg end if - write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & + write(iout_,'(a,1xa,1x,f14.2)') trim(prefix_),& + & ' Aggregation ratio: ', & & lv%szratio end if end if if (coarse.and.allocated(lv%sm)) & - & call lv%sm%descr(info,iout=iout_,coarse=coarse) + & call lv%sm%descr(info,iout=iout_,coarse=coarse,prefix=prefix) end if 9998 continue diff --git a/amgprec/impl/level/amg_z_base_onelev_descr.f90 b/amgprec/impl/level/amg_z_base_onelev_descr.f90 index 913289f7..99a1e9d7 100644 --- a/amgprec/impl/level/amg_z_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_z_base_onelev_descr.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) +subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity,prefix) use psb_base_mod use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_descr @@ -53,6 +53,7 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) 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 ! Local variables @@ -60,6 +61,7 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) character(len=20), parameter :: name='amg_z_base_onelev_descr' integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -79,56 +81,62 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) + write(iout_,*) trim(prefix_) if (il == ilmin) then call lv%parms%mlcycledsc(iout_,info) end if if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then if (allocated(lv%aggr)) then - call lv%aggr%descr(lv%parms,iout_,info) + call lv%aggr%descr(lv%parms,iout_,info,prefix=prefix) else - write(iout_,*) 'Internal error: unallocated aggregator object' + write(iout_,*) trim(prefix_),' ', 'Internal error: unallocated aggregator object' info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 end if - write(iout_,*) + write(iout_,*) trim(prefix_) end if if (il > 1) then if (coarse) then - write(iout_,*) ' Level ',il,' (coarse)' + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' else - write(iout_,*) ' Level ',il + write(iout_,*) trim(prefix_), ' Level ',il end if - call lv%parms%descr(iout_,info,coarse=coarse) + call lv%parms%descr(iout_,info,coarse=coarse,prefix=prefix) if (nl > 1) then if (allocated(lv%linmap%naggr)) then - write(iout_,*) ' Coarse Matrix: Global size: ', & + write(iout_,*) trim(prefix_), ' Coarse Matrix: Global size: ', & & lv%linmap%nagtot - write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + write(iout_,*) trim(prefix_), ' Nonzeros: ',lv%ac_nz_tot if (verbosity_>0) then - write(iout_,*) ' Local matrix sizes: ', & + write(iout_,*) trim(prefix_), ' Local matrix sizes: ', & & lv%linmap%naggr(:) else - write(iout_,'(2(a,1x,i12))') & + write(iout_,'(a,1x,2(a,1x,i12))') trim(prefix_),& & ' Local matrix sizes: min:', & & lv%linmap%nagmin,' max:', lv%linmap%nagmax - write(iout_,'(a,1x,f14.1)') & + write(iout_,'(a,1x,a,1x,f14.1)') trim(prefix_),& & ' avg:', & & lv%linmap%nagavg end if - write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & + write(iout_,'(a,1xa,1x,f14.2)') trim(prefix_),& + & ' Aggregation ratio: ', & & lv%szratio end if end if if (coarse.and.allocated(lv%sm)) & - & call lv%sm%descr(info,iout=iout_,coarse=coarse) + & call lv%sm%descr(info,iout=iout_,coarse=coarse,prefix=prefix) end if 9998 continue diff --git a/amgprec/impl/smoother/amg_c_base_smoother_descr.f90 b/amgprec/impl/smoother/amg_c_base_smoother_descr.f90 index 1b3839f1..4ed7798c 100644 --- a/amgprec/impl/smoother/amg_c_base_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_c_base_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_base_smoother_descr(sm,info,iout,coarse) +subroutine amg_c_base_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_c_base_smoother_mod, amg_protect_name => amg_c_base_smoother_descr @@ -47,12 +47,14 @@ subroutine amg_c_base_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_base_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -68,20 +70,25 @@ subroutine amg_c_base_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit end if + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (coarse_) then - if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse) + if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse,prefix=prefix) else if (allocated(sm%sv)) then select type (sv => sm%sv) class is (amg_c_id_solver_type) - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' class default - write(iout_,*) 'Decoupled preconditioner/smoother with local solver' - call sm%sv%descr(info,iout,coarse) + write(iout_,*) trim(prefix_), 'Decoupled preconditioner/smoother with local solver' + call sm%sv%descr(info,iout,coarse,prefix=prefix) end select else - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' end if end if diff --git a/amgprec/impl/smoother/amg_c_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_c_jac_smoother_descr.f90 index 522954f8..f0f670cc 100644 --- a/amgprec/impl/smoother/amg_c_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_c_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_c_diag_solver @@ -50,12 +50,14 @@ subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_c_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_c_bwgs_solver_type) - write(iout_,*) ' Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Backward Gauss-Seidel ' class is (amg_c_gs_solver_type) - write(iout_,*) ' Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_c_l1_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_c_l1_jac_smoother_descr.f90 index 3b8507b4..fb053d86 100644 --- a/amgprec/impl/smoother/amg_c_l1_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_c_l1_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_c_diag_solver @@ -50,12 +50,14 @@ subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_l1_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_c_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_c_bwgs_solver_type) - write(iout_,*) ' L1-Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Backward Gauss-Seidel ' class is (amg_c_gs_solver_type) - write(iout_,*) ' L1-Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' L1-Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_d_base_smoother_descr.f90 b/amgprec/impl/smoother/amg_d_base_smoother_descr.f90 index b6251836..2c59b7d2 100644 --- a/amgprec/impl/smoother/amg_d_base_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_d_base_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_base_smoother_descr(sm,info,iout,coarse) +subroutine amg_d_base_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_d_base_smoother_mod, amg_protect_name => amg_d_base_smoother_descr @@ -47,12 +47,14 @@ subroutine amg_d_base_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_base_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -68,20 +70,25 @@ subroutine amg_d_base_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit end if + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (coarse_) then - if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse) + if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse,prefix=prefix) else if (allocated(sm%sv)) then select type (sv => sm%sv) class is (amg_d_id_solver_type) - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' class default - write(iout_,*) 'Decoupled preconditioner/smoother with local solver' - call sm%sv%descr(info,iout,coarse) + write(iout_,*) trim(prefix_), 'Decoupled preconditioner/smoother with local solver' + call sm%sv%descr(info,iout,coarse,prefix=prefix) end select else - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' end if end if diff --git a/amgprec/impl/smoother/amg_d_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_d_jac_smoother_descr.f90 index b2cf9896..11d6bbad 100644 --- a/amgprec/impl/smoother/amg_d_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_d_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_d_diag_solver @@ -50,12 +50,14 @@ subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_d_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_d_bwgs_solver_type) - write(iout_,*) ' Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Backward Gauss-Seidel ' class is (amg_d_gs_solver_type) - write(iout_,*) ' Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_d_l1_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_d_l1_jac_smoother_descr.f90 index d4588efb..015a1256 100644 --- a/amgprec/impl/smoother/amg_d_l1_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_d_l1_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_d_diag_solver @@ -50,12 +50,14 @@ subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_l1_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_d_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_d_bwgs_solver_type) - write(iout_,*) ' L1-Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Backward Gauss-Seidel ' class is (amg_d_gs_solver_type) - write(iout_,*) ' L1-Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' L1-Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_s_base_smoother_descr.f90 b/amgprec/impl/smoother/amg_s_base_smoother_descr.f90 index efa282b2..f81f9c95 100644 --- a/amgprec/impl/smoother/amg_s_base_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_s_base_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_base_smoother_descr(sm,info,iout,coarse) +subroutine amg_s_base_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_s_base_smoother_mod, amg_protect_name => amg_s_base_smoother_descr @@ -47,12 +47,14 @@ subroutine amg_s_base_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_base_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -68,20 +70,25 @@ subroutine amg_s_base_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit end if + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (coarse_) then - if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse) + if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse,prefix=prefix) else if (allocated(sm%sv)) then select type (sv => sm%sv) class is (amg_s_id_solver_type) - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' class default - write(iout_,*) 'Decoupled preconditioner/smoother with local solver' - call sm%sv%descr(info,iout,coarse) + write(iout_,*) trim(prefix_), 'Decoupled preconditioner/smoother with local solver' + call sm%sv%descr(info,iout,coarse,prefix=prefix) end select else - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' end if end if diff --git a/amgprec/impl/smoother/amg_s_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_s_jac_smoother_descr.f90 index 9b5f21ae..08836ea2 100644 --- a/amgprec/impl/smoother/amg_s_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_s_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_s_diag_solver @@ -50,12 +50,14 @@ subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_s_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_s_bwgs_solver_type) - write(iout_,*) ' Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Backward Gauss-Seidel ' class is (amg_s_gs_solver_type) - write(iout_,*) ' Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_s_l1_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_s_l1_jac_smoother_descr.f90 index 838344ae..ea458a0f 100644 --- a/amgprec/impl/smoother/amg_s_l1_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_s_l1_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_s_diag_solver @@ -50,12 +50,14 @@ subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_l1_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_s_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_s_bwgs_solver_type) - write(iout_,*) ' L1-Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Backward Gauss-Seidel ' class is (amg_s_gs_solver_type) - write(iout_,*) ' L1-Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' L1-Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_z_base_smoother_descr.f90 b/amgprec/impl/smoother/amg_z_base_smoother_descr.f90 index d77f0292..42d9cbb9 100644 --- a/amgprec/impl/smoother/amg_z_base_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_z_base_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_base_smoother_descr(sm,info,iout,coarse) +subroutine amg_z_base_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_z_base_smoother_mod, amg_protect_name => amg_z_base_smoother_descr @@ -47,12 +47,14 @@ subroutine amg_z_base_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_base_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -68,20 +70,25 @@ subroutine amg_z_base_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit end if + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (coarse_) then - if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse) + if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse,prefix=prefix) else if (allocated(sm%sv)) then select type (sv => sm%sv) class is (amg_z_id_solver_type) - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' class default - write(iout_,*) 'Decoupled preconditioner/smoother with local solver' - call sm%sv%descr(info,iout,coarse) + write(iout_,*) trim(prefix_), 'Decoupled preconditioner/smoother with local solver' + call sm%sv%descr(info,iout,coarse,prefix=prefix) end select else - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' end if end if diff --git a/amgprec/impl/smoother/amg_z_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_z_jac_smoother_descr.f90 index 7d4bb9cf..79f85d23 100644 --- a/amgprec/impl/smoother/amg_z_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_z_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_z_diag_solver @@ -50,12 +50,14 @@ subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_z_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_z_bwgs_solver_type) - write(iout_,*) ' Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Backward Gauss-Seidel ' class is (amg_z_gs_solver_type) - write(iout_,*) ' Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_z_l1_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_z_l1_jac_smoother_descr.f90 index e050c864..63ebf9ee 100644 --- a/amgprec/impl/smoother/amg_z_l1_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_z_l1_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_z_diag_solver @@ -50,12 +50,14 @@ subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse - + character(len=*), intent(in), optional :: prefix + ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_l1_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_z_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_z_bwgs_solver_type) - write(iout_,*) ' L1-Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Backward Gauss-Seidel ' class is (amg_z_gs_solver_type) - write(iout_,*) ' L1-Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' L1-Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/solver/amg_c_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_c_ainv_solver_descr.f90 index 9a25435f..8bbdf666 100644 --- a/amgprec/impl/solver/amg_c_ainv_solver_descr.f90 +++ b/amgprec/impl/solver/amg_c_ainv_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse) +subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_ainv_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,11 +63,16 @@ subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' - write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) - write(iout_,*) ' Fill level : ',sv%fill_in - write(iout_,*) ' Fill threshold : ',sv%thresh + write(iout_,*) trim(prefix_), ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) trim(prefix_), ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) trim(prefix_), ' Fill level : ',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold : ',sv%thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_c_base_solver_descr.f90 b/amgprec/impl/solver/amg_c_base_solver_descr.f90 index 2d6d0e1a..b768d52b 100644 --- a/amgprec/impl/solver/amg_c_base_solver_descr.f90 +++ b/amgprec/impl/solver/amg_c_base_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_base_solver_descr(sv,info,iout,coarse) +subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_c_base_solver_mod, amg_protect_name => amg_c_base_solver_descr @@ -45,6 +45,7 @@ subroutine amg_c_base_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act diff --git a/amgprec/impl/solver/amg_c_invk_solver_descr.f90 b/amgprec/impl/solver/amg_c_invk_solver_descr.f90 index 50b97117..46b79813 100644 --- a/amgprec/impl/solver/amg_c_invk_solver_descr.f90 +++ b/amgprec/impl/solver/amg_c_invk_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_invk_solver_descr(sv,info,iout,coarse) +subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_c_invk_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_invk_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,10 +63,15 @@ subroutine amg_c_invk_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_c_invt_solver_descr.f90 b/amgprec/impl/solver/amg_c_invt_solver_descr.f90 index cc3b90dc..5a8508c5 100644 --- a/amgprec/impl/solver/amg_c_invt_solver_descr.f90 +++ b/amgprec/impl/solver/amg_c_invt_solver_descr.f90 @@ -35,8 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_invt_solver_descr(sv,info,iout,coarse) - +subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_c_invt_solver, amg_protect_name => amg_c_invt_solver_descr @@ -48,11 +47,13 @@ subroutine amg_c_invt_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_c_invt_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,12 +62,17 @@ subroutine amg_c_invt_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh - write(iout_,*) ' Inverse fill level :',sv%inv_fill - write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + write(iout_,*) trim(prefix_), ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' Inverse fill threshold :',sv%inv_thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_d_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_d_ainv_solver_descr.f90 index 4205f75b..cca5d2f9 100644 --- a/amgprec/impl/solver/amg_d_ainv_solver_descr.f90 +++ b/amgprec/impl/solver/amg_d_ainv_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse) +subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_ainv_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,11 +63,16 @@ subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' - write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) - write(iout_,*) ' Fill level : ',sv%fill_in - write(iout_,*) ' Fill threshold : ',sv%thresh + write(iout_,*) trim(prefix_), ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) trim(prefix_), ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) trim(prefix_), ' Fill level : ',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold : ',sv%thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_d_base_solver_descr.f90 b/amgprec/impl/solver/amg_d_base_solver_descr.f90 index 5d54523d..46f94c38 100644 --- a/amgprec/impl/solver/amg_d_base_solver_descr.f90 +++ b/amgprec/impl/solver/amg_d_base_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_base_solver_descr(sv,info,iout,coarse) +subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_d_base_solver_mod, amg_protect_name => amg_d_base_solver_descr @@ -45,6 +45,7 @@ subroutine amg_d_base_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act diff --git a/amgprec/impl/solver/amg_d_invk_solver_descr.f90 b/amgprec/impl/solver/amg_d_invk_solver_descr.f90 index b8658e8c..3a0633c2 100644 --- a/amgprec/impl/solver/amg_d_invk_solver_descr.f90 +++ b/amgprec/impl/solver/amg_d_invk_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_invk_solver_descr(sv,info,iout,coarse) +subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_d_invk_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_invk_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,10 +63,15 @@ subroutine amg_d_invk_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_d_invt_solver_descr.f90 b/amgprec/impl/solver/amg_d_invt_solver_descr.f90 index f2f4fba4..33d7b32f 100644 --- a/amgprec/impl/solver/amg_d_invt_solver_descr.f90 +++ b/amgprec/impl/solver/amg_d_invt_solver_descr.f90 @@ -35,8 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_invt_solver_descr(sv,info,iout,coarse) - +subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_d_invt_solver, amg_protect_name => amg_d_invt_solver_descr @@ -48,11 +47,13 @@ subroutine amg_d_invt_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_d_invt_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,12 +62,17 @@ subroutine amg_d_invt_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh - write(iout_,*) ' Inverse fill level :',sv%inv_fill - write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + write(iout_,*) trim(prefix_), ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' Inverse fill threshold :',sv%inv_thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_s_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_s_ainv_solver_descr.f90 index d6cd87b7..5f39a070 100644 --- a/amgprec/impl/solver/amg_s_ainv_solver_descr.f90 +++ b/amgprec/impl/solver/amg_s_ainv_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse) +subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_ainv_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,11 +63,16 @@ subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' - write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) - write(iout_,*) ' Fill level : ',sv%fill_in - write(iout_,*) ' Fill threshold : ',sv%thresh + write(iout_,*) trim(prefix_), ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) trim(prefix_), ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) trim(prefix_), ' Fill level : ',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold : ',sv%thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_s_base_solver_descr.f90 b/amgprec/impl/solver/amg_s_base_solver_descr.f90 index 25eccf82..ee6f0922 100644 --- a/amgprec/impl/solver/amg_s_base_solver_descr.f90 +++ b/amgprec/impl/solver/amg_s_base_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_base_solver_descr(sv,info,iout,coarse) +subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_s_base_solver_mod, amg_protect_name => amg_s_base_solver_descr @@ -45,6 +45,7 @@ subroutine amg_s_base_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act diff --git a/amgprec/impl/solver/amg_s_invk_solver_descr.f90 b/amgprec/impl/solver/amg_s_invk_solver_descr.f90 index 7b38d124..b793b98b 100644 --- a/amgprec/impl/solver/amg_s_invk_solver_descr.f90 +++ b/amgprec/impl/solver/amg_s_invk_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_invk_solver_descr(sv,info,iout,coarse) +subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_s_invk_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_invk_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,10 +63,15 @@ subroutine amg_s_invk_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_s_invt_solver_descr.f90 b/amgprec/impl/solver/amg_s_invt_solver_descr.f90 index 822c7a3b..d706096c 100644 --- a/amgprec/impl/solver/amg_s_invt_solver_descr.f90 +++ b/amgprec/impl/solver/amg_s_invt_solver_descr.f90 @@ -35,8 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_invt_solver_descr(sv,info,iout,coarse) - +subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_s_invt_solver, amg_protect_name => amg_s_invt_solver_descr @@ -48,11 +47,13 @@ subroutine amg_s_invt_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_s_invt_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,12 +62,17 @@ subroutine amg_s_invt_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh - write(iout_,*) ' Inverse fill level :',sv%inv_fill - write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + write(iout_,*) trim(prefix_), ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' Inverse fill threshold :',sv%inv_thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_z_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_z_ainv_solver_descr.f90 index 9bc96160..c208e68d 100644 --- a/amgprec/impl/solver/amg_z_ainv_solver_descr.f90 +++ b/amgprec/impl/solver/amg_z_ainv_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse) +subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_ainv_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,11 +63,16 @@ subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' - write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) - write(iout_,*) ' Fill level : ',sv%fill_in - write(iout_,*) ' Fill threshold : ',sv%thresh + write(iout_,*) trim(prefix_), ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) trim(prefix_), ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) trim(prefix_), ' Fill level : ',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold : ',sv%thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_z_base_solver_descr.f90 b/amgprec/impl/solver/amg_z_base_solver_descr.f90 index 3a666273..a2035b02 100644 --- a/amgprec/impl/solver/amg_z_base_solver_descr.f90 +++ b/amgprec/impl/solver/amg_z_base_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_base_solver_descr(sv,info,iout,coarse) +subroutine amg_z_base_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_z_base_solver_mod, amg_protect_name => amg_z_base_solver_descr @@ -45,6 +45,7 @@ subroutine amg_z_base_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act diff --git a/amgprec/impl/solver/amg_z_invk_solver_descr.f90 b/amgprec/impl/solver/amg_z_invk_solver_descr.f90 index 0920e570..9bbd88ac 100644 --- a/amgprec/impl/solver/amg_z_invk_solver_descr.f90 +++ b/amgprec/impl/solver/amg_z_invk_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_invk_solver_descr(sv,info,iout,coarse) +subroutine amg_z_invk_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_z_invk_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_invk_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,10 +63,15 @@ subroutine amg_z_invk_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_z_invt_solver_descr.f90 b/amgprec/impl/solver/amg_z_invt_solver_descr.f90 index 653f90b1..50f73de2 100644 --- a/amgprec/impl/solver/amg_z_invt_solver_descr.f90 +++ b/amgprec/impl/solver/amg_z_invt_solver_descr.f90 @@ -35,8 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_invt_solver_descr(sv,info,iout,coarse) - +subroutine amg_z_invt_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_z_invt_solver, amg_protect_name => amg_z_invt_solver_descr @@ -48,11 +47,13 @@ subroutine amg_z_invt_solver_descr(sv,info,iout,coarse) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: iout logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer(psb_ipk_) :: err_act character(len=20), parameter :: name='amg_z_invt_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,12 +62,17 @@ subroutine amg_z_invt_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh - write(iout_,*) ' Inverse fill level :',sv%inv_fill - write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + write(iout_,*) trim(prefix_), ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' Inverse fill threshold :',sv%inv_thresh call psb_erractionrestore(err_act) return