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

Fixed PREC%SET.

Browse Source
stopcriterion
Salvatore Filippone 7 years ago
parent f6f9cf2e0f
commit 20efbb2c85
11 changed files with 496 additions and 628 deletions
Show Stats Download Patch File Download Diff File

147
tests/fileread/mld_cf_sample.f90
Unescape Escape View File

@ -68,23 +68,19 @@ program mld_cf_sample
character(len=10) :: ptype ! preconditioner type character(len=10) :: ptype ! preconditioner type
! general AMG data ! general AMG data
character(len=16) :: mltype ! AMG cycle type character(len=16) :: mlcycle ! AMG cycle type
integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles
integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner
! AMG aggregation ! AMG aggregation
character(len=16) :: aggrkind ! aggregation type: SMOOTHED, NONSMOOTHED character(len=16) :: aggr_prol ! aggregation type: SMOOTHED, NONSMOOTHED
character(len=16) :: aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC character(len=16) :: par_aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC
character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE
character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER
real(psb_spk_) :: mnaggratio ! minimum aggregation ratio real(psb_spk_) :: mncrratio ! minimum aggregation ratio
real(psb_spk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector real(psb_spk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector
integer(psb_ipk_) :: thrvsz ! size of threshold vector integer(psb_ipk_) :: thrvsz ! size of threshold vector
real(psb_spk_) :: athres ! smoothed aggregation threshold real(psb_spk_) :: athres ! smoothed aggregation threshold
real(psb_spk_) :: ascale ! smoothed aggregation scale factor for threshold
character(len=16) :: aggr_omalg ! algorithm for estimating omega parameter
character(len=16) :: aggr_eig ! Eigenvalue estimation procedure
real(psb_spk_) :: omega_val ! Eigenvalue estimate value
integer(psb_ipk_) :: csize ! minimum size of coarsest matrix integer(psb_ipk_) :: csize ! minimum size of coarsest matrix
! AMG smoother or pre-smoother; also 1-lev preconditioner ! AMG smoother or pre-smoother; also 1-lev preconditioner
@ -364,20 +360,37 @@ program mld_cf_sample
! !
! initialize the preconditioner ! initialize the preconditioner
! !
if (psb_toupper(p_choice%ptype) == 'ML') then call prec%init(p_choice%ptype,info)
select case(trim(psb_toupper(p_choice%ptype)))
case ('NONE','NOPREC','JACOBI')
! Do nothing, keep defaults
case ('BJAC')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case('AS')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case ('ML')
! multilevel preconditioner ! multilevel preconditioner
call prec%init(p_choice%ptype,info)
call prec%set('ml_type', p_choice%mltype, info) call prec%set('ml_cycle', p_choice%mlcycle, info)
call prec%set('outer_sweeps', p_choice%otr_sweeps,info) call prec%set('outer_sweeps', p_choice%otr_sweeps,info)
if (p_choice%csize>0)& if (p_choice%csize>0)&
& call prec%set('coarse_aggr_size', p_choice%csize, info) & call prec%set('min_coarse_size', p_choice%csize, info)
if (p_choice%mnaggratio>0)& if (p_choice%mncrratio>1)&
& call prec%set('min_aggr_ratio', p_choice%mnaggratio, info) & call prec%set('min_cr_ratio', p_choice%mncrratio, info)
if (p_choice%maxlevs>0)& if (p_choice%maxlevs>0)&
& call prec%set('max_prec_levs', p_choice%maxlevs, info) & call prec%set('max_levs', p_choice%maxlevs, info)
if (p_choice%ascale > dzero) &
& call prec%set('aggr_scale', p_choice%ascale, info)
if (p_choice%athres >= dzero) & if (p_choice%athres >= dzero) &
& call prec%set('aggr_thresh', p_choice%athres, info) & call prec%set('aggr_thresh', p_choice%athres, info)
if (p_choice%thrvsz>0) then if (p_choice%thrvsz>0) then
@ -386,16 +399,11 @@ program mld_cf_sample
end do end do
end if end if
call prec%set('aggr_kind', p_choice%aggrkind, info) call prec%set('aggr_prol', p_choice%aggr_prol, info)
call prec%set('aggr_alg', p_choice%aggr_alg, info) call prec%set('par_aggr_alg', p_choice%par_aggr_alg, info)
call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_ord', p_choice%aggr_ord, info)
call prec%set('aggr_filter', p_choice%aggr_filter,info) call prec%set('aggr_filter', p_choice%aggr_filter,info)
call prec%set('aggr_omega_alg', p_choice%aggr_omalg, info)
if (psb_toupper(p_choice%aggr_omalg) == 'EIG_EST') then
call prec%set('aggr_eig', p_choice%aggr_eig, info)
else if (psb_toupper(p_choice%aggr_omalg) == 'USER_CHOICE') then
call prec%set('aggr_omega_val', p_choice%omega_val, info)
end if
call prec%set('coarse_solve', p_choice%csolve, info) call prec%set('coarse_solve', p_choice%csolve, info)
if (psb_toupper(p_choice%csolve) == 'BJAC') & if (psb_toupper(p_choice%csolve) == 'BJAC') &
& call prec%set('coarse_subsolve', p_choice%csbsolve, info) & call prec%set('coarse_subsolve', p_choice%csbsolve, info)
@ -424,50 +432,24 @@ program mld_cf_sample
call prec%set('sub_fillin', p_choice%fill2, info,pos='post') call prec%set('sub_fillin', p_choice%fill2, info,pos='post')
call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post')
end if end if
end select
! build the preconditioner
call psb_barrier(ictxt) ! build the preconditioner
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%hierarchy_build(a,desc_a,info) t1 = psb_wtime()
thier = psb_wtime()-t1 call prec%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then thier = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld')
end if goto 9999
call psb_barrier(ictxt) end if
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%smoothers_build(a,desc_a,info) t1 = psb_wtime()
tprec = psb_wtime()-t1 call prec%smoothers_build(a,desc_a,info)
if (info /= psb_success_) then tprec = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld')
end if goto 9999
else
! 1-level preconditioner
nlv = 1
call prec%init(p_choice%ptype,info)
if (psb_toupper(p_choice%ptype) /= 'NONE') then
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
!!! call prec%set('solver_sweeps', p_choice%svsweeps, info)
end if
! build the preconditioner
thier = dzero
t1 = psb_wtime()
call prec%build(a,desc_a,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precbld')
goto 9999
end if
end if end if
call psb_amx(ictxt, thier) call psb_amx(ictxt, thier)
@ -480,7 +462,9 @@ program mld_cf_sample
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
end if end if
iparm = 0 !
! iterative method parameters
!
call psb_barrier(ictxt) call psb_barrier(ictxt)
t1 = psb_wtime() t1 = psb_wtime()
call psb_krylov(s_choice%kmethd,a,prec,b_col,x_col,s_choice%eps,& call psb_krylov(s_choice%kmethd,a,prec,b_col,x_col,s_choice%eps,&
@ -628,16 +612,16 @@ contains
call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec
call read_data(prec%ptype,psb_inp_unit) ! preconditioner type call read_data(prec%ptype,psb_inp_unit) ! preconditioner type
! general AMG data ! general AMG data
call read_data(prec%mltype,psb_inp_unit) ! AMG cycle type call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type
call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles
call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec
call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat
! aggregation ! aggregation
call read_data(prec%aggrkind,psb_inp_unit) ! aggregation type call read_data(prec%aggr_prol,psb_inp_unit) ! aggregation type
call read_data(prec%aggr_alg,psb_inp_unit) ! parallel aggregation alg call read_data(prec%par_aggr_alg,psb_inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,psb_inp_unit) ! filtering call read_data(prec%aggr_filter,psb_inp_unit) ! filtering
call read_data(prec%mnaggratio,psb_inp_unit) ! minimum aggregation ratio call read_data(prec%mncrratio,psb_inp_unit) ! minimum aggregation ratio
call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info) call psb_realloc(prec%thrvsz,prec%athresv,info)
@ -646,9 +630,6 @@ contains
read(psb_inp_unit,*) ! dummy read to skip a record read(psb_inp_unit,*) ! dummy read to skip a record
end if end if
call read_data(prec%athres,psb_inp_unit) ! smoothed aggr thresh call read_data(prec%athres,psb_inp_unit) ! smoothed aggr thresh
call read_data(prec%aggr_omalg,psb_inp_unit) ! alg for estimating omega
call read_data(prec%aggr_eig,psb_inp_unit) ! alg for estimating omega
call read_data(prec%omega_val,psb_inp_unit) ! alg for estimating omega
! AMG smoother (or pre-smoother) / 1-lev preconditioner ! AMG smoother (or pre-smoother) / 1-lev preconditioner
call read_data(prec%smther,psb_inp_unit) ! smoother type call read_data(prec%smther,psb_inp_unit) ! smoother type
call read_data(prec%jsweeps,psb_inp_unit) ! (pre-)smoother / 1-lev prec sweeps call read_data(prec%jsweeps,psb_inp_unit) ! (pre-)smoother / 1-lev prec sweeps
@ -707,7 +688,7 @@ contains
! broadcast (other) AMG parameters ! broadcast (other) AMG parameters
if (psb_toupper(prec%ptype) == 'ML') then if (psb_toupper(prec%ptype) == 'ML') then
call psb_bcast(icontxt,prec%mltype) call psb_bcast(icontxt,prec%mlcycle)
call psb_bcast(icontxt,prec%otr_sweeps) call psb_bcast(icontxt,prec%otr_sweeps)
call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%maxlevs)
@ -720,21 +701,17 @@ contains
call psb_bcast(icontxt,prec%fill2) call psb_bcast(icontxt,prec%fill2)
call psb_bcast(icontxt,prec%thr2) call psb_bcast(icontxt,prec%thr2)
call psb_bcast(icontxt,prec%aggrkind) call psb_bcast(icontxt,prec%aggr_prol)
call psb_bcast(icontxt,prec%aggr_alg) call psb_bcast(icontxt,prec%par_aggr_alg)
call psb_bcast(icontxt,prec%aggr_ord) call psb_bcast(icontxt,prec%aggr_ord)
call psb_bcast(icontxt,prec%aggr_filter) call psb_bcast(icontxt,prec%aggr_filter)
call psb_bcast(icontxt,prec%mnaggratio) call psb_bcast(icontxt,prec%mncrratio)
call psb_bcast(ictxt,prec%thrvsz) call psb_bcast(ictxt,prec%thrvsz)
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info) if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info)
call psb_bcast(ictxt,prec%athresv) call psb_bcast(ictxt,prec%athresv)
end if end if
call psb_bcast(ictxt,prec%athres) call psb_bcast(ictxt,prec%athres)
call psb_bcast(ictxt,prec%ascale)
call psb_bcast(ictxt,prec%aggr_omalg)
call psb_bcast(ictxt,prec%aggr_eig)
call psb_bcast(ictxt,prec%omega_val)
call psb_bcast(icontxt,prec%csize) call psb_bcast(icontxt,prec%csize)
call psb_bcast(icontxt,prec%cmat) call psb_bcast(icontxt,prec%cmat)

147
tests/fileread/mld_df_sample.f90
Unescape Escape View File

@ -68,23 +68,19 @@ program mld_df_sample
character(len=10) :: ptype ! preconditioner type character(len=10) :: ptype ! preconditioner type
! general AMG data ! general AMG data
character(len=16) :: mltype ! AMG cycle type character(len=16) :: mlcycle ! AMG cycle type
integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles
integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner
! AMG aggregation ! AMG aggregation
character(len=16) :: aggrkind ! aggregation type: SMOOTHED, NONSMOOTHED character(len=16) :: aggr_prol ! aggregation type: SMOOTHED, NONSMOOTHED
character(len=16) :: aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC character(len=16) :: par_aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC
character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE
character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER
real(psb_dpk_) :: mnaggratio ! minimum aggregation ratio real(psb_dpk_) :: mncrratio ! minimum aggregation ratio
real(psb_dpk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector real(psb_dpk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector
integer(psb_ipk_) :: thrvsz ! size of threshold vector integer(psb_ipk_) :: thrvsz ! size of threshold vector
real(psb_dpk_) :: athres ! smoothed aggregation threshold real(psb_dpk_) :: athres ! smoothed aggregation threshold
real(psb_dpk_) :: ascale ! smoothed aggregation scale factor for threshold
character(len=16) :: aggr_omalg ! algorithm for estimating omega parameter
character(len=16) :: aggr_eig ! Eigenvalue estimation procedure
real(psb_dpk_) :: omega_val ! Eigenvalue estimate value
integer(psb_ipk_) :: csize ! minimum size of coarsest matrix integer(psb_ipk_) :: csize ! minimum size of coarsest matrix
! AMG smoother or pre-smoother; also 1-lev preconditioner ! AMG smoother or pre-smoother; also 1-lev preconditioner
@ -364,20 +360,37 @@ program mld_df_sample
! !
! initialize the preconditioner ! initialize the preconditioner
! !
if (psb_toupper(p_choice%ptype) == 'ML') then call prec%init(p_choice%ptype,info)
select case(trim(psb_toupper(p_choice%ptype)))
case ('NONE','NOPREC','JACOBI')
! Do nothing, keep defaults
case ('BJAC')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case('AS')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case ('ML')
! multilevel preconditioner ! multilevel preconditioner
call prec%init(p_choice%ptype,info)
call prec%set('ml_type', p_choice%mltype, info) call prec%set('ml_cycle', p_choice%mlcycle, info)
call prec%set('outer_sweeps', p_choice%otr_sweeps,info) call prec%set('outer_sweeps', p_choice%otr_sweeps,info)
if (p_choice%csize>0)& if (p_choice%csize>0)&
& call prec%set('coarse_aggr_size', p_choice%csize, info) & call prec%set('min_coarse_size', p_choice%csize, info)
if (p_choice%mnaggratio>0)& if (p_choice%mncrratio>1)&
& call prec%set('min_aggr_ratio', p_choice%mnaggratio, info) & call prec%set('min_cr_ratio', p_choice%mncrratio, info)
if (p_choice%maxlevs>0)& if (p_choice%maxlevs>0)&
& call prec%set('max_prec_levs', p_choice%maxlevs, info) & call prec%set('max_levs', p_choice%maxlevs, info)
if (p_choice%ascale > dzero) &
& call prec%set('aggr_scale', p_choice%ascale, info)
if (p_choice%athres >= dzero) & if (p_choice%athres >= dzero) &
& call prec%set('aggr_thresh', p_choice%athres, info) & call prec%set('aggr_thresh', p_choice%athres, info)
if (p_choice%thrvsz>0) then if (p_choice%thrvsz>0) then
@ -386,16 +399,11 @@ program mld_df_sample
end do end do
end if end if
call prec%set('aggr_kind', p_choice%aggrkind, info) call prec%set('aggr_prol', p_choice%aggr_prol, info)
call prec%set('aggr_alg', p_choice%aggr_alg, info) call prec%set('par_aggr_alg', p_choice%par_aggr_alg, info)
call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_ord', p_choice%aggr_ord, info)
call prec%set('aggr_filter', p_choice%aggr_filter,info) call prec%set('aggr_filter', p_choice%aggr_filter,info)
call prec%set('aggr_omega_alg', p_choice%aggr_omalg, info)
if (psb_toupper(p_choice%aggr_omalg) == 'EIG_EST') then
call prec%set('aggr_eig', p_choice%aggr_eig, info)
else if (psb_toupper(p_choice%aggr_omalg) == 'USER_CHOICE') then
call prec%set('aggr_omega_val', p_choice%omega_val, info)
end if
call prec%set('coarse_solve', p_choice%csolve, info) call prec%set('coarse_solve', p_choice%csolve, info)
if (psb_toupper(p_choice%csolve) == 'BJAC') & if (psb_toupper(p_choice%csolve) == 'BJAC') &
& call prec%set('coarse_subsolve', p_choice%csbsolve, info) & call prec%set('coarse_subsolve', p_choice%csbsolve, info)
@ -424,50 +432,24 @@ program mld_df_sample
call prec%set('sub_fillin', p_choice%fill2, info,pos='post') call prec%set('sub_fillin', p_choice%fill2, info,pos='post')
call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post')
end if end if
end select
! build the preconditioner
call psb_barrier(ictxt) ! build the preconditioner
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%hierarchy_build(a,desc_a,info) t1 = psb_wtime()
thier = psb_wtime()-t1 call prec%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then thier = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld')
end if goto 9999
call psb_barrier(ictxt) end if
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%smoothers_build(a,desc_a,info) t1 = psb_wtime()
tprec = psb_wtime()-t1 call prec%smoothers_build(a,desc_a,info)
if (info /= psb_success_) then tprec = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld')
end if goto 9999
else
! 1-level preconditioner
nlv = 1
call prec%init(p_choice%ptype,info)
if (psb_toupper(p_choice%ptype) /= 'NONE') then
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
!!! call prec%set('solver_sweeps', p_choice%svsweeps, info)
end if
! build the preconditioner
thier = dzero
t1 = psb_wtime()
call prec%build(a,desc_a,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precbld')
goto 9999
end if
end if end if
call psb_amx(ictxt, thier) call psb_amx(ictxt, thier)
@ -480,7 +462,9 @@ program mld_df_sample
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
end if end if
iparm = 0 !
! iterative method parameters
!
call psb_barrier(ictxt) call psb_barrier(ictxt)
t1 = psb_wtime() t1 = psb_wtime()
call psb_krylov(s_choice%kmethd,a,prec,b_col,x_col,s_choice%eps,& call psb_krylov(s_choice%kmethd,a,prec,b_col,x_col,s_choice%eps,&
@ -628,16 +612,16 @@ contains
call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec
call read_data(prec%ptype,psb_inp_unit) ! preconditioner type call read_data(prec%ptype,psb_inp_unit) ! preconditioner type
! general AMG data ! general AMG data
call read_data(prec%mltype,psb_inp_unit) ! AMG cycle type call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type
call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles
call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec
call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat
! aggregation ! aggregation
call read_data(prec%aggrkind,psb_inp_unit) ! aggregation type call read_data(prec%aggr_prol,psb_inp_unit) ! aggregation type
call read_data(prec%aggr_alg,psb_inp_unit) ! parallel aggregation alg call read_data(prec%par_aggr_alg,psb_inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,psb_inp_unit) ! filtering call read_data(prec%aggr_filter,psb_inp_unit) ! filtering
call read_data(prec%mnaggratio,psb_inp_unit) ! minimum aggregation ratio call read_data(prec%mncrratio,psb_inp_unit) ! minimum aggregation ratio
call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info) call psb_realloc(prec%thrvsz,prec%athresv,info)
@ -646,9 +630,6 @@ contains
read(psb_inp_unit,*) ! dummy read to skip a record read(psb_inp_unit,*) ! dummy read to skip a record
end if end if
call read_data(prec%athres,psb_inp_unit) ! smoothed aggr thresh call read_data(prec%athres,psb_inp_unit) ! smoothed aggr thresh
call read_data(prec%aggr_omalg,psb_inp_unit) ! alg for estimating omega
call read_data(prec%aggr_eig,psb_inp_unit) ! alg for estimating omega
call read_data(prec%omega_val,psb_inp_unit) ! alg for estimating omega
! AMG smoother (or pre-smoother) / 1-lev preconditioner ! AMG smoother (or pre-smoother) / 1-lev preconditioner
call read_data(prec%smther,psb_inp_unit) ! smoother type call read_data(prec%smther,psb_inp_unit) ! smoother type
call read_data(prec%jsweeps,psb_inp_unit) ! (pre-)smoother / 1-lev prec sweeps call read_data(prec%jsweeps,psb_inp_unit) ! (pre-)smoother / 1-lev prec sweeps
@ -707,7 +688,7 @@ contains
! broadcast (other) AMG parameters ! broadcast (other) AMG parameters
if (psb_toupper(prec%ptype) == 'ML') then if (psb_toupper(prec%ptype) == 'ML') then
call psb_bcast(icontxt,prec%mltype) call psb_bcast(icontxt,prec%mlcycle)
call psb_bcast(icontxt,prec%otr_sweeps) call psb_bcast(icontxt,prec%otr_sweeps)
call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%maxlevs)
@ -720,21 +701,17 @@ contains
call psb_bcast(icontxt,prec%fill2) call psb_bcast(icontxt,prec%fill2)
call psb_bcast(icontxt,prec%thr2) call psb_bcast(icontxt,prec%thr2)
call psb_bcast(icontxt,prec%aggrkind) call psb_bcast(icontxt,prec%aggr_prol)
call psb_bcast(icontxt,prec%aggr_alg) call psb_bcast(icontxt,prec%par_aggr_alg)
call psb_bcast(icontxt,prec%aggr_ord) call psb_bcast(icontxt,prec%aggr_ord)
call psb_bcast(icontxt,prec%aggr_filter) call psb_bcast(icontxt,prec%aggr_filter)
call psb_bcast(icontxt,prec%mnaggratio) call psb_bcast(icontxt,prec%mncrratio)
call psb_bcast(ictxt,prec%thrvsz) call psb_bcast(ictxt,prec%thrvsz)
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info) if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info)
call psb_bcast(ictxt,prec%athresv) call psb_bcast(ictxt,prec%athresv)
end if end if
call psb_bcast(ictxt,prec%athres) call psb_bcast(ictxt,prec%athres)
call psb_bcast(ictxt,prec%ascale)
call psb_bcast(ictxt,prec%aggr_omalg)
call psb_bcast(ictxt,prec%aggr_eig)
call psb_bcast(ictxt,prec%omega_val)
call psb_bcast(icontxt,prec%csize) call psb_bcast(icontxt,prec%csize)
call psb_bcast(icontxt,prec%cmat) call psb_bcast(icontxt,prec%cmat)

147
tests/fileread/mld_sf_sample.f90
Unescape Escape View File

@ -68,23 +68,19 @@ program mld_sf_sample
character(len=10) :: ptype ! preconditioner type character(len=10) :: ptype ! preconditioner type
! general AMG data ! general AMG data
character(len=16) :: mltype ! AMG cycle type character(len=16) :: mlcycle ! AMG cycle type
integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles
integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner
! AMG aggregation ! AMG aggregation
character(len=16) :: aggrkind ! aggregation type: SMOOTHED, NONSMOOTHED character(len=16) :: aggr_prol ! aggregation type: SMOOTHED, NONSMOOTHED
character(len=16) :: aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC character(len=16) :: par_aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC
character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE
character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER
real(psb_spk_) :: mnaggratio ! minimum aggregation ratio real(psb_spk_) :: mncrratio ! minimum aggregation ratio
real(psb_spk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector real(psb_spk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector
integer(psb_ipk_) :: thrvsz ! size of threshold vector integer(psb_ipk_) :: thrvsz ! size of threshold vector
real(psb_spk_) :: athres ! smoothed aggregation threshold real(psb_spk_) :: athres ! smoothed aggregation threshold
real(psb_spk_) :: ascale ! smoothed aggregation scale factor for threshold
character(len=16) :: aggr_omalg ! algorithm for estimating omega parameter
character(len=16) :: aggr_eig ! Eigenvalue estimation procedure
real(psb_spk_) :: omega_val ! Eigenvalue estimate value
integer(psb_ipk_) :: csize ! minimum size of coarsest matrix integer(psb_ipk_) :: csize ! minimum size of coarsest matrix
! AMG smoother or pre-smoother; also 1-lev preconditioner ! AMG smoother or pre-smoother; also 1-lev preconditioner
@ -364,20 +360,37 @@ program mld_sf_sample
! !
! initialize the preconditioner ! initialize the preconditioner
! !
if (psb_toupper(p_choice%ptype) == 'ML') then call prec%init(p_choice%ptype,info)
select case(trim(psb_toupper(p_choice%ptype)))
case ('NONE','NOPREC','JACOBI')
! Do nothing, keep defaults
case ('BJAC')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case('AS')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case ('ML')
! multilevel preconditioner ! multilevel preconditioner
call prec%init(p_choice%ptype,info)
call prec%set('ml_type', p_choice%mltype, info) call prec%set('ml_cycle', p_choice%mlcycle, info)
call prec%set('outer_sweeps', p_choice%otr_sweeps,info) call prec%set('outer_sweeps', p_choice%otr_sweeps,info)
if (p_choice%csize>0)& if (p_choice%csize>0)&
& call prec%set('coarse_aggr_size', p_choice%csize, info) & call prec%set('min_coarse_size', p_choice%csize, info)
if (p_choice%mnaggratio>0)& if (p_choice%mncrratio>1)&
& call prec%set('min_aggr_ratio', p_choice%mnaggratio, info) & call prec%set('min_cr_ratio', p_choice%mncrratio, info)
if (p_choice%maxlevs>0)& if (p_choice%maxlevs>0)&
& call prec%set('max_prec_levs', p_choice%maxlevs, info) & call prec%set('max_levs', p_choice%maxlevs, info)
if (p_choice%ascale > dzero) &
& call prec%set('aggr_scale', p_choice%ascale, info)
if (p_choice%athres >= dzero) & if (p_choice%athres >= dzero) &
& call prec%set('aggr_thresh', p_choice%athres, info) & call prec%set('aggr_thresh', p_choice%athres, info)
if (p_choice%thrvsz>0) then if (p_choice%thrvsz>0) then
@ -386,16 +399,11 @@ program mld_sf_sample
end do end do
end if end if
call prec%set('aggr_kind', p_choice%aggrkind, info) call prec%set('aggr_prol', p_choice%aggr_prol, info)
call prec%set('aggr_alg', p_choice%aggr_alg, info) call prec%set('par_aggr_alg', p_choice%par_aggr_alg, info)
call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_ord', p_choice%aggr_ord, info)
call prec%set('aggr_filter', p_choice%aggr_filter,info) call prec%set('aggr_filter', p_choice%aggr_filter,info)
call prec%set('aggr_omega_alg', p_choice%aggr_omalg, info)
if (psb_toupper(p_choice%aggr_omalg) == 'EIG_EST') then
call prec%set('aggr_eig', p_choice%aggr_eig, info)
else if (psb_toupper(p_choice%aggr_omalg) == 'USER_CHOICE') then
call prec%set('aggr_omega_val', p_choice%omega_val, info)
end if
call prec%set('coarse_solve', p_choice%csolve, info) call prec%set('coarse_solve', p_choice%csolve, info)
if (psb_toupper(p_choice%csolve) == 'BJAC') & if (psb_toupper(p_choice%csolve) == 'BJAC') &
& call prec%set('coarse_subsolve', p_choice%csbsolve, info) & call prec%set('coarse_subsolve', p_choice%csbsolve, info)
@ -424,50 +432,24 @@ program mld_sf_sample
call prec%set('sub_fillin', p_choice%fill2, info,pos='post') call prec%set('sub_fillin', p_choice%fill2, info,pos='post')
call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post')
end if end if
end select
! build the preconditioner
call psb_barrier(ictxt) ! build the preconditioner
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%hierarchy_build(a,desc_a,info) t1 = psb_wtime()
thier = psb_wtime()-t1 call prec%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then thier = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld')
end if goto 9999
call psb_barrier(ictxt) end if
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%smoothers_build(a,desc_a,info) t1 = psb_wtime()
tprec = psb_wtime()-t1 call prec%smoothers_build(a,desc_a,info)
if (info /= psb_success_) then tprec = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld')
end if goto 9999
else
! 1-level preconditioner
nlv = 1
call prec%init(p_choice%ptype,info)
if (psb_toupper(p_choice%ptype) /= 'NONE') then
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
!!! call prec%set('solver_sweeps', p_choice%svsweeps, info)
end if
! build the preconditioner
thier = dzero
t1 = psb_wtime()
call prec%build(a,desc_a,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precbld')
goto 9999
end if
end if end if
call psb_amx(ictxt, thier) call psb_amx(ictxt, thier)
@ -480,7 +462,9 @@ program mld_sf_sample
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
end if end if
iparm = 0 !
! iterative method parameters
!
call psb_barrier(ictxt) call psb_barrier(ictxt)
t1 = psb_wtime() t1 = psb_wtime()
call psb_krylov(s_choice%kmethd,a,prec,b_col,x_col,s_choice%eps,& call psb_krylov(s_choice%kmethd,a,prec,b_col,x_col,s_choice%eps,&
@ -628,16 +612,16 @@ contains
call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec
call read_data(prec%ptype,psb_inp_unit) ! preconditioner type call read_data(prec%ptype,psb_inp_unit) ! preconditioner type
! general AMG data ! general AMG data
call read_data(prec%mltype,psb_inp_unit) ! AMG cycle type call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type
call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles
call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec
call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat
! aggregation ! aggregation
call read_data(prec%aggrkind,psb_inp_unit) ! aggregation type call read_data(prec%aggr_prol,psb_inp_unit) ! aggregation type
call read_data(prec%aggr_alg,psb_inp_unit) ! parallel aggregation alg call read_data(prec%par_aggr_alg,psb_inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,psb_inp_unit) ! filtering call read_data(prec%aggr_filter,psb_inp_unit) ! filtering
call read_data(prec%mnaggratio,psb_inp_unit) ! minimum aggregation ratio call read_data(prec%mncrratio,psb_inp_unit) ! minimum aggregation ratio
call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info) call psb_realloc(prec%thrvsz,prec%athresv,info)
@ -646,9 +630,6 @@ contains
read(psb_inp_unit,*) ! dummy read to skip a record read(psb_inp_unit,*) ! dummy read to skip a record
end if end if
call read_data(prec%athres,psb_inp_unit) ! smoothed aggr thresh call read_data(prec%athres,psb_inp_unit) ! smoothed aggr thresh
call read_data(prec%aggr_omalg,psb_inp_unit) ! alg for estimating omega
call read_data(prec%aggr_eig,psb_inp_unit) ! alg for estimating omega
call read_data(prec%omega_val,psb_inp_unit) ! alg for estimating omega
! AMG smoother (or pre-smoother) / 1-lev preconditioner ! AMG smoother (or pre-smoother) / 1-lev preconditioner
call read_data(prec%smther,psb_inp_unit) ! smoother type call read_data(prec%smther,psb_inp_unit) ! smoother type
call read_data(prec%jsweeps,psb_inp_unit) ! (pre-)smoother / 1-lev prec sweeps call read_data(prec%jsweeps,psb_inp_unit) ! (pre-)smoother / 1-lev prec sweeps
@ -707,7 +688,7 @@ contains
! broadcast (other) AMG parameters ! broadcast (other) AMG parameters
if (psb_toupper(prec%ptype) == 'ML') then if (psb_toupper(prec%ptype) == 'ML') then
call psb_bcast(icontxt,prec%mltype) call psb_bcast(icontxt,prec%mlcycle)
call psb_bcast(icontxt,prec%otr_sweeps) call psb_bcast(icontxt,prec%otr_sweeps)
call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%maxlevs)
@ -720,21 +701,17 @@ contains
call psb_bcast(icontxt,prec%fill2) call psb_bcast(icontxt,prec%fill2)
call psb_bcast(icontxt,prec%thr2) call psb_bcast(icontxt,prec%thr2)
call psb_bcast(icontxt,prec%aggrkind) call psb_bcast(icontxt,prec%aggr_prol)
call psb_bcast(icontxt,prec%aggr_alg) call psb_bcast(icontxt,prec%par_aggr_alg)
call psb_bcast(icontxt,prec%aggr_ord) call psb_bcast(icontxt,prec%aggr_ord)
call psb_bcast(icontxt,prec%aggr_filter) call psb_bcast(icontxt,prec%aggr_filter)
call psb_bcast(icontxt,prec%mnaggratio) call psb_bcast(icontxt,prec%mncrratio)
call psb_bcast(ictxt,prec%thrvsz) call psb_bcast(ictxt,prec%thrvsz)
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info) if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info)
call psb_bcast(ictxt,prec%athresv) call psb_bcast(ictxt,prec%athresv)
end if end if
call psb_bcast(ictxt,prec%athres) call psb_bcast(ictxt,prec%athres)
call psb_bcast(ictxt,prec%ascale)
call psb_bcast(ictxt,prec%aggr_omalg)
call psb_bcast(ictxt,prec%aggr_eig)
call psb_bcast(ictxt,prec%omega_val)
call psb_bcast(icontxt,prec%csize) call psb_bcast(icontxt,prec%csize)
call psb_bcast(icontxt,prec%cmat) call psb_bcast(icontxt,prec%cmat)

147
tests/fileread/mld_zf_sample.f90
Unescape Escape View File

@ -68,23 +68,19 @@ program mld_zf_sample
character(len=10) :: ptype ! preconditioner type character(len=10) :: ptype ! preconditioner type
! general AMG data ! general AMG data
character(len=16) :: mltype ! AMG cycle type character(len=16) :: mlcycle ! AMG cycle type
integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles
integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner
! AMG aggregation ! AMG aggregation
character(len=16) :: aggrkind ! aggregation type: SMOOTHED, NONSMOOTHED character(len=16) :: aggr_prol ! aggregation type: SMOOTHED, NONSMOOTHED
character(len=16) :: aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC character(len=16) :: par_aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC
character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE
character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER
real(psb_dpk_) :: mnaggratio ! minimum aggregation ratio real(psb_dpk_) :: mncrratio ! minimum aggregation ratio
real(psb_dpk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector real(psb_dpk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector
integer(psb_ipk_) :: thrvsz ! size of threshold vector integer(psb_ipk_) :: thrvsz ! size of threshold vector
real(psb_dpk_) :: athres ! smoothed aggregation threshold real(psb_dpk_) :: athres ! smoothed aggregation threshold
real(psb_dpk_) :: ascale ! smoothed aggregation scale factor for threshold
character(len=16) :: aggr_omalg ! algorithm for estimating omega parameter
character(len=16) :: aggr_eig ! Eigenvalue estimation procedure
real(psb_dpk_) :: omega_val ! Eigenvalue estimate value
integer(psb_ipk_) :: csize ! minimum size of coarsest matrix integer(psb_ipk_) :: csize ! minimum size of coarsest matrix
! AMG smoother or pre-smoother; also 1-lev preconditioner ! AMG smoother or pre-smoother; also 1-lev preconditioner
@ -364,20 +360,37 @@ program mld_zf_sample
! !
! initialize the preconditioner ! initialize the preconditioner
! !
if (psb_toupper(p_choice%ptype) == 'ML') then call prec%init(p_choice%ptype,info)
select case(trim(psb_toupper(p_choice%ptype)))
case ('NONE','NOPREC','JACOBI')
! Do nothing, keep defaults
case ('BJAC')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case('AS')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case ('ML')
! multilevel preconditioner ! multilevel preconditioner
call prec%init(p_choice%ptype,info)
call prec%set('ml_type', p_choice%mltype, info) call prec%set('ml_cycle', p_choice%mlcycle, info)
call prec%set('outer_sweeps', p_choice%otr_sweeps,info) call prec%set('outer_sweeps', p_choice%otr_sweeps,info)
if (p_choice%csize>0)& if (p_choice%csize>0)&
& call prec%set('coarse_aggr_size', p_choice%csize, info) & call prec%set('min_coarse_size', p_choice%csize, info)
if (p_choice%mnaggratio>0)& if (p_choice%mncrratio>1)&
& call prec%set('min_aggr_ratio', p_choice%mnaggratio, info) & call prec%set('min_cr_ratio', p_choice%mncrratio, info)
if (p_choice%maxlevs>0)& if (p_choice%maxlevs>0)&
& call prec%set('max_prec_levs', p_choice%maxlevs, info) & call prec%set('max_levs', p_choice%maxlevs, info)
if (p_choice%ascale > dzero) &
& call prec%set('aggr_scale', p_choice%ascale, info)
if (p_choice%athres >= dzero) & if (p_choice%athres >= dzero) &
& call prec%set('aggr_thresh', p_choice%athres, info) & call prec%set('aggr_thresh', p_choice%athres, info)
if (p_choice%thrvsz>0) then if (p_choice%thrvsz>0) then
@ -386,16 +399,11 @@ program mld_zf_sample
end do end do
end if end if
call prec%set('aggr_kind', p_choice%aggrkind, info) call prec%set('aggr_prol', p_choice%aggr_prol, info)
call prec%set('aggr_alg', p_choice%aggr_alg, info) call prec%set('par_aggr_alg', p_choice%par_aggr_alg, info)
call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_ord', p_choice%aggr_ord, info)
call prec%set('aggr_filter', p_choice%aggr_filter,info) call prec%set('aggr_filter', p_choice%aggr_filter,info)
call prec%set('aggr_omega_alg', p_choice%aggr_omalg, info)
if (psb_toupper(p_choice%aggr_omalg) == 'EIG_EST') then
call prec%set('aggr_eig', p_choice%aggr_eig, info)
else if (psb_toupper(p_choice%aggr_omalg) == 'USER_CHOICE') then
call prec%set('aggr_omega_val', p_choice%omega_val, info)
end if
call prec%set('coarse_solve', p_choice%csolve, info) call prec%set('coarse_solve', p_choice%csolve, info)
if (psb_toupper(p_choice%csolve) == 'BJAC') & if (psb_toupper(p_choice%csolve) == 'BJAC') &
& call prec%set('coarse_subsolve', p_choice%csbsolve, info) & call prec%set('coarse_subsolve', p_choice%csbsolve, info)
@ -424,50 +432,24 @@ program mld_zf_sample
call prec%set('sub_fillin', p_choice%fill2, info,pos='post') call prec%set('sub_fillin', p_choice%fill2, info,pos='post')
call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post')
end if end if
end select
! build the preconditioner
call psb_barrier(ictxt) ! build the preconditioner
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%hierarchy_build(a,desc_a,info) t1 = psb_wtime()
thier = psb_wtime()-t1 call prec%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then thier = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld')
end if goto 9999
call psb_barrier(ictxt) end if
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%smoothers_build(a,desc_a,info) t1 = psb_wtime()
tprec = psb_wtime()-t1 call prec%smoothers_build(a,desc_a,info)
if (info /= psb_success_) then tprec = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld')
end if goto 9999
else
! 1-level preconditioner
nlv = 1
call prec%init(p_choice%ptype,info)
if (psb_toupper(p_choice%ptype) /= 'NONE') then
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
!!! call prec%set('solver_sweeps', p_choice%svsweeps, info)
end if
! build the preconditioner
thier = dzero
t1 = psb_wtime()
call prec%build(a,desc_a,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precbld')
goto 9999
end if
end if end if
call psb_amx(ictxt, thier) call psb_amx(ictxt, thier)
@ -480,7 +462,9 @@ program mld_zf_sample
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
end if end if
iparm = 0 !
! iterative method parameters
!
call psb_barrier(ictxt) call psb_barrier(ictxt)
t1 = psb_wtime() t1 = psb_wtime()
call psb_krylov(s_choice%kmethd,a,prec,b_col,x_col,s_choice%eps,& call psb_krylov(s_choice%kmethd,a,prec,b_col,x_col,s_choice%eps,&
@ -628,16 +612,16 @@ contains
call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec
call read_data(prec%ptype,psb_inp_unit) ! preconditioner type call read_data(prec%ptype,psb_inp_unit) ! preconditioner type
! general AMG data ! general AMG data
call read_data(prec%mltype,psb_inp_unit) ! AMG cycle type call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type
call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles
call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec
call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat
! aggregation ! aggregation
call read_data(prec%aggrkind,psb_inp_unit) ! aggregation type call read_data(prec%aggr_prol,psb_inp_unit) ! aggregation type
call read_data(prec%aggr_alg,psb_inp_unit) ! parallel aggregation alg call read_data(prec%par_aggr_alg,psb_inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,psb_inp_unit) ! filtering call read_data(prec%aggr_filter,psb_inp_unit) ! filtering
call read_data(prec%mnaggratio,psb_inp_unit) ! minimum aggregation ratio call read_data(prec%mncrratio,psb_inp_unit) ! minimum aggregation ratio
call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info) call psb_realloc(prec%thrvsz,prec%athresv,info)
@ -646,9 +630,6 @@ contains
read(psb_inp_unit,*) ! dummy read to skip a record read(psb_inp_unit,*) ! dummy read to skip a record
end if end if
call read_data(prec%athres,psb_inp_unit) ! smoothed aggr thresh call read_data(prec%athres,psb_inp_unit) ! smoothed aggr thresh
call read_data(prec%aggr_omalg,psb_inp_unit) ! alg for estimating omega
call read_data(prec%aggr_eig,psb_inp_unit) ! alg for estimating omega
call read_data(prec%omega_val,psb_inp_unit) ! alg for estimating omega
! AMG smoother (or pre-smoother) / 1-lev preconditioner ! AMG smoother (or pre-smoother) / 1-lev preconditioner
call read_data(prec%smther,psb_inp_unit) ! smoother type call read_data(prec%smther,psb_inp_unit) ! smoother type
call read_data(prec%jsweeps,psb_inp_unit) ! (pre-)smoother / 1-lev prec sweeps call read_data(prec%jsweeps,psb_inp_unit) ! (pre-)smoother / 1-lev prec sweeps
@ -707,7 +688,7 @@ contains
! broadcast (other) AMG parameters ! broadcast (other) AMG parameters
if (psb_toupper(prec%ptype) == 'ML') then if (psb_toupper(prec%ptype) == 'ML') then
call psb_bcast(icontxt,prec%mltype) call psb_bcast(icontxt,prec%mlcycle)
call psb_bcast(icontxt,prec%otr_sweeps) call psb_bcast(icontxt,prec%otr_sweeps)
call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%maxlevs)
@ -720,21 +701,17 @@ contains
call psb_bcast(icontxt,prec%fill2) call psb_bcast(icontxt,prec%fill2)
call psb_bcast(icontxt,prec%thr2) call psb_bcast(icontxt,prec%thr2)
call psb_bcast(icontxt,prec%aggrkind) call psb_bcast(icontxt,prec%aggr_prol)
call psb_bcast(icontxt,prec%aggr_alg) call psb_bcast(icontxt,prec%par_aggr_alg)
call psb_bcast(icontxt,prec%aggr_ord) call psb_bcast(icontxt,prec%aggr_ord)
call psb_bcast(icontxt,prec%aggr_filter) call psb_bcast(icontxt,prec%aggr_filter)
call psb_bcast(icontxt,prec%mnaggratio) call psb_bcast(icontxt,prec%mncrratio)
call psb_bcast(ictxt,prec%thrvsz) call psb_bcast(ictxt,prec%thrvsz)
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info) if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info)
call psb_bcast(ictxt,prec%athresv) call psb_bcast(ictxt,prec%athresv)
end if end if
call psb_bcast(ictxt,prec%athres) call psb_bcast(ictxt,prec%athres)
call psb_bcast(ictxt,prec%ascale)
call psb_bcast(ictxt,prec%aggr_omalg)
call psb_bcast(ictxt,prec%aggr_eig)
call psb_bcast(ictxt,prec%omega_val)
call psb_bcast(icontxt,prec%csize) call psb_bcast(icontxt,prec%csize)
call psb_bcast(icontxt,prec%cmat) call psb_bcast(icontxt,prec%cmat)

20
tests/fileread/runs/dfs.inp
Unescape Escape View File

@ -1,11 +1,11 @@
mld_mat.mtx ! This matrix (and others) from: http://math.nist.gov/MatrixMarket/ or mld_mat.mtx ! This matrix (and others) from: http://math.nist.gov/MatrixMarket/ or
mld_rhs.mtx ! rhs | http://www.cise.ufl.edu/research/sparse/matrices/index.html mld_rhs.mtx ! rhs | http://www.cise.ufl.edu/research/sparse/matrices/index.html
NONE ! Initial guess NONE ! Initial guess
mld_sol.mtx ! Reference solution NONE !mld_sol.mtx ! Reference solution
MM ! File format: MatrixMarket or Harwell-Boeing MM ! File format: MatrixMarket or Harwell-Boeing
CSR ! Storage format: CSR COO JAD CSR ! Storage format: CSR COO JAD
BLOCK ! PART (partition method): BLOCK GRAPH GRAPH ! PART (partition method): BLOCK GRAPH
CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES BICGSTAB ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES
2 ! ISTOPC 2 ! ISTOPC
00500 ! ITMAX 00500 ! ITMAX
1 ! ITRACE 1 ! ITRACE
@ -13,24 +13,24 @@ CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS F
1.d-6 ! EPS 1.d-6 ! EPS
ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars) ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars)
ML ! Preconditioner type: NONE JACOBI BJAC AS ML ML ! Preconditioner type: NONE JACOBI BJAC AS ML
VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD WCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD
1 ! Number of outer sweeps 1 ! Number of outer sweeps
-3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default -3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default
-3 ! Target coarse matrix size; if <0, lib default -3 ! Target coarse matrix size; if <0, lib default
SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED
DEC ! Parallel aggregation: DEC, SYMDEC SYMDEC ! Parallel aggregation: DEC, SYMDEC
NATURAL ! Ordering of aggregation NATURAL DEGREE NATURAL ! Ordering of aggregation NATURAL DEGREE
NOFILTER ! Filtering of matrix ? FILTER NOFILTER NOFILTER ! Filtering of matrix ? FILTER NOFILTER
-1.5 ! Coarsening ratio, if < 0 use library default -1.5 ! Coarsening ratio, if < 0 use library default
2 ! Number of thresholds in vector, next line ignored if <= 0 2 ! Number of thresholds in vector, next line ignored if <= 0
0.05 0.025 ! Thresholds 0.05 0.025 ! Thresholds
0.0100d0 ! Smoothed aggregation threshold: >= 0.0 0.0100d0 ! Smoothed aggregation threshold: >= 0.0
FBGS ! Smoother type JACOBI GS BGS BJAC AS; ignored for non-ML BJAC ! Smoother type JACOBI GS BGS BJAC AS; ignored for non-ML
1 ! Number of sweeps for (pre) smoother 1 ! Number of sweeps for (pre) smoother
0 ! Number of overlap layers for AS preconditioner 0 ! Number of overlap layers for AS preconditioner
HALO ! AS restriction operator: NONE HALO HALO ! AS restriction operator: NONE HALO
NONE ! AS prolongation operator: NONE SUM AVG NONE ! AS prolongation operator: NONE SUM AVG
JACOBI ! Subdomain solver: JACOBI BS BGS ILU ILUT MILU MUMPS SLU UMF ILU ! Subdomain solver: JACOBI BS BGS ILU ILUT MILU MUMPS SLU UMF
0 ! Fill level P for ILU(P) and ILU(T,P) 0 ! Fill level P for ILU(P) and ILU(T,P)
1.d-4 ! Threshold T for ILU(T,P) 1.d-4 ! Threshold T for ILU(T,P)
NONE ! Second (post) smoother, ignored if NONE NONE ! Second (post) smoother, ignored if NONE
@ -41,9 +41,9 @@ NONE ! AS prolongation operator: NONE SUM AVG
JACOBI ! Subdomain solver: JACOBI BS BGS ILU ILUT MILU MUMPS SLU UMF JACOBI ! Subdomain solver: JACOBI BS BGS ILU ILUT MILU MUMPS SLU UMF
0 ! Fill level P for ILU(P) and ILU(T,P) 0 ! Fill level P for ILU(P) and ILU(T,P)
1.d-4 ! Threshold T for ILU(T,P) 1.d-4 ! Threshold T for ILU(T,P)
UMF ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC BJAC ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC
REPL ! Coarsest-level matrix distribution: DIST REPL DIST ! Coarsest-level matrix distribution: DIST REPL
UMF ! Coarsest-level subsolver: ILU UMF SLU MUMPS SLUDIST ILU ! Coarsest-level subsolver: ILU UMF SLU MUMPS SLUDIST
1 ! Coarsest-level fillin P for ILU(P) and ILU(T,P) 1 ! Coarsest-level fillin P for ILU(P) and ILU(T,P)
1.d-4 ! Coarsest-level threshold T for ILU(T,P) 1.d-4 ! Coarsest-level threshold T for ILU(T,P)
1 ! Number of Jacobi sweeps for JACOBI/GS/BJAC coarsest-level solver 1 ! Number of Jacobi sweeps for JACOBI/GS/BJAC coarsest-level solver

128
tests/pdegen/mld_d_pde2d.f90
Unescape Escape View File

@ -161,20 +161,19 @@ program mld_d_pde2d
character(len=10) :: ptype ! preconditioner type character(len=10) :: ptype ! preconditioner type
! general AMG data ! general AMG data
character(len=16) :: mltype ! AMG cycle type character(len=16) :: mlcycle ! AMG cycle type
integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles
integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner
! AMG aggregation ! AMG aggregation
character(len=16) :: aggrkind ! aggregation type: SMOOTHED, NONSMOOTHED character(len=16) :: aggr_prol ! aggregation type: SMOOTHED, NONSMOOTHED
character(len=16) :: aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC character(len=16) :: par_aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC
character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE
character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER
real(psb_dpk_) :: mnaggratio ! minimum aggregation ratio real(psb_dpk_) :: mncrratio ! minimum aggregation ratio
real(psb_dpk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector real(psb_dpk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector
integer(psb_ipk_) :: thrvsz ! size of threshold vector integer(psb_ipk_) :: thrvsz ! size of threshold vector
real(psb_dpk_) :: athres ! smoothed aggregation threshold real(psb_dpk_) :: athres ! smoothed aggregation threshold
real(psb_dpk_) :: ascale ! smoothed aggregation scale factor for threshold
integer(psb_ipk_) :: csize ! minimum size of coarsest matrix integer(psb_ipk_) :: csize ! minimum size of coarsest matrix
! AMG smoother or pre-smoother; also 1-lev preconditioner ! AMG smoother or pre-smoother; also 1-lev preconditioner
@ -267,20 +266,37 @@ program mld_d_pde2d
! !
! initialize the preconditioner ! initialize the preconditioner
! !
if (psb_toupper(p_choice%ptype) == 'ML') then call prec%init(p_choice%ptype,info)
select case(trim(psb_toupper(p_choice%ptype)))
case ('NONE','NOPREC','JACOBI')
! Do nothing, keep defaults
case ('BJAC')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case('AS')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case ('ML')
! multilevel preconditioner ! multilevel preconditioner
call prec%init(p_choice%ptype,info)
call prec%set('ml_type', p_choice%mltype, info) call prec%set('ml_cycle', p_choice%mlcycle, info)
call prec%set('outer_sweeps', p_choice%otr_sweeps,info) call prec%set('outer_sweeps', p_choice%otr_sweeps,info)
if (p_choice%csize>0)& if (p_choice%csize>0)&
& call prec%set('coarse_aggr_size', p_choice%csize, info) & call prec%set('min_coarse_size', p_choice%csize, info)
if (p_choice%mnaggratio>0)& if (p_choice%mncrratio>1)&
& call prec%set('min_aggr_ratio', p_choice%mnaggratio, info) & call prec%set('min_cr_ratio', p_choice%mncrratio, info)
if (p_choice%maxlevs>0)& if (p_choice%maxlevs>0)&
& call prec%set('max_prec_levs', p_choice%maxlevs, info) & call prec%set('max_levs', p_choice%maxlevs, info)
if (p_choice%ascale > dzero) &
& call prec%set('aggr_scale', p_choice%ascale, info)
if (p_choice%athres >= dzero) & if (p_choice%athres >= dzero) &
& call prec%set('aggr_thresh', p_choice%athres, info) & call prec%set('aggr_thresh', p_choice%athres, info)
if (p_choice%thrvsz>0) then if (p_choice%thrvsz>0) then
@ -289,10 +305,11 @@ program mld_d_pde2d
end do end do
end if end if
call prec%set('aggr_kind', p_choice%aggrkind, info) call prec%set('aggr_prol', p_choice%aggr_prol, info)
call prec%set('aggr_alg', p_choice%aggr_alg, info) call prec%set('par_aggr_alg', p_choice%par_aggr_alg, info)
call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_ord', p_choice%aggr_ord, info)
call prec%set('aggr_filter', p_choice%aggr_filter,info) call prec%set('aggr_filter', p_choice%aggr_filter,info)
call prec%set('coarse_solve', p_choice%csolve, info) call prec%set('coarse_solve', p_choice%csolve, info)
if (psb_toupper(p_choice%csolve) == 'BJAC') & if (psb_toupper(p_choice%csolve) == 'BJAC') &
& call prec%set('coarse_subsolve', p_choice%csbsolve, info) & call prec%set('coarse_subsolve', p_choice%csbsolve, info)
@ -321,50 +338,24 @@ program mld_d_pde2d
call prec%set('sub_fillin', p_choice%fill2, info,pos='post') call prec%set('sub_fillin', p_choice%fill2, info,pos='post')
call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post')
end if end if
end select
! build the preconditioner
call psb_barrier(ictxt) ! build the preconditioner
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%hierarchy_build(a,desc_a,info) t1 = psb_wtime()
thier = psb_wtime()-t1 call prec%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then thier = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld')
end if goto 9999
call psb_barrier(ictxt) end if
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%smoothers_build(a,desc_a,info) t1 = psb_wtime()
tprec = psb_wtime()-t1 call prec%smoothers_build(a,desc_a,info)
if (info /= psb_success_) then tprec = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld')
end if goto 9999
else
! 1-level preconditioner
nlv = 1
call prec%init(p_choice%ptype,info)
if (psb_toupper(p_choice%ptype) /= 'NONE') then
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
!!! call prec%set('solver_sweeps', p_choice%svsweeps, info)
end if
! build the preconditioner
thier = dzero
t1 = psb_wtime()
call prec%build(a,desc_a,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precbld')
goto 9999
end if
end if end if
call psb_amx(ictxt, thier) call psb_amx(ictxt, thier)
@ -496,16 +487,16 @@ contains
call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec
call read_data(prec%ptype,psb_inp_unit) ! preconditioner type call read_data(prec%ptype,psb_inp_unit) ! preconditioner type
! general AMG data ! general AMG data
call read_data(prec%mltype,psb_inp_unit) ! AMG cycle type call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type
call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles
call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec
call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat
! aggregation ! aggregation
call read_data(prec%aggrkind,psb_inp_unit) ! aggregation type call read_data(prec%aggr_prol,psb_inp_unit) ! aggregation type
call read_data(prec%aggr_alg,psb_inp_unit) ! parallel aggregation alg call read_data(prec%par_aggr_alg,psb_inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,psb_inp_unit) ! filtering call read_data(prec%aggr_filter,psb_inp_unit) ! filtering
call read_data(prec%mnaggratio,psb_inp_unit) ! minimum aggregation ratio call read_data(prec%mncrratio,psb_inp_unit) ! minimum aggregation ratio
call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info) call psb_realloc(prec%thrvsz,prec%athresv,info)
@ -567,7 +558,7 @@ contains
! broadcast (other) AMG parameters ! broadcast (other) AMG parameters
if (psb_toupper(prec%ptype) == 'ML') then if (psb_toupper(prec%ptype) == 'ML') then
call psb_bcast(icontxt,prec%mltype) call psb_bcast(icontxt,prec%mlcycle)
call psb_bcast(icontxt,prec%otr_sweeps) call psb_bcast(icontxt,prec%otr_sweeps)
call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%maxlevs)
@ -580,18 +571,17 @@ contains
call psb_bcast(icontxt,prec%fill2) call psb_bcast(icontxt,prec%fill2)
call psb_bcast(icontxt,prec%thr2) call psb_bcast(icontxt,prec%thr2)
call psb_bcast(icontxt,prec%aggrkind) call psb_bcast(icontxt,prec%aggr_prol)
call psb_bcast(icontxt,prec%aggr_alg) call psb_bcast(icontxt,prec%par_aggr_alg)
call psb_bcast(icontxt,prec%aggr_ord) call psb_bcast(icontxt,prec%aggr_ord)
call psb_bcast(icontxt,prec%aggr_filter) call psb_bcast(icontxt,prec%aggr_filter)
call psb_bcast(icontxt,prec%mnaggratio) call psb_bcast(icontxt,prec%mncrratio)
call psb_bcast(ictxt,prec%thrvsz) call psb_bcast(ictxt,prec%thrvsz)
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info) if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info)
call psb_bcast(ictxt,prec%athresv) call psb_bcast(ictxt,prec%athresv)
end if end if
call psb_bcast(ictxt,prec%athres) call psb_bcast(ictxt,prec%athres)
call psb_bcast(ictxt,prec%ascale)
call psb_bcast(icontxt,prec%csize) call psb_bcast(icontxt,prec%csize)
call psb_bcast(icontxt,prec%cmat) call psb_bcast(icontxt,prec%cmat)

128
tests/pdegen/mld_d_pde3d.f90
Unescape Escape View File

@ -173,20 +173,19 @@ program mld_d_pde3d
character(len=10) :: ptype ! preconditioner type character(len=10) :: ptype ! preconditioner type
! general AMG data ! general AMG data
character(len=16) :: mltype ! AMG cycle type character(len=16) :: mlcycle ! AMG cycle type
integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles
integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner
! AMG aggregation ! AMG aggregation
character(len=16) :: aggrkind ! aggregation type: SMOOTHED, NONSMOOTHED character(len=16) :: aggr_prol ! aggregation type: SMOOTHED, NONSMOOTHED
character(len=16) :: aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC character(len=16) :: par_aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC
character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE
character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER
real(psb_dpk_) :: mnaggratio ! minimum aggregation ratio real(psb_dpk_) :: mncrratio ! minimum aggregation ratio
real(psb_dpk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector real(psb_dpk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector
integer(psb_ipk_) :: thrvsz ! size of threshold vector integer(psb_ipk_) :: thrvsz ! size of threshold vector
real(psb_dpk_) :: athres ! smoothed aggregation threshold real(psb_dpk_) :: athres ! smoothed aggregation threshold
real(psb_dpk_) :: ascale ! smoothed aggregation scale factor for threshold
integer(psb_ipk_) :: csize ! minimum size of coarsest matrix integer(psb_ipk_) :: csize ! minimum size of coarsest matrix
! AMG smoother or pre-smoother; also 1-lev preconditioner ! AMG smoother or pre-smoother; also 1-lev preconditioner
@ -280,20 +279,37 @@ program mld_d_pde3d
! !
! initialize the preconditioner ! initialize the preconditioner
! !
if (psb_toupper(p_choice%ptype) == 'ML') then call prec%init(p_choice%ptype,info)
select case(trim(psb_toupper(p_choice%ptype)))
case ('NONE','NOPREC','JACOBI')
! Do nothing, keep defaults
case ('BJAC')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case('AS')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case ('ML')
! multilevel preconditioner ! multilevel preconditioner
call prec%init(p_choice%ptype,info)
call prec%set('ml_type', p_choice%mltype, info) call prec%set('ml_cycle', p_choice%mlcycle, info)
call prec%set('outer_sweeps', p_choice%otr_sweeps,info) call prec%set('outer_sweeps', p_choice%otr_sweeps,info)
if (p_choice%csize>0)& if (p_choice%csize>0)&
& call prec%set('coarse_aggr_size', p_choice%csize, info) & call prec%set('min_coarse_size', p_choice%csize, info)
if (p_choice%mnaggratio>0)& if (p_choice%mncrratio>1)&
& call prec%set('min_aggr_ratio', p_choice%mnaggratio, info) & call prec%set('min_cr_ratio', p_choice%mncrratio, info)
if (p_choice%maxlevs>0)& if (p_choice%maxlevs>0)&
& call prec%set('max_prec_levs', p_choice%maxlevs, info) & call prec%set('max_levs', p_choice%maxlevs, info)
if (p_choice%ascale > dzero) &
& call prec%set('aggr_scale', p_choice%ascale, info)
if (p_choice%athres >= dzero) & if (p_choice%athres >= dzero) &
& call prec%set('aggr_thresh', p_choice%athres, info) & call prec%set('aggr_thresh', p_choice%athres, info)
if (p_choice%thrvsz>0) then if (p_choice%thrvsz>0) then
@ -302,10 +318,11 @@ program mld_d_pde3d
end do end do
end if end if
call prec%set('aggr_kind', p_choice%aggrkind, info) call prec%set('aggr_prol', p_choice%aggr_prol, info)
call prec%set('aggr_alg', p_choice%aggr_alg, info) call prec%set('par_aggr_alg', p_choice%par_aggr_alg, info)
call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_ord', p_choice%aggr_ord, info)
call prec%set('aggr_filter', p_choice%aggr_filter,info) call prec%set('aggr_filter', p_choice%aggr_filter,info)
call prec%set('coarse_solve', p_choice%csolve, info) call prec%set('coarse_solve', p_choice%csolve, info)
if (psb_toupper(p_choice%csolve) == 'BJAC') & if (psb_toupper(p_choice%csolve) == 'BJAC') &
& call prec%set('coarse_subsolve', p_choice%csbsolve, info) & call prec%set('coarse_subsolve', p_choice%csbsolve, info)
@ -334,50 +351,24 @@ program mld_d_pde3d
call prec%set('sub_fillin', p_choice%fill2, info,pos='post') call prec%set('sub_fillin', p_choice%fill2, info,pos='post')
call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post')
end if end if
end select
! build the preconditioner
call psb_barrier(ictxt) ! build the preconditioner
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%hierarchy_build(a,desc_a,info) t1 = psb_wtime()
thier = psb_wtime()-t1 call prec%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then thier = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld')
end if goto 9999
call psb_barrier(ictxt) end if
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%smoothers_build(a,desc_a,info) t1 = psb_wtime()
tprec = psb_wtime()-t1 call prec%smoothers_build(a,desc_a,info)
if (info /= psb_success_) then tprec = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld')
end if goto 9999
else
! 1-level preconditioner
nlv = 1
call prec%init(p_choice%ptype,info)
if (psb_toupper(p_choice%ptype) /= 'NONE') then
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
!!! call prec%set('solver_sweeps', p_choice%svsweeps, info)
end if
! build the preconditioner
thier = dzero
t1 = psb_wtime()
call prec%build(a,desc_a,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precbld')
goto 9999
end if
end if end if
call psb_amx(ictxt, thier) call psb_amx(ictxt, thier)
@ -509,16 +500,16 @@ contains
call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec
call read_data(prec%ptype,psb_inp_unit) ! preconditioner type call read_data(prec%ptype,psb_inp_unit) ! preconditioner type
! general AMG data ! general AMG data
call read_data(prec%mltype,psb_inp_unit) ! AMG cycle type call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type
call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles
call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec
call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat
! aggregation ! aggregation
call read_data(prec%aggrkind,psb_inp_unit) ! aggregation type call read_data(prec%aggr_prol,psb_inp_unit) ! aggregation type
call read_data(prec%aggr_alg,psb_inp_unit) ! parallel aggregation alg call read_data(prec%par_aggr_alg,psb_inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,psb_inp_unit) ! filtering call read_data(prec%aggr_filter,psb_inp_unit) ! filtering
call read_data(prec%mnaggratio,psb_inp_unit) ! minimum aggregation ratio call read_data(prec%mncrratio,psb_inp_unit) ! minimum aggregation ratio
call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info) call psb_realloc(prec%thrvsz,prec%athresv,info)
@ -580,7 +571,7 @@ contains
! broadcast (other) AMG parameters ! broadcast (other) AMG parameters
if (psb_toupper(prec%ptype) == 'ML') then if (psb_toupper(prec%ptype) == 'ML') then
call psb_bcast(icontxt,prec%mltype) call psb_bcast(icontxt,prec%mlcycle)
call psb_bcast(icontxt,prec%otr_sweeps) call psb_bcast(icontxt,prec%otr_sweeps)
call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%maxlevs)
@ -593,18 +584,17 @@ contains
call psb_bcast(icontxt,prec%fill2) call psb_bcast(icontxt,prec%fill2)
call psb_bcast(icontxt,prec%thr2) call psb_bcast(icontxt,prec%thr2)
call psb_bcast(icontxt,prec%aggrkind) call psb_bcast(icontxt,prec%aggr_prol)
call psb_bcast(icontxt,prec%aggr_alg) call psb_bcast(icontxt,prec%par_aggr_alg)
call psb_bcast(icontxt,prec%aggr_ord) call psb_bcast(icontxt,prec%aggr_ord)
call psb_bcast(icontxt,prec%aggr_filter) call psb_bcast(icontxt,prec%aggr_filter)
call psb_bcast(icontxt,prec%mnaggratio) call psb_bcast(icontxt,prec%mncrratio)
call psb_bcast(ictxt,prec%thrvsz) call psb_bcast(ictxt,prec%thrvsz)
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info) if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info)
call psb_bcast(ictxt,prec%athresv) call psb_bcast(ictxt,prec%athresv)
end if end if
call psb_bcast(ictxt,prec%athres) call psb_bcast(ictxt,prec%athres)
call psb_bcast(ictxt,prec%ascale)
call psb_bcast(icontxt,prec%csize) call psb_bcast(icontxt,prec%csize)
call psb_bcast(icontxt,prec%cmat) call psb_bcast(icontxt,prec%cmat)

