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

mld2p4-2:

Browse Source 
README
 mlprec/mld_base_prec_type.F90
 mlprec/mld_c_prec_type.f90
 mlprec/mld_cprecbld.f90
 mlprec/mld_d_prec_type.f90
 mlprec/mld_dprecbld.f90
 mlprec/mld_dprecinit.F90
 mlprec/mld_s_prec_type.f90
 mlprec/mld_sprecbld.f90
 mlprec/mld_z_prec_type.f90
 mlprec/mld_zprecbld.f90
 mlprec/mld_zprecinit.F90
 tests/pdegen/ppde.f90
 tests/pdegen/runs/ppde.inp
 tests/pdegen/spde.f90

Fixes for printout of description, plus computing operator
complexity.
stopcriterion
Salvatore Filippone 14 years ago
parent 8e4c0c99fd
commit eed800dbb4
15 changed files with 755 additions and 927 deletions
Show Stats Download Patch File Download Diff File

7
README
Unescape Escape View File

@ -1,7 +1,12 @@
This directory contains the MLD2P4 set of preconditioners, version 1.1 This directory contains the MLD2P4 set of preconditioners, version 2.0
WHAT'S NEW WHAT'S NEW
Version 2.0.
Finally moved to F2003, with the support of PSBLAS3.
In version 1.1: In version 1.1:
- The MLD_SIZEOF() function has been redefined to be INTEGER(8), so - The MLD_SIZEOF() function has been redefined to be INTEGER(8), so
as to be able to measure large data sets. as to be able to measure large data sets.

407
mlprec/mld_base_prec_type.F90
Unescape Escape View File

