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

mld2p4:

Browse Source 
docs/pdf/userinterface.tex
 docs/userguide.pdf
 mlprec/mld_cbaseprec_bld.f90
 mlprec/mld_cfact_bld.f90
 mlprec/mld_cmlprec_bld.f90
 mlprec/mld_cprecbld.f90
 mlprec/mld_cprecinit.f90
 mlprec/mld_cprecset.f90
 mlprec/mld_csub_aply.f90
 mlprec/mld_csub_solve.f90
 mlprec/mld_dbaseprec_bld.f90
 mlprec/mld_dfact_bld.f90
 mlprec/mld_dmlprec_bld.f90
 mlprec/mld_dprecbld.f90
 mlprec/mld_dprecinit.f90
 mlprec/mld_dprecset.f90
 mlprec/mld_dsub_aply.f90
 mlprec/mld_dsub_solve.f90
 mlprec/mld_prec_type.f90
 mlprec/mld_sbaseprec_bld.f90
 mlprec/mld_sfact_bld.f90
 mlprec/mld_smlprec_bld.f90
 mlprec/mld_sprecbld.f90
 mlprec/mld_sprecinit.f90
 mlprec/mld_sprecset.f90
 mlprec/mld_ssub_aply.f90
 mlprec/mld_ssub_solve.f90
 mlprec/mld_zbaseprec_bld.f90
 mlprec/mld_zfact_bld.f90
 mlprec/mld_zmlprec_bld.f90
 mlprec/mld_zprecbld.f90
 mlprec/mld_zprecinit.f90
 mlprec/mld_zprecset.f90
 mlprec/mld_zsub_aply.f90
 mlprec/mld_zsub_solve.f90
 test/fileread/cf_sample.f90
 test/fileread/df_bench.f90
 test/fileread/df_sample.f90
 test/fileread/runs/cfs.inp
 test/fileread/runs/dfs.inp
 test/fileread/runs/sfs.inp
 test/fileread/runs/zfs.inp
 test/fileread/sf_sample.f90
 test/fileread/zf_bench.f90
 test/fileread/zf_sample.f90
 test/pargen/ppde.f90
 test/pargen/spde.f90

Fixes for: consistency checks in preconditioners.
stopcriterion
Salvatore Filippone 17 years ago
parent 9bf85f340a
commit 9c85e54740
47 changed files with 1196 additions and 1205 deletions
Show Stats Download Patch File Download Diff File

7
docs/pdf/userinterface.tex
Unescape Escape View File

@ -242,15 +242,14 @@ aggregation. Currently only the infinity norm of the matrix A is available\\
& 'DISTR'
& Coarse matrix: distributed or replicated \\
\verb|mld_coarse_solve_| & \verb|character(len=*)|
& 'BJAC' \ \ \ 'UMF' \ \ \ 'SLUDIST'
& 'BJAC' \ \ \ 'UMF' \ \ \ 'SLU' \ \ \ 'SLUDIST'
& 'BJAC'
& \textbf{VEDI OSSERVAZIONI EMAIL 15-16/06/08} available solver for coarse system.
Only 'BJAC' and 'SLUDIST' can be used for distributed coarse matrix. 'BJAC' corresponds to some sweeps of a block-Jacobi solver, while 'SLUDIST' corresponds
& Only 'BJAC' and 'SLUDIST' can be used for distributed coarse matrix. 'BJAC' corresponds to some sweeps of a block-Jacobi solver, while 'SLUDIST' corresponds
to the use of the external package SuperLU\_Dist~\cite{SUPERLUDIST}, version 2.0, for distributed sparse factorization and solve. \\
\verb|mld_coarse_subsolve_| & \verb|character(len=*)|
& 'ILU' \ \ \ 'MILU' \ \ \ 'ILUT' \ \ \ 'UMF' \ \ \ 'SLU'
& 'UMF'
& \textbf{VEDI OSSERVAZIONI EMAIL 15-16/06/08} available solver for diagonal local blocks of the coarse matrix, when 'BJAC' is used as coarse solver\\
& available solver for diagonal local blocks of the coarse matrix, when 'BJAC' is used as coarse solver\\
\verb|mld_coarse_sweeps_|& \verb|integer|
& any number $> 0$
& 4

740
docs/userguide.pdf
View File

File diff suppressed because it is too large Load Diff

2
mlprec/mld_cbaseprec_bld.f90
Unescape Escape View File

@ -173,7 +173,7 @@ subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
if (debug_level >= psb_debug_outer_) &

8
mlprec/mld_cfact_bld.f90
Unescape Escape View File

@ -194,7 +194,7 @@ subroutine mld_cfact_bld(a,p,upd,info,blck)
! Clip into p%av(ap_nd_) the off block-diagonal part of the local
! matrix. The clipped matrix is then stored in CSR format.
!
if (p%iprcparm(mld_smooth_sweeps_) > 1) then
if (p%iprcparm(mld_smoother_sweeps_) > 1) then
call psb_sp_clip(atmp,p%av(mld_ap_nd_),info,&
& jmin=atmp%m+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,&
@ -213,7 +213,7 @@ subroutine mld_cfact_bld(a,p,upd,info,blck)
! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor.
!
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
end if
if (debug_level >= psb_debug_outer_) &
@ -303,7 +303,7 @@ subroutine mld_cfact_bld(a,p,upd,info,blck)
! clipped matrix is then stored in CSR format.
!
if (p%iprcparm(mld_smooth_sweeps_) > 1) then
if (p%iprcparm(mld_smoother_sweeps_) > 1) then
n_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data)
nrow_a = a%m
@ -330,7 +330,7 @@ subroutine mld_cfact_bld(a,p,upd,info,blck)
! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor.
!
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
call psb_sp_free(atmp,info)
if (info/=0) then