128
tests/pdegen/mld_s_pde2d.f90
Unescape Escape View File

@ -161,20 +161,19 @@ program mld_s_pde2d
character(len=10) :: ptype ! preconditioner type character(len=10) :: ptype ! preconditioner type
! general AMG data ! general AMG data
character(len=16) :: mltype ! AMG cycle type character(len=16) :: mlcycle ! AMG cycle type
integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles
integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner
! AMG aggregation ! AMG aggregation
character(len=16) :: aggrkind ! aggregation type: SMOOTHED, NONSMOOTHED character(len=16) :: aggr_prol ! aggregation type: SMOOTHED, NONSMOOTHED
character(len=16) :: aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC character(len=16) :: par_aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC
character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE
character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER
real(psb_spk_) :: mnaggratio ! minimum aggregation ratio real(psb_spk_) :: mncrratio ! minimum aggregation ratio
real(psb_spk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector real(psb_spk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector
integer(psb_ipk_) :: thrvsz ! size of threshold vector integer(psb_ipk_) :: thrvsz ! size of threshold vector
real(psb_spk_) :: athres ! smoothed aggregation threshold real(psb_spk_) :: athres ! smoothed aggregation threshold
real(psb_spk_) :: ascale ! smoothed aggregation scale factor for threshold
integer(psb_ipk_) :: csize ! minimum size of coarsest matrix integer(psb_ipk_) :: csize ! minimum size of coarsest matrix
! AMG smoother or pre-smoother; also 1-lev preconditioner ! AMG smoother or pre-smoother; also 1-lev preconditioner
@ -267,20 +266,37 @@ program mld_s_pde2d
! !
! initialize the preconditioner ! initialize the preconditioner
! !
if (psb_toupper(p_choice%ptype) == 'ML') then call prec%init(p_choice%ptype,info)
select case(trim(psb_toupper(p_choice%ptype)))
case ('NONE','NOPREC','JACOBI')
! Do nothing, keep defaults
case ('BJAC')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case('AS')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case ('ML')
! multilevel preconditioner ! multilevel preconditioner
call prec%init(p_choice%ptype,info)
call prec%set('ml_type', p_choice%mltype, info) call prec%set('ml_cycle', p_choice%mlcycle, info)
call prec%set('outer_sweeps', p_choice%otr_sweeps,info) call prec%set('outer_sweeps', p_choice%otr_sweeps,info)
if (p_choice%csize>0)& if (p_choice%csize>0)&
& call prec%set('coarse_aggr_size', p_choice%csize, info) & call prec%set('min_coarse_size', p_choice%csize, info)
if (p_choice%mnaggratio>0)& if (p_choice%mncrratio>1)&
& call prec%set('min_aggr_ratio', p_choice%mnaggratio, info) & call prec%set('min_cr_ratio', p_choice%mncrratio, info)
if (p_choice%maxlevs>0)& if (p_choice%maxlevs>0)&
& call prec%set('max_prec_levs', p_choice%maxlevs, info) & call prec%set('max_levs', p_choice%maxlevs, info)
if (p_choice%ascale > dzero) &
& call prec%set('aggr_scale', p_choice%ascale, info)
if (p_choice%athres >= dzero) & if (p_choice%athres >= dzero) &
& call prec%set('aggr_thresh', p_choice%athres, info) & call prec%set('aggr_thresh', p_choice%athres, info)
if (p_choice%thrvsz>0) then if (p_choice%thrvsz>0) then
@ -289,10 +305,11 @@ program mld_s_pde2d
end do end do
end if end if
call prec%set('aggr_kind', p_choice%aggrkind, info) call prec%set('aggr_prol', p_choice%aggr_prol, info)
call prec%set('aggr_alg', p_choice%aggr_alg, info) call prec%set('par_aggr_alg', p_choice%par_aggr_alg, info)
call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_ord', p_choice%aggr_ord, info)
call prec%set('aggr_filter', p_choice%aggr_filter,info) call prec%set('aggr_filter', p_choice%aggr_filter,info)
call prec%set('coarse_solve', p_choice%csolve, info) call prec%set('coarse_solve', p_choice%csolve, info)
if (psb_toupper(p_choice%csolve) == 'BJAC') & if (psb_toupper(p_choice%csolve) == 'BJAC') &
& call prec%set('coarse_subsolve', p_choice%csbsolve, info) & call prec%set('coarse_subsolve', p_choice%csbsolve, info)
@ -321,50 +338,24 @@ program mld_s_pde2d
call prec%set('sub_fillin', p_choice%fill2, info,pos='post') call prec%set('sub_fillin', p_choice%fill2, info,pos='post')
call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post')
end if end if
end select
! build the preconditioner
call psb_barrier(ictxt) ! build the preconditioner
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%hierarchy_build(a,desc_a,info) t1 = psb_wtime()
thier = psb_wtime()-t1 call prec%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then thier = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld')
end if goto 9999
call psb_barrier(ictxt) end if
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%smoothers_build(a,desc_a,info) t1 = psb_wtime()
tprec = psb_wtime()-t1 call prec%smoothers_build(a,desc_a,info)
if (info /= psb_success_) then tprec = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld')
end if goto 9999
else
! 1-level preconditioner
nlv = 1
call prec%init(p_choice%ptype,info)
if (psb_toupper(p_choice%ptype) /= 'NONE') then
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
!!! call prec%set('solver_sweeps', p_choice%svsweeps, info)
end if
! build the preconditioner
thier = dzero
t1 = psb_wtime()
call prec%build(a,desc_a,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precbld')
goto 9999
end if
end if end if
call psb_amx(ictxt, thier) call psb_amx(ictxt, thier)
@ -496,16 +487,16 @@ contains
call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec
call read_data(prec%ptype,psb_inp_unit) ! preconditioner type call read_data(prec%ptype,psb_inp_unit) ! preconditioner type
! general AMG data ! general AMG data
call read_data(prec%mltype,psb_inp_unit) ! AMG cycle type call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type
call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles
call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec
call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat
! aggregation ! aggregation
call read_data(prec%aggrkind,psb_inp_unit) ! aggregation type call read_data(prec%aggr_prol,psb_inp_unit) ! aggregation type
call read_data(prec%aggr_alg,psb_inp_unit) ! parallel aggregation alg call read_data(prec%par_aggr_alg,psb_inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,psb_inp_unit) ! filtering call read_data(prec%aggr_filter,psb_inp_unit) ! filtering
call read_data(prec%mnaggratio,psb_inp_unit) ! minimum aggregation ratio call read_data(prec%mncrratio,psb_inp_unit) ! minimum aggregation ratio
call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info) call psb_realloc(prec%thrvsz,prec%athresv,info)
@ -567,7 +558,7 @@ contains
! broadcast (other) AMG parameters ! broadcast (other) AMG parameters
if (psb_toupper(prec%ptype) == 'ML') then if (psb_toupper(prec%ptype) == 'ML') then
call psb_bcast(icontxt,prec%mltype) call psb_bcast(icontxt,prec%mlcycle)
call psb_bcast(icontxt,prec%otr_sweeps) call psb_bcast(icontxt,prec%otr_sweeps)
call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%maxlevs)
@ -580,18 +571,17 @@ contains
call psb_bcast(icontxt,prec%fill2) call psb_bcast(icontxt,prec%fill2)
call psb_bcast(icontxt,prec%thr2) call psb_bcast(icontxt,prec%thr2)
call psb_bcast(icontxt,prec%aggrkind) call psb_bcast(icontxt,prec%aggr_prol)
call psb_bcast(icontxt,prec%aggr_alg) call psb_bcast(icontxt,prec%par_aggr_alg)
call psb_bcast(icontxt,prec%aggr_ord) call psb_bcast(icontxt,prec%aggr_ord)
call psb_bcast(icontxt,prec%aggr_filter) call psb_bcast(icontxt,prec%aggr_filter)
call psb_bcast(icontxt,prec%mnaggratio) call psb_bcast(icontxt,prec%mncrratio)
call psb_bcast(ictxt,prec%thrvsz) call psb_bcast(ictxt,prec%thrvsz)
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info) if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info)
call psb_bcast(ictxt,prec%athresv) call psb_bcast(ictxt,prec%athresv)
end if end if
call psb_bcast(ictxt,prec%athres) call psb_bcast(ictxt,prec%athres)
call psb_bcast(ictxt,prec%ascale)
call psb_bcast(icontxt,prec%csize) call psb_bcast(icontxt,prec%csize)
call psb_bcast(icontxt,prec%cmat) call psb_bcast(icontxt,prec%cmat)

