fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Added set to parmatch

Browse Source
mergeparmatch
Cirdans-Home 4 years ago
parent a65f618a96
commit 5aa3cfca1b
20 changed files with 536 additions and 499 deletions
Show Stats Download Patch File Download Diff File

281
amgprec/amg_base_prec_type.F90
Unescape Escape View File

@ -1,15 +1,15 @@
! !
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2020 ! (C) Copyright 2020
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,8 +33,8 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
! File: amg_base_prec_type.F90 ! File: amg_base_prec_type.F90
! !
! Module: amg_base_prec_type ! Module: amg_base_prec_type
@ -50,16 +50,16 @@
! !
! It contains routines for ! It contains routines for
! - converting character constants defining the preconditioner into integer ! - converting character constants defining the preconditioner into integer
! constants; ! constants;
! - checking if the preconditioner is correctly defined; ! - checking if the preconditioner is correctly defined;
! - printing a description of the preconditioner; ! - printing a description of the preconditioner;
! - deallocating the preconditioner data structure. ! - deallocating the preconditioner data structure.
! !
module amg_base_prec_type 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. ! blows up on some systems.
! !
use psb_const_mod use psb_const_mod
@ -78,7 +78,7 @@ module amg_base_prec_type
& psb_err_from_subroutine_, psb_err_missing_override_method_, & & psb_err_from_subroutine_, psb_err_missing_override_method_, &
& psb_error_handler, psb_out_unit, psb_err_unit & psb_error_handler, psb_out_unit, psb_err_unit
! !
! Version numbers ! Version numbers
! !
character(len=*), parameter :: amg_version_string_ = "1.0.0" 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 procedure, pass(pm) :: printout => d_ml_parms_printout
end type amg_dml_parms end type amg_dml_parms
type amg_iaggr_data 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 = -ione
integer(psb_ipk_) :: min_coarse_size_per_process = -ione integer(psb_ipk_) :: min_coarse_size_per_process = -ione
integer(psb_lpk_) :: target_coarse_size 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_ integer(psb_ipk_) :: max_levs = 20_psb_ipk_
end type amg_iaggr_data end type amg_iaggr_data
type, extends(amg_iaggr_data) :: amg_saggr_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_) :: min_cr_ratio = 1.5_psb_spk_
real(psb_spk_) :: op_complexity = szero real(psb_spk_) :: op_complexity = szero
real(psb_spk_) :: avg_cr = szero real(psb_spk_) :: avg_cr = szero
end type amg_saggr_data end type amg_saggr_data
type, extends(amg_iaggr_data) :: amg_daggr_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_) :: min_cr_ratio = 1.5_psb_dpk_
real(psb_dpk_) :: op_complexity = dzero real(psb_dpk_) :: op_complexity = dzero
real(psb_dpk_) :: avg_cr = dzero real(psb_dpk_) :: avg_cr = dzero
end type amg_daggr_data end type amg_daggr_data
! !
! Entries in iprcparm ! Entries in iprcparm
! !
! These are in baseprec ! 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_solve_ = 2
integer(psb_ipk_), parameter :: amg_sub_restr_ = 3 integer(psb_ipk_), parameter :: amg_sub_restr_ = 3
integer(psb_ipk_), parameter :: amg_sub_prol_ = 4 integer(psb_ipk_), parameter :: amg_sub_prol_ = 4
@ -169,7 +169,7 @@ module amg_base_prec_type
! !
! These are in onelev ! These are in onelev
! !
integer(psb_ipk_), parameter :: amg_ml_cycle_ = 20 integer(psb_ipk_), parameter :: amg_ml_cycle_ = 20
integer(psb_ipk_), parameter :: amg_smoother_sweeps_pre_ = 21 integer(psb_ipk_), parameter :: amg_smoother_sweeps_pre_ = 21
integer(psb_ipk_), parameter :: amg_smoother_sweeps_post_ = 22 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_eig_ = 28
integer(psb_ipk_), parameter :: amg_aggr_filter_ = 29 integer(psb_ipk_), parameter :: amg_aggr_filter_ = 29
integer(psb_ipk_), parameter :: amg_coarse_mat_ = 30 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_sweeps_ = 32
integer(psb_ipk_), parameter :: amg_coarse_fillin_ = 33 integer(psb_ipk_), parameter :: amg_coarse_fillin_ = 33
integer(psb_ipk_), parameter :: amg_coarse_subsolve_ = 34 integer(psb_ipk_), parameter :: amg_coarse_subsolve_ = 34
@ -196,7 +196,7 @@ module amg_base_prec_type
! !
! Legal values for entry: amg_smoother_type_ ! Legal values for entry: amg_smoother_type_
! !
integer(psb_ipk_), parameter :: amg_min_prec_ = 0 integer(psb_ipk_), parameter :: amg_min_prec_ = 0
integer(psb_ipk_), parameter :: amg_noprec_ = 0 integer(psb_ipk_), parameter :: amg_noprec_ = 0
integer(psb_ipk_), parameter :: amg_base_smooth_ = 0 integer(psb_ipk_), parameter :: amg_base_smooth_ = 0
@ -243,7 +243,7 @@ module amg_base_prec_type
integer(psb_ipk_), parameter :: amg_ilu_scale_none_ = 0 integer(psb_ipk_), parameter :: amg_ilu_scale_none_ = 0
integer(psb_ipk_), parameter :: amg_ilu_scale_maxval_ = 1 integer(psb_ipk_), parameter :: amg_ilu_scale_maxval_ = 1
integer(psb_ipk_), parameter :: amg_ilu_scale_diag_ = 2 integer(psb_ipk_), parameter :: amg_ilu_scale_diag_ = 2
integer(psb_ipk_), parameter :: amg_ilu_scale_arwsum_ = 3 integer(psb_ipk_), parameter :: amg_ilu_scale_arwsum_ = 3
integer(psb_ipk_), parameter :: amg_ilu_scale_aclsum_ = 4 integer(psb_ipk_), parameter :: amg_ilu_scale_aclsum_ = 4
integer(psb_ipk_), parameter :: amg_ilu_scale_arcsum_ = 5 integer(psb_ipk_), parameter :: amg_ilu_scale_arcsum_ = 5
! For the time being enable only maxval scale ! For the time being enable only maxval scale
@ -261,19 +261,21 @@ module amg_base_prec_type
integer(psb_ipk_), parameter :: amg_new_ml_prec_ = 7 integer(psb_ipk_), parameter :: amg_new_ml_prec_ = 7
integer(psb_ipk_), parameter :: amg_mult_dev_ml_ = 7 integer(psb_ipk_), parameter :: amg_mult_dev_ml_ = 7
integer(psb_ipk_), parameter :: amg_max_ml_cycle_ = 8 integer(psb_ipk_), parameter :: amg_max_ml_cycle_ = 8
! !
! Legal values for entry: amg_par_aggr_alg_ ! Legal values for entry: amg_par_aggr_alg_
! !
integer(psb_ipk_), parameter :: amg_dec_aggr_ = 0 integer(psb_ipk_), parameter :: amg_dec_aggr_ = 0
integer(psb_ipk_), parameter :: amg_sym_dec_aggr_ = 1 integer(psb_ipk_), parameter :: amg_sym_dec_aggr_ = 1
integer(psb_ipk_), parameter :: amg_ext_aggr_ = 2 integer(psb_ipk_), parameter :: amg_ext_aggr_ = 2
integer(psb_ipk_), parameter :: amg_max_par_aggr_alg_ = amg_ext_aggr_ integer(psb_ipk_), parameter :: amg_coupled_aggr_ = 3
integer(psb_ipk_), parameter :: amg_max_par_aggr_alg_ = amg_coupled_aggr_
! !
! Legal values for entry: amg_aggr_type_ ! Legal values for entry: amg_aggr_type_
! !
integer(psb_ipk_), parameter :: amg_noalg_ = 0 integer(psb_ipk_), parameter :: amg_noalg_ = 0
integer(psb_ipk_), parameter :: amg_soc1_ = 1 integer(psb_ipk_), parameter :: amg_soc1_ = 1
integer(psb_ipk_), parameter :: amg_soc2_ = 2 integer(psb_ipk_), parameter :: amg_soc2_ = 2
integer(psb_ipk_), parameter :: amg_matchboxp_ = 3
! !
! Legal values for entry: amg_aggr_prol_ ! Legal values for entry: amg_aggr_prol_
! !
@ -288,7 +290,7 @@ module amg_base_prec_type
integer(psb_ipk_), parameter :: amg_no_filter_mat_ = 0 integer(psb_ipk_), parameter :: amg_no_filter_mat_ = 0
integer(psb_ipk_), parameter :: amg_filter_mat_ = 1 integer(psb_ipk_), parameter :: amg_filter_mat_ = 1
integer(psb_ipk_), parameter :: amg_max_filter_mat_ = amg_filter_mat_ integer(psb_ipk_), parameter :: amg_max_filter_mat_ = amg_filter_mat_
! !
! Legal values for entry: amg_aggr_ord_ ! Legal values for entry: amg_aggr_ord_
! !
integer(psb_ipk_), parameter :: amg_aggr_ord_nat_ = 0 integer(psb_ipk_), parameter :: amg_aggr_ord_nat_ = 0
@ -308,7 +310,7 @@ module amg_base_prec_type
! !
integer(psb_ipk_), parameter :: amg_distr_mat_ = 0 integer(psb_ipk_), parameter :: amg_distr_mat_ = 0
integer(psb_ipk_), parameter :: amg_repl_mat_ = 1 integer(psb_ipk_), parameter :: amg_repl_mat_ = 1
integer(psb_ipk_), parameter :: amg_max_coarse_mat_ = amg_repl_mat_ integer(psb_ipk_), parameter :: amg_max_coarse_mat_ = amg_repl_mat_
! !
! Legal values for entry: amg_prec_status_ ! Legal values for entry: amg_prec_status_
! !
@ -338,7 +340,7 @@ module amg_base_prec_type
! !
! Fields for sparse matrices ensembles stored in av() ! Fields for sparse matrices ensembles stored in av()
! !
integer(psb_ipk_), parameter :: amg_l_pr_ = 1 integer(psb_ipk_), parameter :: amg_l_pr_ = 1
integer(psb_ipk_), parameter :: amg_u_pr_ = 2 integer(psb_ipk_), parameter :: amg_u_pr_ = 2
integer(psb_ipk_), parameter :: amg_bp_ilu_avsz_ = 2 integer(psb_ipk_), parameter :: amg_bp_ilu_avsz_ = 2
@ -347,7 +349,7 @@ module amg_base_prec_type
integer(psb_ipk_), parameter :: amg_sm_pr_t_ = 5 integer(psb_ipk_), parameter :: amg_sm_pr_t_ = 5
integer(psb_ipk_), parameter :: amg_sm_pr_ = 6 integer(psb_ipk_), parameter :: amg_sm_pr_ = 6
integer(psb_ipk_), parameter :: amg_smth_avsz_ = 6 integer(psb_ipk_), parameter :: amg_smth_avsz_ = 6
integer(psb_ipk_), parameter :: amg_max_avsz_ = amg_smth_avsz_ integer(psb_ipk_), parameter :: amg_max_avsz_ = amg_smth_avsz_
! !
! Character constants used by amg_file_prec_descr ! Character constants used by amg_file_prec_descr
@ -362,12 +364,13 @@ module amg_base_prec_type
character(len=15), parameter, private :: & character(len=15), parameter, private :: &
& matrix_names(0:1)=(/'distributed ','replicated '/) & matrix_names(0:1)=(/'distributed ','replicated '/)
character(len=18), parameter, private :: & character(len=18), parameter, private :: &
& aggr_type_names(0:2)=(/'None ',& & aggr_type_names(0:3)=(/'None ',&
& 'SOC measure 1 ', 'SOC Measure 2 '/) & 'SOC measure 1 ', 'SOC Measure 2 ',&
& 'Parallel Matching '/)
character(len=18), parameter, private :: & character(len=18), parameter, private :: &
& par_aggr_alg_names(0:2)=(/& & par_aggr_alg_names(0:3)=(/&
& 'decoupled aggr. ', 'sym. dec. aggr. ',& & 'decoupled aggr. ', 'sym. dec. aggr. ',&
& 'user defined aggr.'/) & 'user defined aggr.', 'coupled aggr. '/)
character(len=18), parameter, private :: & character(len=18), parameter, private :: &
& ord_names(0:1)=(/'Natural ordering ','Desc. degree ord. '/) & ord_names(0:1)=(/'Natural ordering ','Desc. degree ord. '/)
character(len=6), parameter, private :: & character(len=6), parameter, private :: &
@ -395,7 +398,7 @@ module amg_base_prec_type
module procedure amg_icheck_def, amg_scheck_def, amg_dcheck_def module procedure amg_icheck_def, amg_scheck_def, amg_dcheck_def
end interface end interface
interface psb_bcast interface psb_bcast
module procedure amg_ml_bcast, amg_sml_bcast, amg_dml_bcast module procedure amg_ml_bcast, amg_sml_bcast, amg_dml_bcast
end interface psb_bcast end interface psb_bcast
@ -408,9 +411,9 @@ module amg_base_prec_type
! Will need a more sophisticated strategy. ! Will need a more sophisticated strategy.
! !
logical, private, save :: do_remap=.false. logical, private, save :: do_remap=.false.
contains contains
function amg_get_do_remap() result(res) function amg_get_do_remap() result(res)
implicit none implicit none
logical :: res logical :: res
@ -424,7 +427,7 @@ contains
do_remap = val do_remap = val
end subroutine amg_set_do_remap end subroutine amg_set_do_remap
! !
! Function: amg_stringval ! Function: amg_stringval
! !
@ -439,10 +442,10 @@ contains
! !
function amg_stringval(string) result(val) function amg_stringval(string) result(val)
use psb_prec_const_mod use psb_prec_const_mod
implicit none implicit none
! Arguments ! Arguments
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
integer(psb_ipk_) :: val integer(psb_ipk_) :: val
character(len=*), parameter :: name='amg_stringval' character(len=*), parameter :: name='amg_stringval'
! Local variable ! Local variable
integer :: index_tab integer :: index_tab
@ -450,14 +453,14 @@ contains
index_tab=index(string,char(9)) index_tab=index(string,char(9))
if (index_tab.NE.0) then if (index_tab.NE.0) then
string2=string(1:index_tab-1) string2=string(1:index_tab-1)
else else
string2=string string2=string
endif endif
select case(psb_toupper(trim(string2))) select case(psb_toupper(trim(string2)))
case('NONE') case('NONE')
val = 0 val = 0
case('HALO') case('HALO')
val = psb_halo_ val = psb_halo_
case('SUM') case('SUM')
val = psb_sum_ val = psb_sum_
case('AVG') case('AVG')
@ -553,56 +556,56 @@ contains
case('OUTER_SWEEPS') case('OUTER_SWEEPS')
val = amg_outer_sweeps_ val = amg_outer_sweeps_
case('LOCAL_SOLVER') case('LOCAL_SOLVER')
val = amg_local_solver_ val = amg_local_solver_
case('GLOBAL_SOLVER') case('GLOBAL_SOLVER')
val = amg_global_solver_ val = amg_global_solver_
case default case default
val = -1 val = -1
end select end select
end function amg_stringval end function amg_stringval
subroutine ml_parms_get_coarse(pm,pmin) subroutine ml_parms_get_coarse(pm,pmin)
implicit none implicit none
class(amg_ml_parms), intent(inout) :: pm class(amg_ml_parms), intent(inout) :: pm
class(amg_ml_parms), intent(in) :: pmin class(amg_ml_parms), intent(in) :: pmin
pm%coarse_mat = pmin%coarse_mat pm%coarse_mat = pmin%coarse_mat
pm%coarse_solve = pmin%coarse_solve pm%coarse_solve = pmin%coarse_solve
end subroutine ml_parms_get_coarse end subroutine ml_parms_get_coarse
subroutine ml_parms_printout(pm,iout) subroutine ml_parms_printout(pm,iout)
implicit none implicit none
class(amg_ml_parms), intent(in) :: pm class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
write(iout,*) 'ML : ',pm%ml_cycle write(iout,*) 'ML : ',pm%ml_cycle
write(iout,*) 'Sweeps: ',pm%sweeps_pre,pm%sweeps_post write(iout,*) 'Sweeps: ',pm%sweeps_pre,pm%sweeps_post
write(iout,*) 'AGGR : ',pm%par_aggr_alg,pm%aggr_prol, pm%aggr_ord 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,*) ' : ',pm%aggr_omega_alg,pm%aggr_eig,pm%aggr_filter
write(iout,*) 'COARSE: ',pm%coarse_mat,pm%coarse_solve write(iout,*) 'COARSE: ',pm%coarse_mat,pm%coarse_solve
end subroutine ml_parms_printout end subroutine ml_parms_printout
subroutine s_ml_parms_printout(pm,iout) subroutine s_ml_parms_printout(pm,iout)
implicit none implicit none
class(amg_sml_parms), intent(in) :: pm class(amg_sml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
call pm%amg_ml_parms%printout(iout) call pm%amg_ml_parms%printout(iout)
write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh
end subroutine s_ml_parms_printout end subroutine s_ml_parms_printout
subroutine d_ml_parms_printout(pm,iout) subroutine d_ml_parms_printout(pm,iout)
implicit none implicit none
class(amg_dml_parms), intent(in) :: pm class(amg_dml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
call pm%amg_ml_parms%printout(iout) call pm%amg_ml_parms%printout(iout)
write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh
end subroutine d_ml_parms_printout end subroutine d_ml_parms_printout
! !
! Routines printing out a description of the preconditioner ! Routines printing out a description of the preconditioner
@ -618,7 +621,7 @@ contains
info = psb_success_ info = psb_success_
if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then
write(iout,*) ' Multilevel cycle: ',& write(iout,*) ' Multilevel cycle: ',&
& ml_names(pm%ml_cycle) & ml_names(pm%ml_cycle)
select case (pm%ml_cycle) select case (pm%ml_cycle)
@ -644,7 +647,7 @@ contains
info = psb_success_ info = psb_success_
if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then
write(iout,*) ' Parallel aggregation algorithm: ',& write(iout,*) ' Parallel aggregation algorithm: ',&
& par_aggr_alg_names(pm%par_aggr_alg) & par_aggr_alg_names(pm%par_aggr_alg)
if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',& if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',&
@ -656,23 +659,23 @@ contains
write(iout,*) ' Aggregation prolongator: ', & write(iout,*) ' Aggregation prolongator: ', &
& aggr_prols(pm%aggr_prol) & aggr_prols(pm%aggr_prol)
if (pm%aggr_prol /= amg_no_smooth_) then if (pm%aggr_prol /= amg_no_smooth_) then
write(iout,*) ' with: ', aggr_filters(pm%aggr_filter) write(iout,*) ' with: ', aggr_filters(pm%aggr_filter)
if (pm%aggr_omega_alg == amg_eig_est_) then if (pm%aggr_omega_alg == amg_eig_est_) then
write(iout,*) ' Damping omega computation: spectral radius estimate' write(iout,*) ' Damping omega computation: spectral radius estimate'
write(iout,*) ' Spectral radius estimate: ', & write(iout,*) ' Spectral radius estimate: ', &
& eigen_estimates(pm%aggr_eig) & 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.' write(iout,*) ' Damping omega computation: user defined value.'
else else
write(iout,*) ' Damping omega computation: unknown value in iprcparm!!' write(iout,*) ' Damping omega computation: unknown value in iprcparm!!'
end if end if
end if end if
!end if !end if
else else
write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',& write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',&
& pm%ml_cycle & pm%ml_cycle
end if end if
return return
end subroutine ml_parms_mldescr end subroutine ml_parms_mldescr
@ -689,13 +692,13 @@ contains
logical :: coarse_ logical :: coarse_
info = psb_success_ info = psb_success_
if (present(coarse)) then if (present(coarse)) then
coarse_ = coarse coarse_ = coarse
else else
coarse_ = .false. coarse_ = .false.
end if end if
if (coarse_) then if (coarse_) then
call pm%coarsedescr(iout,info) call pm%coarsedescr(iout,info)
end if end if
@ -718,12 +721,12 @@ contains
write(iout,*) ' Coarse matrix: ',& write(iout,*) ' Coarse matrix: ',&
& matrix_names(pm%coarse_mat) & matrix_names(pm%coarse_mat)
select case(pm%coarse_solve) select case(pm%coarse_solve)
case (amg_bjac_,amg_as_) case (amg_bjac_,amg_as_)
write(iout,*) ' Number of sweeps : ',& write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre & pm%sweeps_pre
write(iout,*) ' Coarse solver: ',& write(iout,*) ' Coarse solver: ',&
& 'Block Jacobi' & 'Block Jacobi'
case (amg_l1_bjac_) case (amg_l1_bjac_)
write(iout,*) ' Number of sweeps : ',& write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre & pm%sweeps_pre
write(iout,*) ' Coarse solver: ',& write(iout,*) ' Coarse solver: ',&
@ -790,7 +793,7 @@ contains
! !
function is_legal_base_prec(ip) function is_legal_base_prec(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_base_prec logical :: is_legal_base_prec
@ -798,60 +801,68 @@ contains
return return
end function is_legal_base_prec end function is_legal_base_prec
function is_int_non_negative(ip) function is_int_non_negative(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_int_non_negative logical :: is_int_non_negative
is_int_non_negative = (ip >= 0) is_int_non_negative = (ip >= 0)
return return
end function is_int_non_negative end function is_int_non_negative
function is_legal_ilu_scale(ip) function is_legal_ilu_scale(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ilu_scale logical :: is_legal_ilu_scale
is_legal_ilu_scale = ((ip >= amg_ilu_scale_none_).and.(ip <= amg_max_ilu_scale_)) is_legal_ilu_scale = ((ip >= amg_ilu_scale_none_).and.(ip <= amg_max_ilu_scale_))
return return
end function is_legal_ilu_scale end function is_legal_ilu_scale
function is_int_positive(ip) function is_int_positive(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_int_positive logical :: is_int_positive
is_int_positive = (ip >= 1) is_int_positive = (ip >= 1)
return return
end function is_int_positive end function is_int_positive
function is_legal_prolong(ip) function is_legal_prolong(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_prolong logical :: is_legal_prolong
is_legal_prolong = ((ip>=psb_none_).and.(ip<=psb_square_root_)) is_legal_prolong = ((ip>=psb_none_).and.(ip<=psb_square_root_))
return return
end function is_legal_prolong end function is_legal_prolong
function is_legal_restrict(ip) function is_legal_restrict(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_restrict logical :: is_legal_restrict
is_legal_restrict = ((ip == psb_nohalo_).or.(ip==psb_halo_)) is_legal_restrict = ((ip == psb_nohalo_).or.(ip==psb_halo_))
return return
end function is_legal_restrict end function is_legal_restrict
function is_legal_ml_cycle(ip) function is_legal_ml_cycle(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_cycle logical :: is_legal_ml_cycle
is_legal_ml_cycle = ((ip>=amg_no_ml_).and.(ip<=amg_max_ml_cycle_)) is_legal_ml_cycle = ((ip>=amg_no_ml_).and.(ip<=amg_max_ml_cycle_))
return return
end function is_legal_ml_cycle end function is_legal_ml_cycle
function is_legal_ml_par_aggr_alg(ip) function is_legal_coupled_par_aggr_alg(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_par_aggr_alg logical :: is_legal_coupled_par_aggr_alg
is_legal_ml_par_aggr_alg = ((ip>=amg_dec_aggr_).and.(ip<=amg_max_par_aggr_alg_)) is_legal_coupled_par_aggr_alg = (ip == amg_coupled_aggr_)
return return
end function is_legal_ml_par_aggr_alg end function is_legal_coupled_par_aggr_alg
function is_legal_decoupled_par_aggr_alg(ip)
implicit none
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_decoupled_par_aggr_alg
is_legal_decoupled_par_aggr_alg = ((ip>=amg_dec_aggr_).and.(ip<=amg_max_par_aggr_alg_))
return
end function is_legal_decoupled_par_aggr_alg
function is_legal_ml_aggr_type(ip) function is_legal_ml_aggr_type(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_type logical :: is_legal_ml_aggr_type
@ -859,7 +870,7 @@ contains
return return
end function is_legal_ml_aggr_type end function is_legal_ml_aggr_type
function is_legal_ml_aggr_ord(ip) function is_legal_ml_aggr_ord(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_ord logical :: is_legal_ml_aggr_ord
@ -867,7 +878,7 @@ contains
return return
end function is_legal_ml_aggr_ord end function is_legal_ml_aggr_ord
function is_legal_ml_aggr_omega_alg(ip) function is_legal_ml_aggr_omega_alg(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_omega_alg logical :: is_legal_ml_aggr_omega_alg
@ -875,7 +886,7 @@ contains
return return
end function is_legal_ml_aggr_omega_alg end function is_legal_ml_aggr_omega_alg
function is_legal_ml_aggr_eig(ip) function is_legal_ml_aggr_eig(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_eig logical :: is_legal_ml_aggr_eig
@ -883,7 +894,7 @@ contains
return return
end function is_legal_ml_aggr_eig end function is_legal_ml_aggr_eig
function is_legal_ml_aggr_prol(ip) function is_legal_ml_aggr_prol(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_prol logical :: is_legal_ml_aggr_prol
@ -891,7 +902,7 @@ contains
return return
end function is_legal_ml_aggr_prol end function is_legal_ml_aggr_prol
function is_legal_ml_coarse_mat(ip) function is_legal_ml_coarse_mat(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_coarse_mat logical :: is_legal_ml_coarse_mat
@ -899,7 +910,7 @@ contains
return return
end function is_legal_ml_coarse_mat end function is_legal_ml_coarse_mat
function is_legal_aggr_filter(ip) function is_legal_aggr_filter(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_aggr_filter logical :: is_legal_aggr_filter
@ -907,7 +918,7 @@ contains
return return
end function is_legal_aggr_filter end function is_legal_aggr_filter
function is_distr_ml_coarse_mat(ip) function is_distr_ml_coarse_mat(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_distr_ml_coarse_mat logical :: is_distr_ml_coarse_mat
@ -915,7 +926,7 @@ contains
return return
end function is_distr_ml_coarse_mat end function is_distr_ml_coarse_mat
function is_legal_ml_fact(ip) function is_legal_ml_fact(ip)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_fact logical :: is_legal_ml_fact
! Here the minimum is really 1, amg_fact_none_ is not acceptable. ! Here the minimum is really 1, amg_fact_none_ is not acceptable.
@ -925,7 +936,7 @@ contains
end function is_legal_ml_fact end function is_legal_ml_fact
function is_legal_ilu_fact(ip) function is_legal_ilu_fact(ip)
use psb_prec_const_mod use psb_prec_const_mod
implicit none implicit none
integer(psb_ipk_), intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ilu_fact logical :: is_legal_ilu_fact
@ -934,14 +945,14 @@ contains
return return
end function is_legal_ilu_fact end function is_legal_ilu_fact
function is_legal_d_omega(ip) function is_legal_d_omega(ip)
implicit none implicit none
real(psb_dpk_), intent(in) :: ip real(psb_dpk_), intent(in) :: ip
logical :: is_legal_d_omega logical :: is_legal_d_omega
is_legal_d_omega = ((ip>=0.0d0).and.(ip<=2.0d0)) is_legal_d_omega = ((ip>=0.0d0).and.(ip<=2.0d0))
return return
end function is_legal_d_omega end function is_legal_d_omega
function is_legal_d_fact_thrs(ip) function is_legal_d_fact_thrs(ip)
implicit none implicit none
real(psb_dpk_), intent(in) :: ip real(psb_dpk_), intent(in) :: ip
logical :: is_legal_d_fact_thrs logical :: is_legal_d_fact_thrs
@ -949,7 +960,7 @@ contains
return return
end function is_legal_d_fact_thrs end function is_legal_d_fact_thrs
function is_legal_d_aggr_thrs(ip) function is_legal_d_aggr_thrs(ip)
implicit none implicit none
real(psb_dpk_), intent(in) :: ip real(psb_dpk_), intent(in) :: ip
logical :: is_legal_d_aggr_thrs logical :: is_legal_d_aggr_thrs
@ -958,14 +969,14 @@ contains
end function is_legal_d_aggr_thrs end function is_legal_d_aggr_thrs
function is_legal_s_omega(ip) function is_legal_s_omega(ip)
implicit none implicit none
real(psb_spk_), intent(in) :: ip real(psb_spk_), intent(in) :: ip
logical :: is_legal_s_omega logical :: is_legal_s_omega
is_legal_s_omega = ((ip>=0.0).and.(ip<=2.0)) is_legal_s_omega = ((ip>=0.0).and.(ip<=2.0))
return return
end function is_legal_s_omega end function is_legal_s_omega
function is_legal_s_fact_thrs(ip) function is_legal_s_fact_thrs(ip)
implicit none implicit none
real(psb_spk_), intent(in) :: ip real(psb_spk_), intent(in) :: ip
logical :: is_legal_s_fact_thrs logical :: is_legal_s_fact_thrs
@ -973,7 +984,7 @@ contains
return return
end function is_legal_s_fact_thrs end function is_legal_s_fact_thrs
function is_legal_s_aggr_thrs(ip) function is_legal_s_aggr_thrs(ip)
implicit none implicit none
real(psb_spk_), intent(in) :: ip real(psb_spk_), intent(in) :: ip
logical :: is_legal_s_aggr_thrs logical :: is_legal_s_aggr_thrs
@ -983,11 +994,11 @@ contains
subroutine amg_icheck_def(ip,name,id,is_legal) subroutine amg_icheck_def(ip,name,id,is_legal)
implicit none implicit none
integer(psb_ipk_), intent(inout) :: ip integer(psb_ipk_), intent(inout) :: ip
integer(psb_ipk_), intent(in) :: id integer(psb_ipk_), intent(in) :: id
character(len=*), intent(in) :: name character(len=*), intent(in) :: name
interface interface
function is_legal(i) function is_legal(i)
import :: psb_ipk_ import :: psb_ipk_
integer(psb_ipk_), intent(in) :: i integer(psb_ipk_), intent(in) :: i
@ -996,7 +1007,7 @@ contains
end interface end interface
character(len=20), parameter :: rname='amg_check_def' 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 ',& write(0,*)trim(rname),': Error: Illegal value for ',&
& name,' :',ip, '. defaulting to ',id & name,' :',ip, '. defaulting to ',id
ip = id ip = id
@ -1004,11 +1015,11 @@ contains
end subroutine amg_icheck_def end subroutine amg_icheck_def
subroutine amg_scheck_def(ip,name,id,is_legal) subroutine amg_scheck_def(ip,name,id,is_legal)
implicit none implicit none
real(psb_spk_), intent(inout) :: ip real(psb_spk_), intent(inout) :: ip
real(psb_spk_), intent(in) :: id real(psb_spk_), intent(in) :: id
character(len=*), intent(in) :: name character(len=*), intent(in) :: name
interface interface
function is_legal(i) function is_legal(i)
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_), intent(in) :: i real(psb_spk_), intent(in) :: i
@ -1017,7 +1028,7 @@ contains
end interface end interface
character(len=20), parameter :: rname='amg_check_def' 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 ',& write(0,*)trim(rname),': Error: Illegal value for ',&
& name,' :',ip, '. defaulting to ',id & name,' :',ip, '. defaulting to ',id
ip = id ip = id
@ -1025,11 +1036,11 @@ contains
end subroutine amg_scheck_def end subroutine amg_scheck_def
subroutine amg_dcheck_def(ip,name,id,is_legal) subroutine amg_dcheck_def(ip,name,id,is_legal)
implicit none implicit none
real(psb_dpk_), intent(inout) :: ip real(psb_dpk_), intent(inout) :: ip
real(psb_dpk_), intent(in) :: id real(psb_dpk_), intent(in) :: id
character(len=*), intent(in) :: name character(len=*), intent(in) :: name
interface interface
function is_legal(i) function is_legal(i)
use psb_base_mod, only : psb_dpk_ use psb_base_mod, only : psb_dpk_
real(psb_dpk_), intent(in) :: i real(psb_dpk_), intent(in) :: i
@ -1038,7 +1049,7 @@ contains
end interface end interface
character(len=20), parameter :: rname='amg_check_def' 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 ',& write(0,*)trim(rname),': Error: Illegal value for ',&
& name,' :',ip, '. defaulting to ',id & name,' :',ip, '. defaulting to ',id
ip = id ip = id
@ -1047,7 +1058,7 @@ contains
function pr_to_str(iprec) function pr_to_str(iprec)
implicit none implicit none
integer(psb_ipk_), intent(in) :: iprec integer(psb_ipk_), intent(in) :: iprec
character(len=10) :: pr_to_str character(len=10) :: pr_to_str
@ -1055,11 +1066,11 @@ contains
select case(iprec) select case(iprec)
case(amg_noprec_) case(amg_noprec_)
pr_to_str='NOPREC' pr_to_str='NOPREC'
case(amg_jac_) case(amg_jac_)
pr_to_str='JAC' pr_to_str='JAC'
case(amg_bjac_) case(amg_bjac_)
pr_to_str='BJAC' pr_to_str='BJAC'
case(amg_as_) case(amg_as_)
pr_to_str='AS' pr_to_str='AS'
end select end select
@ -1067,7 +1078,7 @@ contains
subroutine amg_ml_bcast(ctxt,dat,root) subroutine amg_ml_bcast(ctxt,dat,root)
implicit none implicit none
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
type(amg_ml_parms), intent(inout) :: dat type(amg_ml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
@ -1089,7 +1100,7 @@ contains
subroutine amg_sml_bcast(ctxt,dat,root) subroutine amg_sml_bcast(ctxt,dat,root)
implicit none implicit none
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
type(amg_sml_parms), intent(inout) :: dat type(amg_sml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
@ -1100,7 +1111,7 @@ contains
end subroutine amg_sml_bcast end subroutine amg_sml_bcast
subroutine amg_dml_bcast(ctxt,dat,root) subroutine amg_dml_bcast(ctxt,dat,root)
implicit none implicit none
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
type(amg_dml_parms), intent(inout) :: dat type(amg_dml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
@ -1112,7 +1123,7 @@ contains
subroutine ml_parms_clone(pm,pmout,info) subroutine ml_parms_clone(pm,pmout,info)
implicit none implicit none
class(amg_ml_parms), intent(inout) :: pm class(amg_ml_parms), intent(inout) :: pm
class(amg_ml_parms), intent(out) :: pmout class(amg_ml_parms), intent(out) :: pmout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -1132,19 +1143,19 @@ contains
pmout%coarse_solve = pm%coarse_solve pmout%coarse_solve = pm%coarse_solve
end subroutine ml_parms_clone end subroutine ml_parms_clone
subroutine s_ml_parms_clone(pm,pmout,info) subroutine s_ml_parms_clone(pm,pmout,info)
implicit none implicit none
class(amg_sml_parms), intent(inout) :: pm class(amg_sml_parms), intent(inout) :: pm
class(amg_ml_parms), intent(out) :: pmout class(amg_ml_parms), intent(out) :: pmout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='clone' character(len=20) :: name='clone'
info = 0 info = 0
select type(pout => pmout) select type(pout => pmout)
class is (amg_sml_parms) class is (amg_sml_parms)
@ -1159,21 +1170,21 @@ contains
call psb_get_erraction(err_act) call psb_get_erraction(err_act)
call psb_error_handler(err_act) call psb_error_handler(err_act)
end select end select
end subroutine s_ml_parms_clone end subroutine s_ml_parms_clone
subroutine d_ml_parms_clone(pm,pmout,info) subroutine d_ml_parms_clone(pm,pmout,info)
implicit none implicit none
class(amg_dml_parms), intent(inout) :: pm class(amg_dml_parms), intent(inout) :: pm
class(amg_ml_parms), intent(out) :: pmout class(amg_ml_parms), intent(out) :: pmout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='clone' character(len=20) :: name='clone'
info = 0 info = 0
select type(pout => pmout) select type(pout => pmout)
class is (amg_dml_parms) class is (amg_dml_parms)
@ -1189,13 +1200,13 @@ contains
call psb_error_handler(err_act) call psb_error_handler(err_act)
return return
end select end select
end subroutine d_ml_parms_clone end subroutine d_ml_parms_clone
function amg_s_equal_aggregation(parms1, parms2) result(val) function amg_s_equal_aggregation(parms1, parms2) result(val)
type(amg_sml_parms), intent(in) :: parms1, parms2 type(amg_sml_parms), intent(in) :: parms1, parms2
logical :: val logical :: val
val = (parms1%par_aggr_alg == parms2%par_aggr_alg ) .and. & val = (parms1%par_aggr_alg == parms2%par_aggr_alg ) .and. &
& (parms1%aggr_type == parms2%aggr_type ) .and. & & (parms1%aggr_type == parms2%aggr_type ) .and. &
& (parms1%aggr_ord == parms2%aggr_ord ) .and. & & (parms1%aggr_ord == parms2%aggr_ord ) .and. &
@ -1210,7 +1221,7 @@ contains
function amg_d_equal_aggregation(parms1, parms2) result(val) function amg_d_equal_aggregation(parms1, parms2) result(val)
type(amg_dml_parms), intent(in) :: parms1, parms2 type(amg_dml_parms), intent(in) :: parms1, parms2
logical :: val logical :: val
val = (parms1%par_aggr_alg == parms2%par_aggr_alg ) .and. & val = (parms1%par_aggr_alg == parms2%par_aggr_alg ) .and. &
& (parms1%aggr_type == parms2%aggr_type ) .and. & & (parms1%aggr_type == parms2%aggr_type ) .and. &
& (parms1%aggr_ord == parms2%aggr_ord ) .and. & & (parms1%aggr_ord == parms2%aggr_ord ) .and. &
@ -1221,5 +1232,5 @@ contains
& (parms1%aggr_omega_val == parms2%aggr_omega_val ) .and. & & (parms1%aggr_omega_val == parms2%aggr_omega_val ) .and. &
& (parms1%aggr_thresh == parms2%aggr_thresh ) & (parms1%aggr_thresh == parms2%aggr_thresh )
end function amg_d_equal_aggregation end function amg_d_equal_aggregation
end module amg_base_prec_type end module amg_base_prec_type

2
amgprec/amg_d_matchboxp_mod.f90
Unescape Escape View File

@ -80,7 +80,7 @@ module dmatchboxp_mod
subroutine dMatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,& subroutine dMatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate, myrank, numprocs, icomm,& & verdistance, mate, myrank, numprocs, icomm,&
& msgindsent,msgactualsent,msgpercent,& & msgindsent,msgactualsent,msgpercent,&
& ph0_time, ph1_time, ph2_time, ph1_card, ph2_card) bind(c,name='MatchBoxPC') & ph0_time, ph1_time, ph2_time, ph1_card, ph2_card) bind(c,name='dMatchBoxPC')
use iso_c_binding use iso_c_binding
import :: psb_c_ipk_, psb_c_lpk_, psb_c_mpk_, psb_c_epk_ import :: psb_c_ipk_, psb_c_lpk_, psb_c_mpk_, psb_c_epk_
implicit none implicit none

2
amgprec/amg_s_matchboxp_mod.f90
Unescape Escape View File

@ -80,7 +80,7 @@ module smatchboxp_mod
subroutine sMatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,& subroutine sMatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate, myrank, numprocs, icomm,& & verdistance, mate, myrank, numprocs, icomm,&
& msgindsent,msgactualsent,msgpercent,& & msgindsent,msgactualsent,msgpercent,&
& ph0_time, ph1_time, ph2_time, ph1_card, ph2_card) bind(c,name='MatchBoxPC') & ph0_time, ph1_time, ph2_time, ph1_card, ph2_card) bind(c,name='sMatchBoxPC')
use iso_c_binding use iso_c_binding
import :: psb_c_ipk_, psb_c_lpk_, psb_c_mpk_, psb_c_epk_ import :: psb_c_ipk_, psb_c_lpk_, psb_c_mpk_, psb_c_epk_
implicit none implicit none

18
amgprec/impl/aggregator/MatchBoxPC.h
Unescape Escape View File

@ -172,6 +172,24 @@ MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time, MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
MilanLongInt* ph1_card, MilanLongInt* ph2_card ); MilanLongInt* ph1_card, MilanLongInt* ph2_card );
void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
MilanLongInt* verDistance,
MilanLongInt* Mate,
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
MilanLongInt* verDistance,
MilanLongInt* Mate,
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
#ifdef __cplusplus #ifdef __cplusplus
} }
#endif #endif

46
amgprec/impl/aggregator/amg_c_dec_aggregator_tprol.f90
Unescape Escape View File

@ -1,15 +1,15 @@
! !
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,26 +33,26 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
! File: amg_c_dec_aggregator_tprol.f90 ! File: amg_c_dec_aggregator_tprol.f90
! !
! Subroutine: amg_c_dec_aggregator_tprol ! Subroutine: amg_c_dec_aggregator_tprol
! Version: complex ! Version: complex
! !
! This routine is mainly an interface to soc_map_bld where the real work is performed. ! This routine is mainly an interface to soc_map_bld where the real work is performed.
! It takes care of some consistency checking, and calls map_to_tprol, which is ! It takes care of some consistency checking, and calls map_to_tprol, which is
! refactored and shared among all the aggregation methods that produce a simple ! refactored and shared among all the aggregation methods that produce a simple
! integer mapping. ! integer mapping.
! !
! !
! Arguments: ! Arguments:
! ag - type(amg_c_dec_aggregator_type), input/output. ! ag - type(amg_c_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm. ! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object ! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object ! ag_data - Auxiliary global aggregation parameters object
! !
! !
! a - type(psb_cspmat_type). ! a - type(psb_cspmat_type).
! The sparse matrix structure containing the local part of the ! The sparse matrix structure containing the local part of the
! fine-level matrix. ! fine-level matrix.
@ -70,10 +70,10 @@
! nlaggr(i) contains the aggregates held by process i. ! nlaggr(i) contains the aggregates held by process i.
! t_prol - type(psb_cspmat_type), output ! t_prol - type(psb_cspmat_type), output
! The tentative prolongator, based on ilaggr. ! The tentative prolongator, based on ilaggr.
! !
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,& subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info) & a,desc_a,ilaggr,nlaggr,t_prol,info)
use psb_base_mod use psb_base_mod
@ -81,7 +81,7 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_c_inner_mod use amg_c_inner_mod
implicit none implicit none
class(amg_c_dec_aggregator_type), target, intent(inout) :: ag class(amg_c_dec_aggregator_type), target, intent(inout) :: ag
type(amg_sml_parms), intent(inout) :: parms type(amg_sml_parms), intent(inout) :: parms
type(amg_saggr_data), intent(in) :: ag_data type(amg_saggr_data), intent(in) :: ag_data
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -112,7 +112,7 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)
call amg_check_def(parms%par_aggr_alg,'Aggregation',& call amg_check_def(parms%par_aggr_alg,'Aggregation',&
& amg_dec_aggr_,is_legal_ml_par_aggr_alg) & amg_dec_aggr_,is_legal_decoupled_par_aggr_alg)
call amg_check_def(parms%aggr_ord,'Ordering',& call amg_check_def(parms%aggr_ord,'Ordering',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord) & amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs) call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
@ -130,11 +130,11 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol') call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')
goto 9999 goto 9999
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine amg_c_dec_aggregator_build_tprol end subroutine amg_c_dec_aggregator_build_tprol

46
amgprec/impl/aggregator/amg_c_symdec_aggregator_tprol.f90
Unescape Escape View File

@ -1,15 +1,15 @@
! ! is_legal_decoupled_par_aggr_alg
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,28 +33,28 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
! File: amg_c_symdec_aggregator_tprol.f90 ! File: amg_c_symdec_aggregator_tprol.f90
! !
! Subroutine: amg_c_symdec_aggregator_tprol ! Subroutine: amg_c_symdec_aggregator_tprol
! Version: complex ! Version: complex
! !
! !
! This routine is mainly an interface to soc_map_bld where the real work is performed. ! This routine is mainly an interface to soc_map_bld where the real work is performed.
! It takes care of some consistency checking, and calls map_to_tprol, which is ! It takes care of some consistency checking, and calls map_to_tprol, which is
! refactored and shared among all the aggregation methods that produce a simple ! refactored and shared among all the aggregation methods that produce a simple
! integer mapping. It also symmetrizes the pattern of the local matrix A. ! integer mapping. It also symmetrizes the pattern of the local matrix A.
!
! !
! !
!
! Arguments: ! Arguments:
! Arguments: ! Arguments:
! ag - type(amg_c_dec_aggregator_type), input/output. ! ag - type(amg_c_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm. ! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object ! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object ! ag_data - Auxiliary global aggregation parameters object
! !
! a - type(psb_cspmat_type). ! a - type(psb_cspmat_type).
! The sparse matrix structure containing the local part of the ! The sparse matrix structure containing the local part of the
! fine-level matrix. ! fine-level matrix.
@ -72,10 +72,10 @@
! nlaggr(i) contains the aggregates held by process i. ! nlaggr(i) contains the aggregates held by process i.
! op_prol - type(psb_cspmat_type), output ! op_prol - type(psb_cspmat_type), output
! The tentative prolongator, based on ilaggr. ! The tentative prolongator, based on ilaggr.
! !
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,& subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,op_prol,info) & a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
@ -84,7 +84,7 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_c_inner_mod use amg_c_inner_mod
implicit none implicit none
class(amg_c_symdec_aggregator_type), target, intent(inout) :: ag class(amg_c_symdec_aggregator_type), target, intent(inout) :: ag
type(amg_sml_parms), intent(inout) :: parms type(amg_sml_parms), intent(inout) :: parms
type(amg_saggr_data), intent(in) :: ag_data type(amg_saggr_data), intent(in) :: ag_data
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -117,7 +117,7 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)
call amg_check_def(parms%par_aggr_alg,'Aggregation',& call amg_check_def(parms%par_aggr_alg,'Aggregation',&
& amg_dec_aggr_,is_legal_ml_par_aggr_alg) & amg_dec_aggr_,is_legal_decoupled_par_aggr_alg)
call amg_check_def(parms%aggr_ord,'Ordering',& call amg_check_def(parms%aggr_ord,'Ordering',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord) & amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs) call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
@ -129,7 +129,7 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
call atmp%set_ncols(nr) call atmp%set_ncols(nr)
if (info == psb_success_) call atmp%transp(atrans) if (info == psb_success_) call atmp%transp(atrans)
if (info == psb_success_) call atrans%cscnv(info,type='COO') if (info == psb_success_) call atrans%cscnv(info,type='COO')
if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.) if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.)
call atmp%set_nrows(nr) call atmp%set_nrows(nr)
call atmp%set_ncols(nr) call atmp%set_ncols(nr)
if (info == psb_success_) call atrans%free() if (info == psb_success_) call atrans%free()
@ -145,7 +145,7 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& desc_a,nlaggr,ilaggr,info) & desc_a,nlaggr,ilaggr,info)
if (info == psb_success_) call atmp%free() if (info == psb_success_) call atmp%free()
if (info == psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) if (info == psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol') call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

46
amgprec/impl/aggregator/amg_d_dec_aggregator_tprol.f90
Unescape Escape View File

@ -1,15 +1,15 @@
! !
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,26 +33,26 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
! File: amg_d_dec_aggregator_tprol.f90 ! File: amg_d_dec_aggregator_tprol.f90
! !
! Subroutine: amg_d_dec_aggregator_tprol ! Subroutine: amg_d_dec_aggregator_tprol
! Version: real ! Version: real
! !
! This routine is mainly an interface to soc_map_bld where the real work is performed. ! This routine is mainly an interface to soc_map_bld where the real work is performed.
! It takes care of some consistency checking, and calls map_to_tprol, which is ! It takes care of some consistency checking, and calls map_to_tprol, which is
! refactored and shared among all the aggregation methods that produce a simple ! refactored and shared among all the aggregation methods that produce a simple
! integer mapping. ! integer mapping.
! !
! !
! Arguments: ! Arguments:
! ag - type(amg_d_dec_aggregator_type), input/output. ! ag - type(amg_d_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm. ! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object ! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object ! ag_data - Auxiliary global aggregation parameters object
! !
! !
! a - type(psb_dspmat_type). ! a - type(psb_dspmat_type).
! The sparse matrix structure containing the local part of the ! The sparse matrix structure containing the local part of the
! fine-level matrix. ! fine-level matrix.
@ -70,10 +70,10 @@
! nlaggr(i) contains the aggregates held by process i. ! nlaggr(i) contains the aggregates held by process i.
! t_prol - type(psb_dspmat_type), output ! t_prol - type(psb_dspmat_type), output
! The tentative prolongator, based on ilaggr. ! The tentative prolongator, based on ilaggr.
! !
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,& subroutine amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info) & a,desc_a,ilaggr,nlaggr,t_prol,info)
use psb_base_mod use psb_base_mod
@ -81,7 +81,7 @@ subroutine amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_d_inner_mod use amg_d_inner_mod
implicit none implicit none
class(amg_d_dec_aggregator_type), target, intent(inout) :: ag class(amg_d_dec_aggregator_type), target, intent(inout) :: ag
type(amg_dml_parms), intent(inout) :: parms type(amg_dml_parms), intent(inout) :: parms
type(amg_daggr_data), intent(in) :: ag_data type(amg_daggr_data), intent(in) :: ag_data
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -112,7 +112,7 @@ subroutine amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)
call amg_check_def(parms%par_aggr_alg,'Aggregation',& call amg_check_def(parms%par_aggr_alg,'Aggregation',&
& amg_dec_aggr_,is_legal_ml_par_aggr_alg) & amg_dec_aggr_,is_legal_decoupled_par_aggr_alg)
call amg_check_def(parms%aggr_ord,'Ordering',& call amg_check_def(parms%aggr_ord,'Ordering',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord) & amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
@ -130,11 +130,11 @@ subroutine amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol') call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')
goto 9999 goto 9999
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine amg_d_dec_aggregator_build_tprol end subroutine amg_d_dec_aggregator_build_tprol

2
amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.f90
Unescape Escape View File

@ -177,7 +177,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)
call amg_check_def(parms%par_aggr_alg,'Aggregation',& call amg_check_def(parms%par_aggr_alg,'Aggregation',&
& amg_dec_aggr_,is_legal_ml_par_aggr_alg) & amg_coupled_aggr_,is_legal_coupled_par_aggr_alg)
call amg_check_def(parms%aggr_ord,'Ordering',& call amg_check_def(parms%aggr_ord,'Ordering',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord) & amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)

46
amgprec/impl/aggregator/amg_d_symdec_aggregator_tprol.f90
Unescape Escape View File

@ -1,15 +1,15 @@
! ! is_legal_decoupled_par_aggr_alg
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,28 +33,28 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
! File: amg_d_symdec_aggregator_tprol.f90 ! File: amg_d_symdec_aggregator_tprol.f90
! !
! Subroutine: amg_d_symdec_aggregator_tprol ! Subroutine: amg_d_symdec_aggregator_tprol
! Version: real ! Version: real
! !
! !
! This routine is mainly an interface to soc_map_bld where the real work is performed. ! This routine is mainly an interface to soc_map_bld where the real work is performed.
! It takes care of some consistency checking, and calls map_to_tprol, which is ! It takes care of some consistency checking, and calls map_to_tprol, which is
! refactored and shared among all the aggregation methods that produce a simple ! refactored and shared among all the aggregation methods that produce a simple
! integer mapping. It also symmetrizes the pattern of the local matrix A. ! integer mapping. It also symmetrizes the pattern of the local matrix A.
!
! !
! !
!
! Arguments: ! Arguments:
! Arguments: ! Arguments:
! ag - type(amg_d_dec_aggregator_type), input/output. ! ag - type(amg_d_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm. ! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object ! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object ! ag_data - Auxiliary global aggregation parameters object
! !
! a - type(psb_dspmat_type). ! a - type(psb_dspmat_type).
! The sparse matrix structure containing the local part of the ! The sparse matrix structure containing the local part of the
! fine-level matrix. ! fine-level matrix.
@ -72,10 +72,10 @@
! nlaggr(i) contains the aggregates held by process i. ! nlaggr(i) contains the aggregates held by process i.
! op_prol - type(psb_dspmat_type), output ! op_prol - type(psb_dspmat_type), output
! The tentative prolongator, based on ilaggr. ! The tentative prolongator, based on ilaggr.
! !
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,& subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,op_prol,info) & a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
@ -84,7 +84,7 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_d_inner_mod use amg_d_inner_mod
implicit none implicit none
class(amg_d_symdec_aggregator_type), target, intent(inout) :: ag class(amg_d_symdec_aggregator_type), target, intent(inout) :: ag
type(amg_dml_parms), intent(inout) :: parms type(amg_dml_parms), intent(inout) :: parms
type(amg_daggr_data), intent(in) :: ag_data type(amg_daggr_data), intent(in) :: ag_data
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -117,7 +117,7 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)
call amg_check_def(parms%par_aggr_alg,'Aggregation',& call amg_check_def(parms%par_aggr_alg,'Aggregation',&
& amg_dec_aggr_,is_legal_ml_par_aggr_alg) & amg_dec_aggr_,is_legal_decoupled_par_aggr_alg)
call amg_check_def(parms%aggr_ord,'Ordering',& call amg_check_def(parms%aggr_ord,'Ordering',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord) & amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
@ -129,7 +129,7 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
call atmp%set_ncols(nr) call atmp%set_ncols(nr)
if (info == psb_success_) call atmp%transp(atrans) if (info == psb_success_) call atmp%transp(atrans)
if (info == psb_success_) call atrans%cscnv(info,type='COO') if (info == psb_success_) call atrans%cscnv(info,type='COO')
if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.) if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.)
call atmp%set_nrows(nr) call atmp%set_nrows(nr)
call atmp%set_ncols(nr) call atmp%set_ncols(nr)
if (info == psb_success_) call atrans%free() if (info == psb_success_) call atrans%free()
@ -145,7 +145,7 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& desc_a,nlaggr,ilaggr,info) & desc_a,nlaggr,ilaggr,info)
if (info == psb_success_) call atmp%free() if (info == psb_success_) call atmp%free()
if (info == psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) if (info == psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol') call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

46
amgprec/impl/aggregator/amg_s_dec_aggregator_tprol.f90
Unescape Escape View File

@ -1,15 +1,15 @@
! !
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,26 +33,26 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
! File: amg_s_dec_aggregator_tprol.f90 ! File: amg_s_dec_aggregator_tprol.f90
! !
! Subroutine: amg_s_dec_aggregator_tprol ! Subroutine: amg_s_dec_aggregator_tprol
! Version: real ! Version: real
! !
! This routine is mainly an interface to soc_map_bld where the real work is performed. ! This routine is mainly an interface to soc_map_bld where the real work is performed.
! It takes care of some consistency checking, and calls map_to_tprol, which is ! It takes care of some consistency checking, and calls map_to_tprol, which is
! refactored and shared among all the aggregation methods that produce a simple ! refactored and shared among all the aggregation methods that produce a simple
! integer mapping. ! integer mapping.
! !
! !
! Arguments: ! Arguments:
! ag - type(amg_s_dec_aggregator_type), input/output. ! ag - type(amg_s_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm. ! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object ! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object ! ag_data - Auxiliary global aggregation parameters object
! !
! !
! a - type(psb_sspmat_type). ! a - type(psb_sspmat_type).
! The sparse matrix structure containing the local part of the ! The sparse matrix structure containing the local part of the
! fine-level matrix. ! fine-level matrix.
@ -70,10 +70,10 @@
! nlaggr(i) contains the aggregates held by process i. ! nlaggr(i) contains the aggregates held by process i.
! t_prol - type(psb_sspmat_type), output ! t_prol - type(psb_sspmat_type), output
! The tentative prolongator, based on ilaggr. ! The tentative prolongator, based on ilaggr.
! !
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,& subroutine amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info) & a,desc_a,ilaggr,nlaggr,t_prol,info)
use psb_base_mod use psb_base_mod
@ -81,7 +81,7 @@ subroutine amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_s_inner_mod use amg_s_inner_mod
implicit none implicit none
class(amg_s_dec_aggregator_type), target, intent(inout) :: ag class(amg_s_dec_aggregator_type), target, intent(inout) :: ag
type(amg_sml_parms), intent(inout) :: parms type(amg_sml_parms), intent(inout) :: parms
type(amg_saggr_data), intent(in) :: ag_data type(amg_saggr_data), intent(in) :: ag_data
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -112,7 +112,7 @@ subroutine amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)
call amg_check_def(parms%par_aggr_alg,'Aggregation',& call amg_check_def(parms%par_aggr_alg,'Aggregation',&
& amg_dec_aggr_,is_legal_ml_par_aggr_alg) & amg_dec_aggr_,is_legal_decoupled_par_aggr_alg)
call amg_check_def(parms%aggr_ord,'Ordering',& call amg_check_def(parms%aggr_ord,'Ordering',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord) & amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs) call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
@ -130,11 +130,11 @@ subroutine amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol') call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')
goto 9999 goto 9999
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine amg_s_dec_aggregator_build_tprol end subroutine amg_s_dec_aggregator_build_tprol