2
mlprec/mld_cmlprec_bld.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info)
end select
call mld_check_def(p%rprcparm(mld_aggr_damp_),'Omega',szero,is_legal_s_omega)
call mld_check_def(p%rprcparm(mld_aggr_thresh_),'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
call mld_check_def(p%iprcparm(mld_smooth_sweeps_),'Jacobi sweeps',&
call mld_check_def(p%iprcparm(mld_smoother_sweeps_),'Jacobi sweeps',&
& 1,is_legal_jac_sweeps)
!

55
mlprec/mld_cprecbld.f90
Unescape Escape View File

@ -80,6 +80,7 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
integer :: debug_level, debug_unit
@ -137,6 +138,17 @@ subroutine mld_cprecbld(a,desc_a,p,info)
end if
if (iszv >= 1) then
!
! Check on the iprcparm contents: they should be the same
! on all processes.
!
if (me == psb_root_) ipv(:) = p%baseprecv(1)%iprcparm(:)
call psb_bcast(ictxt,ipv)
if (any(ipv(:) /= p%baseprecv(1)%iprcparm(:) )) then
write(debug_unit,*) me,name,&
&': Inconsistent arguments among processes, forcing a default'
p%baseprecv(1)%iprcparm(:) = ipv(:)
end if
!
! Allocate and build the fine level preconditioner
!
@ -162,6 +174,17 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! levels
!
do i=2, iszv
!
! Check on the iprcparm contents: they should be the same
! on all processes.
!
if (me == psb_root_) ipv(:) = p%baseprecv(i)%iprcparm(:)
call psb_bcast(ictxt,ipv)
if (any(ipv(:) /= p%baseprecv(i)%iprcparm(:) )) then
write(debug_unit,*) me,name,&
&': Inconsistent arguments among processes, resetting.'
p%baseprecv(i)%iprcparm(:) = ipv(:)
end if
!
! Allocate the av component of the preconditioner data type
@ -173,6 +196,38 @@ subroutine mld_cprecbld(a,desc_a,p,info)
!
call mld_check_def(p%baseprecv(i)%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%baseprecv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%baseprecv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%baseprecv(i)%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%baseprecv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%baseprecv(i)%iprcparm(mld_sub_solve_) = val
p%baseprecv(i)%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%baseprecv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%baseprecv(i)%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%baseprecv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(i)%iprcparm(mld_sub_solve_) = val
p%baseprecv(i)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(i)%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end if
call init_baseprc_av(p%baseprecv(i),info)

14
mlprec/mld_cprecinit.f90
Unescape Escape View File

@ -124,7 +124,7 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('DIAG')
nlev_ = 1
@ -140,7 +140,7 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('BJAC')
nlev_ = 1
@ -157,7 +157,7 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('AS')
nlev_ = 1
@ -174,7 +174,7 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('ML')
@ -198,7 +198,7 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1
@ -220,7 +220,7 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0
end do
ilev_ = nlev_
@ -242,7 +242,7 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 4
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0
case default

273
mlprec/mld_cprecset.f90
Unescape Escape View File

@ -109,7 +109,8 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
info = 3111
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
return
endif
@ -124,7 +125,7 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smooth_sweeps_)
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smoother_sweeps_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -135,7 +136,7 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
@ -145,20 +146,38 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
if (nlev_ > 1) then
p%baseprecv(nlev_)%iprcparm(mld_coarse_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_smoother_type_) = mld_bjac_
select case (val)
case(mld_umf_, mld_slu_)
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
case default
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
end select
endif
case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
@ -174,65 +193,90 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
& ': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) then
p%baseprecv(nlev_)%iprcparm(mld_coarse_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_smoother_type_) = mld_bjac_
select case (val)
case(mld_umf_, mld_slu_)
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
case default
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
end select
endif
case(mld_coarse_subsolve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
end if
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
@ -314,117 +358,10 @@ subroutine mld_cprecsetc(p,what,string,info,ilev)
return
endif
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
if (ilev_ == 1) then
!
! Rules for fine level are slightly different.
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_)
call mld_stringval(string,val,info)
if ((nlev_ > 1).and.(val==mld_noprec_)) then
write(0,*) name,': Error: invalid WHAT'
info = -2
endif
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_)
call mld_stringval(string,val,info)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
call mld_stringval(string,val,info)
if (info == 0) call mld_precset(p,what,val,info,ilev=ilev)
end subroutine mld_cprecsetc

16
mlprec/mld_csub_aply.f90
Unescape Escape View File

@ -93,8 +93,8 @@
! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel
! preconditioner.
!
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(smooth_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(smooth_sweeps_) > 1. Furthermore
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(mld_smoother_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(mld_smoother_sweeps_) > 1. Furthermore
! Tasks 1, 2 and 3 may be performed when the matrix A is
! distributed among the processes (prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_),
! while task 4 may be performed when A is replicated on the processes
@ -126,7 +126,7 @@
! If trans='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of K^(-1)).
! if trans='C','c' then op(K^(-1)) = K^(-C) (transpose conjugate of K^(-1)).
! If prec%iprcparm(smooth_sweeps_) > 1, the value of trans provided
! If prec%iprcparm(mld_smoother_sweeps_) > 1, the value of trans provided
! in input is ignored.
! work - complex(psb_spk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data).
@ -200,7 +200,7 @@ subroutine mld_csub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
endif
if (prec%iprcparm(mld_smooth_sweeps_) == 1) then
if (prec%iprcparm(mld_smoother_sweeps_) == 1) then
call mld_sub_solve(alpha,prec,x,beta,y,desc_data,trans_,aux,info)
@ -209,10 +209,10 @@ subroutine mld_csub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
goto 9999
endif
else if (prec%iprcparm(mld_smooth_sweeps_) > 1) then
else if (prec%iprcparm(mld_smoother_sweeps_) > 1) then
!
!
! Apply prec%iprcparm(smooth_sweeps_) sweeps of a block-Jacobi solver
! Apply prec%iprcparm(mld_smoother_sweeps_) sweeps of a block-Jacobi solver
! to compute an approximate solution of a linear system.
!
@ -231,7 +231,7 @@ subroutine mld_csub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
tx = czero
ty = czero
do i=1, prec%iprcparm(mld_smooth_sweeps_)
do i=1, prec%iprcparm(mld_smoother_sweeps_)
!
! Compute Y(j+1) = D^(-1)*(X-ND*Y(j)), where D and ND are the
! block diagonal part and the remaining part of the local matrix
@ -267,7 +267,7 @@ subroutine mld_csub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
info = 10
call psb_errpush(info,name,&
& i_err=(/2,prec%iprcparm(mld_smooth_sweeps_),0,0,0/))
& i_err=(/2,prec%iprcparm(mld_smoother_sweeps_),0,0,0/))
goto 9999
endif

2
mlprec/mld_csub_solve.f90
Unescape Escape View File

@ -104,7 +104,7 @@
! If trans='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of K^(-1)).
! if trans='C','c' then op(K^(-1)) = K^(-C) (transpose conjugate of K^(-1)).
! If prec%iprcparm(smooth_sweeps_) > 1, the value of trans provided
! If prec%iprcparm(mld_smoother_sweeps_) > 1, the value of trans provided
! in input is ignored.
! work - complex(psb_spk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data).

2
mlprec/mld_dbaseprec_bld.f90
Unescape Escape View File

@ -173,7 +173,7 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
if (debug_level >= psb_debug_outer_) &

8
mlprec/mld_dfact_bld.f90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine mld_dfact_bld(a,p,upd,info,blck)
! Clip into p%av(ap_nd_) the off block-diagonal part of the local
! matrix. The clipped matrix is then stored in CSR format.
!
if (p%iprcparm(mld_smooth_sweeps_) > 1) then
if (p%iprcparm(mld_smoother_sweeps_) > 1) then
call psb_sp_clip(atmp,p%av(mld_ap_nd_),info,&
& jmin=atmp%m+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,&
@ -212,7 +212,7 @@ subroutine mld_dfact_bld(a,p,upd,info,blck)
! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor.
!
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
end if
if (debug_level >= psb_debug_outer_) &
@ -302,7 +302,7 @@ subroutine mld_dfact_bld(a,p,upd,info,blck)
! clipped matrix is then stored in CSR format.
!
if (p%iprcparm(mld_smooth_sweeps_) > 1) then
if (p%iprcparm(mld_smoother_sweeps_) > 1) then
n_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data)
nrow_a = a%m
@ -329,7 +329,7 @@ subroutine mld_dfact_bld(a,p,upd,info,blck)
! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor.
!
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
call psb_sp_free(atmp,info)
if (info/=0) then

2
mlprec/mld_dmlprec_bld.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
end select
call mld_check_def(p%rprcparm(mld_aggr_damp_),'Omega',dzero,is_legal_omega)
call mld_check_def(p%rprcparm(mld_aggr_thresh_),'Aggr_Thresh',dzero,is_legal_aggr_thrs)
call mld_check_def(p%iprcparm(mld_smooth_sweeps_),'Jacobi sweeps',&
call mld_check_def(p%iprcparm(mld_smoother_sweeps_),'Jacobi sweeps',&
& 1,is_legal_jac_sweeps)
!

55
mlprec/mld_dprecbld.f90
Unescape Escape View File

@ -80,6 +80,7 @@ subroutine mld_dprecbld(a,desc_a,p,info)
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
integer :: debug_level, debug_unit
@ -137,6 +138,17 @@ subroutine mld_dprecbld(a,desc_a,p,info)
end if
if (iszv >= 1) then
!
! Check on the iprcparm contents: they should be the same
! on all processes.
!
if (me == psb_root_) ipv(:) = p%baseprecv(1)%iprcparm(:)
call psb_bcast(ictxt,ipv)
if (any(ipv(:) /= p%baseprecv(1)%iprcparm(:) )) then
write(debug_unit,*) me,name,&
&': Inconsistent arguments among processes, forcing a default'
p%baseprecv(1)%iprcparm(:) = ipv(:)
end if
!
! Allocate and build the fine level preconditioner
!
@ -162,6 +174,17 @@ subroutine mld_dprecbld(a,desc_a,p,info)
! levels
!
do i=2, iszv
!
! Check on the iprcparm contents: they should be the same
! on all processes.
!
if (me == psb_root_) ipv(:) = p%baseprecv(i)%iprcparm(:)
call psb_bcast(ictxt,ipv)
if (any(ipv(:) /= p%baseprecv(i)%iprcparm(:) )) then
write(debug_unit,*) me,name,&
&': Inconsistent arguments among processes, resetting.'
p%baseprecv(i)%iprcparm(:) = ipv(:)
end if
!
! Allocate the av component of the preconditioner data type
@ -173,6 +196,38 @@ subroutine mld_dprecbld(a,desc_a,p,info)
!
call mld_check_def(p%baseprecv(i)%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%baseprecv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%baseprecv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%baseprecv(i)%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%baseprecv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%baseprecv(i)%iprcparm(mld_sub_solve_) = val
p%baseprecv(i)%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%baseprecv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%baseprecv(i)%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%baseprecv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(i)%iprcparm(mld_sub_solve_) = val
p%baseprecv(i)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(i)%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end if
call init_baseprc_av(p%baseprecv(i),info)

14
mlprec/mld_dprecinit.f90
Unescape Escape View File

@ -124,7 +124,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('DIAG')
nlev_ = 1
@ -140,7 +140,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('BJAC')
nlev_ = 1
@ -157,7 +157,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('AS')
nlev_ = 1
@ -174,7 +174,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('ML')
@ -198,7 +198,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1
@ -220,7 +220,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
end do
ilev_ = nlev_
@ -242,7 +242,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 4
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
case default

282
mlprec/mld_dprecset.f90
Unescape Escape View File

@ -76,14 +76,14 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
implicit none
! Arguments
! Arguments
type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
! Local variables
! Local variables
integer :: ilev_, nlev_
character(len=*), parameter :: name='mld_precseti'
@ -109,7 +109,8 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
info = 3111
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
return
endif
@ -117,14 +118,14 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
if (ilev_ == 1) then
!
! Rules for fine level are slightly different.
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smooth_sweeps_)
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smoother_sweeps_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -135,7 +136,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
@ -145,20 +146,38 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
if (nlev_ > 1) then
p%baseprecv(nlev_)%iprcparm(mld_coarse_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_smoother_type_) = mld_bjac_
select case (val)
case(mld_umf_, mld_slu_)
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
case default
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
end select
endif
case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
@ -174,65 +193,90 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
& ': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) then
p%baseprecv(nlev_)%iprcparm(mld_coarse_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_smoother_type_) = mld_bjac_
select case (val)
case(mld_umf_, mld_slu_)
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
case default
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
end select
endif
case(mld_coarse_subsolve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
end if
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
@ -285,9 +329,9 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
! Local variables
! Local variables
integer :: ilev_, nlev_,val
character(len=*), parameter :: name='mld_precseti'
character(len=*), parameter :: name='mld_precsetc'
info = 0
@ -314,117 +358,9 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
return
endif
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
if (ilev_ == 1) then
!
! Rules for fine level are slightly different.
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_)
call mld_stringval(string,val,info)
if ((nlev_ > 1).and.(val==mld_noprec_)) then
write(0,*) name,': Error: invalid WHAT'
info = -2
endif
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_)
call mld_stringval(string,val,info)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
call mld_stringval(string,val,info)
if (info == 0) call mld_precset(p,what,val,info,ilev=ilev)
end subroutine mld_dprecsetc

16
mlprec/mld_dsub_aply.f90
Unescape Escape View File

@ -93,8 +93,8 @@
! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel
! preconditioner.
!
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(smooth_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(smooth_sweeps_) > 1. Furthermore
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(mld_smoother_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(mld_smoother_sweeps_) > 1. Furthermore
! Tasks 1, 2 and 3 may be performed when the matrix A is
! distributed among the processes (prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_),
! while task 4 may be performed when A is replicated on the processes
@ -125,7 +125,7 @@
! trans - character(len=1), input.
! If trans='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of K^(-1)).
! If prec%iprcparm(smooth_sweeps_) > 1, the value of trans provided
! If prec%iprcparm(mld_smoother_sweeps_) > 1, the value of trans provided
! in input is ignored.
! work - real(psb_dpk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data).
@ -199,7 +199,7 @@ subroutine mld_dsub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
endif
if (prec%iprcparm(mld_smooth_sweeps_) == 1) then
if (prec%iprcparm(mld_smoother_sweeps_) == 1) then
call mld_sub_solve(alpha,prec,x,beta,y,desc_data,trans_,aux,info)
@ -208,10 +208,10 @@ subroutine mld_dsub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
goto 9999
endif
else if (prec%iprcparm(mld_smooth_sweeps_) > 1) then
else if (prec%iprcparm(mld_smoother_sweeps_) > 1) then
!
!
! Apply prec%iprcparm(smooth_sweeps_) sweeps of a block-Jacobi solver
! Apply prec%iprcparm(mld_smoother_sweeps_) sweeps of a block-Jacobi solver
! to compute an approximate solution of a linear system.
!
!
@ -231,7 +231,7 @@ subroutine mld_dsub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
tx = dzero
ty = dzero
do i=1, prec%iprcparm(mld_smooth_sweeps_)
do i=1, prec%iprcparm(mld_smoother_sweeps_)
!
! Compute Y(j+1) = D^(-1)*(X-ND*Y(j)), where D and ND are the
! block diagonal part and the remaining part of the local matrix
@ -267,7 +267,7 @@ subroutine mld_dsub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
info = 10
call psb_errpush(info,name,&
& i_err=(/2,prec%iprcparm(mld_smooth_sweeps_),0,0,0/))
& i_err=(/2,prec%iprcparm(mld_smoother_sweeps_),0,0,0/))
goto 9999
endif

2
mlprec/mld_dsub_solve.f90
Unescape Escape View File

@ -103,7 +103,7 @@
! trans - character(len=1), input.
! If trans='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of K^(-1)).
! If prec%iprcparm(smooth_sweeps_) > 1, the value of trans provided
! If prec%iprcparm(mld_smoother_sweeps_) > 1, the value of trans provided
! in input is ignored.
! work - real(psb_dpk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data).

55
mlprec/mld_prec_type.f90
Unescape Escape View File

@ -236,30 +236,31 @@ module mld_prec_type
!
! Entries in iprcparm
!
integer, parameter :: mld_smoother_type_ = 1
integer, parameter :: mld_sub_solve_ = 2
integer, parameter :: mld_sub_restr_ = 3
integer, parameter :: mld_sub_prol_ = 4
integer, parameter :: mld_sub_ren_ = 5
integer, parameter :: mld_sub_ovr_ = 6
integer, parameter :: mld_sub_fillin_ = 8
integer, parameter :: mld_smooth_sweeps_ = 9
integer, parameter :: mld_ml_type_ = 10
integer, parameter :: mld_smoother_pos_ = 11
integer, parameter :: mld_aggr_kind_ = 12
integer, parameter :: mld_aggr_alg_ = 13
integer, parameter :: mld_aggr_eig_ = 14
integer, parameter :: mld_coarse_mat_ = 16
integer, parameter :: mld_smoother_type_ = 1
integer, parameter :: mld_sub_solve_ = 2
integer, parameter :: mld_sub_restr_ = 3
integer, parameter :: mld_sub_prol_ = 4
integer, parameter :: mld_sub_ren_ = 5
integer, parameter :: mld_sub_ovr_ = 6
integer, parameter :: mld_sub_fillin_ = 8
integer, parameter :: mld_smoother_sweeps_ = 9
integer, parameter :: mld_ml_type_ = 10
integer, parameter :: mld_smoother_pos_ = 11
integer, parameter :: mld_aggr_kind_ = 12
integer, parameter :: mld_aggr_alg_ = 13
integer, parameter :: mld_aggr_eig_ = 14
integer, parameter :: mld_coarse_mat_ = 16
!! 2 ints for 64 bit versions
integer, parameter :: mld_slu_ptr_ = 17
integer, parameter :: mld_umf_symptr_ = 17
integer, parameter :: mld_umf_numptr_ = 19
integer, parameter :: mld_slud_ptr_ = 21
integer, parameter :: mld_prec_status_ = 24
integer, parameter :: mld_coarse_solve_ = 25
integer, parameter :: mld_coarse_sweeps_ = 26
integer, parameter :: mld_coarse_fillin_ = 27
integer, parameter :: mld_ifpsz_ = 32
integer, parameter :: mld_slu_ptr_ = 17
integer, parameter :: mld_umf_symptr_ = 17
integer, parameter :: mld_umf_numptr_ = 19
integer, parameter :: mld_slud_ptr_ = 21
integer, parameter :: mld_prec_status_ = 24
integer, parameter :: mld_coarse_solve_ = 25
integer, parameter :: mld_coarse_sweeps_ = 26
integer, parameter :: mld_coarse_fillin_ = 27
integer, parameter :: mld_coarse_subsolve_ = 28
integer, parameter :: mld_ifpsz_ = 32
!
! Legal values for entry: mld_smoother_type_
@ -811,7 +812,7 @@ contains
write(iout_,*) 'Should never get here!'
end select
write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_))
& (p%baseprecv(ilev)%iprcparm(mld_smoother_sweeps_))
end if
end do
end if
@ -924,7 +925,7 @@ contains
write(iout_,*) 'Should never get here!'
end select
write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_))
& (p%baseprecv(ilev)%iprcparm(mld_smoother_sweeps_))
end if
end do
end if
@ -1057,7 +1058,7 @@ contains
write(iout_,*) 'Should never get here!'
end select
write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_))
& (p%baseprecv(ilev)%iprcparm(mld_smoother_sweeps_))
end if
end do
end if
@ -1169,7 +1170,7 @@ contains
write(iout_,*) 'Should never get here!'
end select
write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_))
& (p%baseprecv(ilev)%iprcparm(mld_smoother_sweeps_))
end if
end do
end if

