fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'mergeparmatch' of github.com:sfilippone/amg4psblas into mergeparmatch

Browse Source
This commit is contained in:
Salvatore Filippone
2021-04-09 04:22:30 -04:00
parent 189a4170ec 0153904ef2
commit 97fe836609
9 changed files with 226 additions and 223 deletions
Download Patch File Download Diff File Expand all files Collapse all files
amgprec/amg_base_prec_type.F90
+86 -83
View File
@@ -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
amgprec/impl/amg_c_smoothers_bld.f90
+33 -33
View File
@@ -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)
amgprec/impl/amg_ccprecset.F90
+2 -2
View File
@@ -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)
amgprec/impl/amg_d_smoothers_bld.f90
+33 -33
View File
@@ -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)
amgprec/impl/amg_dcprecset.F90
+2 -2
View File
@@ -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)
amgprec/impl/amg_s_smoothers_bld.f90
+33 -33
View File
@@ -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)
amgprec/impl/amg_scprecset.F90
+2 -2
View File
@@ -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)
amgprec/impl/amg_z_smoothers_bld.f90
+33 -33
View File
@@ -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)
amgprec/impl/amg_zcprecset.F90
+2 -2
View File
@@ -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)