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

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,&
& verdistance, mate, myrank, numprocs, icomm,&
& 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
import :: psb_c_ipk_, psb_c_lpk_, psb_c_mpk_, psb_c_epk_
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,&
& verdistance, mate, myrank, numprocs, icomm,&
& 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
import :: psb_c_ipk_, psb_c_lpk_, psb_c_mpk_, psb_c_epk_
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,
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
}
#endif

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

@ -1,15 +1,15 @@
!
!
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,26 +33,26 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_c_dec_aggregator_tprol.f90
!
! Subroutine: amg_c_dec_aggregator_tprol
! 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
! refactored and shared among all the aggregation methods that produce a simple
! integer mapping.
!
!
!
! Arguments:
! ag - type(amg_c_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object
!
!
!
!
! a - type(psb_cspmat_type).
! The sparse matrix structure containing the local part of the
! fine-level matrix.
@ -70,10 +70,10 @@
! nlaggr(i) contains the aggregates held by process i.
! t_prol - type(psb_cspmat_type), output
! The tentative prolongator, based on ilaggr.
!
!
! info - integer, output.
! Error code.
!
! Error code.
!
subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info)
use psb_base_mod
@ -81,7 +81,7 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_c_inner_mod
implicit none
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(psb_cspmat_type), intent(in) :: 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',&
& amg_mult_ml_,is_legal_ml_cycle)
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',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
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')
goto 9999
endif
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
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
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,28 +33,28 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_c_symdec_aggregator_tprol.f90
!
! Subroutine: amg_c_symdec_aggregator_tprol
! 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
! 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:
! ag - type(amg_c_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object
!
!
! a - type(psb_cspmat_type).
! The sparse matrix structure containing the local part of the
! fine-level matrix.
@ -72,10 +72,10 @@
! nlaggr(i) contains the aggregates held by process i.
! op_prol - type(psb_cspmat_type), output
! The tentative prolongator, based on ilaggr.
!
!
! info - integer, output.
! Error code.
!
! Error code.
!
subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod
@ -84,7 +84,7 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_c_inner_mod
implicit none
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(psb_cspmat_type), intent(in) :: 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',&
& amg_mult_ml_,is_legal_ml_cycle)
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',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
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)
if (info == psb_success_) call atmp%transp(atrans)
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_ncols(nr)
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)
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
info=psb_err_from_subroutine_
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
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,26 +33,26 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_d_dec_aggregator_tprol.f90
!
! Subroutine: amg_d_dec_aggregator_tprol
! 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
! refactored and shared among all the aggregation methods that produce a simple
! integer mapping.
!
!
!
! Arguments:
! ag - type(amg_d_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object
!
!
!
!
! a - type(psb_dspmat_type).
! The sparse matrix structure containing the local part of the
! fine-level matrix.
@ -70,10 +70,10 @@
! nlaggr(i) contains the aggregates held by process i.
! t_prol - type(psb_dspmat_type), output
! The tentative prolongator, based on ilaggr.
!
!
! info - integer, output.
! Error code.
!
! Error code.
!
subroutine amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info)
use psb_base_mod
@ -81,7 +81,7 @@ subroutine amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_d_inner_mod
implicit none
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(psb_dspmat_type), intent(in) :: 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',&
& amg_mult_ml_,is_legal_ml_cycle)
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',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
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')
goto 9999
endif
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
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',&
& amg_mult_ml_,is_legal_ml_cycle)
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',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
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
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,28 +33,28 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_d_symdec_aggregator_tprol.f90
!
! Subroutine: amg_d_symdec_aggregator_tprol
! 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
! 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:
! ag - type(amg_d_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object
!
!
! a - type(psb_dspmat_type).
! The sparse matrix structure containing the local part of the
! fine-level matrix.
@ -72,10 +72,10 @@
! nlaggr(i) contains the aggregates held by process i.
! op_prol - type(psb_dspmat_type), output
! The tentative prolongator, based on ilaggr.
!
!
! info - integer, output.
! Error code.
!
! Error code.
!
subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod
@ -84,7 +84,7 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_d_inner_mod
implicit none
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(psb_dspmat_type), intent(in) :: 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',&
& amg_mult_ml_,is_legal_ml_cycle)
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',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
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)
if (info == psb_success_) call atmp%transp(atrans)
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_ncols(nr)
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)
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
info=psb_err_from_subroutine_
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
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,26 +33,26 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_s_dec_aggregator_tprol.f90
!
! Subroutine: amg_s_dec_aggregator_tprol
! 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
! refactored and shared among all the aggregation methods that produce a simple
! integer mapping.
!
!
!
! Arguments:
! ag - type(amg_s_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object
!
!
!
!
! a - type(psb_sspmat_type).
! The sparse matrix structure containing the local part of the
! fine-level matrix.
@ -70,10 +70,10 @@
! nlaggr(i) contains the aggregates held by process i.
! t_prol - type(psb_sspmat_type), output
! The tentative prolongator, based on ilaggr.
!
!
! info - integer, output.
! Error code.
!
! Error code.
!
subroutine amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info)
use psb_base_mod
@ -81,7 +81,7 @@ subroutine amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_s_inner_mod
implicit none
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(psb_sspmat_type), intent(in) :: 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',&
& amg_mult_ml_,is_legal_ml_cycle)
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',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
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')
goto 9999
endif
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
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',&
& amg_mult_ml_,is_legal_ml_cycle)
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',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
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
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,28 +33,28 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_s_symdec_aggregator_tprol.f90
!
! Subroutine: amg_s_symdec_aggregator_tprol
! 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
! 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:
! ag - type(amg_s_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object
!
!
! a - type(psb_sspmat_type).
! The sparse matrix structure containing the local part of the
! fine-level matrix.
@ -72,10 +72,10 @@
! nlaggr(i) contains the aggregates held by process i.
! op_prol - type(psb_sspmat_type), output
! The tentative prolongator, based on ilaggr.
!
!
! info - integer, output.
! Error code.
!
! Error code.
!
subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod
@ -84,7 +84,7 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_s_inner_mod
implicit none
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(psb_sspmat_type), intent(in) :: 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',&
& amg_mult_ml_,is_legal_ml_cycle)
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',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
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)
if (info == psb_success_) call atmp%transp(atrans)
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_ncols(nr)
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)
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
info=psb_err_from_subroutine_
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
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,26 +33,26 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_z_dec_aggregator_tprol.f90
!
! Subroutine: amg_z_dec_aggregator_tprol
! 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
! refactored and shared among all the aggregation methods that produce a simple
! integer mapping.
!
!
!
! Arguments:
! ag - type(amg_z_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object
!
!
!
!
! a - type(psb_zspmat_type).
! The sparse matrix structure containing the local part of the
! fine-level matrix.
@ -70,10 +70,10 @@
! nlaggr(i) contains the aggregates held by process i.
! t_prol - type(psb_zspmat_type), output
! The tentative prolongator, based on ilaggr.
!
!
! info - integer, output.
! Error code.
!
! Error code.
!
subroutine amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info)
use psb_base_mod
@ -81,7 +81,7 @@ subroutine amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_z_inner_mod
implicit none
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(psb_zspmat_type), intent(in) :: 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',&
& amg_mult_ml_,is_legal_ml_cycle)
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',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
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')
goto 9999
endif
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
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
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,28 +33,28 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_z_symdec_aggregator_tprol.f90
!
! Subroutine: amg_z_symdec_aggregator_tprol
! 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
! 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:
! ag - type(amg_z_dec_aggregator_type), input/output.
! The aggregator object, carrying with itself the mapping algorithm.
! parms - The auxiliary parameters object
! ag_data - Auxiliary global aggregation parameters object
!
!
! a - type(psb_zspmat_type).
! The sparse matrix structure containing the local part of the
! fine-level matrix.
@ -72,10 +72,10 @@
! nlaggr(i) contains the aggregates held by process i.
! op_prol - type(psb_zspmat_type), output
! The tentative prolongator, based on ilaggr.
!
!
! info - integer, output.
! Error code.
!
! Error code.
!
subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod
@ -84,7 +84,7 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
use amg_z_inner_mod
implicit none
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(psb_zspmat_type), intent(in) :: 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',&
& amg_mult_ml_,is_legal_ml_cycle)
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',&
& amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
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)
if (info == psb_success_) call atmp%transp(atrans)
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_ncols(nr)
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)
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
info=psb_err_from_subroutine_
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
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,10 +33,10 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
use psb_base_mod
use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_cseti
use amg_c_base_aggregator_mod
@ -59,13 +59,13 @@ subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
Implicit None
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='c_base_onelev_cseti'
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_)
type(amg_c_mumps_solver_type) :: amg_c_mumps_solver_mold
#endif
call psb_erractionsave(err_act)
info = psb_success_
@ -100,14 +100,14 @@ subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
else
ipos_ = amg_smooth_both_
end if
select case (psb_toupper(what))
case ('SMOOTHER_TYPE')
select case (val)
select case (val)
case (amg_noprec_)
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)
case (amg_jac_)
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)
@ -115,11 +115,11 @@ subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
case (amg_l1_jac_)
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)
case (amg_bjac_)
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)
case (amg_l1_bjac_)
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)
@ -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')
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')
case default
!
! Do nothing and hope for the best :)
! Do nothing and hope for the best :)
!
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()
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
case('SUB_SOLVE')
select case (val)
select case (val)
case (amg_f_none_)
call lv%set(amg_c_id_solver_mold,info,pos=pos)
case (amg_diag_scale_)
call lv%set(amg_c_diag_solver_mold,info,pos=pos)
case (amg_l1_diag_scale_)
call lv%set(amg_c_l1_diag_solver_mold,info,pos=pos)
case (amg_gs_)
call lv%set(amg_c_gs_solver_mold,info,pos=pos)
case (amg_bwgs_)
call lv%set(amg_c_bwgs_solver_mold,info,pos=pos)
case (psb_ilu_n_,psb_milu_n_,psb_ilu_t_)
call lv%set(amg_c_ilu_solver_mold,info,pos=pos)
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)
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)
end if
end if
#ifdef HAVE_SLU_
case (amg_slu_)
case (amg_slu_)
call lv%set(amg_c_slu_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_
case (amg_mumps_)
case (amg_mumps_)
call lv%set(amg_c_mumps_solver_mold,info,pos=pos)
#endif
case default
!
! Do nothing and hope for the best :)
! Do nothing and hope for the best :)
!
end select
case ('SMOOTHER_SWEEPS')
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
end if
end if
select case(val)
case(amg_dec_aggr_)
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_
end select
if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD')
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
case default
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info,idx=idx)
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_dec_aggregator_mod
use amg_d_symdec_aggregator_mod
use amg_d_parmatch_aggregator_mod
use amg_d_jac_smoother
use amg_d_as_smoother
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)
case('SYMDEC')
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
info = psb_err_internal_error_
end select

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

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

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

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

Write Preview
Loading…
Cancel
Save