2
amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.f90
Unescape Escape View File

@ -177,7 +177,7 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)
call amg_check_def(parms%par_aggr_alg,'Aggregation',& call amg_check_def(parms%par_aggr_alg,'Aggregation',&
& amg_dec_aggr_,is_legal_ml_par_aggr_alg) & amg_coupled_aggr_,is_legal_coupled_par_aggr_alg)
call amg_check_def(parms%aggr_ord,'Ordering',& call amg_check_def(parms%aggr_ord,'Ordering',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord) & amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs) call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)

46
amgprec/impl/aggregator/amg_s_symdec_aggregator_tprol.f90
Unescape Escape View File

@ -1,15 +1,15 @@
! ! is_legal_decoupled_par_aggr_alg
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,28 +33,28 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
! File: amg_s_symdec_aggregator_tprol.f90 ! File: amg_s_symdec_aggregator_tprol.f90
! !
! Subroutine: amg_s_symdec_aggregator_tprol ! Subroutine: amg_s_symdec_aggregator_tprol
! Version: real ! Version: real
! !
! !
! This routine is mainly an interface to soc_map_bld where the real work is performed. ! This routine is mainly an interface to soc_map_bld where the real work is performed.
! It takes care of some consistency checking, and calls map_to_tprol, which is ! It takes care of some consistency checking, and calls map_to_tprol, which is
! refactored and shared among all the aggregation methods that produce a simple ! refactored and shared among all the aggregation methods that produce a simple
! integer mapping. It also symmetrizes the pattern of the local matrix A. ! integer mapping. It also symmetrizes the pattern of the local matrix A.
!
! !
! !
!
! Arguments: ! Arguments:
! Arguments: ! Arguments:
! ag - type(amg_s_dec_aggregator_type), input/output. ! ag - type(amg_s_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm. ! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object ! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object ! ag_data - Auxiliary global aggregation parameters object
! !
! a - type(psb_sspmat_type). ! a - type(psb_sspmat_type).
! The sparse matrix structure containing the local part of the ! The sparse matrix structure containing the local part of the
! fine-level matrix. ! fine-level matrix.
@ -72,10 +72,10 @@
! nlaggr(i) contains the aggregates held by process i. ! nlaggr(i) contains the aggregates held by process i.
! op_prol - type(psb_sspmat_type), output ! op_prol - type(psb_sspmat_type), output
! The tentative prolongator, based on ilaggr. ! The tentative prolongator, based on ilaggr.
! !
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,& subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,op_prol,info) & a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
@ -84,7 +84,7 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_s_inner_mod use amg_s_inner_mod
implicit none implicit none
class(amg_s_symdec_aggregator_type), target, intent(inout) :: ag class(amg_s_symdec_aggregator_type), target, intent(inout) :: ag
type(amg_sml_parms), intent(inout) :: parms type(amg_sml_parms), intent(inout) :: parms
type(amg_saggr_data), intent(in) :: ag_data type(amg_saggr_data), intent(in) :: ag_data
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -117,7 +117,7 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)
call amg_check_def(parms%par_aggr_alg,'Aggregation',& call amg_check_def(parms%par_aggr_alg,'Aggregation',&
& amg_dec_aggr_,is_legal_ml_par_aggr_alg) & amg_dec_aggr_,is_legal_decoupled_par_aggr_alg)
call amg_check_def(parms%aggr_ord,'Ordering',& call amg_check_def(parms%aggr_ord,'Ordering',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord) & amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs) call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
@ -129,7 +129,7 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
call atmp%set_ncols(nr) call atmp%set_ncols(nr)
if (info == psb_success_) call atmp%transp(atrans) if (info == psb_success_) call atmp%transp(atrans)
if (info == psb_success_) call atrans%cscnv(info,type='COO') if (info == psb_success_) call atrans%cscnv(info,type='COO')
if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.) if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.)
call atmp%set_nrows(nr) call atmp%set_nrows(nr)
call atmp%set_ncols(nr) call atmp%set_ncols(nr)
if (info == psb_success_) call atrans%free() if (info == psb_success_) call atrans%free()
@ -145,7 +145,7 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& desc_a,nlaggr,ilaggr,info) & desc_a,nlaggr,ilaggr,info)
if (info == psb_success_) call atmp%free() if (info == psb_success_) call atmp%free()
if (info == psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) if (info == psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol') call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

46
amgprec/impl/aggregator/amg_z_dec_aggregator_tprol.f90
Unescape Escape View File

@ -1,15 +1,15 @@
! !
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,26 +33,26 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
! File: amg_z_dec_aggregator_tprol.f90 ! File: amg_z_dec_aggregator_tprol.f90
! !
! Subroutine: amg_z_dec_aggregator_tprol ! Subroutine: amg_z_dec_aggregator_tprol
! Version: complex ! Version: complex
! !
! This routine is mainly an interface to soc_map_bld where the real work is performed. ! This routine is mainly an interface to soc_map_bld where the real work is performed.
! It takes care of some consistency checking, and calls map_to_tprol, which is ! It takes care of some consistency checking, and calls map_to_tprol, which is
! refactored and shared among all the aggregation methods that produce a simple ! refactored and shared among all the aggregation methods that produce a simple
! integer mapping. ! integer mapping.
! !
! !
! Arguments: ! Arguments:
! ag - type(amg_z_dec_aggregator_type), input/output. ! ag - type(amg_z_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm. ! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object ! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object ! ag_data - Auxiliary global aggregation parameters object
! !
! !
! a - type(psb_zspmat_type). ! a - type(psb_zspmat_type).
! The sparse matrix structure containing the local part of the ! The sparse matrix structure containing the local part of the
! fine-level matrix. ! fine-level matrix.
@ -70,10 +70,10 @@
! nlaggr(i) contains the aggregates held by process i. ! nlaggr(i) contains the aggregates held by process i.
! t_prol - type(psb_zspmat_type), output ! t_prol - type(psb_zspmat_type), output
! The tentative prolongator, based on ilaggr. ! The tentative prolongator, based on ilaggr.
! !
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,& subroutine amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info) & a,desc_a,ilaggr,nlaggr,t_prol,info)
use psb_base_mod use psb_base_mod
@ -81,7 +81,7 @@ subroutine amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_z_inner_mod use amg_z_inner_mod
implicit none implicit none
class(amg_z_dec_aggregator_type), target, intent(inout) :: ag class(amg_z_dec_aggregator_type), target, intent(inout) :: ag
type(amg_dml_parms), intent(inout) :: parms type(amg_dml_parms), intent(inout) :: parms
type(amg_daggr_data), intent(in) :: ag_data type(amg_daggr_data), intent(in) :: ag_data
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -112,7 +112,7 @@ subroutine amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)
call amg_check_def(parms%par_aggr_alg,'Aggregation',& call amg_check_def(parms%par_aggr_alg,'Aggregation',&
& amg_dec_aggr_,is_legal_ml_par_aggr_alg) & amg_dec_aggr_,is_legal_decoupled_par_aggr_alg)
call amg_check_def(parms%aggr_ord,'Ordering',& call amg_check_def(parms%aggr_ord,'Ordering',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord) & amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
@ -130,11 +130,11 @@ subroutine amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol') call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')
goto 9999 goto 9999
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine amg_z_dec_aggregator_build_tprol end subroutine amg_z_dec_aggregator_build_tprol