2
mlprec/mld_sbaseprec_bld.f90
Unescape Escape View File

@ -173,7 +173,7 @@ subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
if (debug_level >= psb_debug_outer_) &

8
mlprec/mld_sfact_bld.f90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine mld_sfact_bld(a,p,upd,info,blck)
! Clip into p%av(ap_nd_) the off block-diagonal part of the local
! matrix. The clipped matrix is then stored in CSR format.
!
if (p%iprcparm(mld_smooth_sweeps_) > 1) then
if (p%iprcparm(mld_smoother_sweeps_) > 1) then
call psb_sp_clip(atmp,p%av(mld_ap_nd_),info,&
& jmin=atmp%m+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,&
@ -212,7 +212,7 @@ subroutine mld_sfact_bld(a,p,upd,info,blck)
! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor.
!
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
end if
if (debug_level >= psb_debug_outer_) &
@ -302,7 +302,7 @@ subroutine mld_sfact_bld(a,p,upd,info,blck)
! clipped matrix is then stored in CSR format.
!
if (p%iprcparm(mld_smooth_sweeps_) > 1) then
if (p%iprcparm(mld_smoother_sweeps_) > 1) then
n_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data)
nrow_a = a%m
@ -329,7 +329,7 @@ subroutine mld_sfact_bld(a,p,upd,info,blck)
! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor.
!
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
call psb_sp_free(atmp,info)
if (info/=0) then