@ -103,8 +103,11 @@ module mld_base_prec_type
integer :: coarse_mat, coarse_solve integer :: coarse_mat, coarse_solve
contains contains
procedure, pass(pm) :: descr => ml_parms_descr procedure, pass(pm) :: descr => ml_parms_descr
procedure, pass(pm) :: mldescr => ml_parms_mldescr
procedure, pass(pm) :: coarsedescr => ml_parms_coarsedescr
end type mld_ml_parms end type mld_ml_parms
type, extends(mld_ml_parms) :: mld_sml_parms type, extends(mld_ml_parms) :: mld_sml_parms
real(psb_spk_) :: aggr_omega_val, aggr_thresh real(psb_spk_) :: aggr_omega_val, aggr_thresh
contains contains
@ -426,7 +429,7 @@ contains
! Routines printing out a description of the preconditioner ! Routines printing out a description of the preconditioner
! !
subroutine ml_parms_descr(pm,iout,info,coarse) subroutine ml_parms_mldescr(pm,iout,info)
use psb_base_mod use psb_base_mod
@ -436,30 +439,8 @@ contains
class(mld_ml_parms), intent(in) :: pm class(mld_ml_parms), intent(in) :: pm
integer, intent(in) :: iout integer, intent(in) :: iout
integer, intent(out) :: info integer, intent(out) :: info
logical, intent(in), optional :: coarse
logical :: coarse_
info = psb_success_ info = psb_success_
if (present(coarse)) then
coarse_ = coarse
else
coarse_ = .false.
end if
if (coarse_) then
write(iout,*) ' Coarsest matrix: ',&
& matrix_names(pm%coarse_mat)
if (pm%coarse_solve == mld_bjac_) then
write(iout,*) ' Coarse solver: Block Jacobi '
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps
else
write(iout,*) ' Coarse solver: ',&
& fact_names(pm%coarse_solve)
endif
else
if (pm%ml_type>mld_no_ml_) then if (pm%ml_type>mld_no_ml_) then
write(iout,*) ' Multilevel type: ',& write(iout,*) ' Multilevel type: ',&
@ -484,6 +465,10 @@ contains
& pm%sweeps_post & pm%sweeps_post
end select end select
end if end if
write(iout,*) ' Aggregation: ', &
& aggr_names(pm%aggr_alg)
write(iout,*) ' Aggregation type: ', &
& aggr_kinds(pm%aggr_kind)
if (pm%aggr_kind /= mld_no_smooth_) then if (pm%aggr_kind /= mld_no_smooth_) then
if (pm%aggr_omega_alg == mld_eig_est_) then if (pm%aggr_omega_alg == mld_eig_est_) then
write(iout,*) ' Damping omega computation: spectral radius estimate' write(iout,*) ' Damping omega computation: spectral radius estimate'
@ -495,390 +480,112 @@ contains
write(iout,*) ' Damping omega computation: unknown value in iprcparm!!' write(iout,*) ' Damping omega computation: unknown value in iprcparm!!'
end if end if
end if end if
write(iout,*) ' Aggregation: ', &
& aggr_names(pm%aggr_alg)
write(iout,*) ' Aggregation type: ', &
& aggr_kinds(pm%aggr_kind)
end if
end if end if
return return
end subroutine ml_parms_descr end subroutine ml_parms_mldescr
subroutine s_ml_parms_descr(pm,iout,info,coarse) subroutine ml_parms_coarsedescr(pm,iout,info)
use psb_base_mod use psb_base_mod
Implicit None Implicit None
! Arguments ! Arguments
class(mld_sml_parms), intent(in) :: pm class(mld_ml_parms), intent(in) :: pm
integer, intent(in) :: iout integer, intent(in) :: iout
integer, intent(out) :: info integer, intent(out) :: info
logical, intent(in), optional :: coarse
info = psb_success_ info = psb_success_
write(iout,*) ' Coarsest matrix: ',&
& matrix_names(pm%coarse_mat)
if (pm%coarse_solve == mld_bjac_) then
write(iout,*) ' Coarse solver: Block Jacobi '
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps
else
write(iout,*) ' Coarse solver: ',&
& fact_names(pm%coarse_solve)
endif
call pm%mld_ml_parms%descr(iout,info,coarse) end subroutine ml_parms_coarsedescr
write(iout,*) ' Aggregation threshold: ', &
& pm%aggr_thresh
return
end subroutine s_ml_parms_descr
subroutine d_ml_parms_descr(pm,iout,info,coarse) subroutine ml_parms_descr(pm,iout,info,coarse)
use psb_base_mod use psb_base_mod
Implicit None Implicit None
! Arguments ! Arguments
class(mld_dml_parms), intent(in) :: pm class(mld_ml_parms), intent(in) :: pm
integer, intent(in) :: iout integer, intent(in) :: iout
integer, intent(out) :: info integer, intent(out) :: info
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
logical :: coarse_
info = psb_success_ info = psb_success_
if (present(coarse)) then
call pm%mld_ml_parms%descr(iout,info,coarse) coarse_ = coarse
write(iout,*) ' Aggregation threshold: ', &
& pm%aggr_thresh
return
end subroutine d_ml_parms_descr
subroutine mld_base_prec_descr(iout,iprcparm, info,rprcparm,dprcparm)
implicit none
integer, intent(in) :: iprcparm(:),iout
integer, intent(out) :: info
real(psb_spk_), intent(in), optional :: rprcparm(:)
real(psb_dpk_), intent(in), optional :: dprcparm(:)
info = psb_success_
if (count((/ present(rprcparm),present(dprcparm) /)) /= 1) then
info=psb_err_no_optional_arg_
!!$ call psb_errpush(info,name,a_err=" rprcparm, dprcparm")
return
endif
select case(iprcparm(mld_smoother_type_))
case(mld_noprec_)
write(iout,*) ' No preconditioning'
case(mld_jac_)
write(iout,*) ' Jacobi '
case(mld_bjac_)
write(iout,*) ' Block Jacobi with ',&
& fact_names(iprcparm(mld_sub_solve_))
select case(iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) ' Fill level:',iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout,*) ' Fill level:',iprcparm(mld_sub_fillin_)
if (present(rprcparm)) then
write(iout,*) ' Fill threshold :',rprcparm(mld_sub_iluthrs_)
else
write(iout,*) ' Fill threshold :',dprcparm(mld_sub_iluthrs_)
end if
case(mld_slu_,mld_umf_,mld_sludist_,mld_diag_scale_)
case default
write(iout,*) ' Should never get here!'
end select
case(mld_as_)
write(iout,*) ' Additive Schwarz with ',&
& fact_names(iprcparm(mld_sub_solve_))
select case(iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) ' Fill level:',iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout,*) ' Fill level:',iprcparm(mld_sub_fillin_)
if (present(rprcparm)) then
write(iout,*) ' Fill threshold :',rprcparm(mld_sub_iluthrs_)
else else
write(iout,*) ' Fill threshold :',dprcparm(mld_sub_iluthrs_) coarse_ = .false.
end if end if
case(mld_slu_,mld_umf_,mld_sludist_,mld_diag_scale_)
case default
write(iout,*) ' Should never get here!'
end select
write(iout,*) ' Overlap:',&
& iprcparm(mld_sub_ovr_)
write(iout,*) ' Restriction: ',&
& restrict_names(iprcparm(mld_sub_restr_))
write(iout,*) ' Prolongation: ',&
& prolong_names(iprcparm(mld_sub_prol_))
end select
return
end subroutine mld_base_prec_descr
subroutine mld_ml_alg_descr(iout,ilev,iprcparm, info,rprcparm,dprcparm) if (coarse_) then
implicit none call pm%coarsedescr(iout,info)
integer, intent(in) :: iprcparm(:),iout,ilev end if
integer, intent(out) :: info
real(psb_spk_), intent(in), optional :: rprcparm(:)
real(psb_dpk_), intent(in), optional :: dprcparm(:)
integer :: sweeps
info = psb_success_
if (count((/ present(rprcparm),present(dprcparm) /)) /= 1) then
info=psb_err_no_optional_arg_
!!$ call psb_errpush(info,name,a_err=" rprcparm, dprcparm")
return return
endif
if (iprcparm(mld_ml_type_)>mld_no_ml_) then end subroutine ml_parms_descr
write(iout,*) ' Multilevel type: ',& subroutine s_ml_parms_descr(pm,iout,info,coarse)
& ml_names(iprcparm(mld_ml_type_))
write(iout,*) ' Smoother position: ',&
& smooth_pos_names(iprcparm(mld_smoother_pos_))
if (iprcparm(mld_ml_type_) == mld_add_ml_) then
write(iout,*) ' Number of sweeps : ',&
& iprcparm(mld_smoother_sweeps_)
else
select case (iprcparm(mld_smoother_pos_))
case (mld_pre_smooth_)
write(iout,*) ' Number of sweeps : ',&
& iprcparm(mld_smoother_sweeps_pre_)
case (mld_post_smooth_)
write(iout,*) ' Number of sweeps : ',&
& iprcparm(mld_smoother_sweeps_post_)
case (mld_twoside_smooth_)
write(iout,*) ' Number of sweeps : pre: ',&
& iprcparm(mld_smoother_sweeps_pre_) ,&
& ' post: ',&
& iprcparm(mld_smoother_sweeps_post_)
end select
end if
write(iout,*) ' Aggregation: ', & use psb_base_mod
& aggr_names(iprcparm(mld_aggr_alg_))
write(iout,*) ' Aggregation type: ', &
& aggr_kinds(iprcparm(mld_aggr_kind_))
if (present(rprcparm)) then
write(iout,*) ' Aggregation threshold: ', &
& rprcparm(mld_aggr_thresh_)
else
write(iout,*) ' Aggregation threshold: ', &
& dprcparm(mld_aggr_thresh_)
end if
if (iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
if (iprcparm(mld_aggr_omega_alg_) == mld_eig_est_) then
write(iout,*) ' Damping omega computation: spectral radius estimate'
write(iout,*) ' Spectral radius estimate: ', &
& eigen_estimates(iprcparm(mld_aggr_eig_))
else if (iprcparm(mld_aggr_omega_alg_) == mld_user_choice_) then
write(iout,*) ' Damping omega computation: user defined value.'
else
write(iout,*) ' Damping omega computation: unknown value in iprcparm!!'
end if
end if
end if
return Implicit None
end subroutine mld_ml_alg_descr
subroutine mld_ml_level_descr(iout,ilev,iprcparm,nlaggr, info,rprcparm,dprcparm) ! Arguments
implicit none class(mld_sml_parms), intent(in) :: pm
integer, intent(in) :: iprcparm(:),iout,ilev integer, intent(in) :: iout
integer, intent(in), allocatable :: nlaggr(:)
integer, intent(out) :: info integer, intent(out) :: info
real(psb_spk_), intent(in), optional :: rprcparm(:) logical, intent(in), optional :: coarse
real(psb_dpk_), intent(in), optional :: dprcparm(:)
info = psb_success_ info = psb_success_
if (count((/ present(rprcparm),present(dprcparm) /)) /= 1) then
info=psb_err_no_optional_arg_
!!$ call psb_errpush(info,name,a_err=" rprcparm, dprcparm")
return
endif
if (iprcparm(mld_ml_type_)>mld_no_ml_) then call pm%mld_ml_parms%descr(iout,info,coarse)
write(iout,*) ' Level ',ilev if (pm%aggr_kind /= mld_no_smooth_) then
if (allocated(nlaggr)) then write(iout,*) ' Damping omega value :',pm%aggr_omega_val
write(iout,*) ' Size of coarse matrix: ', &
& sum(nlaggr(:))
write(iout,*) ' Sizes of aggregates: ', &
& nlaggr(:)
end if
if (iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
if (present(rprcparm)) then
write(iout,*) ' Damping omega: ', &
& rprcparm(mld_aggr_omega_val_)
else
write(iout,*) ' Damping omega: ', &
& dprcparm(mld_aggr_omega_val_)
end if
end if
end if end if
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
return return
end subroutine mld_ml_level_descr
subroutine mld_ml_coarse_descr(iout,ilev,iprcparm,iprcparm2,nlaggr,info,& end subroutine s_ml_parms_descr
& rprcparm,dprcparm, rprcparm2,dprcparm2)
implicit none
integer, intent(in) :: iprcparm(:),iprcparm2(:),iout,ilev
integer, intent(in), allocatable :: nlaggr(:)
integer, intent(out) :: info
real(psb_spk_), intent(in), optional :: rprcparm(:), rprcparm2(:)
real(psb_dpk_), intent(in), optional :: dprcparm(:), dprcparm2(:)
info = psb_success_
if (count((/ present(rprcparm),present(dprcparm) /)) /= 1) then
info=psb_err_no_optional_arg_
!!$ call psb_errpush(info,name,a_err=" rprcparm, dprcparm")
return
endif
if (count((/ present(rprcparm2),present(dprcparm2) /)) /= 1) then
info=psb_err_no_optional_arg_
!!$ call psb_errpush(info,name,a_err=" rprcparm, dprcparm")
return
endif
if (iprcparm(mld_ml_type_)>mld_no_ml_) then
write(iout,*) ' Level ',ilev,' (coarsest)'
write(iout,*) ' Coarsest matrix: ',&
& matrix_names(iprcparm(mld_coarse_mat_))
if (allocated(nlaggr)) then
write(iout,*) ' Size of coarsest matrix: ', &
& sum( nlaggr(:))
write(iout,*) ' Sizes of aggregates: ', &
& nlaggr(:)
end if
if (iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
if (present(rprcparm)) then
write(iout,*) ' Damping omega: ', &
& rprcparm(mld_aggr_omega_val_)
else
write(iout,*) ' Damping omega: ', &
& dprcparm(mld_aggr_omega_val_)
end if
end if
if (iprcparm(mld_coarse_mat_) == mld_distr_mat_ .and. &
& iprcparm(mld_sub_solve_) /= mld_sludist_) then
!!$ write(iout,*) ' Coarsest matrix solver: ',&
!!$ & smoother_names(iprcparm2(mld_smoother_type_))
select case (iprcparm2(mld_smoother_type_))
case(mld_bjac_,mld_as_)
write(iout,*) ' subdomain solver: ',&
& fact_names(iprcparm2(mld_sub_solve_))
write(iout,*) ' Number of smoother sweeps: ', &
& (iprcparm2(mld_smoother_sweeps_))
case(mld_jac_)
write(iout,*) ' Number of smoother sweeps: ', &
& (iprcparm2(mld_smoother_sweeps_))
end select
else
write(iout,*) ' Coarsest matrix solver: ', &
& fact_names(iprcparm2(mld_sub_solve_))
end if
select case(iprcparm2(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) ' Fill level:',iprcparm2(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout,*) ' Fill level:',iprcparm2(mld_sub_fillin_)
if (present(rprcparm2)) then
write(iout,*) ' Fill threshold :',rprcparm2(mld_sub_iluthrs_)
else if (present(dprcparm2)) then
write(iout,*) ' Fill threshold :',dprcparm2(mld_sub_iluthrs_)
end if
case(mld_slu_,mld_umf_,mld_sludist_,mld_diag_scale_)
case default
write(iout,*) ' Should never get here!'
end select
end if
subroutine d_ml_parms_descr(pm,iout,info,coarse)
return use psb_base_mod
end subroutine mld_ml_coarse_descr
Implicit None
subroutine mld_ml_new_coarse_descr(iout,ilev,iprcparm,nlaggr,info,& ! Arguments
& rprcparm,dprcparm) class(mld_dml_parms), intent(in) :: pm
implicit none integer, intent(in) :: iout
integer, intent(in) :: iprcparm(:),iout,ilev
integer, intent(in), allocatable :: nlaggr(:)
integer, intent(out) :: info integer, intent(out) :: info
real(psb_spk_), intent(in), optional :: rprcparm(:) logical, intent(in), optional :: coarse
real(psb_dpk_), intent(in), optional :: dprcparm(:)
info = psb_success_ info = psb_success_
if (count((/ present(rprcparm),present(dprcparm) /)) /= 1) then
info=psb_err_no_optional_arg_
!!$ call psb_errpush(info,name,a_err=" rprcparm, dprcparm")
return
endif
!!$ if (count((/ present(rprcparm2),present(dprcparm2) /)) /= 1) then
!!$ info=psb_err_no_optional_arg_
! !$ call psb_errpush(info,name,a_err=" rprcparm, dprcparm")
!!$ return
!!$ endif
if (iprcparm(mld_ml_type_)>mld_no_ml_) then
write(iout,*) ' Level ',ilev,' (coarsest)' call pm%mld_ml_parms%descr(iout,info,coarse)
write(iout,*) ' Coarsest matrix: ',& if (pm%aggr_kind /= mld_no_smooth_) then
& matrix_names(iprcparm(mld_coarse_mat_)) write(iout,*) ' Damping omega value :',pm%aggr_omega_val
if (allocated(nlaggr)) then
write(iout,*) ' Size of coarsest matrix: ', &
& sum( nlaggr(:))
write(iout,*) ' Sizes of aggregates: ', &
& nlaggr(:)
end if
if (iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
if (present(rprcparm)) then
write(iout,*) ' Damping omega: ', &
& rprcparm(mld_aggr_omega_val_)
else
write(iout,*) ' Damping omega: ', &
& dprcparm(mld_aggr_omega_val_)
end if
end if
!!$ if (iprcparm(mld_coarse_mat_) == mld_distr_mat_ .and. &
!!$ & iprcparm(mld_sub_solve_) /= mld_sludist_) then
! !$ write(iout,*) ' Coarsest matrix solver: ',&
! !$ & smoother_names(iprcparm2(mld_smoother_type_))
!!$ select case (iprcparm2(mld_smoother_type_))
!!$ case(mld_bjac_,mld_as_)
!!$ write(iout,*) ' subdomain solver: ',&
!!$ & fact_names(iprcparm2(mld_sub_solve_))
!!$ write(iout,*) ' Number of smoother sweeps: ', &
!!$ & (iprcparm2(mld_smoother_sweeps_))
!!$ case(mld_jac_)
!!$ write(iout,*) ' Number of smoother sweeps: ', &
!!$ & (iprcparm2(mld_smoother_sweeps_))
!!$ end select
!!$ else
!!$ write(iout,*) ' Coarsest matrix solver: ', &
!!$ & fact_names(iprcparm2(mld_sub_solve_))
!!$ end if
!!$ select case(iprcparm2(mld_sub_solve_))
!!$ case(mld_ilu_n_,mld_milu_n_)
!!$ write(iout,*) ' Fill level:',iprcparm2(mld_sub_fillin_)
!!$ case(mld_ilu_t_)
!!$ write(iout,*) ' Fill level:',iprcparm2(mld_sub_fillin_)
!!$ if (present(rprcparm2)) then
!!$ write(iout,*) ' Fill threshold :',rprcparm2(mld_sub_iluthrs_)
!!$ else if (present(dprcparm2)) then
!!$ write(iout,*) ' Fill threshold :',dprcparm2(mld_sub_iluthrs_)
!!$ end if
!!$ case(mld_slu_,mld_umf_,mld_sludist_,mld_diag_scale_)
!!$ case default
!!$ write(iout,*) ' Should never get here!'
!!$ end select
end if end if
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
return return
end subroutine mld_ml_new_coarse_descr
end subroutine d_ml_parms_descr
! !

136
mlprec/mld_c_prec_type.f90
Unescape Escape View File

@ -229,11 +229,14 @@ module mld_c_prec_type
type, extends(psb_cprec_type) :: mld_cprec_type type, extends(psb_cprec_type) :: mld_cprec_type
integer :: ictxt integer :: ictxt
real(psb_spk_) :: op_complexity=-sone
type(mld_conelev_type), allocatable :: precv(:) type(mld_conelev_type), allocatable :: precv(:)
contains contains
procedure, pass(prec) :: c_apply2v => mld_c_apply2v procedure, pass(prec) :: c_apply2v => mld_c_apply2v
procedure, pass(prec) :: c_apply1v => mld_c_apply1v procedure, pass(prec) :: c_apply1v => mld_c_apply1v
procedure, pass(prec) :: dump => mld_c_dump procedure, pass(prec) :: dump => mld_c_dump
procedure, pass(prec) :: get_complexity => mld_c_get_compl
procedure, pass(prec) :: cmp_complexity => mld_c_cmp_compl
end type mld_cprec_type end type mld_cprec_type
private :: c_base_solver_bld, c_base_solver_apply, & private :: c_base_solver_bld, c_base_solver_apply, &
@ -251,7 +254,8 @@ module mld_c_prec_type
& c_base_onelev_seti, c_base_onelev_setc, & & c_base_onelev_seti, c_base_onelev_setc, &
& c_base_onelev_setr, c_base_onelev_check, & & c_base_onelev_setr, c_base_onelev_check, &
& c_base_onelev_default, c_base_onelev_dump, & & c_base_onelev_default, c_base_onelev_dump, &
& c_base_onelev_descr & c_base_onelev_descr, mld_c_dump, &
& mld_c_get_compl, mld_c_cmp_compl
! !
@ -261,19 +265,19 @@ module mld_c_prec_type
interface mld_precfree interface mld_precfree
module procedure mld_c_onelev_precfree, mld_cprec_free module procedure mld_c_onelev_precfree, mld_cprec_free
end interface end interface mld_precfree
interface mld_nullify_onelevprec interface mld_nullify_onelevprec
module procedure mld_nullify_c_onelevprec module procedure mld_nullify_c_onelevprec
end interface end interface mld_nullify_onelevprec
interface mld_precdescr interface mld_precdescr
module procedure mld_cfile_prec_descr module procedure mld_cfile_prec_descr
end interface end interface mld_precdescr
interface mld_sizeof interface mld_sizeof
module procedure mld_cprec_sizeof, mld_c_onelev_prec_sizeof module procedure mld_cprec_sizeof, mld_c_onelev_prec_sizeof
end interface end interface mld_sizeof
interface mld_precaply interface mld_precaply
subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work) subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work)
@ -296,7 +300,7 @@ module mld_c_prec_type
integer, intent(out) :: info integer, intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
end subroutine mld_cprecaply1 end subroutine mld_cprecaply1
end interface end interface mld_precaply
contains contains
! !
@ -331,6 +335,46 @@ contains
if (allocated(prec%sm)) val = val + prec%sm%sizeof() if (allocated(prec%sm)) val = val + prec%sm%sizeof()
end function mld_c_onelev_prec_sizeof end function mld_c_onelev_prec_sizeof
function mld_c_get_compl(prec) result(val)
implicit none
class(mld_cprec_type), intent(in) :: prec
real(psb_spk_) :: val
val = prec%op_complexity
end function mld_c_get_compl
subroutine mld_c_cmp_compl(prec)
use psb_base_mod, only : psb_min, psb_sum
implicit none
class(mld_cprec_type), intent(inout) :: prec
real(psb_spk_) :: num,den
integer :: ictxt, il
num = -sone
den = sone
ictxt = prec%ictxt
if (allocated(prec%precv)) then
il = 1
num = prec%precv(il)%base_a%get_nzeros()
if (num >= szero) then
den = num
do il=2,size(prec%precv)
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
end do
end if
end if
call psb_min(ictxt,num)
if (num < szero) then
den = sone
else
call psb_sum(ictxt,num)
call psb_sum(ictxt,den)
end if
prec%op_complexity = num/den
end subroutine mld_c_cmp_compl
! !
! Subroutine: mld_file_prec_descr ! Subroutine: mld_file_prec_descr
! Version: real ! Version: real
@ -373,7 +417,6 @@ contains
ictxt = p%ictxt ictxt = p%ictxt
if (allocated(p%precv)) then if (allocated(p%precv)) then
!!$ ictxt = psb_cd_get_context(p%precv(1)%prec%desc_data)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
@ -406,51 +449,26 @@ contains
write(iout_,*) 'Base preconditioner (smoother) details' write(iout_,*) 'Base preconditioner (smoother) details'
endif endif
call p%precv(1)%sm%descr(info,iout=iout_) call p%precv(1)%sm%descr(info,iout=iout_)
if (nlev == 1) then
write(iout_,*)
return
end if
end if end if
if (nlev > 1) then
! !
! Print multilevel details ! Print multilevel details
! !
write(iout_,*) write(iout_,*)
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels: ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity()
! do ilev=2,nlev
! Currently, all the preconditioner parameters must have call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_)
! the same value at levels
! 2,...,nlev-1, hence only the values at level 2 are printed
!
ilev=2
call p%precv(ilev)%parms%descr(iout_,info)
!
! Coarse matrices are different at levels 2,...,nlev-1, hence related
! info is printed separately
!
write(iout_,*)
do ilev = 2, nlev-1
write(iout_,*) ' Level ',ilev
call p%precv(ilev)%descr(info,iout=iout_)
end do end do
!
! Print coarsest level details
!
! Should rework this.
ilev = nlev
write(iout_,*) write(iout_,*)
write(iout_,*) ' Level ',ilev,' (coarsest)'
call p%precv(ilev)%parms%descr(iout_,info,coarse=.true.)
call p%precv(ilev)%descr(info,iout=iout_,coarse=.true.)
end if end if
endif
write(iout_,*)
else else
write(iout_,*) trim(name), & write(iout_,*) trim(name), &
& ': Error: no base preconditioner available, something is wrong!' & ': Error: no base preconditioner available, something is wrong!'
@ -458,6 +476,7 @@ contains
return return
endif endif
end subroutine mld_cfile_prec_descr end subroutine mld_cfile_prec_descr
! !
@ -474,7 +493,7 @@ contains
! error code. ! error code.
! !
subroutine c_base_onelev_descr(lv,info,iout,coarse) subroutine c_base_onelev_descr(lv,il,nl,info,iout)
use psb_base_mod use psb_base_mod
@ -482,44 +501,53 @@ contains
! Arguments ! Arguments
class(mld_conelev_type), intent(in) :: lv class(mld_conelev_type), intent(in) :: lv
integer, intent(in) :: il,nl
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np integer :: ictxt, me, np
character(len=20), parameter :: name='mld_c_base_onelev_descr' character(len=20), parameter :: name='mld_c_base_onelev_descr'
integer :: iout_ integer :: iout_
logical :: coarse_ logical :: coarse
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(coarse)) then
coarse_ = coarse coarse = (il==nl)
else
coarse_ = .false.
end if
if (present(iout)) then if (present(iout)) then
iout_ = iout iout_ = iout
else else
iout_ = 6 iout_ = 6
end if end if
if (lv%parms%ml_type > mld_no_ml_) then write(iout_,*)
if (il == 2) then
call lv%parms%mldescr(iout_,info)
write(iout_,*)
end if
if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)'
else
write(iout_,*) ' Level ',il
end if
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', & write(iout_,*) ' Size of coarse matrix: ', &
& sum(lv%map%naggr(:)) & sum(lv%map%naggr(:))
write(iout_,*) ' Sizes of aggregates: ', & write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:) & lv%map%naggr(:)
end if end if
if (lv%parms%aggr_kind /= mld_no_smooth_) then
write(iout_,*) ' Damping omega: ', &
& lv%parms%aggr_omega_val
end if end if
end if
if (allocated(lv%sm)) & if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse) & call lv%sm%descr(info,iout=iout_,coarse=coarse)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