46
amgprec/impl/aggregator/amg_z_symdec_aggregator_tprol.f90
Unescape Escape View File

@ -1,15 +1,15 @@
! ! is_legal_decoupled_par_aggr_alg
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,28 +33,28 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
! File: amg_z_symdec_aggregator_tprol.f90 ! File: amg_z_symdec_aggregator_tprol.f90
! !
! Subroutine: amg_z_symdec_aggregator_tprol ! Subroutine: amg_z_symdec_aggregator_tprol
! Version: complex ! Version: complex
! !
! !
! This routine is mainly an interface to soc_map_bld where the real work is performed. ! This routine is mainly an interface to soc_map_bld where the real work is performed.
! It takes care of some consistency checking, and calls map_to_tprol, which is ! It takes care of some consistency checking, and calls map_to_tprol, which is
! refactored and shared among all the aggregation methods that produce a simple ! refactored and shared among all the aggregation methods that produce a simple
! integer mapping. It also symmetrizes the pattern of the local matrix A. ! integer mapping. It also symmetrizes the pattern of the local matrix A.
!
! !
! !
!
! Arguments: ! Arguments:
! Arguments: ! Arguments:
! ag - type(amg_z_dec_aggregator_type), input/output. ! ag - type(amg_z_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm. ! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object ! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object ! ag_data - Auxiliary global aggregation parameters object
! !
! a - type(psb_zspmat_type). ! a - type(psb_zspmat_type).
! The sparse matrix structure containing the local part of the ! The sparse matrix structure containing the local part of the
! fine-level matrix. ! fine-level matrix.
@ -72,10 +72,10 @@
! nlaggr(i) contains the aggregates held by process i. ! nlaggr(i) contains the aggregates held by process i.
! op_prol - type(psb_zspmat_type), output ! op_prol - type(psb_zspmat_type), output
! The tentative prolongator, based on ilaggr. ! The tentative prolongator, based on ilaggr.
! !
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,& subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,op_prol,info) & a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
@ -84,7 +84,7 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_z_inner_mod use amg_z_inner_mod
implicit none implicit none
class(amg_z_symdec_aggregator_type), target, intent(inout) :: ag class(amg_z_symdec_aggregator_type), target, intent(inout) :: ag
type(amg_dml_parms), intent(inout) :: parms type(amg_dml_parms), intent(inout) :: parms
type(amg_daggr_data), intent(in) :: ag_data type(amg_daggr_data), intent(in) :: ag_data
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -117,7 +117,7 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)
call amg_check_def(parms%par_aggr_alg,'Aggregation',& call amg_check_def(parms%par_aggr_alg,'Aggregation',&
& amg_dec_aggr_,is_legal_ml_par_aggr_alg) & amg_dec_aggr_,is_legal_decoupled_par_aggr_alg)
call amg_check_def(parms%aggr_ord,'Ordering',& call amg_check_def(parms%aggr_ord,'Ordering',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord) & amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
@ -129,7 +129,7 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
call atmp%set_ncols(nr) call atmp%set_ncols(nr)
if (info == psb_success_) call atmp%transp(atrans) if (info == psb_success_) call atmp%transp(atrans)
if (info == psb_success_) call atrans%cscnv(info,type='COO') if (info == psb_success_) call atrans%cscnv(info,type='COO')
if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.) if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.)
call atmp%set_nrows(nr) call atmp%set_nrows(nr)
call atmp%set_ncols(nr) call atmp%set_ncols(nr)
if (info == psb_success_) call atrans%free() if (info == psb_success_) call atrans%free()
@ -145,7 +145,7 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& desc_a,nlaggr,ilaggr,info) & desc_a,nlaggr,ilaggr,info)
if (info == psb_success_) call atmp%free() if (info == psb_success_) call atmp%free()
if (info == psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) if (info == psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol') call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

88
amgprec/impl/level/amg_c_base_onelev_cseti.F90
Unescape Escape View File

@ -1,15 +1,15 @@
! !
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,10 +33,10 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx) subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
use psb_base_mod use psb_base_mod
use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_cseti use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_cseti
use amg_c_base_aggregator_mod use amg_c_base_aggregator_mod
@ -59,13 +59,13 @@ subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
Implicit None Implicit None
! Arguments ! Arguments
class(amg_c_onelev_type), intent(inout) :: lv class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_), intent(in), optional :: idx
! Local ! Local
integer(psb_ipk_) :: ipos_, err_act integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='c_base_onelev_cseti' character(len=20) :: name='c_base_onelev_cseti'
type(amg_c_base_smoother_type) :: amg_c_base_smoother_mold type(amg_c_base_smoother_type) :: amg_c_base_smoother_mold
@ -84,7 +84,7 @@ subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_)
type(amg_c_mumps_solver_type) :: amg_c_mumps_solver_mold type(amg_c_mumps_solver_type) :: amg_c_mumps_solver_mold
#endif #endif
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -100,14 +100,14 @@ subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
else else
ipos_ = amg_smooth_both_ ipos_ = amg_smooth_both_
end if end if
select case (psb_toupper(what)) select case (psb_toupper(what))
case ('SMOOTHER_TYPE') case ('SMOOTHER_TYPE')
select case (val) select case (val)
case (amg_noprec_) case (amg_noprec_)
call lv%set(amg_c_base_smoother_mold,info,pos=pos) call lv%set(amg_c_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_c_id_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_c_id_solver_mold,info,pos=pos)
case (amg_jac_) case (amg_jac_)
call lv%set(amg_c_jac_smoother_mold,info,pos=pos) call lv%set(amg_c_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_c_diag_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_c_diag_solver_mold,info,pos=pos)
@ -115,11 +115,11 @@ subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
case (amg_l1_jac_) case (amg_l1_jac_)
call lv%set(amg_c_jac_smoother_mold,info,pos=pos) call lv%set(amg_c_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_c_l1_diag_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_c_l1_diag_solver_mold,info,pos=pos)
case (amg_bjac_) case (amg_bjac_)
call lv%set(amg_c_jac_smoother_mold,info,pos=pos) call lv%set(amg_c_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_c_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_c_ilu_solver_mold,info,pos=pos)
case (amg_l1_bjac_) case (amg_l1_bjac_)
call lv%set(amg_c_l1_jac_smoother_mold,info,pos=pos) call lv%set(amg_c_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_c_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_c_ilu_solver_mold,info,pos=pos)
@ -133,61 +133,61 @@ subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
if (info == 0) call lv%set(amg_c_gs_solver_mold,info,pos='pre') if (info == 0) call lv%set(amg_c_gs_solver_mold,info,pos='pre')
call lv%set(amg_c_jac_smoother_mold,info,pos='post') call lv%set(amg_c_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(amg_c_bwgs_solver_mold,info,pos='post') if (info == 0) call lv%set(amg_c_bwgs_solver_mold,info,pos='post')
case default case default
! !
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
case('SUB_SOLVE') case('SUB_SOLVE')
select case (val) select case (val)
case (amg_f_none_) case (amg_f_none_)
call lv%set(amg_c_id_solver_mold,info,pos=pos) call lv%set(amg_c_id_solver_mold,info,pos=pos)
case (amg_diag_scale_) case (amg_diag_scale_)
call lv%set(amg_c_diag_solver_mold,info,pos=pos) call lv%set(amg_c_diag_solver_mold,info,pos=pos)
case (amg_l1_diag_scale_) case (amg_l1_diag_scale_)
call lv%set(amg_c_l1_diag_solver_mold,info,pos=pos) call lv%set(amg_c_l1_diag_solver_mold,info,pos=pos)
case (amg_gs_) case (amg_gs_)
call lv%set(amg_c_gs_solver_mold,info,pos=pos) call lv%set(amg_c_gs_solver_mold,info,pos=pos)
case (amg_bwgs_) case (amg_bwgs_)
call lv%set(amg_c_bwgs_solver_mold,info,pos=pos) call lv%set(amg_c_bwgs_solver_mold,info,pos=pos)
case (psb_ilu_n_,psb_milu_n_,psb_ilu_t_) case (psb_ilu_n_,psb_milu_n_,psb_ilu_t_)
call lv%set(amg_c_ilu_solver_mold,info,pos=pos) call lv%set(amg_c_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if end if
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (amg_slu_) case (amg_slu_)
call lv%set(amg_c_slu_solver_mold,info,pos=pos) call lv%set(amg_c_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (amg_mumps_) case (amg_mumps_)
call lv%set(amg_c_mumps_solver_mold,info,pos=pos) call lv%set(amg_c_mumps_solver_mold,info,pos=pos)
#endif #endif
case default case default
! !
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
case ('SMOOTHER_SWEEPS') case ('SMOOTHER_SWEEPS')
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) & if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) &
@ -208,7 +208,7 @@ subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
return return
end if end if
end if end if
select case(val) select case(val)
case(amg_dec_aggr_) case(amg_dec_aggr_)
allocate(amg_c_dec_aggregator_type :: lv%aggr, stat=info) allocate(amg_c_dec_aggregator_type :: lv%aggr, stat=info)
@ -218,7 +218,7 @@ subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
info = psb_err_internal_error_ info = psb_err_internal_error_
end select end select
if (info == psb_success_) call lv%aggr%default() if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD') case ('AGGR_ORD')
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
@ -245,13 +245,13 @@ subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
lv%parms%coarse_solve = val lv%parms%coarse_solve = val
case default case default
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info,idx=idx) call lv%sm%set(what,val,info,idx=idx)
end if end if
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info,idx=idx) call lv%sm2a%set(what,val,info,idx=idx)
end if end if
end if end if