2
mlprec/mld_smlprec_bld.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info)
end select
call mld_check_def(p%rprcparm(mld_aggr_damp_),'Omega',szero,is_legal_s_omega)
call mld_check_def(p%rprcparm(mld_aggr_thresh_),'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
call mld_check_def(p%iprcparm(mld_smooth_sweeps_),'Jacobi sweeps',&
call mld_check_def(p%iprcparm(mld_smoother_sweeps_),'Jacobi sweeps',&
& 1,is_legal_jac_sweeps)
!

55
mlprec/mld_sprecbld.f90
Unescape Escape View File

@ -80,6 +80,7 @@ subroutine mld_sprecbld(a,desc_a,p,info)
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
integer :: debug_level, debug_unit
@ -137,6 +138,17 @@ subroutine mld_sprecbld(a,desc_a,p,info)
end if
if (iszv >= 1) then
!
! Check on the iprcparm contents: they should be the same
! on all processes.
!
if (me == psb_root_) ipv(:) = p%baseprecv(1)%iprcparm(:)
call psb_bcast(ictxt,ipv)
if (any(ipv(:) /= p%baseprecv(1)%iprcparm(:) )) then
write(debug_unit,*) me,name,&
&': Inconsistent arguments among processes, forcing a default'
p%baseprecv(1)%iprcparm(:) = ipv(:)
end if
!
! Allocate and build the fine level preconditioner
!
@ -162,6 +174,17 @@ subroutine mld_sprecbld(a,desc_a,p,info)
! levels
!
do i=2, iszv
!
! Check on the iprcparm contents: they should be the same
! on all processes.
!
if (me == psb_root_) ipv(:) = p%baseprecv(i)%iprcparm(:)
call psb_bcast(ictxt,ipv)
if (any(ipv(:) /= p%baseprecv(i)%iprcparm(:) )) then
write(debug_unit,*) me,name,&
&': Inconsistent arguments among processes, resetting.'
p%baseprecv(i)%iprcparm(:) = ipv(:)
end if
!
! Allocate the av component of the preconditioner data type
@ -173,6 +196,38 @@ subroutine mld_sprecbld(a,desc_a,p,info)
!
call mld_check_def(p%baseprecv(i)%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%baseprecv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%baseprecv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%baseprecv(i)%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%baseprecv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%baseprecv(i)%iprcparm(mld_sub_solve_) = val
p%baseprecv(i)%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%baseprecv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%baseprecv(i)%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%baseprecv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(i)%iprcparm(mld_sub_solve_) = val
p%baseprecv(i)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(i)%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end if
call init_baseprc_av(p%baseprecv(i),info)

14
mlprec/mld_sprecinit.f90
Unescape Escape View File

@ -124,7 +124,7 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('DIAG')
nlev_ = 1
@ -140,7 +140,7 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('BJAC')
nlev_ = 1
@ -157,7 +157,7 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('AS')
nlev_ = 1
@ -174,7 +174,7 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('ML')
@ -198,7 +198,7 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1
@ -220,7 +220,7 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0
end do
ilev_ = nlev_
@ -242,7 +242,7 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 4
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0
case default

272
mlprec/mld_sprecset.f90
Unescape Escape View File

@ -109,7 +109,8 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
info = 3111
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
return
endif
@ -124,7 +125,7 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smooth_sweeps_)
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smoother_sweeps_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -135,7 +136,7 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
@ -145,20 +146,38 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
if (nlev_ > 1) then
p%baseprecv(nlev_)%iprcparm(mld_coarse_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_smoother_type_) = mld_bjac_
select case (val)
case(mld_umf_, mld_slu_)
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
case default
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
end select
endif
case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
@ -174,65 +193,90 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
& ': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) then
p%baseprecv(nlev_)%iprcparm(mld_coarse_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_smoother_type_) = mld_bjac_
select case (val)
case(mld_umf_, mld_slu_)
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
case default
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
end select
endif
case(mld_coarse_subsolve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
end if
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
@ -314,117 +358,9 @@ subroutine mld_sprecsetc(p,what,string,info,ilev)
return
endif
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
if (ilev_ == 1) then
!
! Rules for fine level are slightly different.
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_)
call mld_stringval(string,val,info)
if ((nlev_ > 1).and.(val==mld_noprec_)) then
write(0,*) name,': Error: invalid WHAT'
info = -2
endif
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_)
call mld_stringval(string,val,info)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
call mld_stringval(string,val,info)
if (info == 0) call mld_precset(p,what,val,info,ilev=ilev)
end subroutine mld_sprecsetc

16
mlprec/mld_ssub_aply.f90
Unescape Escape View File

@ -93,8 +93,8 @@
! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel
! preconditioner.
!
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(smooth_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(smooth_sweeps_) > 1. Furthermore
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(mld_smoother_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(mld_smoother_sweeps_) > 1. Furthermore
! Tasks 1, 2 and 3 may be performed when the matrix A is
! distributed among the processes (prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_),
! while task 4 may be performed when A is replicated on the processes
@ -125,7 +125,7 @@
! trans - character(len=1), input.
! If trans='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of K^(-1)).
! If prec%iprcparm(smooth_sweeps_) > 1, the value of trans provided
! If prec%iprcparm(mld_smoother_sweeps_) > 1, the value of trans provided
! in input is ignored.
! work - real(psb_spk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data).
@ -199,7 +199,7 @@ subroutine mld_ssub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
endif
if (prec%iprcparm(mld_smooth_sweeps_) == 1) then
if (prec%iprcparm(mld_smoother_sweeps_) == 1) then
call mld_sub_solve(alpha,prec,x,beta,y,desc_data,trans_,aux,info)
@ -208,10 +208,10 @@ subroutine mld_ssub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
goto 9999
endif
else if (prec%iprcparm(mld_smooth_sweeps_) > 1) then
else if (prec%iprcparm(mld_smoother_sweeps_) > 1) then
!
!
! Apply prec%iprcparm(smooth_sweeps_) sweeps of a block-Jacobi solver
! Apply prec%iprcparm(mld_smoother_sweeps_) sweeps of a block-Jacobi solver
! to compute an approximate solution of a linear system.
!
!
@ -231,7 +231,7 @@ subroutine mld_ssub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
tx = szero
ty = szero
do i=1, prec%iprcparm(mld_smooth_sweeps_)
do i=1, prec%iprcparm(mld_smoother_sweeps_)
!
! Compute Y(j+1) = D^(-1)*(X-ND*Y(j)), where D and ND are the
! block diagonal part and the remaining part of the local matrix
@ -267,7 +267,7 @@ subroutine mld_ssub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
info = 10
call psb_errpush(info,name,&
& i_err=(/2,prec%iprcparm(mld_smooth_sweeps_),0,0,0/))
& i_err=(/2,prec%iprcparm(mld_smoother_sweeps_),0,0,0/))
goto 9999
endif

2
mlprec/mld_ssub_solve.f90
Unescape Escape View File

@ -103,7 +103,7 @@
! trans - character(len=1), input.
! If trans='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of K^(-1)).
! If prec%iprcparm(smooth_sweeps_) > 1, the value of trans provided
! If prec%iprcparm(mld_smoother_sweeps_) > 1, the value of trans provided
! in input is ignored.
! work - real(psb_spk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data).

2
mlprec/mld_zbaseprec_bld.f90
Unescape Escape View File

@ -173,7 +173,7 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
if (debug_level >= psb_debug_outer_) &

8
mlprec/mld_zfact_bld.f90
Unescape Escape View File

@ -194,7 +194,7 @@ subroutine mld_zfact_bld(a,p,upd,info,blck)
! Clip into p%av(ap_nd_) the off block-diagonal part of the local
! matrix. The clipped matrix is then stored in CSR format.
!
if (p%iprcparm(mld_smooth_sweeps_) > 1) then
if (p%iprcparm(mld_smoother_sweeps_) > 1) then
call psb_sp_clip(atmp,p%av(mld_ap_nd_),info,&
& jmin=atmp%m+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,&
@ -213,7 +213,7 @@ subroutine mld_zfact_bld(a,p,upd,info,blck)
! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor.
!
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
end if
if (debug_level >= psb_debug_outer_) &
@ -303,7 +303,7 @@ subroutine mld_zfact_bld(a,p,upd,info,blck)
! clipped matrix is then stored in CSR format.
!
if (p%iprcparm(mld_smooth_sweeps_) > 1) then
if (p%iprcparm(mld_smoother_sweeps_) > 1) then
n_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data)
nrow_a = a%m
@ -330,7 +330,7 @@ subroutine mld_zfact_bld(a,p,upd,info,blck)
! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor.
!
p%iprcparm(mld_smooth_sweeps_) = 1
p%iprcparm(mld_smoother_sweeps_) = 1
end if
call psb_sp_free(atmp,info)
if (info/=0) then

2
mlprec/mld_zmlprec_bld.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
end select
call mld_check_def(p%rprcparm(mld_aggr_damp_),'Omega',dzero,is_legal_omega)
call mld_check_def(p%rprcparm(mld_aggr_thresh_),'Aggr_Thresh',dzero,is_legal_aggr_thrs)
call mld_check_def(p%iprcparm(mld_smooth_sweeps_),'Jacobi sweeps',&
call mld_check_def(p%iprcparm(mld_smoother_sweeps_),'Jacobi sweeps',&
& 1,is_legal_jac_sweeps)
!

55
mlprec/mld_zprecbld.f90
Unescape Escape View File

@ -80,6 +80,7 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
integer :: debug_level, debug_unit
@ -137,6 +138,17 @@ subroutine mld_zprecbld(a,desc_a,p,info)
end if
if (iszv >= 1) then
!
! Check on the iprcparm contents: they should be the same
! on all processes.
!
if (me == psb_root_) ipv(:) = p%baseprecv(1)%iprcparm(:)
call psb_bcast(ictxt,ipv)
if (any(ipv(:) /= p%baseprecv(1)%iprcparm(:) )) then
write(debug_unit,*) me,name,&
&': Inconsistent arguments among processes, forcing a default'
p%baseprecv(1)%iprcparm(:) = ipv(:)
end if
!
! Allocate and build the fine level preconditioner
!
@ -162,6 +174,17 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! levels
!
do i=2, iszv
!
! Check on the iprcparm contents: they should be the same
! on all processes.
!
if (me == psb_root_) ipv(:) = p%baseprecv(i)%iprcparm(:)
call psb_bcast(ictxt,ipv)
if (any(ipv(:) /= p%baseprecv(i)%iprcparm(:) )) then
write(debug_unit,*) me,name,&
&': Inconsistent arguments among processes, resetting.'
p%baseprecv(i)%iprcparm(:) = ipv(:)
end if
!
! Allocate the av component of the preconditioner data type
@ -173,6 +196,38 @@ subroutine mld_zprecbld(a,desc_a,p,info)
!
call mld_check_def(p%baseprecv(i)%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%baseprecv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%baseprecv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%baseprecv(i)%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%baseprecv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%baseprecv(i)%iprcparm(mld_sub_solve_) = val
p%baseprecv(i)%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%baseprecv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%baseprecv(i)%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%baseprecv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(i)%iprcparm(mld_sub_solve_) = val
p%baseprecv(i)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(i)%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end if
call init_baseprc_av(p%baseprecv(i),info)

14
mlprec/mld_zprecinit.f90
Unescape Escape View File

@ -124,7 +124,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('DIAG')
nlev_ = 1
@ -140,7 +140,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('BJAC')
nlev_ = 1
@ -157,7 +157,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('AS')
nlev_ = 1
@ -174,7 +174,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
case ('ML')
@ -198,7 +198,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1
@ -220,7 +220,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
end do
ilev_ = nlev_
@ -242,7 +242,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = 4
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
case default

271
mlprec/mld_zprecset.f90
Unescape Escape View File

@ -109,7 +109,8 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
info = 3111
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
return
endif
@ -124,7 +125,7 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smooth_sweeps_)
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smoother_sweeps_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -135,7 +136,7 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
@ -145,20 +146,38 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
if (nlev_ > 1) then
p%baseprecv(nlev_)%iprcparm(mld_coarse_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_smoother_type_) = mld_bjac_
select case (val)
case(mld_umf_, mld_slu_)
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
case default
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
end select
endif
case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val
p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
@ -174,65 +193,90 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
& ': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) then
p%baseprecv(nlev_)%iprcparm(mld_coarse_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
p%baseprecv(nlev_)%iprcparm(mld_smoother_type_) = mld_bjac_
select case (val)
case(mld_umf_, mld_slu_)
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
case default
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
end select
endif
case(mld_coarse_subsolve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
end if
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
@ -314,117 +358,10 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
return
endif
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
if (ilev_ == 1) then
!
! Rules for fine level are slightly different.
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_eig_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_smoother_type_)
call mld_stringval(string,val,info)
if ((nlev_ > 1).and.(val==mld_noprec_)) then
write(0,*) name,': Error: invalid WHAT'
info = -2
endif
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_)
call mld_stringval(string,val,info)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
call mld_stringval(string,val,info)
if (info == 0) call mld_precset(p,what,val,info,ilev=ilev)
endif
end subroutine mld_zprecsetc

16
mlprec/mld_zsub_aply.f90
Unescape Escape View File

@ -93,8 +93,8 @@
! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel
! preconditioner.
!
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(smooth_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(smooth_sweeps_) > 1. Furthermore
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(mld_smoother_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(mld_smoother_sweeps_) > 1. Furthermore
! Tasks 1, 2 and 3 may be performed when the matrix A is
! distributed among the processes (prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_),
! while task 4 may be performed when A is replicated on the processes
@ -126,7 +126,7 @@
! If trans='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of K^(-1)).
! if trans='C','c' then op(K^(-1)) = K^(-C) (transpose conjugate of K^(-1)).
! If prec%iprcparm(smooth_sweeps_) > 1, the value of trans provided
! If prec%iprcparm(mld_smoother_sweeps_) > 1, the value of trans provided
! in input is ignored.
! work - complex(psb_dpk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data).
@ -200,7 +200,7 @@ subroutine mld_zsub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
endif
if (prec%iprcparm(mld_smooth_sweeps_) == 1) then
if (prec%iprcparm(mld_smoother_sweeps_) == 1) then
call mld_sub_solve(alpha,prec,x,beta,y,desc_data,trans_,aux,info)
@ -209,10 +209,10 @@ subroutine mld_zsub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
goto 9999
endif
else if (prec%iprcparm(mld_smooth_sweeps_) > 1) then
else if (prec%iprcparm(mld_smoother_sweeps_) > 1) then
!
!
! Apply prec%iprcparm(smooth_sweeps_) sweeps of a block-Jacobi solver
! Apply prec%iprcparm(mld_smoother_sweeps_) sweeps of a block-Jacobi solver
! to compute an approximate solution of a linear system.
!
@ -231,7 +231,7 @@ subroutine mld_zsub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
tx = zzero
ty = zzero
do i=1, prec%iprcparm(mld_smooth_sweeps_)
do i=1, prec%iprcparm(mld_smoother_sweeps_)
!
! Compute Y(j+1) = D^(-1)*(X-ND*Y(j)), where D and ND are the
! block diagonal part and the remaining part of the local matrix
@ -267,7 +267,7 @@ subroutine mld_zsub_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
info = 10
call psb_errpush(info,name,&
& i_err=(/2,prec%iprcparm(mld_smooth_sweeps_),0,0,0/))
& i_err=(/2,prec%iprcparm(mld_smoother_sweeps_),0,0,0/))
goto 9999
endif

2
mlprec/mld_zsub_solve.f90
Unescape Escape View File

@ -104,7 +104,7 @@
! If trans='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of K^(-1)).
! if trans='C','c' then op(K^(-1)) = K^(-C) (transpose conjugate of K^(-1)).
! If prec%iprcparm(smooth_sweeps_) > 1, the value of trans provided
! If prec%iprcparm(mld_smoother_sweeps_) > 1, the value of trans provided
! in input is ignored.
! work - complex(psb_dpk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data).

12
test/fileread/cf_sample.f90
Unescape Escape View File

@ -62,7 +62,8 @@ program cf_sample
character(len=16) :: mltype ! additive or multiplicative 2nd level prec
character(len=16) :: smthpos ! side: pre, post, both smoothing
character(len=16) :: cmat ! coarse mat
character(len=16) :: csolve ! Factorization type: ILU, SuperLU, UMFPACK.
character(len=16) :: csolve ! Coarse solver: bjac, umf, slu, sludist
character(len=16) :: csbsolve ! Coarse subsolver: ILU, ILU(T), SuperLU, UMFPACK.
integer :: cfill ! Fill-in for factorization 1
real(psb_spk_) :: cthres ! Threshold for fact. 1 ILU(T)
integer :: cjswp ! Jacobi sweeps
@ -239,12 +240,13 @@ program cf_sample
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_smoother_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_solve_,prec_choice%csolve,info)
call mld_precset(prec,mld_sub_fillin_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_coarse_subsolve_,prec_choice%csbsolve,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_fillin_,prec_choice%cfill,info)
call mld_precset(prec,mld_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info)
call mld_precset(prec,mld_smooth_sweeps_,prec_choice%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_coarse_sweeps_,prec_choice%cjswp,info)
if (prec_choice%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv)
end if
@ -389,6 +391,7 @@ contains
call read_data(prec%smthpos,5) ! side: pre, post, both smoothing
call read_data(prec%cmat,5) ! coarse mat
call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prec%csbsolve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prec%cfill,5) ! Fill-in for factorization 1
call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T)
call read_data(prec%cjswp,5) ! Jacobi sweeps
@ -424,6 +427,7 @@ contains
call psb_bcast(icontxt,prec%smthpos) ! side: pre, post, both smoothing
call psb_bcast(icontxt,prec%cmat) ! coarse mat
call psb_bcast(icontxt,prec%csolve) ! Factorization type: ILU, SuperLU, UMFPACK.
call psb_bcast(icontxt,prec%csbsolve) ! Factorization type: ILU, SuperLU, UMFPACK.
call psb_bcast(icontxt,prec%cfill) ! Fill-in for factorization 1
call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T)
call psb_bcast(icontxt,prec%cjswp) ! Jacobi sweeps

