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.

485
mlprec/mld_base_prec_type.F90
Unescape Escape View File

@ -102,9 +102,12 @@ module mld_base_prec_type
integer :: aggr_omega_alg, aggr_eig, aggr_filter integer :: aggr_omega_alg, aggr_eig, aggr_filter
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,449 +439,153 @@ 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 if (pm%ml_type>mld_no_ml_) then
coarse_ = coarse
else
coarse_ = .false.
end if
if (coarse_) then write(iout,*) ' Multilevel type: ',&
write(iout,*) ' Coarsest matrix: ',& & ml_names(pm%ml_type)
& matrix_names(pm%coarse_mat) write(iout,*) ' Smoother position: ',&
if (pm%coarse_solve == mld_bjac_) then & smooth_pos_names(pm%smoother_pos)
write(iout,*) ' Coarse solver: Block Jacobi ' if (pm%ml_type == mld_add_ml_) then
write(iout,*) ' Number of sweeps : ',& write(iout,*) ' Number of sweeps : ',&
& pm%sweeps & pm%sweeps
else else
write(iout,*) ' Coarse solver: ',& select case (pm%smoother_pos)
& fact_names(pm%coarse_solve) case (mld_pre_smooth_)
endif
else
if (pm%ml_type>mld_no_ml_) then
write(iout,*) ' Multilevel type: ',&
& ml_names(pm%ml_type)
write(iout,*) ' Smoother position: ',&
& smooth_pos_names(pm%smoother_pos)
if (pm%ml_type == mld_add_ml_) then
write(iout,*) ' Number of sweeps : ',& write(iout,*) ' Number of sweeps : ',&
& pm%sweeps & pm%sweeps_pre
case (mld_post_smooth_)
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_post
case (mld_twoside_smooth_)
write(iout,*) ' Number of sweeps : pre: ',&
& pm%sweeps_pre ,&
& ' post: ',&
& pm%sweeps_post
end select
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_omega_alg == mld_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 == mld_user_choice_) then
write(iout,*) ' Damping omega computation: user defined value.'
else else
select case (pm%smoother_pos) write(iout,*) ' Damping omega computation: unknown value in iprcparm!!'
case (mld_pre_smooth_)
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre
case (mld_post_smooth_)
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_post
case (mld_twoside_smooth_)
write(iout,*) ' Number of sweeps : pre: ',&
& pm%sweeps_pre ,&
& ' post: ',&
& pm%sweeps_post
end select
end if
if (pm%aggr_kind /= mld_no_smooth_) then
if (pm%aggr_omega_alg == mld_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 == 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
write(iout,*) ' Aggregation: ', &
& aggr_names(pm%aggr_alg)
write(iout,*) ' Aggregation type: ', &
& aggr_kinds(pm%aggr_kind)
end if 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
coarse_ = coarse
else
coarse_ = .false.
end if
call pm%mld_ml_parms%descr(iout,info,coarse) if (coarse_) then
call pm%coarsedescr(iout,info)
write(iout,*) ' Aggregation threshold: ', & end if
& 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
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
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 return
end subroutine mld_base_prec_descr
subroutine mld_ml_alg_descr(iout,ilev,iprcparm, info,rprcparm,dprcparm)
implicit none
integer, intent(in) :: iprcparm(:),iout,ilev
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
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 logical, intent(in), optional :: coarse
real(psb_spk_), intent(in), optional :: rprcparm(:)
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
end subroutine mld_ml_level_descr
subroutine mld_ml_coarse_descr(iout,ilev,iprcparm,iprcparm2,nlaggr,info,&
& 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_ return
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)' end subroutine s_ml_parms_descr
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(out) :: info
integer, intent(in), allocatable :: nlaggr(:) logical, intent(in), optional :: coarse
integer, intent(out) :: info
real(psb_spk_), intent(in), optional :: rprcparm(:)
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)'
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
call pm%mld_ml_parms%descr(iout,info,coarse)
if (pm%aggr_kind /= mld_no_smooth_) then
write(iout,*) ' Damping omega value :',pm%aggr_omega_val
end if
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
return return
end subroutine mld_ml_new_coarse_descr
end subroutine d_ml_parms_descr
! !
@ -1110,7 +817,7 @@ contains
end function is_legal end function is_legal
end interface end interface
character(len=20), parameter :: rname='mld_check_def' character(len=20), parameter :: rname='mld_check_def'
if (.not.is_legal(ip)) then if (.not.is_legal(ip)) then
write(0,*)trim(rname),': Error: Illegal value for ',& write(0,*)trim(rname),': Error: Illegal value for ',&
& name,' :',ip, '. defaulting to ',id & name,' :',ip, '. defaulting to ',id
@ -1131,7 +838,7 @@ contains
end function is_legal end function is_legal
end interface end interface
character(len=20), parameter :: rname='mld_check_def' character(len=20), parameter :: rname='mld_check_def'
if (.not.is_legal(ip)) then if (.not.is_legal(ip)) then
write(0,*)trim(rname),': Error: Illegal value for ',& write(0,*)trim(rname),': Error: Illegal value for ',&
& name,' :',ip, '. defaulting to ',id & name,' :',ip, '. defaulting to ',id
@ -1192,14 +899,14 @@ contains
call psb_bcast(ictxt,dat%aggr_omega_val,root) call psb_bcast(ictxt,dat%aggr_omega_val,root)
call psb_bcast(ictxt,dat%aggr_thresh,root) call psb_bcast(ictxt,dat%aggr_thresh,root)
end subroutine mld_sml_bcast end subroutine mld_sml_bcast
subroutine mld_dml_bcast(ictxt,dat,root) subroutine mld_dml_bcast(ictxt,dat,root)
use psb_base_mod use psb_base_mod
implicit none implicit none
integer, intent(in) :: ictxt integer, intent(in) :: ictxt
type(mld_dml_parms), intent(inout) :: dat type(mld_dml_parms), intent(inout) :: dat
integer, intent(in), optional :: root integer, intent(in), optional :: root
call psb_bcast(ictxt,dat%mld_ml_parms,root) call psb_bcast(ictxt,dat%mld_ml_parms,root)
call psb_bcast(ictxt,dat%aggr_omega_val,root) call psb_bcast(ictxt,dat%aggr_omega_val,root)
call psb_bcast(ictxt,dat%aggr_thresh,root) call psb_bcast(ictxt,dat%aggr_thresh,root)