2
mlprec/mld_cprecbld.f90
Unescape Escape View File

@ -195,6 +195,8 @@ subroutine mld_cprecbld(a,desc_a,p,info)
endif endif
end if end if
call p%cmp_complexity()
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

129
mlprec/mld_d_prec_type.f90
Unescape Escape View File

@ -229,11 +229,14 @@ module mld_d_prec_type
type, extends(psb_dprec_type) :: mld_dprec_type type, extends(psb_dprec_type) :: mld_dprec_type
integer :: ictxt integer :: ictxt
real(psb_dpk_) :: op_complexity=-done
type(mld_donelev_type), allocatable :: precv(:) type(mld_donelev_type), allocatable :: precv(:)
contains contains
procedure, pass(prec) :: d_apply2v => mld_d_apply2v procedure, pass(prec) :: d_apply2v => mld_d_apply2v
procedure, pass(prec) :: d_apply1v => mld_d_apply1v procedure, pass(prec) :: d_apply1v => mld_d_apply1v
procedure, pass(prec) :: dump => mld_d_dump procedure, pass(prec) :: dump => mld_d_dump
procedure, pass(prec) :: get_complexity => mld_d_get_compl
procedure, pass(prec) :: cmp_complexity => mld_d_cmp_compl
end type mld_dprec_type end type mld_dprec_type
private :: d_base_solver_bld, d_base_solver_apply, & private :: d_base_solver_bld, d_base_solver_apply, &
@ -251,7 +254,8 @@ module mld_d_prec_type
& d_base_onelev_seti, d_base_onelev_setc, & & d_base_onelev_seti, d_base_onelev_setc, &
& d_base_onelev_setr, d_base_onelev_check, & & d_base_onelev_setr, d_base_onelev_check, &
& d_base_onelev_default, d_base_onelev_dump, & & d_base_onelev_default, d_base_onelev_dump, &
& d_base_onelev_descr & d_base_onelev_descr, mld_d_dump, &
& mld_d_get_compl, mld_d_cmp_compl
! !
@ -304,7 +308,6 @@ contains
! !
function mld_dprec_sizeof(prec) result(val) function mld_dprec_sizeof(prec) result(val)
use psb_base_mod
implicit none implicit none
type(mld_dprec_type), intent(in) :: prec type(mld_dprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
@ -318,7 +321,6 @@ contains
end if end if
end function mld_dprec_sizeof end function mld_dprec_sizeof
function mld_d_onelev_prec_sizeof(prec) result(val) function mld_d_onelev_prec_sizeof(prec) result(val)
implicit none implicit none
type(mld_donelev_type), intent(in) :: prec type(mld_donelev_type), intent(in) :: prec
@ -330,10 +332,48 @@ contains
val = val + psb_sizeof(prec%ac) val = val + psb_sizeof(prec%ac)
val = val + psb_sizeof(prec%map) val = val + psb_sizeof(prec%map)
if (allocated(prec%sm)) val = val + prec%sm%sizeof() if (allocated(prec%sm)) val = val + prec%sm%sizeof()
!!$ write(0,*) 'ONelev sizes: ',psb_sizeof(prec%desc_ac),&
!!$ & psb_sizeof(prec%ac), psb_sizeof(prec%map), prec%sm%sizeof()
end function mld_d_onelev_prec_sizeof end function mld_d_onelev_prec_sizeof
function mld_d_get_compl(prec) result(val)
implicit none
class(mld_dprec_type), intent(in) :: prec
real(psb_dpk_) :: val
val = prec%op_complexity
end function mld_d_get_compl
subroutine mld_d_cmp_compl(prec)
use psb_base_mod, only : psb_min, psb_sum
implicit none
class(mld_dprec_type), intent(inout) :: prec
real(psb_dpk_) :: num,den
integer :: ictxt, il
num = -done
den = done
ictxt = prec%ictxt
if (allocated(prec%precv)) then
il = 1
num = prec%precv(il)%base_a%get_nzeros()
if (num >= dzero) then
den = num
do il=2,size(prec%precv)
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
end do
end if
end if
call psb_min(ictxt,num)
if (num < dzero) then
den = done
else
call psb_sum(ictxt,num)
call psb_sum(ictxt,den)
end if
prec%op_complexity = num/den
end subroutine mld_d_cmp_compl
! !
! Subroutine: mld_file_prec_descr ! Subroutine: mld_file_prec_descr
! Version: real ! Version: real
@ -376,7 +416,6 @@ contains
ictxt = p%ictxt ictxt = p%ictxt
if (allocated(p%precv)) then if (allocated(p%precv)) then
!!$ ictxt = psb_cd_get_context(p%precv(1)%prec%desc_data)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
@ -409,51 +448,26 @@ contains
write(iout_,*) 'Base preconditioner (smoother) details' write(iout_,*) 'Base preconditioner (smoother) details'
endif endif
call p%precv(1)%sm%descr(info,iout=iout_) call p%precv(1)%sm%descr(info,iout=iout_)
if (nlev == 1) then
write(iout_,*)
return
end if
end if end if
if (nlev > 1) then
! !
! Print multilevel details ! Print multilevel details
! !
write(iout_,*) write(iout_,*)
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels: ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity()
! do ilev=2,nlev
! Currently, all the preconditioner parameters must have call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_)
! the same value at levels
! 2,...,nlev-1, hence only the values at level 2 are printed
!
ilev=2
call p%precv(ilev)%parms%descr(iout_,info)
!
! Coarse matrices are different at levels 2,...,nlev-1, hence related
! info is printed separately
!
write(iout_,*)
do ilev = 2, nlev-1
write(iout_,*) ' Level ',ilev
call p%precv(ilev)%descr(info,iout=iout_)
end do end do
!
! Print coarsest level details
!
! Should rework this.
ilev = nlev
write(iout_,*) write(iout_,*)
write(iout_,*) ' Level ',ilev,' (coarsest)'
call p%precv(ilev)%parms%descr(iout_,info,coarse=.true.)
call p%precv(ilev)%descr(info,iout=iout_,coarse=.true.)
end if end if
endif
write(iout_,*)
else else
write(iout_,*) trim(name), & write(iout_,*) trim(name), &
& ': Error: no base preconditioner available, something is wrong!' & ': Error: no base preconditioner available, something is wrong!'
@ -478,7 +492,7 @@ contains
! error code. ! error code.
! !
subroutine d_base_onelev_descr(lv,info,iout,coarse) subroutine d_base_onelev_descr(lv,il,nl,info,iout)
use psb_base_mod use psb_base_mod
@ -486,44 +500,53 @@ contains
! Arguments ! Arguments
class(mld_donelev_type), intent(in) :: lv class(mld_donelev_type), intent(in) :: lv
integer, intent(in) :: il,nl
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np integer :: ictxt, me, np
character(len=20), parameter :: name='mld_d_base_onelev_descr' character(len=20), parameter :: name='mld_d_base_onelev_descr'
integer :: iout_ integer :: iout_
logical :: coarse_ logical :: coarse
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(coarse)) then
coarse_ = coarse coarse = (il==nl)
else
coarse_ = .false.
end if
if (present(iout)) then if (present(iout)) then
iout_ = iout iout_ = iout
else else
iout_ = 6 iout_ = 6
end if end if
if (lv%parms%ml_type > mld_no_ml_) then write(iout_,*)
if (il == 2) then
call lv%parms%mldescr(iout_,info)
write(iout_,*)
end if
if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)'
else
write(iout_,*) ' Level ',il
end if
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', & write(iout_,*) ' Size of coarse matrix: ', &
& sum(lv%map%naggr(:)) & sum(lv%map%naggr(:))
write(iout_,*) ' Sizes of aggregates: ', & write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:) & lv%map%naggr(:)
end if end if
if (lv%parms%aggr_kind /= mld_no_smooth_) then
write(iout_,*) ' Damping omega: ', &
& lv%parms%aggr_omega_val
end if end if
end if
if (allocated(lv%sm)) & if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse) & call lv%sm%descr(info,iout=iout_,coarse=coarse)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