3
amgprec/impl/level/amg_d_base_onelev_csetc.F90
Unescape Escape View File

@ -42,6 +42,7 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
use amg_d_base_aggregator_mod use amg_d_base_aggregator_mod
use amg_d_dec_aggregator_mod use amg_d_dec_aggregator_mod
use amg_d_symdec_aggregator_mod use amg_d_symdec_aggregator_mod
use amg_d_parmatch_aggregator_mod
use amg_d_jac_smoother use amg_d_jac_smoother
use amg_d_as_smoother use amg_d_as_smoother
use amg_d_diag_solver use amg_d_diag_solver
@ -267,6 +268,8 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
allocate(amg_d_dec_aggregator_type :: lv%aggr, stat=info) allocate(amg_d_dec_aggregator_type :: lv%aggr, stat=info)
case('SYMDEC') case('SYMDEC')
allocate(amg_d_symdec_aggregator_type :: lv%aggr, stat=info) allocate(amg_d_symdec_aggregator_type :: lv%aggr, stat=info)
case('COUP','COUPLED')
allocate(amg_d_parmatch_aggregator_type :: lv%aggr, stat=info)
case default case default
info = psb_err_internal_error_ info = psb_err_internal_error_
end select end select

89
amgprec/impl/level/amg_d_base_onelev_cseti.F90
Unescape Escape View File