2
test/fileread/df_bench.f90
Unescape Escape View File

@ -239,7 +239,7 @@ program df_bench
call mld_precset(pre,mld_sub_solve_, precs(pp)%ftype2, info,ilev=nlev)
call mld_precset(pre,mld_sub_fillin_, precs(pp)%fill2, info,ilev=nlev)
call mld_precset(pre,mld_fact_thrs_, precs(pp)%thr2, info,ilev=nlev)
call mld_precset(pre,mld_smooth_sweeps_, precs(pp)%jswp, info,ilev=nlev)
call mld_precset(pre,mld_smoother_sweeps_, precs(pp)%jswp, info,ilev=nlev)
call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
else
call mld_precinit(pre,precs(pp)%lv1,info)

24
test/fileread/df_sample.f90
Unescape Escape View File

@ -62,7 +62,8 @@ program df_sample
character(len=16) :: mltype ! additive or multiplicative 2nd level prec
character(len=16) :: smthpos ! side: pre, post, both smoothing
character(len=16) :: cmat ! coarse mat
character(len=16) :: csolve ! Factorization type: ILU, SuperLU, UMFPACK.
character(len=16) :: csolve ! Coarse solver: bjac, umf, slu, sludist
character(len=16) :: csbsolve ! Coarse subsolver: ILU, ILU(T), SuperLU, UMFPACK.
integer :: cfill ! Fill-in for factorization 1
real(psb_dpk_) :: cthres ! Threshold for fact. 1 ILU(T)
integer :: cjswp ! Jacobi sweeps
@ -78,10 +79,10 @@ program df_sample
type(mld_dprec_type) :: prec
! dense matrices
real(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:)
real(kind(1.d0)), allocatable , save :: b_col(:), x_col(:), r_col(:), &
real(psb_dpk_), allocatable, target :: aux_b(:,:), d(:)
real(psb_dpk_), allocatable , save :: b_col(:), x_col(:), r_col(:), &
& x_col_glob(:), r_col_glob(:)
real(kind(1.d0)), pointer :: b_col_glob(:)
real(psb_dpk_), pointer :: b_col_glob(:)
! communications data structure
type(psb_desc_type):: desc_a
@ -91,7 +92,7 @@ program df_sample
! solver paramters
integer :: iter, itmax, ierr, itrace, ircode, ipart,&
& methd, istopc, irst,amatsize,precsize,descsize, nlv
real(kind(1.d0)) :: err, eps
real(psb_dpk_) :: err, eps
character(len=5) :: afmt
character(len=20) :: name
@ -100,7 +101,7 @@ program df_sample
! other variables
integer :: i,info,j,m_problem
integer :: internal, m,ii,nnzero
real(kind(1.d0)) :: t1, t2, tprec, r_amax, b_amax,&
real(psb_dpk_) :: t1, t2, tprec, r_amax, b_amax,&
&scale,resmx,resmxp
integer :: nrhs, nrow, n_row, dim, nv, ne
integer, allocatable :: ivg(:), ipv(:)
@ -239,12 +240,13 @@ program df_sample
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_smoother_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_solve_,prec_choice%csolve,info)
call mld_precset(prec,mld_sub_fillin_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_coarse_subsolve_,prec_choice%csbsolve,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_fillin_,prec_choice%cfill,info)
call mld_precset(prec,mld_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info)
call mld_precset(prec,mld_smooth_sweeps_,prec_choice%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_coarse_sweeps_,prec_choice%cjswp,info)
if (prec_choice%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv)
end if
@ -389,11 +391,12 @@ contains
call read_data(prec%smthpos,5) ! side: pre, post, both smoothing
call read_data(prec%cmat,5) ! coarse mat
call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prec%csbsolve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prec%cfill,5) ! Fill-in for factorization 1
call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T)
call read_data(prec%cjswp,5) ! Jacobi sweeps
call read_data(prec%omega,5) ! smoother omega
call read_data(prec%athres,5) ! smoother aggr thresh
call read_data(prec%athres,5) ! smoother aggr thresh
end if
end if
@ -424,6 +427,7 @@ contains
call psb_bcast(icontxt,prec%smthpos) ! side: pre, post, both smoothing
call psb_bcast(icontxt,prec%cmat) ! coarse mat
call psb_bcast(icontxt,prec%csolve) ! Factorization type: ILU, SuperLU, UMFPACK.
call psb_bcast(icontxt,prec%csbsolve) ! Factorization type: ILU, SuperLU, UMFPACK.
call psb_bcast(icontxt,prec%cfill) ! Fill-in for factorization 1
call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T)
call psb_bcast(icontxt,prec%cjswp) ! Jacobi sweeps