2
mlprec/mld_dprecbld.f90
Unescape Escape View File

@ -194,6 +194,8 @@ subroutine mld_dprecbld(a,desc_a,p,info)
endif endif
end if end if
call p%cmp_complexity()
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

2
mlprec/mld_dprecinit.F90
Unescape Escape View File

@ -204,7 +204,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,0,info) call p%precv(ilev_)%set(mld_sub_ovr_,0,info)
thr = 0.16 thr = 0.16d0
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
thr = thr/2 thr = thr/2

125
mlprec/mld_s_prec_type.f90
Unescape Escape View File

@ -229,11 +229,14 @@ module mld_s_prec_type
type, extends(psb_sprec_type) :: mld_sprec_type type, extends(psb_sprec_type) :: mld_sprec_type
integer :: ictxt integer :: ictxt
real(psb_spk_) :: op_complexity=-sone
type(mld_sonelev_type), allocatable :: precv(:) type(mld_sonelev_type), allocatable :: precv(:)
contains contains
procedure, pass(prec) :: s_apply2v => mld_s_apply2v procedure, pass(prec) :: s_apply2v => mld_s_apply2v
procedure, pass(prec) :: s_apply1v => mld_s_apply1v procedure, pass(prec) :: s_apply1v => mld_s_apply1v
procedure, pass(prec) :: dump => mld_s_dump procedure, pass(prec) :: dump => mld_s_dump
procedure, pass(prec) :: get_complexity => mld_s_get_compl
procedure, pass(prec) :: cmp_complexity => mld_s_cmp_compl
end type mld_sprec_type end type mld_sprec_type
private :: s_base_solver_bld, s_base_solver_apply, & private :: s_base_solver_bld, s_base_solver_apply, &
@ -251,7 +254,8 @@ module mld_s_prec_type
& s_base_onelev_seti, s_base_onelev_setc, & & s_base_onelev_seti, s_base_onelev_setc, &
& s_base_onelev_setr, s_base_onelev_check, & & s_base_onelev_setr, s_base_onelev_check, &
& s_base_onelev_default, s_base_onelev_dump, & & s_base_onelev_default, s_base_onelev_dump, &
& s_base_onelev_descr & s_base_onelev_descr, mld_s_dump, &
& mld_s_get_compl, mld_s_cmp_compl
! !
@ -331,6 +335,46 @@ contains
if (allocated(prec%sm)) val = val + prec%sm%sizeof() if (allocated(prec%sm)) val = val + prec%sm%sizeof()
end function mld_s_onelev_prec_sizeof end function mld_s_onelev_prec_sizeof
function mld_s_get_compl(prec) result(val)
implicit none
class(mld_sprec_type), intent(in) :: prec
real(psb_spk_) :: val
val = prec%op_complexity
end function mld_s_get_compl
subroutine mld_s_cmp_compl(prec)
use psb_base_mod, only : psb_min, psb_sum
implicit none
class(mld_sprec_type), intent(inout) :: prec
real(psb_spk_) :: num,den
integer :: ictxt, il
num = -sone
den = sone
ictxt = prec%ictxt
if (allocated(prec%precv)) then
il = 1
num = prec%precv(il)%base_a%get_nzeros()
if (num >= szero) then
den = num
do il=2,size(prec%precv)
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
end do
end if
end if
call psb_min(ictxt,num)
if (num < szero) then
den = sone
else
call psb_sum(ictxt,num)
call psb_sum(ictxt,den)
end if
prec%op_complexity = num/den
end subroutine mld_s_cmp_compl
! !
! Subroutine: mld_file_prec_descr ! Subroutine: mld_file_prec_descr
! Version: real ! Version: real
@ -373,7 +417,6 @@ contains
ictxt = p%ictxt ictxt = p%ictxt
if (allocated(p%precv)) then if (allocated(p%precv)) then
!!$ ictxt = psb_cd_get_context(p%precv(1)%prec%desc_data)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
@ -406,51 +449,26 @@ contains
write(iout_,*) 'Base preconditioner (smoother) details' write(iout_,*) 'Base preconditioner (smoother) details'
endif endif
call p%precv(1)%sm%descr(info,iout=iout_) call p%precv(1)%sm%descr(info,iout=iout_)
if (nlev == 1) then
write(iout_,*)
return
end if
end if end if
if (nlev > 1) then
! !
! Print multilevel details ! Print multilevel details
! !
write(iout_,*) write(iout_,*)
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels: ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity()
! do ilev=2,nlev
! Currently, all the preconditioner parameters must have call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_)
! the same value at levels
! 2,...,nlev-1, hence only the values at level 2 are printed
!
ilev=2
call p%precv(ilev)%parms%descr(iout_,info)
!
! Coarse matrices are different at levels 2,...,nlev-1, hence related
! info is printed separately
!
write(iout_,*)
do ilev = 2, nlev-1
write(iout_,*) ' Level ',ilev
call p%precv(ilev)%descr(info,iout=iout_)
end do end do
!
! Print coarsest level details
!
! Should rework this.
ilev = nlev
write(iout_,*) write(iout_,*)
write(iout_,*) ' Level ',ilev,' (coarsest)'
call p%precv(ilev)%parms%descr(iout_,info,coarse=.true.)
call p%precv(ilev)%descr(info,iout=iout_,coarse=.true.)
end if end if
endif
write(iout_,*)
else else
write(iout_,*) trim(name), & write(iout_,*) trim(name), &
& ': Error: no base preconditioner available, something is wrong!' & ': Error: no base preconditioner available, something is wrong!'
@ -475,7 +493,7 @@ contains
! error code. ! error code.
! !
subroutine s_base_onelev_descr(lv,info,iout,coarse) subroutine s_base_onelev_descr(lv,il,nl,info,iout)
use psb_base_mod use psb_base_mod
@ -483,44 +501,53 @@ contains
! Arguments ! Arguments
class(mld_sonelev_type), intent(in) :: lv class(mld_sonelev_type), intent(in) :: lv
integer, intent(in) :: il,nl
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np integer :: ictxt, me, np
character(len=20), parameter :: name='mld_s_base_onelev_descr' character(len=20), parameter :: name='mld_s_base_onelev_descr'
integer :: iout_ integer :: iout_
logical :: coarse_ logical :: coarse
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(coarse)) then
coarse_ = coarse coarse = (il==nl)
else
coarse_ = .false.
end if
if (present(iout)) then if (present(iout)) then
iout_ = iout iout_ = iout
else else
iout_ = 6 iout_ = 6
end if end if
if (lv%parms%ml_type > mld_no_ml_) then write(iout_,*)
if (il == 2) then
call lv%parms%mldescr(iout_,info)
write(iout_,*)
end if
if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)'
else
write(iout_,*) ' Level ',il
end if
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', & write(iout_,*) ' Size of coarse matrix: ', &
& sum(lv%map%naggr(:)) & sum(lv%map%naggr(:))
write(iout_,*) ' Sizes of aggregates: ', & write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:) & lv%map%naggr(:)
end if end if
if (lv%parms%aggr_kind /= mld_no_smooth_) then
write(iout_,*) ' Damping omega: ', &
& lv%parms%aggr_omega_val
end if end if
end if
if (allocated(lv%sm)) & if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse) & call lv%sm%descr(info,iout=iout_,coarse=coarse)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