@ -1,15 +1,15 @@
! !
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,15 +33,16 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx) subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
use psb_base_mod use psb_base_mod
use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_cseti use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_cseti
use amg_d_base_aggregator_mod use amg_d_base_aggregator_mod
use amg_d_dec_aggregator_mod use amg_d_dec_aggregator_mod
use amg_d_symdec_aggregator_mod use amg_d_symdec_aggregator_mod
use amg_d_parmatch_aggregator_mod
use amg_d_jac_smoother use amg_d_jac_smoother
use amg_d_as_smoother use amg_d_as_smoother
use amg_d_diag_solver use amg_d_diag_solver
@ -65,13 +66,13 @@ subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
Implicit None Implicit None
! Arguments ! Arguments
class(amg_d_onelev_type), intent(inout) :: lv class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_), intent(in), optional :: idx
! Local ! Local
integer(psb_ipk_) :: ipos_, err_act integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_cseti' character(len=20) :: name='d_base_onelev_cseti'
type(amg_d_base_smoother_type) :: amg_d_base_smoother_mold type(amg_d_base_smoother_type) :: amg_d_base_smoother_mold
@ -96,7 +97,7 @@ subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_)
type(amg_d_mumps_solver_type) :: amg_d_mumps_solver_mold type(amg_d_mumps_solver_type) :: amg_d_mumps_solver_mold
#endif #endif
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -112,14 +113,14 @@ subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
else else
ipos_ = amg_smooth_both_ ipos_ = amg_smooth_both_
end if end if
select case (psb_toupper(what)) select case (psb_toupper(what))
case ('SMOOTHER_TYPE') case ('SMOOTHER_TYPE')
select case (val) select case (val)
case (amg_noprec_) case (amg_noprec_)
call lv%set(amg_d_base_smoother_mold,info,pos=pos) call lv%set(amg_d_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_d_id_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_d_id_solver_mold,info,pos=pos)
case (amg_jac_) case (amg_jac_)
call lv%set(amg_d_jac_smoother_mold,info,pos=pos) call lv%set(amg_d_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_d_diag_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_d_diag_solver_mold,info,pos=pos)
@ -127,11 +128,11 @@ subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
case (amg_l1_jac_) case (amg_l1_jac_)
call lv%set(amg_d_jac_smoother_mold,info,pos=pos) call lv%set(amg_d_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_d_l1_diag_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_d_l1_diag_solver_mold,info,pos=pos)
case (amg_bjac_) case (amg_bjac_)
call lv%set(amg_d_jac_smoother_mold,info,pos=pos) call lv%set(amg_d_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_d_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_d_ilu_solver_mold,info,pos=pos)
case (amg_l1_bjac_) case (amg_l1_bjac_)
call lv%set(amg_d_l1_jac_smoother_mold,info,pos=pos) call lv%set(amg_d_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_d_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_d_ilu_solver_mold,info,pos=pos)
@ -145,53 +146,53 @@ subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
if (info == 0) call lv%set(amg_d_gs_solver_mold,info,pos='pre') if (info == 0) call lv%set(amg_d_gs_solver_mold,info,pos='pre')
call lv%set(amg_d_jac_smoother_mold,info,pos='post') call lv%set(amg_d_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(amg_d_bwgs_solver_mold,info,pos='post') if (info == 0) call lv%set(amg_d_bwgs_solver_mold,info,pos='post')
case default case default
! !
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
case('SUB_SOLVE') case('SUB_SOLVE')
select case (val) select case (val)
case (amg_f_none_) case (amg_f_none_)
call lv%set(amg_d_id_solver_mold,info,pos=pos) call lv%set(amg_d_id_solver_mold,info,pos=pos)
case (amg_diag_scale_) case (amg_diag_scale_)
call lv%set(amg_d_diag_solver_mold,info,pos=pos) call lv%set(amg_d_diag_solver_mold,info,pos=pos)
case (amg_l1_diag_scale_) case (amg_l1_diag_scale_)
call lv%set(amg_d_l1_diag_solver_mold,info,pos=pos) call lv%set(amg_d_l1_diag_solver_mold,info,pos=pos)
case (amg_gs_) case (amg_gs_)
call lv%set(amg_d_gs_solver_mold,info,pos=pos) call lv%set(amg_d_gs_solver_mold,info,pos=pos)
case (amg_bwgs_) case (amg_bwgs_)
call lv%set(amg_d_bwgs_solver_mold,info,pos=pos) call lv%set(amg_d_bwgs_solver_mold,info,pos=pos)
case (psb_ilu_n_,psb_milu_n_,psb_ilu_t_) case (psb_ilu_n_,psb_milu_n_,psb_ilu_t_)
call lv%set(amg_d_ilu_solver_mold,info,pos=pos) call lv%set(amg_d_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if end if
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (amg_slu_) case (amg_slu_)
call lv%set(amg_d_slu_solver_mold,info,pos=pos) call lv%set(amg_d_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (amg_mumps_) case (amg_mumps_)
call lv%set(amg_d_mumps_solver_mold,info,pos=pos) call lv%set(amg_d_mumps_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_ #ifdef HAVE_SLUDIST_
@ -204,10 +205,10 @@ subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
#endif #endif
case default case default
! !
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
case ('SMOOTHER_SWEEPS') case ('SMOOTHER_SWEEPS')
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) & if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) &
@ -228,7 +229,7 @@ subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
return return
end if end if
end if end if
select case(val) select case(val)
case(amg_dec_aggr_) case(amg_dec_aggr_)
allocate(amg_d_dec_aggregator_type :: lv%aggr, stat=info) allocate(amg_d_dec_aggregator_type :: lv%aggr, stat=info)
@ -238,7 +239,7 @@ subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
info = psb_err_internal_error_ info = psb_err_internal_error_
end select end select
if (info == psb_success_) call lv%aggr%default() if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD') case ('AGGR_ORD')
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
@ -265,13 +266,13 @@ subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
lv%parms%coarse_solve = val lv%parms%coarse_solve = val
case default case default
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info,idx=idx) call lv%sm%set(what,val,info,idx=idx)
end if end if
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info,idx=idx) call lv%sm2a%set(what,val,info,idx=idx)
end if end if
end if end if