3
test/fileread/runs/cfs.inp
Unescape Escape View File

@ -22,7 +22,8 @@ DEC ! Type of aggregation DEC SYMDEC GLB
MULT ! Type of multilevel correction: ADD MULT
POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL
ILU ! Coarse level: solver ILU ILUT UMF SLU SLUDIST
BJAC ! Coarse level: solver BJAC UMF SLU SLUDIST
ILU ! Coarse level: subsolver BJAC UMF SLU SLUDIST
0 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps

5
test/fileread/runs/dfs.inp
Unescape Escape View File

@ -1,4 +1,4 @@
thm_3180k.mtx !matphi_140x33x45.mtx !A_1M_gps.mtx !thm1000x600.mtx ! les_t4.mtx ! young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
thm1000x600.mtx !matphi_140x33x45.mtx !A_1M_gps.mtx !thm1000x600.mtx ! les_t4.mtx ! young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE !tnoto_phi.mtx !NONE !les_t4.rhs ! rhs.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html
BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG
CSR ! Storage format CSR COO JAD
@ -22,7 +22,8 @@ DEC ! Type of aggregation DEC SYMDEC GLB
MULT ! Type of multilevel correction: ADD MULT
POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL
ILU ! Coarse level: solver ILU ILUT UMF SLU SLUDIST
BJAC ! Coarse level: solver BJAC UMF SLU SLUDIST
UMF ! Coarse level: subsolver BJAC UMF SLU SLUDIST
0 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps

3
test/fileread/runs/sfs.inp
Unescape Escape View File

@ -22,7 +22,8 @@ DEC ! Type of aggregation DEC SYMDEC GLB
MULT ! Type of multilevel correction: ADD MULT
POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL
ILU ! Coarse level: solver ILU ILUT UMF SLU SLUDIST
UMF ! Coarse level: solver BJAC UMF SLU SLUDIST
ILU ! Coarse level: subsolver BJAC UMF SLU SLUDIST
0 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps

3
test/fileread/runs/zfs.inp
Unescape Escape View File

@ -22,7 +22,8 @@ DEC ! Type of aggregation DEC SYMDEC GLB
MULT ! Type of multilevel correction: ADD MULT
POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL
ILU ! Coarse level: solver ILU ILUT UMF SLU SLUDIST
UMF ! Coarse level: solver BJAC UMF SLU SLUDIST
ILU ! Coarse level: subsolver BJAC UMF SLU SLUDIST
0 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps

14
test/fileread/sf_sample.f90
Unescape Escape View File

@ -62,7 +62,8 @@ program sf_sample
character(len=16) :: mltype ! additive or multiplicative 2nd level prec
character(len=16) :: smthpos ! side: pre, post, both smoothing
character(len=16) :: cmat ! coarse mat
character(len=16) :: csolve ! Factorization type: ILU, SuperLU, UMFPACK.
character(len=16) :: csolve ! Coarse solver: bjac, umf, slu, sludist
character(len=16) :: csbsolve ! Coarse subsolver: ILU, ILU(T), SuperLU, UMFPACK.
integer :: cfill ! Fill-in for factorization 1
real(psb_spk_) :: cthres ! Threshold for fact. 1 ILU(T)
integer :: cjswp ! Jacobi sweeps
@ -239,12 +240,13 @@ program sf_sample
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_smoother_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_solve_,prec_choice%csolve,info)
call mld_precset(prec,mld_sub_fillin_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_coarse_subsolve_,prec_choice%csbsolve,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_fillin_,prec_choice%cfill,info)
call mld_precset(prec,mld_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info)
call mld_precset(prec,mld_smooth_sweeps_,prec_choice%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_coarse_sweeps_,prec_choice%cjswp,info)
if (prec_choice%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv)
end if
@ -389,11 +391,12 @@ contains
call read_data(prec%smthpos,5) ! side: pre, post, both smoothing
call read_data(prec%cmat,5) ! coarse mat
call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prec%csbsolve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prec%cfill,5) ! Fill-in for factorization 1
call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T)
call read_data(prec%cjswp,5) ! Jacobi sweeps
call read_data(prec%omega,5) ! smoother omega
call read_data(prec%athres,5) ! smoother aggr thresh
call read_data(prec%athres,5) ! smoother aggr thresh
end if
end if
@ -424,6 +427,7 @@ contains
call psb_bcast(icontxt,prec%smthpos) ! side: pre, post, both smoothing
call psb_bcast(icontxt,prec%cmat) ! coarse mat
call psb_bcast(icontxt,prec%csolve) ! Factorization type: ILU, SuperLU, UMFPACK.
call psb_bcast(icontxt,prec%csbsolve) ! Factorization type: ILU, SuperLU, UMFPACK.
call psb_bcast(icontxt,prec%cfill) ! Fill-in for factorization 1
call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T)
call psb_bcast(icontxt,prec%cjswp) ! Jacobi sweeps