128
tests/pdegen/mld_s_pde3d.f90
Unescape Escape View File

@ -173,20 +173,19 @@ program mld_s_pde3d
character(len=10) :: ptype ! preconditioner type character(len=10) :: ptype ! preconditioner type
! general AMG data ! general AMG data
character(len=16) :: mltype ! AMG cycle type character(len=16) :: mlcycle ! AMG cycle type
integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles
integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner
! AMG aggregation ! AMG aggregation
character(len=16) :: aggrkind ! aggregation type: SMOOTHED, NONSMOOTHED character(len=16) :: aggr_prol ! aggregation type: SMOOTHED, NONSMOOTHED
character(len=16) :: aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC character(len=16) :: par_aggr_alg ! parallel aggregation algorithm: DEC, SYMDEC
character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE character(len=16) :: aggr_ord ! ordering for aggregation: NATURAL, DEGREE
character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER character(len=16) :: aggr_filter ! filtering: FILTER, NO_FILTER
real(psb_spk_) :: mnaggratio ! minimum aggregation ratio real(psb_spk_) :: mncrratio ! minimum aggregation ratio
real(psb_spk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector real(psb_spk_), allocatable :: athresv(:) ! smoothed aggregation threshold vector
integer(psb_ipk_) :: thrvsz ! size of threshold vector integer(psb_ipk_) :: thrvsz ! size of threshold vector
real(psb_spk_) :: athres ! smoothed aggregation threshold real(psb_spk_) :: athres ! smoothed aggregation threshold
real(psb_spk_) :: ascale ! smoothed aggregation scale factor for threshold
integer(psb_ipk_) :: csize ! minimum size of coarsest matrix integer(psb_ipk_) :: csize ! minimum size of coarsest matrix
! AMG smoother or pre-smoother; also 1-lev preconditioner ! AMG smoother or pre-smoother; also 1-lev preconditioner
@ -280,20 +279,37 @@ program mld_s_pde3d
! !
! initialize the preconditioner ! initialize the preconditioner
! !
if (psb_toupper(p_choice%ptype) == 'ML') then call prec%init(p_choice%ptype,info)
select case(trim(psb_toupper(p_choice%ptype)))
case ('NONE','NOPREC','JACOBI')
! Do nothing, keep defaults
case ('BJAC')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case('AS')
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
case ('ML')
! multilevel preconditioner ! multilevel preconditioner
call prec%init(p_choice%ptype,info)
call prec%set('ml_type', p_choice%mltype, info) call prec%set('ml_cycle', p_choice%mlcycle, info)
call prec%set('outer_sweeps', p_choice%otr_sweeps,info) call prec%set('outer_sweeps', p_choice%otr_sweeps,info)
if (p_choice%csize>0)& if (p_choice%csize>0)&
& call prec%set('coarse_aggr_size', p_choice%csize, info) & call prec%set('min_coarse_size', p_choice%csize, info)
if (p_choice%mnaggratio>0)& if (p_choice%mncrratio>1)&
& call prec%set('min_aggr_ratio', p_choice%mnaggratio, info) & call prec%set('min_cr_ratio', p_choice%mncrratio, info)
if (p_choice%maxlevs>0)& if (p_choice%maxlevs>0)&
& call prec%set('max_prec_levs', p_choice%maxlevs, info) & call prec%set('max_levs', p_choice%maxlevs, info)
if (p_choice%ascale > dzero) &
& call prec%set('aggr_scale', p_choice%ascale, info)
if (p_choice%athres >= dzero) & if (p_choice%athres >= dzero) &
& call prec%set('aggr_thresh', p_choice%athres, info) & call prec%set('aggr_thresh', p_choice%athres, info)
if (p_choice%thrvsz>0) then if (p_choice%thrvsz>0) then
@ -302,10 +318,11 @@ program mld_s_pde3d
end do end do
end if end if
call prec%set('aggr_kind', p_choice%aggrkind, info) call prec%set('aggr_prol', p_choice%aggr_prol, info)
call prec%set('aggr_alg', p_choice%aggr_alg, info) call prec%set('par_aggr_alg', p_choice%par_aggr_alg, info)
call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_ord', p_choice%aggr_ord, info)
call prec%set('aggr_filter', p_choice%aggr_filter,info) call prec%set('aggr_filter', p_choice%aggr_filter,info)
call prec%set('coarse_solve', p_choice%csolve, info) call prec%set('coarse_solve', p_choice%csolve, info)
if (psb_toupper(p_choice%csolve) == 'BJAC') & if (psb_toupper(p_choice%csolve) == 'BJAC') &
& call prec%set('coarse_subsolve', p_choice%csbsolve, info) & call prec%set('coarse_subsolve', p_choice%csbsolve, info)
@ -334,50 +351,24 @@ program mld_s_pde3d
call prec%set('sub_fillin', p_choice%fill2, info,pos='post') call prec%set('sub_fillin', p_choice%fill2, info,pos='post')
call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post')
end if end if
end select
! build the preconditioner
call psb_barrier(ictxt) ! build the preconditioner
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%hierarchy_build(a,desc_a,info) t1 = psb_wtime()
thier = psb_wtime()-t1 call prec%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then thier = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld')
end if goto 9999
call psb_barrier(ictxt) end if
t1 = psb_wtime() call psb_barrier(ictxt)
call prec%smoothers_build(a,desc_a,info) t1 = psb_wtime()
tprec = psb_wtime()-t1 call prec%smoothers_build(a,desc_a,info)
if (info /= psb_success_) then tprec = psb_wtime()-t1
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld') if (info /= psb_success_) then
goto 9999 call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smoothers_bld')
end if goto 9999
else
! 1-level preconditioner
nlv = 1
call prec%init(p_choice%ptype,info)
if (psb_toupper(p_choice%ptype) /= 'NONE') then
call prec%set('smoother_sweeps', p_choice%jsweeps, info)
call prec%set('sub_ovr', p_choice%novr, info)
call prec%set('sub_restr', p_choice%restr, info)
call prec%set('sub_prol', p_choice%prol, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('sub_fillin', p_choice%fill, info)
call prec%set('sub_iluthrs', p_choice%thr, info)
!!! call prec%set('solver_sweeps', p_choice%svsweeps, info)
end if
! build the preconditioner
thier = dzero
t1 = psb_wtime()
call prec%build(a,desc_a,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precbld')
goto 9999
end if
end if end if
call psb_amx(ictxt, thier) call psb_amx(ictxt, thier)
@ -509,16 +500,16 @@ contains
call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec
call read_data(prec%ptype,psb_inp_unit) ! preconditioner type call read_data(prec%ptype,psb_inp_unit) ! preconditioner type
! general AMG data ! general AMG data
call read_data(prec%mltype,psb_inp_unit) ! AMG cycle type call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type
call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles
call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec
call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat
! aggregation ! aggregation
call read_data(prec%aggrkind,psb_inp_unit) ! aggregation type call read_data(prec%aggr_prol,psb_inp_unit) ! aggregation type
call read_data(prec%aggr_alg,psb_inp_unit) ! parallel aggregation alg call read_data(prec%par_aggr_alg,psb_inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation call read_data(prec%aggr_ord,psb_inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,psb_inp_unit) ! filtering call read_data(prec%aggr_filter,psb_inp_unit) ! filtering
call read_data(prec%mnaggratio,psb_inp_unit) ! minimum aggregation ratio call read_data(prec%mncrratio,psb_inp_unit) ! minimum aggregation ratio
call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector call read_data(prec%thrvsz,psb_inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info) call psb_realloc(prec%thrvsz,prec%athresv,info)
@ -580,7 +571,7 @@ contains
! broadcast (other) AMG parameters ! broadcast (other) AMG parameters
if (psb_toupper(prec%ptype) == 'ML') then if (psb_toupper(prec%ptype) == 'ML') then
call psb_bcast(icontxt,prec%mltype) call psb_bcast(icontxt,prec%mlcycle)
call psb_bcast(icontxt,prec%otr_sweeps) call psb_bcast(icontxt,prec%otr_sweeps)
call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%maxlevs)
@ -593,18 +584,17 @@ contains
call psb_bcast(icontxt,prec%fill2) call psb_bcast(icontxt,prec%fill2)
call psb_bcast(icontxt,prec%thr2) call psb_bcast(icontxt,prec%thr2)
call psb_bcast(icontxt,prec%aggrkind) call psb_bcast(icontxt,prec%aggr_prol)
call psb_bcast(icontxt,prec%aggr_alg) call psb_bcast(icontxt,prec%par_aggr_alg)
call psb_bcast(icontxt,prec%aggr_ord) call psb_bcast(icontxt,prec%aggr_ord)
call psb_bcast(icontxt,prec%aggr_filter) call psb_bcast(icontxt,prec%aggr_filter)
call psb_bcast(icontxt,prec%mnaggratio) call psb_bcast(icontxt,prec%mncrratio)
call psb_bcast(ictxt,prec%thrvsz) call psb_bcast(ictxt,prec%thrvsz)
if (prec%thrvsz > 0) then if (prec%thrvsz > 0) then
if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info) if (iam /= psb_root_) call psb_realloc(prec%thrvsz,prec%athresv,info)
call psb_bcast(ictxt,prec%athresv) call psb_bcast(ictxt,prec%athresv)
end if end if
call psb_bcast(ictxt,prec%athres) call psb_bcast(ictxt,prec%athres)
call psb_bcast(ictxt,prec%ascale)
call psb_bcast(icontxt,prec%csize) call psb_bcast(icontxt,prec%csize)
call psb_bcast(icontxt,prec%cmat) call psb_bcast(icontxt,prec%cmat)

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

@ -8,7 +8,7 @@ CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS F
1.d-6 ! EPS 1.d-6 ! EPS
ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars) ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars)
ML ! Preconditioner type: NONE JACOBI BJAC AS ML ML ! Preconditioner type: NONE JACOBI BJAC AS ML
VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE KCYCLESYM MULT ADD
1 ! Number of outer sweeps 1 ! Number of outer sweeps
-3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default -3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default
-3 ! Target coarse matrix size; if <0, lib default -3 ! Target coarse matrix size; if <0, lib default

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

@ -1,5 +1,5 @@
CSR ! Storage format CSR COO JAD CSR ! Storage format CSR COO JAD
0080 ! IDIM; domain size is idim**3 040 ! IDIM; domain size is idim**3
CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES
2 ! ISTOPC 2 ! ISTOPC
00500 ! ITMAX 00500 ! ITMAX

Write Preview
Loading…
Cancel
Save