2
mlprec/mld_sprecbld.f90
Unescape Escape View File

@ -194,6 +194,8 @@ subroutine mld_sprecbld(a,desc_a,p,info)
endif endif
end if end if
call p%cmp_complexity()
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

126
mlprec/mld_z_prec_type.f90
Unescape Escape View File

@ -229,11 +229,14 @@ module mld_z_prec_type
type, extends(psb_zprec_type) :: mld_zprec_type type, extends(psb_zprec_type) :: mld_zprec_type
integer :: ictxt integer :: ictxt
real(psb_dpk_) :: op_complexity=-done
type(mld_zonelev_type), allocatable :: precv(:) type(mld_zonelev_type), allocatable :: precv(:)
contains contains
procedure, pass(prec) :: z_apply2v => mld_z_apply2v procedure, pass(prec) :: z_apply2v => mld_z_apply2v
procedure, pass(prec) :: z_apply1v => mld_z_apply1v procedure, pass(prec) :: z_apply1v => mld_z_apply1v
procedure, pass(prec) :: dump => mld_z_dump procedure, pass(prec) :: dump => mld_z_dump
procedure, pass(prec) :: get_complexity => mld_z_get_compl
procedure, pass(prec) :: cmp_complexity => mld_z_cmp_compl
end type mld_zprec_type end type mld_zprec_type
private :: z_base_solver_bld, z_base_solver_apply, & private :: z_base_solver_bld, z_base_solver_apply, &
@ -251,7 +254,8 @@ module mld_z_prec_type
& z_base_onelev_seti, z_base_onelev_setc, & & z_base_onelev_seti, z_base_onelev_setc, &
& z_base_onelev_setr, z_base_onelev_check, & & z_base_onelev_setr, z_base_onelev_check, &
& z_base_onelev_default, z_base_onelev_dump, & & z_base_onelev_default, z_base_onelev_dump, &
& z_base_onelev_descr & z_base_onelev_descr, mld_z_dump, &
& mld_z_get_compl, mld_z_cmp_compl
! !
@ -330,6 +334,46 @@ contains
if (allocated(prec%sm)) val = val + prec%sm%sizeof() if (allocated(prec%sm)) val = val + prec%sm%sizeof()
end function mld_z_onelev_prec_sizeof end function mld_z_onelev_prec_sizeof
function mld_z_get_compl(prec) result(val)
implicit none
class(mld_zprec_type), intent(in) :: prec
real(psb_dpk_) :: val
val = prec%op_complexity
end function mld_z_get_compl
subroutine mld_z_cmp_compl(prec)
use psb_base_mod, only : psb_min, psb_sum
implicit none
class(mld_zprec_type), intent(inout) :: prec
real(psb_dpk_) :: num,den
integer :: ictxt, il
num = -done
den = done
ictxt = prec%ictxt
if (allocated(prec%precv)) then
il = 1
num = prec%precv(il)%base_a%get_nzeros()
if (num >= dzero) then
den = num
do il=2,size(prec%precv)
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
end do
end if
end if
call psb_min(ictxt,num)
if (num < dzero) then
den = done
else
call psb_sum(ictxt,num)
call psb_sum(ictxt,den)
end if
prec%op_complexity = num/den
end subroutine mld_z_cmp_compl
! !
! Subroutine: mld_file_prec_descr ! Subroutine: mld_file_prec_descr
! Version: real ! Version: real
@ -372,7 +416,6 @@ contains
ictxt = p%ictxt ictxt = p%ictxt
if (allocated(p%precv)) then if (allocated(p%precv)) then
!!$ ictxt = psb_cd_get_context(p%precv(1)%prec%desc_data)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
@ -405,51 +448,26 @@ contains
write(iout_,*) 'Base preconditioner (smoother) details' write(iout_,*) 'Base preconditioner (smoother) details'
endif endif
call p%precv(1)%sm%descr(info,iout=iout_) call p%precv(1)%sm%descr(info,iout=iout_)
if (nlev == 1) then
write(iout_,*)
return
end if
end if end if
if (nlev > 1) then
! !
! Print multilevel details ! Print multilevel details
! !
write(iout_,*) write(iout_,*)
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels: ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity()
! do ilev=2,nlev
! Currently, all the preconditioner parameters must have call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_)
! the same value at levels
! 2,...,nlev-1, hence only the values at level 2 are printed
!
ilev=2
call p%precv(ilev)%parms%descr(iout_,info)
!
! Coarse matrices are different at levels 2,...,nlev-1, hence related
! info is printed separately
!
write(iout_,*)
do ilev = 2, nlev-1
write(iout_,*) ' Level ',ilev
call p%precv(ilev)%descr(info,iout=iout_)
end do end do
!
! Print coarsest level details
!
! Should rework this.
ilev = nlev
write(iout_,*) write(iout_,*)
write(iout_,*) ' Level ',ilev,' (coarsest)'
call p%precv(ilev)%parms%descr(iout_,info,coarse=.true.)
call p%precv(ilev)%descr(info,iout=iout_,coarse=.true.)
end if end if
endif
write(iout_,*)
else else
write(iout_,*) trim(name), & write(iout_,*) trim(name), &
& ': Error: no base preconditioner available, something is wrong!' & ': Error: no base preconditioner available, something is wrong!'
@ -457,6 +475,7 @@ contains
return return
endif endif
end subroutine mld_zfile_prec_descr end subroutine mld_zfile_prec_descr
! !
@ -473,7 +492,7 @@ contains
! error code. ! error code.
! !
subroutine z_base_onelev_descr(lv,info,iout,coarse) subroutine z_base_onelev_descr(lv,il,nl,info,iout)
use psb_base_mod use psb_base_mod
@ -481,44 +500,53 @@ contains
! Arguments ! Arguments
class(mld_zonelev_type), intent(in) :: lv class(mld_zonelev_type), intent(in) :: lv
integer, intent(in) :: il,nl
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np integer :: ictxt, me, np
character(len=20), parameter :: name='mld_z_base_onelev_descr' character(len=20), parameter :: name='mld_z_base_onelev_descr'
integer :: iout_ integer :: iout_
logical :: coarse_ logical :: coarse
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(coarse)) then
coarse_ = coarse coarse = (il==nl)
else
coarse_ = .false.
end if
if (present(iout)) then if (present(iout)) then
iout_ = iout iout_ = iout
else else
iout_ = 6 iout_ = 6
end if end if
if (lv%parms%ml_type > mld_no_ml_) then write(iout_,*)
if (il == 2) then
call lv%parms%mldescr(iout_,info)
write(iout_,*)
end if
if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)'
else
write(iout_,*) ' Level ',il
end if
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', & write(iout_,*) ' Size of coarse matrix: ', &
& sum(lv%map%naggr(:)) & sum(lv%map%naggr(:))
write(iout_,*) ' Sizes of aggregates: ', & write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:) & lv%map%naggr(:)
end if end if
if (lv%parms%aggr_kind /= mld_no_smooth_) then
write(iout_,*) ' Damping omega: ', &
& lv%parms%aggr_omega_val
end if end if
end if
if (allocated(lv%sm)) & if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse) & call lv%sm%descr(info,iout=iout_,coarse=coarse)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