2
test/fileread/zf_bench.f90
Unescape Escape View File

@ -224,7 +224,7 @@ program zf_bench
call mld_precset(pre,mld_sub_solve_, precs(pp)%ftype2, info,ilev=nlev)
call mld_precset(pre,mld_sub_fillin_, precs(pp)%fill2, info,ilev=nlev)
call mld_precset(pre,mld_fact_thrs_, precs(pp)%thr2, info,ilev=nlev)
call mld_precset(pre,mld_smooth_sweeps_, precs(pp)%jswp, info,ilev=nlev)
call mld_precset(pre,mld_smoother_sweeps_, precs(pp)%jswp, info,ilev=nlev)
call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
else
call mld_precinit(pre,precs(pp)%lv1,info)

29
test/fileread/zf_sample.f90
Unescape Escape View File

@ -62,7 +62,8 @@ program zf_sample
character(len=16) :: mltype ! additive or multiplicative 2nd level prec
character(len=16) :: smthpos ! side: pre, post, both smoothing
character(len=16) :: cmat ! coarse mat
character(len=16) :: csolve ! Factorization type: ILU, SuperLU, UMFPACK.
character(len=16) :: csolve ! Coarse solver: bjac, umf, slu, sludist
character(len=16) :: csbsolve ! Coarse subsolver: ILU, ILU(T), SuperLU, UMFPACK.
integer :: cfill ! Fill-in for factorization 1
real(psb_dpk_) :: cthres ! Threshold for fact. 1 ILU(T)
integer :: cjswp ! Jacobi sweeps
@ -78,10 +79,10 @@ program zf_sample
type(mld_zprec_type) :: prec
! dense matrices
complex(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:)
complex(kind(1.d0)), allocatable , save :: b_col(:), x_col(:), r_col(:), &
complex(psb_dpk_), allocatable, target :: aux_b(:,:), d(:)
complex(psb_dpk_), allocatable , save :: b_col(:), x_col(:), r_col(:), &
& x_col_glob(:), r_col_glob(:)
complex(kind(1.d0)), pointer :: b_col_glob(:)
complex(psb_dpk_), pointer :: b_col_glob(:)
! communications data structure
type(psb_desc_type):: desc_a
@ -91,7 +92,7 @@ program zf_sample
! solver paramters
integer :: iter, itmax, ierr, itrace, ircode, ipart,&
& methd, istopc, irst,amatsize,precsize,descsize, nlv
real(kind(1.d0)) :: err, eps
real(psb_dpk_) :: err, eps
character(len=5) :: afmt
character(len=20) :: name
@ -100,7 +101,7 @@ program zf_sample
! other variables
integer :: i,info,j,m_problem
integer :: internal, m,ii,nnzero
real(kind(1.d0)) :: t1, t2, tprec, r_amax, b_amax,&
real(psb_dpk_) :: t1, t2, tprec, r_amax, b_amax,&
&scale,resmx,resmxp
integer :: nrhs, nrow, n_row, dim, nv, ne
integer, allocatable :: ivg(:), ipv(:)
@ -239,12 +240,13 @@ program zf_sample
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_smoother_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_solve_,prec_choice%csolve,info)
call mld_precset(prec,mld_sub_fillin_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_coarse_subsolve_,prec_choice%csbsolve,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_fillin_,prec_choice%cfill,info)
call mld_precset(prec,mld_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info)
call mld_precset(prec,mld_smooth_sweeps_,prec_choice%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_coarse_sweeps_,prec_choice%cjswp,info)
if (prec_choice%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv)
end if
@ -389,11 +391,12 @@ contains
call read_data(prec%smthpos,5) ! side: pre, post, both smoothing
call read_data(prec%cmat,5) ! coarse mat
call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prec%csbsolve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prec%cfill,5) ! Fill-in for factorization 1
call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T)
call read_data(prec%cjswp,5) ! Jacobi sweeps
call read_data(prec%omega,5) ! smoother omega
call read_data(prec%athres,5) ! smoother aggr thresh
call read_data(prec%athres,5) ! smoother aggr thresh
end if
end if
@ -424,6 +427,7 @@ contains
call psb_bcast(icontxt,prec%smthpos) ! side: pre, post, both smoothing
call psb_bcast(icontxt,prec%cmat) ! coarse mat
call psb_bcast(icontxt,prec%csolve) ! Factorization type: ILU, SuperLU, UMFPACK.
call psb_bcast(icontxt,prec%csbsolve) ! Factorization type: ILU, SuperLU, UMFPACK.
call psb_bcast(icontxt,prec%cfill) ! Fill-in for factorization 1
call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T)
call psb_bcast(icontxt,prec%cjswp) ! Jacobi sweeps
@ -450,8 +454,3 @@ contains
write(iout, *) ' 0: block partition '
end subroutine pr_usage
end program zf_sample

4
test/pargen/ppde.f90
Unescape Escape View File

@ -243,8 +243,8 @@ program ppde
call mld_precset(prec,mld_coarse_solve_,prectype%csolve,info)
call mld_precset(prec,mld_sub_fillin_,prectype%cfill,info,ilev=nlv)
call mld_precset(prec,mld_fact_thrs_,prectype%cthres,info,ilev=nlv)
call mld_precset(prec,mld_smooth_sweeps_,prectype%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_smooth_sweeps_,prectype%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_smoother_sweeps_,prectype%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_smoother_sweeps_,prectype%cjswp,info,ilev=nlv)
if (prectype%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prectype%omega,info,ilev=nlv)
end if

4
test/pargen/spde.f90
Unescape Escape View File

@ -256,8 +256,8 @@ program spde
call mld_precset(prec,mld_coarse_solve_,prectype%csolve,info)
call mld_precset(prec,mld_sub_fillin_,prectype%cfill,info,ilev=nlv)
call mld_precset(prec,mld_fact_thrs_,prectype%cthres,info,ilev=nlv)
call mld_precset(prec,mld_smooth_sweeps_,prectype%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_smooth_sweeps_,prectype%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_smoother_sweeps_,prectype%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_smoother_sweeps_,prectype%cjswp,info,ilev=nlv)
if (prectype%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prectype%omega,info,ilev=nlv)
end if

Write Preview
Loading…
Cancel
Save