706
mlprec/mld_c_prec_type.f90
View File

File diff suppressed because it is too large Load Diff

2
mlprec/mld_cprecbld.f90
Unescape Escape View File

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

149
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,58 +448,33 @@ 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_,*) 'Multilevel details'
write(iout_,*) write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) 'Multilevel details' write(iout_,*) ' Operator complexity: ',p%get_complexity()
write(iout_,*) ' Number of levels: ',nlev do ilev=2,nlev
call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_)
! end do
! Currently, all the preconditioner parameters must have write(iout_,*)
! the same value at levels
! 2,...,nlev-1, hence only the values at level 2 are printed end if
!
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
!
! Print coarsest level details
!
! Should rework this.
ilev = nlev
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
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!'
info = -2 info = -2
return return
endif endif
end subroutine mld_dfile_prec_descr end subroutine mld_dfile_prec_descr
@ -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
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
if (lv%parms%ml_type > mld_no_ml_) then 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

@ -193,6 +193,8 @@ subroutine mld_dprecbld(a,desc_a,p,info)
goto 9999 goto 9999
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

165
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
@ -371,12 +415,11 @@ contains
if (iout_ < 0) iout_ = 6 if (iout_ < 0) iout_ = 6
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)
! !
! The preconditioner description is printed by processor psb_root_. ! The preconditioner description is printed by processor psb_root_.
! This agrees with the fact that all the parameters defining the ! This agrees with the fact that all the parameters defining the
@ -406,58 +449,33 @@ 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_,*) 'Multilevel details'
write(iout_,*) write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) 'Multilevel details' write(iout_,*) ' Operator complexity: ',p%get_complexity()
write(iout_,*) ' Number of levels: ',nlev do ilev=2,nlev
call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_)
! end do
! Currently, all the preconditioner parameters must have write(iout_,*)
! the same value at levels
! 2,...,nlev-1, hence only the values at level 2 are printed end if
!
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
!
! Print coarsest level details
!
! Should rework this.
ilev = nlev
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
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!'
info = -2 info = -2
return return
endif endif
end subroutine mld_sfile_prec_descr end subroutine mld_sfile_prec_descr
@ -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,49 +501,58 @@ 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)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then

2
mlprec/mld_sprecbld.f90
Unescape Escape View File

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

150
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
@ -370,12 +414,11 @@ contains
if (iout_ < 0) iout_ = 6 if (iout_ < 0) iout_ = 6
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)
! !
! The preconditioner description is printed by processor psb_root_. ! The preconditioner description is printed by processor psb_root_.
! This agrees with the fact that all the parameters defining the ! This agrees with the fact that all the parameters defining the
@ -405,57 +448,33 @@ 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_,*) 'Multilevel details'
write(iout_,*) write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) 'Multilevel details' write(iout_,*) ' Operator complexity: ',p%get_complexity()
write(iout_,*) ' Number of levels: ',nlev do ilev=2,nlev
call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_)
! end do
! Currently, all the preconditioner parameters must have write(iout_,*)
! the same value at levels
! 2,...,nlev-1, hence only the values at level 2 are printed end if
!
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
!
! Print coarsest level details
!
! Should rework this.
ilev = nlev
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
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!'
info = -2 info = -2
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
write(iout_,*)
if (il == 2) then
call lv%parms%mldescr(iout_,info)
write(iout_,*)
end if
if (lv%parms%ml_type > mld_no_ml_) then 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

@ -194,6 +194,8 @@ subroutine mld_zprecbld(a,desc_a,p,info)
goto 9999 goto 9999
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