diff --git a/amgprec/amg_base_prec_type.F90 b/amgprec/amg_base_prec_type.F90 index a5ee00e2..52acb6e2 100644 --- a/amgprec/amg_base_prec_type.F90 +++ b/amgprec/amg_base_prec_type.F90 @@ -50,16 +50,16 @@ ! ! It contains routines for ! - converting character constants defining the preconditioner into integer -! constants; +! constants; ! - checking if the preconditioner is correctly defined; ! - printing a description of the preconditioner; -! - deallocating the preconditioner data structure. +! - deallocating the preconditioner data structure. ! module amg_base_prec_type ! - ! This reduces the size of .mod file. Without the ONLY clause compilation + ! This reduces the size of .mod file. Without the ONLY clause compilation ! blows up on some systems. ! use psb_const_mod @@ -78,7 +78,7 @@ module amg_base_prec_type & psb_err_from_subroutine_, psb_err_missing_override_method_, & & psb_error_handler, psb_out_unit, psb_err_unit - ! + ! ! Version numbers ! character(len=*), parameter :: amg_version_string_ = "1.0.0" @@ -120,7 +120,7 @@ module amg_base_prec_type procedure, pass(pm) :: printout => d_ml_parms_printout end type amg_dml_parms - + type amg_iaggr_data ! @@ -134,32 +134,32 @@ module amg_base_prec_type integer(psb_ipk_) :: min_coarse_size = -ione integer(psb_ipk_) :: min_coarse_size_per_process = -ione integer(psb_lpk_) :: target_coarse_size - ! 2. maximum number of levels. Defaults to 20 + ! 2. maximum number of levels. Defaults to 20 integer(psb_ipk_) :: max_levs = 20_psb_ipk_ end type amg_iaggr_data - + type, extends(amg_iaggr_data) :: amg_saggr_data - ! 3. min_cr_ratio = 1.5 + ! 3. min_cr_ratio = 1.5 real(psb_spk_) :: min_cr_ratio = 1.5_psb_spk_ real(psb_spk_) :: op_complexity = szero real(psb_spk_) :: avg_cr = szero end type amg_saggr_data type, extends(amg_iaggr_data) :: amg_daggr_data - ! 3. min_cr_ratio = 1.5 + ! 3. min_cr_ratio = 1.5 real(psb_dpk_) :: min_cr_ratio = 1.5_psb_dpk_ real(psb_dpk_) :: op_complexity = dzero real(psb_dpk_) :: avg_cr = dzero end type amg_daggr_data - + ! ! Entries in iprcparm ! ! These are in baseprec - ! - integer(psb_ipk_), parameter :: amg_smoother_type_ = 1 + ! + integer(psb_ipk_), parameter :: amg_smoother_type_ = 1 integer(psb_ipk_), parameter :: amg_sub_solve_ = 2 integer(psb_ipk_), parameter :: amg_sub_restr_ = 3 integer(psb_ipk_), parameter :: amg_sub_prol_ = 4 @@ -169,7 +169,7 @@ module amg_base_prec_type ! ! These are in onelev - ! + ! integer(psb_ipk_), parameter :: amg_ml_cycle_ = 20 integer(psb_ipk_), parameter :: amg_smoother_sweeps_pre_ = 21 integer(psb_ipk_), parameter :: amg_smoother_sweeps_post_ = 22 @@ -181,7 +181,7 @@ module amg_base_prec_type integer(psb_ipk_), parameter :: amg_aggr_eig_ = 28 integer(psb_ipk_), parameter :: amg_aggr_filter_ = 29 integer(psb_ipk_), parameter :: amg_coarse_mat_ = 30 - integer(psb_ipk_), parameter :: amg_coarse_solve_ = 31 + integer(psb_ipk_), parameter :: amg_coarse_solve_ = 31 integer(psb_ipk_), parameter :: amg_coarse_sweeps_ = 32 integer(psb_ipk_), parameter :: amg_coarse_fillin_ = 33 integer(psb_ipk_), parameter :: amg_coarse_subsolve_ = 34 @@ -196,7 +196,7 @@ module amg_base_prec_type ! ! Legal values for entry: amg_smoother_type_ - ! + ! integer(psb_ipk_), parameter :: amg_min_prec_ = 0 integer(psb_ipk_), parameter :: amg_noprec_ = 0 integer(psb_ipk_), parameter :: amg_base_smooth_ = 0 @@ -234,7 +234,8 @@ module amg_base_prec_type integer(psb_ipk_), parameter :: amg_sludist_ = amg_slv_delta_+9 integer(psb_ipk_), parameter :: amg_mumps_ = amg_slv_delta_+10 integer(psb_ipk_), parameter :: amg_bwgs_ = amg_slv_delta_+11 - integer(psb_ipk_), parameter :: amg_max_sub_solve_ = amg_slv_delta_+11 + integer(psb_ipk_), parameter :: amg_krm_ = amg_slv_delta_+12 + integer(psb_ipk_), parameter :: amg_max_sub_solve_ = amg_slv_delta_+12 integer(psb_ipk_), parameter :: amg_min_sub_solve_ = amg_diag_scale_ ! @@ -392,7 +393,7 @@ module amg_base_prec_type & 'MILU(n) ','ILU(t,n) ',& & 'SuperLU ','UMFPACK LU ',& & 'SuperLU_Dist ','MUMPS ',& - & 'Backward GS '/) + & 'Backward GS ','Krylov Method '/) interface amg_check_def module procedure amg_icheck_def, amg_scheck_def, amg_dcheck_def @@ -427,7 +428,7 @@ contains do_remap = val end subroutine amg_set_do_remap - + ! ! Function: amg_stringval ! @@ -442,10 +443,10 @@ contains ! function amg_stringval(string) result(val) use psb_prec_const_mod - implicit none + implicit none ! Arguments character(len=*), intent(in) :: string - integer(psb_ipk_) :: val + integer(psb_ipk_) :: val character(len=*), parameter :: name='amg_stringval' ! Local variable integer :: index_tab @@ -453,14 +454,14 @@ contains index_tab=index(string,char(9)) if (index_tab.NE.0) then string2=string(1:index_tab-1) - else + else string2=string endif select case(psb_toupper(trim(string2))) case('NONE') val = 0 case('HALO') - val = psb_halo_ + val = psb_halo_ case('SUM') val = psb_sum_ case('AVG') @@ -545,6 +546,8 @@ contains val = amg_jac_ case('L1-JACOBI') val = amg_l1_jac_ + case('KRM') + val = amg_krm_ case('AS') val = amg_as_ case('A_NORMI') @@ -569,47 +572,47 @@ contains end function amg_stringval subroutine ml_parms_get_coarse(pm,pmin) - implicit none + implicit none class(amg_ml_parms), intent(inout) :: pm class(amg_ml_parms), intent(in) :: pmin pm%coarse_mat = pmin%coarse_mat pm%coarse_solve = pmin%coarse_solve end subroutine ml_parms_get_coarse - - - + + + subroutine ml_parms_printout(pm,iout) - implicit none + implicit none class(amg_ml_parms), intent(in) :: pm integer(psb_ipk_), intent(in) :: iout - + write(iout,*) 'ML : ',pm%ml_cycle write(iout,*) 'Sweeps: ',pm%sweeps_pre,pm%sweeps_post write(iout,*) 'AGGR : ',pm%par_aggr_alg,pm%aggr_prol, pm%aggr_ord write(iout,*) ' : ',pm%aggr_omega_alg,pm%aggr_eig,pm%aggr_filter write(iout,*) 'COARSE: ',pm%coarse_mat,pm%coarse_solve end subroutine ml_parms_printout - - + + subroutine s_ml_parms_printout(pm,iout) - implicit none + implicit none class(amg_sml_parms), intent(in) :: pm integer(psb_ipk_), intent(in) :: iout - + call pm%amg_ml_parms%printout(iout) write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh end subroutine s_ml_parms_printout - - + + subroutine d_ml_parms_printout(pm,iout) - implicit none + implicit none class(amg_dml_parms), intent(in) :: pm integer(psb_ipk_), intent(in) :: iout - + call pm%amg_ml_parms%printout(iout) write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh end subroutine d_ml_parms_printout - + ! ! Routines printing out a description of the preconditioner @@ -625,7 +628,7 @@ contains info = psb_success_ if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then - + write(iout,*) ' Multilevel cycle: ',& & ml_names(pm%ml_cycle) select case (pm%ml_cycle) @@ -651,7 +654,7 @@ contains info = psb_success_ if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then - + write(iout,*) ' Parallel aggregation algorithm: ',& & par_aggr_alg_names(pm%par_aggr_alg) if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',& @@ -663,23 +666,23 @@ contains write(iout,*) ' Aggregation prolongator: ', & & aggr_prols(pm%aggr_prol) if (pm%aggr_prol /= amg_no_smooth_) then - write(iout,*) ' with: ', aggr_filters(pm%aggr_filter) - if (pm%aggr_omega_alg == amg_eig_est_) then + write(iout,*) ' 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: ', & & eigen_estimates(pm%aggr_eig) - else if (pm%aggr_omega_alg == amg_user_choice_) then + else if (pm%aggr_omega_alg == amg_user_choice_) then write(iout,*) ' Damping omega computation: user defined value.' - else + else write(iout,*) ' Damping omega computation: unknown value in iprcparm!!' end if end if !end if else write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',& - & pm%ml_cycle + & pm%ml_cycle end if - + return end subroutine ml_parms_mldescr @@ -696,13 +699,13 @@ contains logical :: coarse_ info = psb_success_ - if (present(coarse)) then + if (present(coarse)) then coarse_ = coarse else coarse_ = .false. end if - if (coarse_) then + if (coarse_) then call pm%coarsedescr(iout,info) end if @@ -725,12 +728,12 @@ contains write(iout,*) ' Coarse matrix: ',& & matrix_names(pm%coarse_mat) select case(pm%coarse_solve) - case (amg_bjac_,amg_as_) + case (amg_bjac_,amg_as_) write(iout,*) ' Number of sweeps : ',& & pm%sweeps_pre write(iout,*) ' Coarse solver: ',& & 'Block Jacobi' - case (amg_l1_bjac_) + case (amg_l1_bjac_) write(iout,*) ' Number of sweeps : ',& & pm%sweeps_pre write(iout,*) ' Coarse solver: ',& @@ -797,7 +800,7 @@ contains ! function is_legal_base_prec(ip) - implicit none + implicit none integer(psb_ipk_), intent(in) :: ip logical :: is_legal_base_prec @@ -805,44 +808,44 @@ contains return end function is_legal_base_prec function is_int_non_negative(ip) - implicit none + implicit none integer(psb_ipk_), intent(in) :: ip logical :: is_int_non_negative - is_int_non_negative = (ip >= 0) + is_int_non_negative = (ip >= 0) return end function is_int_non_negative function is_legal_ilu_scale(ip) - implicit none + implicit none integer(psb_ipk_), intent(in) :: ip logical :: is_legal_ilu_scale is_legal_ilu_scale = ((ip >= amg_ilu_scale_none_).and.(ip <= amg_max_ilu_scale_)) return end function is_legal_ilu_scale function is_int_positive(ip) - implicit none + implicit none integer(psb_ipk_), intent(in) :: ip logical :: is_int_positive - is_int_positive = (ip >= 1) + is_int_positive = (ip >= 1) return end function is_int_positive function is_legal_prolong(ip) - implicit none + implicit none integer(psb_ipk_), intent(in) :: ip logical :: is_legal_prolong is_legal_prolong = ((ip>=psb_none_).and.(ip<=psb_square_root_)) return end function is_legal_prolong function is_legal_restrict(ip) - implicit none + implicit none integer(psb_ipk_), intent(in) :: ip logical :: is_legal_restrict is_legal_restrict = ((ip == psb_nohalo_).or.(ip==psb_halo_)) return end function is_legal_restrict function is_legal_ml_cycle(ip) - implicit none + implicit none integer(psb_ipk_), intent(in) :: ip logical :: is_legal_ml_cycle @@ -988,7 +991,7 @@ contains return end function is_legal_s_fact_thrs function is_legal_s_aggr_thrs(ip) - implicit none + implicit none real(psb_spk_), intent(in) :: ip logical :: is_legal_s_aggr_thrs @@ -1032,7 +1035,7 @@ contains end interface character(len=20), parameter :: rname='amg_check_def' - if (.not.is_legal(ip)) then + if (.not.is_legal(ip)) then write(0,*)trim(rname),': Error: Illegal value for ',& & name,' :',ip, '. defaulting to ',id ip = id @@ -1040,11 +1043,11 @@ contains end subroutine amg_scheck_def subroutine amg_dcheck_def(ip,name,id,is_legal) - implicit none + implicit none real(psb_dpk_), intent(inout) :: ip real(psb_dpk_), intent(in) :: id character(len=*), intent(in) :: name - interface + interface function is_legal(i) use psb_base_mod, only : psb_dpk_ real(psb_dpk_), intent(in) :: i @@ -1053,7 +1056,7 @@ contains end interface character(len=20), parameter :: rname='amg_check_def' - if (.not.is_legal(ip)) then + if (.not.is_legal(ip)) then write(0,*)trim(rname),': Error: Illegal value for ',& & name,' :',ip, '. defaulting to ',id ip = id @@ -1062,7 +1065,7 @@ contains function pr_to_str(iprec) - implicit none + implicit none integer(psb_ipk_), intent(in) :: iprec character(len=10) :: pr_to_str @@ -1070,11 +1073,11 @@ contains select case(iprec) case(amg_noprec_) pr_to_str='NOPREC' - case(amg_jac_) + case(amg_jac_) pr_to_str='JAC' - case(amg_bjac_) + case(amg_bjac_) pr_to_str='BJAC' - case(amg_as_) + case(amg_as_) pr_to_str='AS' end select @@ -1082,7 +1085,7 @@ contains subroutine amg_ml_bcast(ctxt,dat,root) - implicit none + implicit none type(psb_ctxt_type), intent(in) :: ctxt type(amg_ml_parms), intent(inout) :: dat integer(psb_ipk_), intent(in), optional :: root @@ -1104,7 +1107,7 @@ contains subroutine amg_sml_bcast(ctxt,dat,root) - implicit none + implicit none type(psb_ctxt_type), intent(in) :: ctxt type(amg_sml_parms), intent(inout) :: dat integer(psb_ipk_), intent(in), optional :: root @@ -1115,7 +1118,7 @@ contains end subroutine amg_sml_bcast subroutine amg_dml_bcast(ctxt,dat,root) - implicit none + implicit none type(psb_ctxt_type), intent(in) :: ctxt type(amg_dml_parms), intent(inout) :: dat integer(psb_ipk_), intent(in), optional :: root @@ -1127,7 +1130,7 @@ contains subroutine ml_parms_clone(pm,pmout,info) - implicit none + implicit none class(amg_ml_parms), intent(inout) :: pm class(amg_ml_parms), intent(out) :: pmout integer(psb_ipk_), intent(out) :: info @@ -1147,19 +1150,19 @@ contains pmout%coarse_solve = pm%coarse_solve end subroutine ml_parms_clone - + subroutine s_ml_parms_clone(pm,pmout,info) - implicit none + implicit none class(amg_sml_parms), intent(inout) :: pm class(amg_ml_parms), intent(out) :: pmout integer(psb_ipk_), intent(out) :: info - + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: ierr(5) character(len=20) :: name='clone' - + info = 0 select type(pout => pmout) class is (amg_sml_parms) @@ -1174,21 +1177,21 @@ contains call psb_get_erraction(err_act) call psb_error_handler(err_act) end select - + end subroutine s_ml_parms_clone subroutine d_ml_parms_clone(pm,pmout,info) - implicit none + implicit none class(amg_dml_parms), intent(inout) :: pm class(amg_ml_parms), intent(out) :: pmout integer(psb_ipk_), intent(out) :: info - + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: ierr(5) character(len=20) :: name='clone' - + info = 0 select type(pout => pmout) class is (amg_dml_parms) @@ -1204,13 +1207,13 @@ contains call psb_error_handler(err_act) return end select - + end subroutine d_ml_parms_clone function amg_s_equal_aggregation(parms1, parms2) result(val) type(amg_sml_parms), intent(in) :: parms1, parms2 logical :: val - + val = (parms1%par_aggr_alg == parms2%par_aggr_alg ) .and. & & (parms1%aggr_type == parms2%aggr_type ) .and. & & (parms1%aggr_ord == parms2%aggr_ord ) .and. & @@ -1225,7 +1228,7 @@ contains function amg_d_equal_aggregation(parms1, parms2) result(val) type(amg_dml_parms), intent(in) :: parms1, parms2 logical :: val - + val = (parms1%par_aggr_alg == parms2%par_aggr_alg ) .and. & & (parms1%aggr_type == parms2%aggr_type ) .and. & & (parms1%aggr_ord == parms2%aggr_ord ) .and. & @@ -1236,5 +1239,5 @@ contains & (parms1%aggr_omega_val == parms2%aggr_omega_val ) .and. & & (parms1%aggr_thresh == parms2%aggr_thresh ) end function amg_d_equal_aggregation - + end module amg_base_prec_type diff --git a/amgprec/impl/amg_c_smoothers_bld.f90 b/amgprec/impl/amg_c_smoothers_bld.f90 index 300d7b65..8ad4d6eb 100644 --- a/amgprec/impl/amg_c_smoothers_bld.f90 +++ b/amgprec/impl/amg_c_smoothers_bld.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.7) -! -! (C) Copyright 2021 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2021 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! not be used to endorse or promote products derived from this ! software without specific written permission. -! +! ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR @@ -33,8 +33,8 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_c_smoothers_bld.f90 ! ! Subroutine: amg_c_smoothers_bld @@ -43,7 +43,7 @@ ! This routine performs the final phase of the multilevel preconditioner ! build process: builds the "smoother" objects at each level, ! based on the matrix hierarchy prepared by amg_c_hierarchy_bld. -! +! ! A multilevel preconditioner is regarded as an array of 'one-level' ! data structures, each containing the part of the ! preconditioner associated to a certain level, @@ -52,8 +52,8 @@ ! level 1 is the finest level. No transfer operators are associated to level 1. ! Each level provides a "build" method; for the base type, the "one-level" ! build procedure simply invokes the build method of the first smoother object, -! and also on the second object if allocated. -! +! and also on the second object if allocated. +! ! ! Arguments: ! a - type(psb_cspmat_type). @@ -65,7 +65,7 @@ ! The preconditioner data structure containing the local part ! of the preconditioner to be built. ! info - integer, output. -! Error code. +! Error code. ! ! amold - class(psb_c_base_sparse_mat), input, optional ! Mold for the inner format of matrices contained in the @@ -77,7 +77,7 @@ ! preconditioner ! ! -! +! subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) use psb_base_mod @@ -126,7 +126,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' ! - if (.not.allocated(prec%precv)) then + if (.not.allocated(prec%precv)) then !! Error: should have called amg_cprecinit info=3111 call psb_errpush(info,name) @@ -134,11 +134,11 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) end if ! - ! Check to ensure all procs have the same - ! + ! Check to ensure all procs have the same + ! iszv = size(prec%precv) call psb_bcast(ctxt,iszv) - if (iszv /= size(prec%precv)) then + if (iszv /= size(prec%precv)) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Inconsistent size of precv') goto 9999 @@ -151,12 +151,12 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) call psb_errpush(info,name,a_err=ch_err) goto 9999 endif - + ! ! Issue a warning for inconsistent changes to COARSE_SOLVE ! but only if it really is a multilevel ! - if ((me == psb_root_).and.(iszv>1)) then + if ((me == psb_root_).and.(iszv>1)) then coarse_solve_id = prec%precv(iszv)%parms%coarse_solve select case (coarse_solve_id) case(amg_umf_,amg_slu_) @@ -185,7 +185,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & 'AMG4PSBLAS: Warning: original coarse matrix was requested as replicated', & & ' but it has been changed to distributed.' end if - + case(psb_ilu_n_, psb_ilu_t_,psb_milu_n_) if (prec%precv(iszv)%sm%sv%get_id() /= psb_ilu_n_) then write(psb_err_unit,*) & @@ -210,7 +210,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to distributed' end if - + case(amg_mumps_) if (prec%precv(iszv)%sm%sv%get_id() /= amg_mumps_) then write(psb_err_unit,*) & @@ -232,7 +232,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & ' was not configured at AMG4PSBLAS build time, or' write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.' end if - + case(amg_sludist_) if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then write(psb_err_unit,*) & @@ -260,29 +260,29 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to replicated' end if - - case(amg_bjac_,amg_l1_bjac_,amg_jac_, amg_l1_jac_, amg_gs_, amg_fbgs_, amg_l1_gs_,amg_l1_fbgs_) + + case(amg_bjac_,amg_l1_bjac_,amg_jac_, amg_l1_jac_, amg_gs_, amg_fbgs_, amg_l1_gs_,amg_l1_fbgs_,amg_krm_) if (prec%precv(iszv)%parms%coarse_mat /= amg_distr_mat_) then write(psb_err_unit,*) & & 'AMG4PSBLAS: Warning: original coarse solver was requested as ',& & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to replicated' end if - + case default ! We should never get here. info=psb_err_from_subroutine_ ch_err='unkn coarse_solve' call psb_errpush(info,name,a_err=ch_err) goto 9999 - + end select end if ! Sanity check: need to ensure that the MUMPS local/global NZ ! are handled correctly; this is controlled by local vs global solver. ! From this point of view, REPL is LOCAL because it owns everyting. - ! Should really find a better way of handling this. + ! Should really find a better way of handling this. if (prec%precv(iszv)%parms%coarse_mat == amg_repl_mat_) & & call prec%precv(iszv)%sm%sv%set('MUMPS_LOC_GLOB', amg_local_solver_,info) ! @@ -295,8 +295,8 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) ! !!$ write(0,*) me,' Building at level ',i call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i) - - if (info /= psb_success_) then + + if (info /= psb_success_) then write(ch_err,'(a,i7)') 'Error @ level',i call psb_errpush(psb_err_internal_error_,name,& & a_err=ch_err) diff --git a/amgprec/impl/amg_ccprecset.F90 b/amgprec/impl/amg_ccprecset.F90 index 0230190a..0cd0822e 100644 --- a/amgprec/impl/amg_ccprecset.F90 +++ b/amgprec/impl/amg_ccprecset.F90 @@ -561,7 +561,7 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx) case('KRM') block type(amg_c_krm_solver_type) :: krm_slv - call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos) + call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) @@ -711,7 +711,7 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx) case('KRM') block type(amg_c_krm_solver_type) :: krm_slv - call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos) + call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) diff --git a/amgprec/impl/amg_d_smoothers_bld.f90 b/amgprec/impl/amg_d_smoothers_bld.f90 index 71c5ff51..76347dc4 100644 --- a/amgprec/impl/amg_d_smoothers_bld.f90 +++ b/amgprec/impl/amg_d_smoothers_bld.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.7) -! -! (C) Copyright 2021 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2021 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! not be used to endorse or promote products derived from this ! software without specific written permission. -! +! ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR @@ -33,8 +33,8 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_d_smoothers_bld.f90 ! ! Subroutine: amg_d_smoothers_bld @@ -43,7 +43,7 @@ ! This routine performs the final phase of the multilevel preconditioner ! build process: builds the "smoother" objects at each level, ! based on the matrix hierarchy prepared by amg_d_hierarchy_bld. -! +! ! A multilevel preconditioner is regarded as an array of 'one-level' ! data structures, each containing the part of the ! preconditioner associated to a certain level, @@ -52,8 +52,8 @@ ! level 1 is the finest level. No transfer operators are associated to level 1. ! Each level provides a "build" method; for the base type, the "one-level" ! build procedure simply invokes the build method of the first smoother object, -! and also on the second object if allocated. -! +! and also on the second object if allocated. +! ! ! Arguments: ! a - type(psb_dspmat_type). @@ -65,7 +65,7 @@ ! The preconditioner data structure containing the local part ! of the preconditioner to be built. ! info - integer, output. -! Error code. +! Error code. ! ! amold - class(psb_d_base_sparse_mat), input, optional ! Mold for the inner format of matrices contained in the @@ -77,7 +77,7 @@ ! preconditioner ! ! -! +! subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) use psb_base_mod @@ -126,7 +126,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' ! - if (.not.allocated(prec%precv)) then + if (.not.allocated(prec%precv)) then !! Error: should have called amg_dprecinit info=3111 call psb_errpush(info,name) @@ -134,11 +134,11 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) end if ! - ! Check to ensure all procs have the same - ! + ! Check to ensure all procs have the same + ! iszv = size(prec%precv) call psb_bcast(ctxt,iszv) - if (iszv /= size(prec%precv)) then + if (iszv /= size(prec%precv)) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Inconsistent size of precv') goto 9999 @@ -151,12 +151,12 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) call psb_errpush(info,name,a_err=ch_err) goto 9999 endif - + ! ! Issue a warning for inconsistent changes to COARSE_SOLVE ! but only if it really is a multilevel ! - if ((me == psb_root_).and.(iszv>1)) then + if ((me == psb_root_).and.(iszv>1)) then coarse_solve_id = prec%precv(iszv)%parms%coarse_solve select case (coarse_solve_id) case(amg_umf_,amg_slu_) @@ -185,7 +185,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & 'AMG4PSBLAS: Warning: original coarse matrix was requested as replicated', & & ' but it has been changed to distributed.' end if - + case(psb_ilu_n_, psb_ilu_t_,psb_milu_n_) if (prec%precv(iszv)%sm%sv%get_id() /= psb_ilu_n_) then write(psb_err_unit,*) & @@ -210,7 +210,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to distributed' end if - + case(amg_mumps_) if (prec%precv(iszv)%sm%sv%get_id() /= amg_mumps_) then write(psb_err_unit,*) & @@ -232,7 +232,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & ' was not configured at AMG4PSBLAS build time, or' write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.' end if - + case(amg_sludist_) if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then write(psb_err_unit,*) & @@ -260,29 +260,29 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to replicated' end if - - case(amg_bjac_,amg_l1_bjac_,amg_jac_, amg_l1_jac_, amg_gs_, amg_fbgs_, amg_l1_gs_,amg_l1_fbgs_) + + case(amg_bjac_,amg_l1_bjac_,amg_jac_, amg_l1_jac_, amg_gs_, amg_fbgs_, amg_l1_gs_,amg_l1_fbgs_,amg_krm_) if (prec%precv(iszv)%parms%coarse_mat /= amg_distr_mat_) then write(psb_err_unit,*) & & 'AMG4PSBLAS: Warning: original coarse solver was requested as ',& & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to replicated' end if - + case default ! We should never get here. info=psb_err_from_subroutine_ ch_err='unkn coarse_solve' call psb_errpush(info,name,a_err=ch_err) goto 9999 - + end select end if ! Sanity check: need to ensure that the MUMPS local/global NZ ! are handled correctly; this is controlled by local vs global solver. ! From this point of view, REPL is LOCAL because it owns everyting. - ! Should really find a better way of handling this. + ! Should really find a better way of handling this. if (prec%precv(iszv)%parms%coarse_mat == amg_repl_mat_) & & call prec%precv(iszv)%sm%sv%set('MUMPS_LOC_GLOB', amg_local_solver_,info) ! @@ -295,8 +295,8 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) ! !!$ write(0,*) me,' Building at level ',i call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i) - - if (info /= psb_success_) then + + if (info /= psb_success_) then write(ch_err,'(a,i7)') 'Error @ level',i call psb_errpush(psb_err_internal_error_,name,& & a_err=ch_err) diff --git a/amgprec/impl/amg_dcprecset.F90 b/amgprec/impl/amg_dcprecset.F90 index 33349116..5fc667c1 100644 --- a/amgprec/impl/amg_dcprecset.F90 +++ b/amgprec/impl/amg_dcprecset.F90 @@ -587,7 +587,7 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx) case('KRM') block type(amg_d_krm_solver_type) :: krm_slv - call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos) + call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) @@ -751,7 +751,7 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx) case('KRM') block type(amg_d_krm_solver_type) :: krm_slv - call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos) + call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) diff --git a/amgprec/impl/amg_s_smoothers_bld.f90 b/amgprec/impl/amg_s_smoothers_bld.f90 index 3da353e1..8149d3bb 100644 --- a/amgprec/impl/amg_s_smoothers_bld.f90 +++ b/amgprec/impl/amg_s_smoothers_bld.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.7) -! -! (C) Copyright 2021 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2021 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! not be used to endorse or promote products derived from this ! software without specific written permission. -! +! ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR @@ -33,8 +33,8 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_s_smoothers_bld.f90 ! ! Subroutine: amg_s_smoothers_bld @@ -43,7 +43,7 @@ ! This routine performs the final phase of the multilevel preconditioner ! build process: builds the "smoother" objects at each level, ! based on the matrix hierarchy prepared by amg_s_hierarchy_bld. -! +! ! A multilevel preconditioner is regarded as an array of 'one-level' ! data structures, each containing the part of the ! preconditioner associated to a certain level, @@ -52,8 +52,8 @@ ! level 1 is the finest level. No transfer operators are associated to level 1. ! Each level provides a "build" method; for the base type, the "one-level" ! build procedure simply invokes the build method of the first smoother object, -! and also on the second object if allocated. -! +! and also on the second object if allocated. +! ! ! Arguments: ! a - type(psb_sspmat_type). @@ -65,7 +65,7 @@ ! The preconditioner data structure containing the local part ! of the preconditioner to be built. ! info - integer, output. -! Error code. +! Error code. ! ! amold - class(psb_s_base_sparse_mat), input, optional ! Mold for the inner format of matrices contained in the @@ -77,7 +77,7 @@ ! preconditioner ! ! -! +! subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) use psb_base_mod @@ -126,7 +126,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' ! - if (.not.allocated(prec%precv)) then + if (.not.allocated(prec%precv)) then !! Error: should have called amg_sprecinit info=3111 call psb_errpush(info,name) @@ -134,11 +134,11 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) end if ! - ! Check to ensure all procs have the same - ! + ! Check to ensure all procs have the same + ! iszv = size(prec%precv) call psb_bcast(ctxt,iszv) - if (iszv /= size(prec%precv)) then + if (iszv /= size(prec%precv)) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Inconsistent size of precv') goto 9999 @@ -151,12 +151,12 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) call psb_errpush(info,name,a_err=ch_err) goto 9999 endif - + ! ! Issue a warning for inconsistent changes to COARSE_SOLVE ! but only if it really is a multilevel ! - if ((me == psb_root_).and.(iszv>1)) then + if ((me == psb_root_).and.(iszv>1)) then coarse_solve_id = prec%precv(iszv)%parms%coarse_solve select case (coarse_solve_id) case(amg_umf_,amg_slu_) @@ -185,7 +185,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & 'AMG4PSBLAS: Warning: original coarse matrix was requested as replicated', & & ' but it has been changed to distributed.' end if - + case(psb_ilu_n_, psb_ilu_t_,psb_milu_n_) if (prec%precv(iszv)%sm%sv%get_id() /= psb_ilu_n_) then write(psb_err_unit,*) & @@ -210,7 +210,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to distributed' end if - + case(amg_mumps_) if (prec%precv(iszv)%sm%sv%get_id() /= amg_mumps_) then write(psb_err_unit,*) & @@ -232,7 +232,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & ' was not configured at AMG4PSBLAS build time, or' write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.' end if - + case(amg_sludist_) if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then write(psb_err_unit,*) & @@ -260,29 +260,29 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to replicated' end if - - case(amg_bjac_,amg_l1_bjac_,amg_jac_, amg_l1_jac_, amg_gs_, amg_fbgs_, amg_l1_gs_,amg_l1_fbgs_) + + case(amg_bjac_,amg_l1_bjac_,amg_jac_, amg_l1_jac_, amg_gs_, amg_fbgs_, amg_l1_gs_,amg_l1_fbgs_,amg_krm_) if (prec%precv(iszv)%parms%coarse_mat /= amg_distr_mat_) then write(psb_err_unit,*) & & 'AMG4PSBLAS: Warning: original coarse solver was requested as ',& & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to replicated' end if - + case default ! We should never get here. info=psb_err_from_subroutine_ ch_err='unkn coarse_solve' call psb_errpush(info,name,a_err=ch_err) goto 9999 - + end select end if ! Sanity check: need to ensure that the MUMPS local/global NZ ! are handled correctly; this is controlled by local vs global solver. ! From this point of view, REPL is LOCAL because it owns everyting. - ! Should really find a better way of handling this. + ! Should really find a better way of handling this. if (prec%precv(iszv)%parms%coarse_mat == amg_repl_mat_) & & call prec%precv(iszv)%sm%sv%set('MUMPS_LOC_GLOB', amg_local_solver_,info) ! @@ -295,8 +295,8 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) ! !!$ write(0,*) me,' Building at level ',i call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i) - - if (info /= psb_success_) then + + if (info /= psb_success_) then write(ch_err,'(a,i7)') 'Error @ level',i call psb_errpush(psb_err_internal_error_,name,& & a_err=ch_err) diff --git a/amgprec/impl/amg_scprecset.F90 b/amgprec/impl/amg_scprecset.F90 index 902ad904..95d0478f 100644 --- a/amgprec/impl/amg_scprecset.F90 +++ b/amgprec/impl/amg_scprecset.F90 @@ -561,7 +561,7 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx) case('KRM') block type(amg_s_krm_solver_type) :: krm_slv - call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos) + call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) @@ -711,7 +711,7 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx) case('KRM') block type(amg_s_krm_solver_type) :: krm_slv - call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos) + call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) diff --git a/amgprec/impl/amg_z_smoothers_bld.f90 b/amgprec/impl/amg_z_smoothers_bld.f90 index 7decd491..95293993 100644 --- a/amgprec/impl/amg_z_smoothers_bld.f90 +++ b/amgprec/impl/amg_z_smoothers_bld.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.7) -! -! (C) Copyright 2021 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2021 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! not be used to endorse or promote products derived from this ! software without specific written permission. -! +! ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR @@ -33,8 +33,8 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_z_smoothers_bld.f90 ! ! Subroutine: amg_z_smoothers_bld @@ -43,7 +43,7 @@ ! This routine performs the final phase of the multilevel preconditioner ! build process: builds the "smoother" objects at each level, ! based on the matrix hierarchy prepared by amg_z_hierarchy_bld. -! +! ! A multilevel preconditioner is regarded as an array of 'one-level' ! data structures, each containing the part of the ! preconditioner associated to a certain level, @@ -52,8 +52,8 @@ ! level 1 is the finest level. No transfer operators are associated to level 1. ! Each level provides a "build" method; for the base type, the "one-level" ! build procedure simply invokes the build method of the first smoother object, -! and also on the second object if allocated. -! +! and also on the second object if allocated. +! ! ! Arguments: ! a - type(psb_zspmat_type). @@ -65,7 +65,7 @@ ! The preconditioner data structure containing the local part ! of the preconditioner to be built. ! info - integer, output. -! Error code. +! Error code. ! ! amold - class(psb_z_base_sparse_mat), input, optional ! Mold for the inner format of matrices contained in the @@ -77,7 +77,7 @@ ! preconditioner ! ! -! +! subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) use psb_base_mod @@ -126,7 +126,7 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' ! - if (.not.allocated(prec%precv)) then + if (.not.allocated(prec%precv)) then !! Error: should have called amg_zprecinit info=3111 call psb_errpush(info,name) @@ -134,11 +134,11 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) end if ! - ! Check to ensure all procs have the same - ! + ! Check to ensure all procs have the same + ! iszv = size(prec%precv) call psb_bcast(ctxt,iszv) - if (iszv /= size(prec%precv)) then + if (iszv /= size(prec%precv)) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Inconsistent size of precv') goto 9999 @@ -151,12 +151,12 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) call psb_errpush(info,name,a_err=ch_err) goto 9999 endif - + ! ! Issue a warning for inconsistent changes to COARSE_SOLVE ! but only if it really is a multilevel ! - if ((me == psb_root_).and.(iszv>1)) then + if ((me == psb_root_).and.(iszv>1)) then coarse_solve_id = prec%precv(iszv)%parms%coarse_solve select case (coarse_solve_id) case(amg_umf_,amg_slu_) @@ -185,7 +185,7 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & 'AMG4PSBLAS: Warning: original coarse matrix was requested as replicated', & & ' but it has been changed to distributed.' end if - + case(psb_ilu_n_, psb_ilu_t_,psb_milu_n_) if (prec%precv(iszv)%sm%sv%get_id() /= psb_ilu_n_) then write(psb_err_unit,*) & @@ -210,7 +210,7 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to distributed' end if - + case(amg_mumps_) if (prec%precv(iszv)%sm%sv%get_id() /= amg_mumps_) then write(psb_err_unit,*) & @@ -232,7 +232,7 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & ' was not configured at AMG4PSBLAS build time, or' write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.' end if - + case(amg_sludist_) if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then write(psb_err_unit,*) & @@ -260,29 +260,29 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to replicated' end if - - case(amg_bjac_,amg_l1_bjac_,amg_jac_, amg_l1_jac_, amg_gs_, amg_fbgs_, amg_l1_gs_,amg_l1_fbgs_) + + case(amg_bjac_,amg_l1_bjac_,amg_jac_, amg_l1_jac_, amg_gs_, amg_fbgs_, amg_l1_gs_,amg_l1_fbgs_,amg_krm_) if (prec%precv(iszv)%parms%coarse_mat /= amg_distr_mat_) then write(psb_err_unit,*) & & 'AMG4PSBLAS: Warning: original coarse solver was requested as ',& & amg_fact_names(coarse_solve_id),& & ' but the coarse matrix has been changed to replicated' end if - + case default ! We should never get here. info=psb_err_from_subroutine_ ch_err='unkn coarse_solve' call psb_errpush(info,name,a_err=ch_err) goto 9999 - + end select end if ! Sanity check: need to ensure that the MUMPS local/global NZ ! are handled correctly; this is controlled by local vs global solver. ! From this point of view, REPL is LOCAL because it owns everyting. - ! Should really find a better way of handling this. + ! Should really find a better way of handling this. if (prec%precv(iszv)%parms%coarse_mat == amg_repl_mat_) & & call prec%precv(iszv)%sm%sv%set('MUMPS_LOC_GLOB', amg_local_solver_,info) ! @@ -295,8 +295,8 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold) ! !!$ write(0,*) me,' Building at level ',i call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i) - - if (info /= psb_success_) then + + if (info /= psb_success_) then write(ch_err,'(a,i7)') 'Error @ level',i call psb_errpush(psb_err_internal_error_,name,& & a_err=ch_err) diff --git a/amgprec/impl/amg_zcprecset.F90 b/amgprec/impl/amg_zcprecset.F90 index d88b7397..108f0ddb 100644 --- a/amgprec/impl/amg_zcprecset.F90 +++ b/amgprec/impl/amg_zcprecset.F90 @@ -587,7 +587,7 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx) case('KRM') block type(amg_z_krm_solver_type) :: krm_slv - call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos) + call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) @@ -751,7 +751,7 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx) case('KRM') block type(amg_z_krm_solver_type) :: krm_slv - call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos) + call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)