3
amgprec/impl/level/amg_s_base_onelev_csetc.F90
Unescape Escape View File

@ -42,6 +42,7 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
use amg_s_base_aggregator_mod use amg_s_base_aggregator_mod
use amg_s_dec_aggregator_mod use amg_s_dec_aggregator_mod
use amg_s_symdec_aggregator_mod use amg_s_symdec_aggregator_mod
use amg_s_parmatch_aggregator_mod
use amg_s_jac_smoother use amg_s_jac_smoother
use amg_s_as_smoother use amg_s_as_smoother
use amg_s_diag_solver use amg_s_diag_solver
@ -247,6 +248,8 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
allocate(amg_s_dec_aggregator_type :: lv%aggr, stat=info) allocate(amg_s_dec_aggregator_type :: lv%aggr, stat=info)
case('SYMDEC') case('SYMDEC')
allocate(amg_s_symdec_aggregator_type :: lv%aggr, stat=info) allocate(amg_s_symdec_aggregator_type :: lv%aggr, stat=info)
case('COUP','COUPLED')
allocate(amg_s_parmatch_aggregator_type :: lv%aggr, stat=info)
case default case default
info = psb_err_internal_error_ info = psb_err_internal_error_
end select end select

89
amgprec/impl/level/amg_s_base_onelev_cseti.F90
Unescape Escape View File