2
mlprec/mld_zprecbld.f90
Unescape Escape View File

@ -195,6 +195,8 @@ subroutine mld_zprecbld(a,desc_a,p,info)
endif endif
end if end if
call p%cmp_complexity()
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

2
mlprec/mld_zprecinit.F90
Unescape Escape View File

@ -202,7 +202,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,0,info) call p%precv(ilev_)%set(mld_sub_ovr_,0,info)
thr = 0.16 thr = 0.16d0
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
thr = thr/2 thr = thr/2

3
tests/pdegen/ppde.f90
Unescape Escape View File

@ -195,7 +195,8 @@ program ppde
call mld_precset(prec,mld_aggr_alg_, prectype%aggr_alg,info) call mld_precset(prec,mld_aggr_alg_, prectype%aggr_alg,info)
call mld_precset(prec,mld_ml_type_, prectype%mltype, info) call mld_precset(prec,mld_ml_type_, prectype%mltype, info)
call mld_precset(prec,mld_smoother_pos_, prectype%smthpos, info) call mld_precset(prec,mld_smoother_pos_, prectype%smthpos, info)
call mld_precset(prec,mld_aggr_thresh_, prectype%athres, info) if (prectype%athres >= dzero) &
& call mld_precset(prec,mld_aggr_thresh_, prectype%athres, info)
call mld_precset(prec,mld_coarse_solve_, prectype%csolve, info) call mld_precset(prec,mld_coarse_solve_, prectype%csolve, info)
call mld_precset(prec,mld_coarse_subsolve_, prectype%csbsolve,info) call mld_precset(prec,mld_coarse_subsolve_, prectype%csbsolve,info)
call mld_precset(prec,mld_coarse_mat_, prectype%cmat, info) call mld_precset(prec,mld_coarse_mat_, prectype%cmat, info)

