|
|
|
@ -50,16 +50,16 @@
|
|
|
|
|
!
|
|
|
|
|
! It contains routines for
|
|
|
|
|
! - converting character constants defining the preconditioner into integer
|
|
|
|
|
! constants;
|
|
|
|
|
! constants;
|
|
|
|
|
! - checking if the preconditioner is correctly defined;
|
|
|
|
|
! - printing a description of the preconditioner;
|
|
|
|
|
! - deallocating the preconditioner data structure.
|
|
|
|
|
! - deallocating the preconditioner data structure.
|
|
|
|
|
!
|
|
|
|
|
|
|
|
|
|
module amg_base_prec_type
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! This reduces the size of .mod file. Without the ONLY clause compilation
|
|
|
|
|
! This reduces the size of .mod file. Without the ONLY clause compilation
|
|
|
|
|
! blows up on some systems.
|
|
|
|
|
!
|
|
|
|
|
use psb_const_mod
|
|
|
|
@ -78,7 +78,7 @@ module amg_base_prec_type
|
|
|
|
|
& psb_err_from_subroutine_, psb_err_missing_override_method_, &
|
|
|
|
|
& psb_error_handler, psb_out_unit, psb_err_unit
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
! Version numbers
|
|
|
|
|
!
|
|
|
|
|
character(len=*), parameter :: amg_version_string_ = "1.0.0"
|
|
|
|
@ -120,7 +120,7 @@ module amg_base_prec_type
|
|
|
|
|
procedure, pass(pm) :: printout => d_ml_parms_printout
|
|
|
|
|
end type amg_dml_parms
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
type amg_iaggr_data
|
|
|
|
|
!
|
|
|
|
@ -134,32 +134,32 @@ module amg_base_prec_type
|
|
|
|
|
integer(psb_ipk_) :: min_coarse_size = -ione
|
|
|
|
|
integer(psb_ipk_) :: min_coarse_size_per_process = -ione
|
|
|
|
|
integer(psb_lpk_) :: target_coarse_size
|
|
|
|
|
! 2. maximum number of levels. Defaults to 20
|
|
|
|
|
! 2. maximum number of levels. Defaults to 20
|
|
|
|
|
integer(psb_ipk_) :: max_levs = 20_psb_ipk_
|
|
|
|
|
end type amg_iaggr_data
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
type, extends(amg_iaggr_data) :: amg_saggr_data
|
|
|
|
|
! 3. min_cr_ratio = 1.5
|
|
|
|
|
! 3. min_cr_ratio = 1.5
|
|
|
|
|
real(psb_spk_) :: min_cr_ratio = 1.5_psb_spk_
|
|
|
|
|
real(psb_spk_) :: op_complexity = szero
|
|
|
|
|
real(psb_spk_) :: avg_cr = szero
|
|
|
|
|
end type amg_saggr_data
|
|
|
|
|
|
|
|
|
|
type, extends(amg_iaggr_data) :: amg_daggr_data
|
|
|
|
|
! 3. min_cr_ratio = 1.5
|
|
|
|
|
! 3. min_cr_ratio = 1.5
|
|
|
|
|
real(psb_dpk_) :: min_cr_ratio = 1.5_psb_dpk_
|
|
|
|
|
real(psb_dpk_) :: op_complexity = dzero
|
|
|
|
|
real(psb_dpk_) :: avg_cr = dzero
|
|
|
|
|
end type amg_daggr_data
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! Entries in iprcparm
|
|
|
|
|
!
|
|
|
|
|
! These are in baseprec
|
|
|
|
|
!
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_smoother_type_ = 1
|
|
|
|
|
!
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_smoother_type_ = 1
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_sub_solve_ = 2
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_sub_restr_ = 3
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_sub_prol_ = 4
|
|
|
|
@ -169,7 +169,7 @@ module amg_base_prec_type
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! These are in onelev
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_ml_cycle_ = 20
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_smoother_sweeps_pre_ = 21
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_smoother_sweeps_post_ = 22
|
|
|
|
@ -181,7 +181,7 @@ module amg_base_prec_type
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_aggr_eig_ = 28
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_aggr_filter_ = 29
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_coarse_mat_ = 30
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_coarse_solve_ = 31
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_coarse_solve_ = 31
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_coarse_sweeps_ = 32
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_coarse_fillin_ = 33
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_coarse_subsolve_ = 34
|
|
|
|
@ -196,7 +196,7 @@ module amg_base_prec_type
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! Legal values for entry: amg_smoother_type_
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_min_prec_ = 0
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_noprec_ = 0
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_base_smooth_ = 0
|
|
|
|
@ -234,7 +234,8 @@ module amg_base_prec_type
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_sludist_ = amg_slv_delta_+9
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_mumps_ = amg_slv_delta_+10
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_bwgs_ = amg_slv_delta_+11
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_max_sub_solve_ = amg_slv_delta_+11
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_krm_ = amg_slv_delta_+12
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_max_sub_solve_ = amg_slv_delta_+12
|
|
|
|
|
integer(psb_ipk_), parameter :: amg_min_sub_solve_ = amg_diag_scale_
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
@ -392,7 +393,7 @@ module amg_base_prec_type
|
|
|
|
|
& 'MILU(n) ','ILU(t,n) ',&
|
|
|
|
|
& 'SuperLU ','UMFPACK LU ',&
|
|
|
|
|
& 'SuperLU_Dist ','MUMPS ',&
|
|
|
|
|
& 'Backward GS '/)
|
|
|
|
|
& 'Backward GS ','Krylov Method '/)
|
|
|
|
|
|
|
|
|
|
interface amg_check_def
|
|
|
|
|
module procedure amg_icheck_def, amg_scheck_def, amg_dcheck_def
|
|
|
|
@ -427,7 +428,7 @@ contains
|
|
|
|
|
|
|
|
|
|
do_remap = val
|
|
|
|
|
end subroutine amg_set_do_remap
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! Function: amg_stringval
|
|
|
|
|
!
|
|
|
|
@ -442,10 +443,10 @@ contains
|
|
|
|
|
!
|
|
|
|
|
function amg_stringval(string) result(val)
|
|
|
|
|
use psb_prec_const_mod
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
! Arguments
|
|
|
|
|
character(len=*), intent(in) :: string
|
|
|
|
|
integer(psb_ipk_) :: val
|
|
|
|
|
integer(psb_ipk_) :: val
|
|
|
|
|
character(len=*), parameter :: name='amg_stringval'
|
|
|
|
|
! Local variable
|
|
|
|
|
integer :: index_tab
|
|
|
|
@ -453,14 +454,14 @@ contains
|
|
|
|
|
index_tab=index(string,char(9))
|
|
|
|
|
if (index_tab.NE.0) then
|
|
|
|
|
string2=string(1:index_tab-1)
|
|
|
|
|
else
|
|
|
|
|
else
|
|
|
|
|
string2=string
|
|
|
|
|
endif
|
|
|
|
|
select case(psb_toupper(trim(string2)))
|
|
|
|
|
case('NONE')
|
|
|
|
|
val = 0
|
|
|
|
|
case('HALO')
|
|
|
|
|
val = psb_halo_
|
|
|
|
|
val = psb_halo_
|
|
|
|
|
case('SUM')
|
|
|
|
|
val = psb_sum_
|
|
|
|
|
case('AVG')
|
|
|
|
@ -545,6 +546,8 @@ contains
|
|
|
|
|
val = amg_jac_
|
|
|
|
|
case('L1-JACOBI')
|
|
|
|
|
val = amg_l1_jac_
|
|
|
|
|
case('KRM')
|
|
|
|
|
val = amg_krm_
|
|
|
|
|
case('AS')
|
|
|
|
|
val = amg_as_
|
|
|
|
|
case('A_NORMI')
|
|
|
|
@ -569,47 +572,47 @@ contains
|
|
|
|
|
end function amg_stringval
|
|
|
|
|
|
|
|
|
|
subroutine ml_parms_get_coarse(pm,pmin)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
class(amg_ml_parms), intent(inout) :: pm
|
|
|
|
|
class(amg_ml_parms), intent(in) :: pmin
|
|
|
|
|
pm%coarse_mat = pmin%coarse_mat
|
|
|
|
|
pm%coarse_solve = pmin%coarse_solve
|
|
|
|
|
end subroutine ml_parms_get_coarse
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
subroutine ml_parms_printout(pm,iout)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
class(amg_ml_parms), intent(in) :: pm
|
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
write(iout,*) 'ML : ',pm%ml_cycle
|
|
|
|
|
write(iout,*) 'Sweeps: ',pm%sweeps_pre,pm%sweeps_post
|
|
|
|
|
write(iout,*) 'AGGR : ',pm%par_aggr_alg,pm%aggr_prol, pm%aggr_ord
|
|
|
|
|
write(iout,*) ' : ',pm%aggr_omega_alg,pm%aggr_eig,pm%aggr_filter
|
|
|
|
|
write(iout,*) 'COARSE: ',pm%coarse_mat,pm%coarse_solve
|
|
|
|
|
end subroutine ml_parms_printout
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
subroutine s_ml_parms_printout(pm,iout)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
class(amg_sml_parms), intent(in) :: pm
|
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
call pm%amg_ml_parms%printout(iout)
|
|
|
|
|
write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh
|
|
|
|
|
end subroutine s_ml_parms_printout
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
subroutine d_ml_parms_printout(pm,iout)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
class(amg_dml_parms), intent(in) :: pm
|
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
call pm%amg_ml_parms%printout(iout)
|
|
|
|
|
write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh
|
|
|
|
|
end subroutine d_ml_parms_printout
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! Routines printing out a description of the preconditioner
|
|
|
|
@ -625,7 +628,7 @@ contains
|
|
|
|
|
info = psb_success_
|
|
|
|
|
if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
write(iout,*) ' Multilevel cycle: ',&
|
|
|
|
|
& ml_names(pm%ml_cycle)
|
|
|
|
|
select case (pm%ml_cycle)
|
|
|
|
@ -651,7 +654,7 @@ contains
|
|
|
|
|
info = psb_success_
|
|
|
|
|
if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
write(iout,*) ' Parallel aggregation algorithm: ',&
|
|
|
|
|
& par_aggr_alg_names(pm%par_aggr_alg)
|
|
|
|
|
if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',&
|
|
|
|
@ -663,23 +666,23 @@ contains
|
|
|
|
|
write(iout,*) ' Aggregation prolongator: ', &
|
|
|
|
|
& aggr_prols(pm%aggr_prol)
|
|
|
|
|
if (pm%aggr_prol /= amg_no_smooth_) then
|
|
|
|
|
write(iout,*) ' with: ', aggr_filters(pm%aggr_filter)
|
|
|
|
|
if (pm%aggr_omega_alg == amg_eig_est_) then
|
|
|
|
|
write(iout,*) ' with: ', aggr_filters(pm%aggr_filter)
|
|
|
|
|
if (pm%aggr_omega_alg == amg_eig_est_) then
|
|
|
|
|
write(iout,*) ' Damping omega computation: spectral radius estimate'
|
|
|
|
|
write(iout,*) ' Spectral radius estimate: ', &
|
|
|
|
|
& eigen_estimates(pm%aggr_eig)
|
|
|
|
|
else if (pm%aggr_omega_alg == amg_user_choice_) then
|
|
|
|
|
else if (pm%aggr_omega_alg == amg_user_choice_) then
|
|
|
|
|
write(iout,*) ' Damping omega computation: user defined value.'
|
|
|
|
|
else
|
|
|
|
|
else
|
|
|
|
|
write(iout,*) ' Damping omega computation: unknown value in iprcparm!!'
|
|
|
|
|
end if
|
|
|
|
|
end if
|
|
|
|
|
!end if
|
|
|
|
|
else
|
|
|
|
|
write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',&
|
|
|
|
|
& pm%ml_cycle
|
|
|
|
|
& pm%ml_cycle
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
end subroutine ml_parms_mldescr
|
|
|
|
@ -696,13 +699,13 @@ contains
|
|
|
|
|
logical :: coarse_
|
|
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
|
if (present(coarse)) then
|
|
|
|
|
if (present(coarse)) then
|
|
|
|
|
coarse_ = coarse
|
|
|
|
|
else
|
|
|
|
|
coarse_ = .false.
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
if (coarse_) then
|
|
|
|
|
if (coarse_) then
|
|
|
|
|
call pm%coarsedescr(iout,info)
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
@ -725,12 +728,12 @@ contains
|
|
|
|
|
write(iout,*) ' Coarse matrix: ',&
|
|
|
|
|
& matrix_names(pm%coarse_mat)
|
|
|
|
|
select case(pm%coarse_solve)
|
|
|
|
|
case (amg_bjac_,amg_as_)
|
|
|
|
|
case (amg_bjac_,amg_as_)
|
|
|
|
|
write(iout,*) ' Number of sweeps : ',&
|
|
|
|
|
& pm%sweeps_pre
|
|
|
|
|
write(iout,*) ' Coarse solver: ',&
|
|
|
|
|
& 'Block Jacobi'
|
|
|
|
|
case (amg_l1_bjac_)
|
|
|
|
|
case (amg_l1_bjac_)
|
|
|
|
|
write(iout,*) ' Number of sweeps : ',&
|
|
|
|
|
& pm%sweeps_pre
|
|
|
|
|
write(iout,*) ' Coarse solver: ',&
|
|
|
|
@ -797,7 +800,7 @@ contains
|
|
|
|
|
!
|
|
|
|
|
|
|
|
|
|
function is_legal_base_prec(ip)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_ipk_), intent(in) :: ip
|
|
|
|
|
logical :: is_legal_base_prec
|
|
|
|
|
|
|
|
|
@ -805,44 +808,44 @@ contains
|
|
|
|
|
return
|
|
|
|
|
end function is_legal_base_prec
|
|
|
|
|
function is_int_non_negative(ip)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_ipk_), intent(in) :: ip
|
|
|
|
|
logical :: is_int_non_negative
|
|
|
|
|
|
|
|
|
|
is_int_non_negative = (ip >= 0)
|
|
|
|
|
is_int_non_negative = (ip >= 0)
|
|
|
|
|
return
|
|
|
|
|
end function is_int_non_negative
|
|
|
|
|
function is_legal_ilu_scale(ip)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_ipk_), intent(in) :: ip
|
|
|
|
|
logical :: is_legal_ilu_scale
|
|
|
|
|
is_legal_ilu_scale = ((ip >= amg_ilu_scale_none_).and.(ip <= amg_max_ilu_scale_))
|
|
|
|
|
return
|
|
|
|
|
end function is_legal_ilu_scale
|
|
|
|
|
function is_int_positive(ip)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_ipk_), intent(in) :: ip
|
|
|
|
|
logical :: is_int_positive
|
|
|
|
|
|
|
|
|
|
is_int_positive = (ip >= 1)
|
|
|
|
|
is_int_positive = (ip >= 1)
|
|
|
|
|
return
|
|
|
|
|
end function is_int_positive
|
|
|
|
|
function is_legal_prolong(ip)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_ipk_), intent(in) :: ip
|
|
|
|
|
logical :: is_legal_prolong
|
|
|
|
|
is_legal_prolong = ((ip>=psb_none_).and.(ip<=psb_square_root_))
|
|
|
|
|
return
|
|
|
|
|
end function is_legal_prolong
|
|
|
|
|
function is_legal_restrict(ip)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_ipk_), intent(in) :: ip
|
|
|
|
|
logical :: is_legal_restrict
|
|
|
|
|
is_legal_restrict = ((ip == psb_nohalo_).or.(ip==psb_halo_))
|
|
|
|
|
return
|
|
|
|
|
end function is_legal_restrict
|
|
|
|
|
function is_legal_ml_cycle(ip)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_ipk_), intent(in) :: ip
|
|
|
|
|
logical :: is_legal_ml_cycle
|
|
|
|
|
|
|
|
|
@ -988,7 +991,7 @@ contains
|
|
|
|
|
return
|
|
|
|
|
end function is_legal_s_fact_thrs
|
|
|
|
|
function is_legal_s_aggr_thrs(ip)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
real(psb_spk_), intent(in) :: ip
|
|
|
|
|
logical :: is_legal_s_aggr_thrs
|
|
|
|
|
|
|
|
|
@ -1032,7 +1035,7 @@ contains
|
|
|
|
|
end interface
|
|
|
|
|
character(len=20), parameter :: rname='amg_check_def'
|
|
|
|
|
|
|
|
|
|
if (.not.is_legal(ip)) then
|
|
|
|
|
if (.not.is_legal(ip)) then
|
|
|
|
|
write(0,*)trim(rname),': Error: Illegal value for ',&
|
|
|
|
|
& name,' :',ip, '. defaulting to ',id
|
|
|
|
|
ip = id
|
|
|
|
@ -1040,11 +1043,11 @@ contains
|
|
|
|
|
end subroutine amg_scheck_def
|
|
|
|
|
|
|
|
|
|
subroutine amg_dcheck_def(ip,name,id,is_legal)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
real(psb_dpk_), intent(inout) :: ip
|
|
|
|
|
real(psb_dpk_), intent(in) :: id
|
|
|
|
|
character(len=*), intent(in) :: name
|
|
|
|
|
interface
|
|
|
|
|
interface
|
|
|
|
|
function is_legal(i)
|
|
|
|
|
use psb_base_mod, only : psb_dpk_
|
|
|
|
|
real(psb_dpk_), intent(in) :: i
|
|
|
|
@ -1053,7 +1056,7 @@ contains
|
|
|
|
|
end interface
|
|
|
|
|
character(len=20), parameter :: rname='amg_check_def'
|
|
|
|
|
|
|
|
|
|
if (.not.is_legal(ip)) then
|
|
|
|
|
if (.not.is_legal(ip)) then
|
|
|
|
|
write(0,*)trim(rname),': Error: Illegal value for ',&
|
|
|
|
|
& name,' :',ip, '. defaulting to ',id
|
|
|
|
|
ip = id
|
|
|
|
@ -1062,7 +1065,7 @@ contains
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
function pr_to_str(iprec)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
integer(psb_ipk_), intent(in) :: iprec
|
|
|
|
|
character(len=10) :: pr_to_str
|
|
|
|
@ -1070,11 +1073,11 @@ contains
|
|
|
|
|
select case(iprec)
|
|
|
|
|
case(amg_noprec_)
|
|
|
|
|
pr_to_str='NOPREC'
|
|
|
|
|
case(amg_jac_)
|
|
|
|
|
case(amg_jac_)
|
|
|
|
|
pr_to_str='JAC'
|
|
|
|
|
case(amg_bjac_)
|
|
|
|
|
case(amg_bjac_)
|
|
|
|
|
pr_to_str='BJAC'
|
|
|
|
|
case(amg_as_)
|
|
|
|
|
case(amg_as_)
|
|
|
|
|
pr_to_str='AS'
|
|
|
|
|
end select
|
|
|
|
|
|
|
|
|
@ -1082,7 +1085,7 @@ contains
|
|
|
|
|
|
|
|
|
|
subroutine amg_ml_bcast(ctxt,dat,root)
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
type(psb_ctxt_type), intent(in) :: ctxt
|
|
|
|
|
type(amg_ml_parms), intent(inout) :: dat
|
|
|
|
|
integer(psb_ipk_), intent(in), optional :: root
|
|
|
|
@ -1104,7 +1107,7 @@ contains
|
|
|
|
|
|
|
|
|
|
subroutine amg_sml_bcast(ctxt,dat,root)
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
type(psb_ctxt_type), intent(in) :: ctxt
|
|
|
|
|
type(amg_sml_parms), intent(inout) :: dat
|
|
|
|
|
integer(psb_ipk_), intent(in), optional :: root
|
|
|
|
@ -1115,7 +1118,7 @@ contains
|
|
|
|
|
end subroutine amg_sml_bcast
|
|
|
|
|
|
|
|
|
|
subroutine amg_dml_bcast(ctxt,dat,root)
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
type(psb_ctxt_type), intent(in) :: ctxt
|
|
|
|
|
type(amg_dml_parms), intent(inout) :: dat
|
|
|
|
|
integer(psb_ipk_), intent(in), optional :: root
|
|
|
|
@ -1127,7 +1130,7 @@ contains
|
|
|
|
|
|
|
|
|
|
subroutine ml_parms_clone(pm,pmout,info)
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
class(amg_ml_parms), intent(inout) :: pm
|
|
|
|
|
class(amg_ml_parms), intent(out) :: pmout
|
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
@ -1147,19 +1150,19 @@ contains
|
|
|
|
|
pmout%coarse_solve = pm%coarse_solve
|
|
|
|
|
|
|
|
|
|
end subroutine ml_parms_clone
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
subroutine s_ml_parms_clone(pm,pmout,info)
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
class(amg_sml_parms), intent(inout) :: pm
|
|
|
|
|
class(amg_ml_parms), intent(out) :: pmout
|
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
integer(psb_ipk_) :: err_act
|
|
|
|
|
integer(psb_ipk_) :: ierr(5)
|
|
|
|
|
character(len=20) :: name='clone'
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
info = 0
|
|
|
|
|
select type(pout => pmout)
|
|
|
|
|
class is (amg_sml_parms)
|
|
|
|
@ -1174,21 +1177,21 @@ contains
|
|
|
|
|
call psb_get_erraction(err_act)
|
|
|
|
|
call psb_error_handler(err_act)
|
|
|
|
|
end select
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
end subroutine s_ml_parms_clone
|
|
|
|
|
|
|
|
|
|
subroutine d_ml_parms_clone(pm,pmout,info)
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
implicit none
|
|
|
|
|
class(amg_dml_parms), intent(inout) :: pm
|
|
|
|
|
class(amg_ml_parms), intent(out) :: pmout
|
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
integer(psb_ipk_) :: err_act
|
|
|
|
|
integer(psb_ipk_) :: ierr(5)
|
|
|
|
|
character(len=20) :: name='clone'
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
info = 0
|
|
|
|
|
select type(pout => pmout)
|
|
|
|
|
class is (amg_dml_parms)
|
|
|
|
@ -1204,13 +1207,13 @@ contains
|
|
|
|
|
call psb_error_handler(err_act)
|
|
|
|
|
return
|
|
|
|
|
end select
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
end subroutine d_ml_parms_clone
|
|
|
|
|
|
|
|
|
|
function amg_s_equal_aggregation(parms1, parms2) result(val)
|
|
|
|
|
type(amg_sml_parms), intent(in) :: parms1, parms2
|
|
|
|
|
logical :: val
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
val = (parms1%par_aggr_alg == parms2%par_aggr_alg ) .and. &
|
|
|
|
|
& (parms1%aggr_type == parms2%aggr_type ) .and. &
|
|
|
|
|
& (parms1%aggr_ord == parms2%aggr_ord ) .and. &
|
|
|
|
@ -1225,7 +1228,7 @@ contains
|
|
|
|
|
function amg_d_equal_aggregation(parms1, parms2) result(val)
|
|
|
|
|
type(amg_dml_parms), intent(in) :: parms1, parms2
|
|
|
|
|
logical :: val
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
val = (parms1%par_aggr_alg == parms2%par_aggr_alg ) .and. &
|
|
|
|
|
& (parms1%aggr_type == parms2%aggr_type ) .and. &
|
|
|
|
|
& (parms1%aggr_ord == parms2%aggr_ord ) .and. &
|
|
|
|
@ -1236,5 +1239,5 @@ contains
|
|
|
|
|
& (parms1%aggr_omega_val == parms2%aggr_omega_val ) .and. &
|
|
|
|
|
& (parms1%aggr_thresh == parms2%aggr_thresh )
|
|
|
|
|
end function amg_d_equal_aggregation
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
end module amg_base_prec_type
|
|
|
|
|