@ -1,15 +1,15 @@
! !
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,15 +33,16 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx) subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
use psb_base_mod use psb_base_mod
use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_cseti use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_cseti
use amg_s_base_aggregator_mod use amg_s_base_aggregator_mod
use amg_s_dec_aggregator_mod use amg_s_dec_aggregator_mod
use amg_s_symdec_aggregator_mod use amg_s_symdec_aggregator_mod
use amg_s_parmatch_aggregator_mod
use amg_s_jac_smoother use amg_s_jac_smoother
use amg_s_as_smoother use amg_s_as_smoother
use amg_s_diag_solver use amg_s_diag_solver
@ -59,13 +60,13 @@ subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
Implicit None Implicit None
! Arguments ! Arguments
class(amg_s_onelev_type), intent(inout) :: lv class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_), intent(in), optional :: idx
! Local ! Local
integer(psb_ipk_) :: ipos_, err_act integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='s_base_onelev_cseti' character(len=20) :: name='s_base_onelev_cseti'
type(amg_s_base_smoother_type) :: amg_s_base_smoother_mold type(amg_s_base_smoother_type) :: amg_s_base_smoother_mold
@ -84,7 +85,7 @@ subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_)
type(amg_s_mumps_solver_type) :: amg_s_mumps_solver_mold type(amg_s_mumps_solver_type) :: amg_s_mumps_solver_mold
#endif #endif
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -100,14 +101,14 @@ subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
else else
ipos_ = amg_smooth_both_ ipos_ = amg_smooth_both_
end if end if
select case (psb_toupper(what)) select case (psb_toupper(what))
case ('SMOOTHER_TYPE') case ('SMOOTHER_TYPE')
select case (val) select case (val)
case (amg_noprec_) case (amg_noprec_)
call lv%set(amg_s_base_smoother_mold,info,pos=pos) call lv%set(amg_s_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_s_id_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_s_id_solver_mold,info,pos=pos)
case (amg_jac_) case (amg_jac_)
call lv%set(amg_s_jac_smoother_mold,info,pos=pos) call lv%set(amg_s_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_s_diag_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_s_diag_solver_mold,info,pos=pos)
@ -115,11 +116,11 @@ subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
case (amg_l1_jac_) case (amg_l1_jac_)
call lv%set(amg_s_jac_smoother_mold,info,pos=pos) call lv%set(amg_s_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_s_l1_diag_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_s_l1_diag_solver_mold,info,pos=pos)
case (amg_bjac_) case (amg_bjac_)
call lv%set(amg_s_jac_smoother_mold,info,pos=pos) call lv%set(amg_s_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_s_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_s_ilu_solver_mold,info,pos=pos)
case (amg_l1_bjac_) case (amg_l1_bjac_)
call lv%set(amg_s_l1_jac_smoother_mold,info,pos=pos) call lv%set(amg_s_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_s_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_s_ilu_solver_mold,info,pos=pos)
@ -133,61 +134,61 @@ subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
if (info == 0) call lv%set(amg_s_gs_solver_mold,info,pos='pre') if (info == 0) call lv%set(amg_s_gs_solver_mold,info,pos='pre')
call lv%set(amg_s_jac_smoother_mold,info,pos='post') call lv%set(amg_s_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(amg_s_bwgs_solver_mold,info,pos='post') if (info == 0) call lv%set(amg_s_bwgs_solver_mold,info,pos='post')
case default case default
! !
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
case('SUB_SOLVE') case('SUB_SOLVE')
select case (val) select case (val)
case (amg_f_none_) case (amg_f_none_)
call lv%set(amg_s_id_solver_mold,info,pos=pos) call lv%set(amg_s_id_solver_mold,info,pos=pos)
case (amg_diag_scale_) case (amg_diag_scale_)
call lv%set(amg_s_diag_solver_mold,info,pos=pos) call lv%set(amg_s_diag_solver_mold,info,pos=pos)
case (amg_l1_diag_scale_) case (amg_l1_diag_scale_)
call lv%set(amg_s_l1_diag_solver_mold,info,pos=pos) call lv%set(amg_s_l1_diag_solver_mold,info,pos=pos)
case (amg_gs_) case (amg_gs_)
call lv%set(amg_s_gs_solver_mold,info,pos=pos) call lv%set(amg_s_gs_solver_mold,info,pos=pos)
case (amg_bwgs_) case (amg_bwgs_)
call lv%set(amg_s_bwgs_solver_mold,info,pos=pos) call lv%set(amg_s_bwgs_solver_mold,info,pos=pos)
case (psb_ilu_n_,psb_milu_n_,psb_ilu_t_) case (psb_ilu_n_,psb_milu_n_,psb_ilu_t_)
call lv%set(amg_s_ilu_solver_mold,info,pos=pos) call lv%set(amg_s_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if end if
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (amg_slu_) case (amg_slu_)
call lv%set(amg_s_slu_solver_mold,info,pos=pos) call lv%set(amg_s_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (amg_mumps_) case (amg_mumps_)
call lv%set(amg_s_mumps_solver_mold,info,pos=pos) call lv%set(amg_s_mumps_solver_mold,info,pos=pos)
#endif #endif
case default case default
! !
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
case ('SMOOTHER_SWEEPS') case ('SMOOTHER_SWEEPS')
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) & if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) &
@ -208,7 +209,7 @@ subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
return return
end if end if
end if end if
select case(val) select case(val)
case(amg_dec_aggr_) case(amg_dec_aggr_)
allocate(amg_s_dec_aggregator_type :: lv%aggr, stat=info) allocate(amg_s_dec_aggregator_type :: lv%aggr, stat=info)
@ -218,7 +219,7 @@ subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
info = psb_err_internal_error_ info = psb_err_internal_error_
end select end select
if (info == psb_success_) call lv%aggr%default() if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD') case ('AGGR_ORD')
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
@ -245,13 +246,13 @@ subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
lv%parms%coarse_solve = val lv%parms%coarse_solve = val
case default case default
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info,idx=idx) call lv%sm%set(what,val,info,idx=idx)
end if end if
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info,idx=idx) call lv%sm2a%set(what,val,info,idx=idx)
end if end if
end if end if