2
tests/pdegen/runs/ppde.inp
Unescape Escape View File

@ -27,4 +27,4 @@ UMF ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDI
1 ! Coarse level: Level-set N for ILU(N) 1 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P) 1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps 4 ! Coarse level: Number of Jacobi sweeps
0.10d0 ! Smoother Aggregation Threshold: >= 0.0 -0.10d0 ! Smoother Aggregation Threshold: >= 0.0 default if < 0.0

3
tests/pdegen/spde.f90
Unescape Escape View File

@ -193,7 +193,8 @@ program spde
call mld_precset(prec,mld_aggr_alg_, prectype%aggr_alg,info) call mld_precset(prec,mld_aggr_alg_, prectype%aggr_alg,info)
call mld_precset(prec,mld_ml_type_, prectype%mltype, info) call mld_precset(prec,mld_ml_type_, prectype%mltype, info)
call mld_precset(prec,mld_smoother_pos_, prectype%smthpos, info) call mld_precset(prec,mld_smoother_pos_, prectype%smthpos, info)
call mld_precset(prec,mld_aggr_thresh_, prectype%athres, info) if (prectype%athres >= szero) &
& call mld_precset(prec,mld_aggr_thresh_, prectype%athres, info)
call mld_precset(prec,mld_coarse_solve_, prectype%csolve, info) call mld_precset(prec,mld_coarse_solve_, prectype%csolve, info)
call mld_precset(prec,mld_coarse_subsolve_, prectype%csbsolve,info) call mld_precset(prec,mld_coarse_subsolve_, prectype%csbsolve,info)
call mld_precset(prec,mld_coarse_mat_, prectype%cmat, info) call mld_precset(prec,mld_coarse_mat_, prectype%cmat, info)

Write Preview
Loading…
Cancel
Save