88
amgprec/impl/level/amg_z_base_onelev_cseti.F90
Unescape Escape View File

@ -1,15 +1,15 @@
! !
! !
! AMG4PSBLAS version 1.0 ! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package ! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7) ! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! !
! (C) Copyright 2021 ! (C) Copyright 2021
! !
! Salvatore Filippone ! Salvatore Filippone
! Pasqua D'Ambra ! Pasqua D'Ambra
! Fabio Durastante ! Fabio Durastante
! !
! Redistribution and use in source and binary forms, with or without ! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions ! modification, are permitted provided that the following conditions
! are met: ! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 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 ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,10 +33,10 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! 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 ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx) subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
use psb_base_mod use psb_base_mod
use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_cseti use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_cseti
use amg_z_base_aggregator_mod use amg_z_base_aggregator_mod
@ -65,13 +65,13 @@ subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
Implicit None Implicit None
! Arguments ! Arguments
class(amg_z_onelev_type), intent(inout) :: lv class(amg_z_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_), intent(in), optional :: idx
! Local ! Local
integer(psb_ipk_) :: ipos_, err_act integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='z_base_onelev_cseti' character(len=20) :: name='z_base_onelev_cseti'
type(amg_z_base_smoother_type) :: amg_z_base_smoother_mold type(amg_z_base_smoother_type) :: amg_z_base_smoother_mold
@ -96,7 +96,7 @@ subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_)
type(amg_z_mumps_solver_type) :: amg_z_mumps_solver_mold type(amg_z_mumps_solver_type) :: amg_z_mumps_solver_mold
#endif #endif
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -112,14 +112,14 @@ subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
else else
ipos_ = amg_smooth_both_ ipos_ = amg_smooth_both_
end if end if
select case (psb_toupper(what)) select case (psb_toupper(what))
case ('SMOOTHER_TYPE') case ('SMOOTHER_TYPE')
select case (val) select case (val)
case (amg_noprec_) case (amg_noprec_)
call lv%set(amg_z_base_smoother_mold,info,pos=pos) call lv%set(amg_z_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_z_id_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_z_id_solver_mold,info,pos=pos)
case (amg_jac_) case (amg_jac_)
call lv%set(amg_z_jac_smoother_mold,info,pos=pos) call lv%set(amg_z_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_z_diag_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_z_diag_solver_mold,info,pos=pos)
@ -127,11 +127,11 @@ subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
case (amg_l1_jac_) case (amg_l1_jac_)
call lv%set(amg_z_jac_smoother_mold,info,pos=pos) call lv%set(amg_z_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_z_l1_diag_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_z_l1_diag_solver_mold,info,pos=pos)
case (amg_bjac_) case (amg_bjac_)
call lv%set(amg_z_jac_smoother_mold,info,pos=pos) call lv%set(amg_z_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_z_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_z_ilu_solver_mold,info,pos=pos)
case (amg_l1_bjac_) case (amg_l1_bjac_)
call lv%set(amg_z_l1_jac_smoother_mold,info,pos=pos) call lv%set(amg_z_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_z_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(amg_z_ilu_solver_mold,info,pos=pos)
@ -145,53 +145,53 @@ subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
if (info == 0) call lv%set(amg_z_gs_solver_mold,info,pos='pre') if (info == 0) call lv%set(amg_z_gs_solver_mold,info,pos='pre')
call lv%set(amg_z_jac_smoother_mold,info,pos='post') call lv%set(amg_z_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(amg_z_bwgs_solver_mold,info,pos='post') if (info == 0) call lv%set(amg_z_bwgs_solver_mold,info,pos='post')
case default case default
! !
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
case('SUB_SOLVE') case('SUB_SOLVE')
select case (val) select case (val)
case (amg_f_none_) case (amg_f_none_)
call lv%set(amg_z_id_solver_mold,info,pos=pos) call lv%set(amg_z_id_solver_mold,info,pos=pos)
case (amg_diag_scale_) case (amg_diag_scale_)
call lv%set(amg_z_diag_solver_mold,info,pos=pos) call lv%set(amg_z_diag_solver_mold,info,pos=pos)
case (amg_l1_diag_scale_) case (amg_l1_diag_scale_)
call lv%set(amg_z_l1_diag_solver_mold,info,pos=pos) call lv%set(amg_z_l1_diag_solver_mold,info,pos=pos)
case (amg_gs_) case (amg_gs_)
call lv%set(amg_z_gs_solver_mold,info,pos=pos) call lv%set(amg_z_gs_solver_mold,info,pos=pos)
case (amg_bwgs_) case (amg_bwgs_)
call lv%set(amg_z_bwgs_solver_mold,info,pos=pos) call lv%set(amg_z_bwgs_solver_mold,info,pos=pos)
case (psb_ilu_n_,psb_milu_n_,psb_ilu_t_) case (psb_ilu_n_,psb_milu_n_,psb_ilu_t_)
call lv%set(amg_z_ilu_solver_mold,info,pos=pos) call lv%set(amg_z_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if end if
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (amg_slu_) case (amg_slu_)
call lv%set(amg_z_slu_solver_mold,info,pos=pos) call lv%set(amg_z_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (amg_mumps_) case (amg_mumps_)
call lv%set(amg_z_mumps_solver_mold,info,pos=pos) call lv%set(amg_z_mumps_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_ #ifdef HAVE_SLUDIST_
@ -204,10 +204,10 @@ subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
#endif #endif
case default case default
! !
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
case ('SMOOTHER_SWEEPS') case ('SMOOTHER_SWEEPS')
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) & if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) &
@ -228,7 +228,7 @@ subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
return return
end if end if
end if end if
select case(val) select case(val)
case(amg_dec_aggr_) case(amg_dec_aggr_)
allocate(amg_z_dec_aggregator_type :: lv%aggr, stat=info) allocate(amg_z_dec_aggregator_type :: lv%aggr, stat=info)
@ -238,7 +238,7 @@ subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
info = psb_err_internal_error_ info = psb_err_internal_error_
end select end select
if (info == psb_success_) call lv%aggr%default() if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD') case ('AGGR_ORD')
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
@ -265,13 +265,13 @@ subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
lv%parms%coarse_solve = val lv%parms%coarse_solve = val
case default case default
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info,idx=idx) call lv%sm%set(what,val,info,idx=idx)
end if end if
end if end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info,idx=idx) call lv%sm2a%set(what,val,info,idx=idx)
end if end if
end if end if

Write Preview
Loading…
Cancel
Save