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' & 'DISTR'
& Coarse matrix: distributed or replicated \\ & Coarse matrix: distributed or replicated \\
\verb|mld_coarse_solve_| & \verb|character(len=*)| \verb|mld_coarse_solve_| & \verb|character(len=*)|
& 'BJAC' \ \ \ 'UMF' \ \ \ 'SLUDIST' & 'BJAC' \ \ \ 'UMF' \ \ \ 'SLU' \ \ \ 'SLUDIST'
& 'BJAC' & '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. \\ 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=*)| \verb|mld_coarse_subsolve_| & \verb|character(len=*)|
& 'ILU' \ \ \ 'MILU' \ \ \ 'ILUT' \ \ \ 'UMF' \ \ \ 'SLU' & 'ILU' \ \ \ 'MILU' \ \ \ 'ILUT' \ \ \ 'UMF' \ \ \ 'SLU'
& 'UMF' & '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| \verb|mld_coarse_sweeps_|& \verb|integer|
& any number $> 0$ & any number $> 0$
& 4 & 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 ! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_sub_ovr_) = 0 p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
if (debug_level >= psb_debug_outer_) & 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 ! Clip into p%av(ap_nd_) the off block-diagonal part of the local
! matrix. The clipped matrix is then stored in CSR format. ! 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,& call psb_sp_clip(atmp,p%av(mld_ap_nd_),info,&
& jmin=atmp%m+1,rscale=.false.,cscale=.false.) & jmin=atmp%m+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,& 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 ! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor. ! on a single processor.
! !
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
end if end if
if (debug_level >= psb_debug_outer_) & 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. ! 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_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data)
nrow_a = a%m 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 ! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor. ! on a single processor.
! !
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
call psb_sp_free(atmp,info) call psb_sp_free(atmp,info)
if (info/=0) then 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 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_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%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) & 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 ! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv Integer :: err,i,k,ictxt, me,np, err_act, iszv
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5) integer :: int_err(5)
character :: upd_ character :: upd_
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
@ -137,6 +138,17 @@ subroutine mld_cprecbld(a,desc_a,p,info)
end if end if
if (iszv >= 1) then 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 ! Allocate and build the fine level preconditioner
! !
@ -162,6 +174,17 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! levels ! levels
! !
do i=2, iszv 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 ! 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',& call mld_check_def(p%baseprecv(i)%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_distr_ml_coarse_mat) & 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 end if
call init_baseprc_av(p%baseprecv(i),info) 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_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 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') case ('DIAG')
nlev_ = 1 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_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 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') case ('BJAC')
nlev_ = 1 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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') case ('AS')
nlev_ = 1 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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 ('ML') 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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 if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1 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_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0
end do end do
ilev_ = nlev_ 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_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0 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 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0
case default case default

181
mlprec/mld_cprecset.f90
Unescape Escape View File

@ -109,7 +109,8 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
endif endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
info = 3111 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 return
endif endif
@ -124,7 +125,7 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
! !
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& 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 p%baseprecv(ilev_)%iprcparm(what) = val
case default case default
write(0,*) name,': Error: invalid WHAT' write(0,*) name,': Error: invalid WHAT'
@ -135,7 +136,7 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,& & 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_) & mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_) case(mld_coarse_mat_)
@ -145,20 +146,38 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_) case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2 info = -2
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val 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_) case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2 info = -2
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_) case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
@ -178,14 +197,14 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
! ilev not specified: set preconditioner parameters at all the appropriate ! ilev not specified: set preconditioner parameters at all the appropriate
! levels ! levels
! !
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,& & mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_) & mld_smoother_sweeps_)
do ilev_=1,nlev_-1 do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -195,7 +214,8 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
& mld_smoother_pos_,mld_aggr_eig_) & mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1 do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -203,28 +223,52 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
end do end do
case(mld_coarse_mat_) case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
& ': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_) case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' 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 info = -1
return return
end if end if
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_) case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_) case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -314,117 +358,10 @@ subroutine mld_cprecsetc(p,what,string,info,ilev)
return return
endif 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) call mld_stringval(string,val,info)
if ((nlev_ > 1).and.(val==mld_noprec_)) then if (info == 0) call mld_precset(p,what,val,info,ilev=ilev)
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
end subroutine mld_cprecsetc 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 ! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel
! preconditioner. ! preconditioner.
! !
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(smooth_sweeps_) = 1, ! Tasks 1, 3 and 4 may be selected when prec%iprcparm(mld_smoother_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(smooth_sweeps_) > 1. Furthermore ! 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 ! 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_), ! 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 ! 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='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of 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 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. ! in input is ignored.
! work - complex(psb_spk_), dimension (:), target. ! work - complex(psb_spk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data). ! 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 end if
endif 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) 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 goto 9999
endif 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. ! 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 tx = czero
ty = 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 ! 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 ! 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 info = 10
call psb_errpush(info,name,& 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 goto 9999
endif 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='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of 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 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. ! in input is ignored.
! work - complex(psb_spk_), dimension (:), target. ! work - complex(psb_spk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data). ! 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 ! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_sub_ovr_) = 0 p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
if (debug_level >= psb_debug_outer_) & 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 ! Clip into p%av(ap_nd_) the off block-diagonal part of the local
! matrix. The clipped matrix is then stored in CSR format. ! 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,& call psb_sp_clip(atmp,p%av(mld_ap_nd_),info,&
& jmin=atmp%m+1,rscale=.false.,cscale=.false.) & jmin=atmp%m+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,& 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 ! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor. ! on a single processor.
! !
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
end if end if
if (debug_level >= psb_debug_outer_) & 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. ! 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_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data)
nrow_a = a%m 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 ! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor. ! on a single processor.
! !
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
call psb_sp_free(atmp,info) call psb_sp_free(atmp,info)
if (info/=0) then 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 end select
call mld_check_def(p%rprcparm(mld_aggr_damp_),'Omega',dzero,is_legal_omega) 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%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) & 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 ! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv Integer :: err,i,k,ictxt, me,np, err_act, iszv
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5) integer :: int_err(5)
character :: upd_ character :: upd_
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
@ -137,6 +138,17 @@ subroutine mld_dprecbld(a,desc_a,p,info)
end if end if
if (iszv >= 1) then 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 ! Allocate and build the fine level preconditioner
! !
@ -162,6 +174,17 @@ subroutine mld_dprecbld(a,desc_a,p,info)
! levels ! levels
! !
do i=2, iszv 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 ! 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',& call mld_check_def(p%baseprecv(i)%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_distr_ml_coarse_mat) & 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 end if
call init_baseprc_av(p%baseprecv(i),info) 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_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 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') case ('DIAG')
nlev_ = 1 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_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 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') case ('BJAC')
nlev_ = 1 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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') case ('AS')
nlev_ = 1 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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 ('ML') 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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 if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1 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_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
end do end do
ilev_ = nlev_ 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_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0 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 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
case default case default

184
mlprec/mld_dprecset.f90
Unescape Escape View File

@ -109,7 +109,8 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
endif endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
info = 3111 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 return
endif endif
@ -124,7 +125,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
! !
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& 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 p%baseprecv(ilev_)%iprcparm(what) = val
case default case default
write(0,*) name,': Error: invalid WHAT' write(0,*) name,': Error: invalid WHAT'
@ -135,7 +136,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,& & 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_) & mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_) case(mld_coarse_mat_)
@ -145,20 +146,38 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_) case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2 info = -2
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val 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_) case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2 info = -2
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_) case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
@ -178,14 +197,14 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
! ilev not specified: set preconditioner parameters at all the appropriate ! ilev not specified: set preconditioner parameters at all the appropriate
! levels ! levels
! !
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,& & mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_) & mld_smoother_sweeps_)
do ilev_=1,nlev_-1 do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -195,7 +214,8 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
& mld_smoother_pos_,mld_aggr_eig_) & mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1 do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -203,28 +223,52 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
end do end do
case(mld_coarse_mat_) case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
& ': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_) case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' 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 info = -1
return return
end if end if
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_) case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_) case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -287,7 +331,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
! Local variables ! Local variables
integer :: ilev_, nlev_,val integer :: ilev_, nlev_,val
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precsetc'
info = 0 info = 0
@ -314,117 +358,9 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
return return
endif 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) call mld_stringval(string,val,info)
do ilev_=2,nlev_-1 if (info == 0) call mld_precset(p,what,val,info,ilev=ilev)
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
end subroutine mld_dprecsetc 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 ! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel
! preconditioner. ! preconditioner.
! !
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(smooth_sweeps_) = 1, ! Tasks 1, 3 and 4 may be selected when prec%iprcparm(mld_smoother_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(smooth_sweeps_) > 1. Furthermore ! 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 ! 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_), ! 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 ! while task 4 may be performed when A is replicated on the processes
@ -125,7 +125,7 @@
! trans - character(len=1), input. ! trans - character(len=1), input.
! If trans='N','n' then op(K^(-1)) = K^(-1); ! 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='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. ! in input is ignored.
! work - real(psb_dpk_), dimension (:), target. ! work - real(psb_dpk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data). ! 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 end if
endif 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) 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 goto 9999
endif 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. ! 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 tx = dzero
ty = 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 ! 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 ! 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 info = 10
call psb_errpush(info,name,& 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 goto 9999
endif endif

2
mlprec/mld_dsub_solve.f90
Unescape Escape View File

@ -103,7 +103,7 @@
! trans - character(len=1), input. ! trans - character(len=1), input.
! If trans='N','n' then op(K^(-1)) = K^(-1); ! 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='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. ! in input is ignored.
! work - real(psb_dpk_), dimension (:), target. ! work - real(psb_dpk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data). ! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data).

11
mlprec/mld_prec_type.f90
Unescape Escape View File

@ -243,7 +243,7 @@ module mld_prec_type
integer, parameter :: mld_sub_ren_ = 5 integer, parameter :: mld_sub_ren_ = 5
integer, parameter :: mld_sub_ovr_ = 6 integer, parameter :: mld_sub_ovr_ = 6
integer, parameter :: mld_sub_fillin_ = 8 integer, parameter :: mld_sub_fillin_ = 8
integer, parameter :: mld_smooth_sweeps_ = 9 integer, parameter :: mld_smoother_sweeps_ = 9
integer, parameter :: mld_ml_type_ = 10 integer, parameter :: mld_ml_type_ = 10
integer, parameter :: mld_smoother_pos_ = 11 integer, parameter :: mld_smoother_pos_ = 11
integer, parameter :: mld_aggr_kind_ = 12 integer, parameter :: mld_aggr_kind_ = 12
@ -259,6 +259,7 @@ module mld_prec_type
integer, parameter :: mld_coarse_solve_ = 25 integer, parameter :: mld_coarse_solve_ = 25
integer, parameter :: mld_coarse_sweeps_ = 26 integer, parameter :: mld_coarse_sweeps_ = 26
integer, parameter :: mld_coarse_fillin_ = 27 integer, parameter :: mld_coarse_fillin_ = 27
integer, parameter :: mld_coarse_subsolve_ = 28
integer, parameter :: mld_ifpsz_ = 32 integer, parameter :: mld_ifpsz_ = 32
! !
@ -811,7 +812,7 @@ contains
write(iout_,*) 'Should never get here!' write(iout_,*) 'Should never get here!'
end select end select
write(iout_,*) 'Number of Jacobi sweeps: ', & write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_)) & (p%baseprecv(ilev)%iprcparm(mld_smoother_sweeps_))
end if end if
end do end do
end if end if
@ -924,7 +925,7 @@ contains
write(iout_,*) 'Should never get here!' write(iout_,*) 'Should never get here!'
end select end select
write(iout_,*) 'Number of Jacobi sweeps: ', & write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_)) & (p%baseprecv(ilev)%iprcparm(mld_smoother_sweeps_))
end if end if
end do end do
end if end if
@ -1057,7 +1058,7 @@ contains
write(iout_,*) 'Should never get here!' write(iout_,*) 'Should never get here!'
end select end select
write(iout_,*) 'Number of Jacobi sweeps: ', & write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_)) & (p%baseprecv(ilev)%iprcparm(mld_smoother_sweeps_))
end if end if
end do end do
end if end if
@ -1169,7 +1170,7 @@ contains
write(iout_,*) 'Should never get here!' write(iout_,*) 'Should never get here!'
end select end select
write(iout_,*) 'Number of Jacobi sweeps: ', & write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_)) & (p%baseprecv(ilev)%iprcparm(mld_smoother_sweeps_))
end if end if
end do end do
end if 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 ! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_sub_ovr_) = 0 p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
if (debug_level >= psb_debug_outer_) & 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 ! Clip into p%av(ap_nd_) the off block-diagonal part of the local
! matrix. The clipped matrix is then stored in CSR format. ! 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,& call psb_sp_clip(atmp,p%av(mld_ap_nd_),info,&
& jmin=atmp%m+1,rscale=.false.,cscale=.false.) & jmin=atmp%m+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,& 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 ! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor. ! on a single processor.
! !
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
end if end if
if (debug_level >= psb_debug_outer_) & 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. ! 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_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data)
nrow_a = a%m 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 ! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor. ! on a single processor.
! !
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
call psb_sp_free(atmp,info) call psb_sp_free(atmp,info)
if (info/=0) then 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 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_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%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) & 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 ! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv Integer :: err,i,k,ictxt, me,np, err_act, iszv
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5) integer :: int_err(5)
character :: upd_ character :: upd_
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
@ -137,6 +138,17 @@ subroutine mld_sprecbld(a,desc_a,p,info)
end if end if
if (iszv >= 1) then 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 ! Allocate and build the fine level preconditioner
! !
@ -162,6 +174,17 @@ subroutine mld_sprecbld(a,desc_a,p,info)
! levels ! levels
! !
do i=2, iszv 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 ! 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',& call mld_check_def(p%baseprecv(i)%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_distr_ml_coarse_mat) & 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 end if
call init_baseprc_av(p%baseprecv(i),info) 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_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 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') case ('DIAG')
nlev_ = 1 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_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 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') case ('BJAC')
nlev_ = 1 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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') case ('AS')
nlev_ = 1 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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 ('ML') 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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 if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1 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_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0
end do end do
ilev_ = nlev_ 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_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0 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 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0
case default case default

182
mlprec/mld_sprecset.f90
Unescape Escape View File

@ -109,7 +109,8 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
endif endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
info = 3111 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 return
endif endif
@ -124,7 +125,7 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
! !
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& 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 p%baseprecv(ilev_)%iprcparm(what) = val
case default case default
write(0,*) name,': Error: invalid WHAT' write(0,*) name,': Error: invalid WHAT'
@ -135,7 +136,7 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,& & 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_) & mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_) case(mld_coarse_mat_)
@ -145,20 +146,38 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_) case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2 info = -2
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val 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_) case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2 info = -2
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_) case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
@ -178,14 +197,14 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
! ilev not specified: set preconditioner parameters at all the appropriate ! ilev not specified: set preconditioner parameters at all the appropriate
! levels ! levels
! !
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,& & mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_) & mld_smoother_sweeps_)
do ilev_=1,nlev_-1 do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -195,7 +214,8 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
& mld_smoother_pos_,mld_aggr_eig_) & mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1 do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -203,28 +223,52 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
end do end do
case(mld_coarse_mat_) case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
& ': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_) case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' 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 info = -1
return return
end if end if
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_) case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_) case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -314,117 +358,9 @@ subroutine mld_sprecsetc(p,what,string,info,ilev)
return return
endif 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) call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val if (info == 0) call mld_precset(p,what,val,info,ilev=ilev)
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
end subroutine mld_sprecsetc 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 ! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel
! preconditioner. ! preconditioner.
! !
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(smooth_sweeps_) = 1, ! Tasks 1, 3 and 4 may be selected when prec%iprcparm(mld_smoother_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(smooth_sweeps_) > 1. Furthermore ! 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 ! 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_), ! 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 ! while task 4 may be performed when A is replicated on the processes
@ -125,7 +125,7 @@
! trans - character(len=1), input. ! trans - character(len=1), input.
! If trans='N','n' then op(K^(-1)) = K^(-1); ! 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='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. ! in input is ignored.
! work - real(psb_spk_), dimension (:), target. ! work - real(psb_spk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data). ! 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 end if
endif 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) 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 goto 9999
endif 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. ! 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 tx = szero
ty = 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 ! 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 ! 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 info = 10
call psb_errpush(info,name,& 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 goto 9999
endif endif

2
mlprec/mld_ssub_solve.f90
Unescape Escape View File

@ -103,7 +103,7 @@
! trans - character(len=1), input. ! trans - character(len=1), input.
! If trans='N','n' then op(K^(-1)) = K^(-1); ! 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='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. ! in input is ignored.
! work - real(psb_spk_), dimension (:), target. ! work - real(psb_spk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data). ! 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 ! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_sub_ovr_) = 0 p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
if (debug_level >= psb_debug_outer_) & 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 ! Clip into p%av(ap_nd_) the off block-diagonal part of the local
! matrix. The clipped matrix is then stored in CSR format. ! 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,& call psb_sp_clip(atmp,p%av(mld_ap_nd_),info,&
& jmin=atmp%m+1,rscale=.false.,cscale=.false.) & jmin=atmp%m+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,& 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 ! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor. ! on a single processor.
! !
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
end if end if
if (debug_level >= psb_debug_outer_) & 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. ! 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_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data)
nrow_a = a%m 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 ! multiple Jacobi sweeps. This is certain to happen when running
! on a single processor. ! on a single processor.
! !
p%iprcparm(mld_smooth_sweeps_) = 1 p%iprcparm(mld_smoother_sweeps_) = 1
end if end if
call psb_sp_free(atmp,info) call psb_sp_free(atmp,info)
if (info/=0) then 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 end select
call mld_check_def(p%rprcparm(mld_aggr_damp_),'Omega',dzero,is_legal_omega) 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%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) & 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 ! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv Integer :: err,i,k,ictxt, me,np, err_act, iszv
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5) integer :: int_err(5)
character :: upd_ character :: upd_
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
@ -137,6 +138,17 @@ subroutine mld_zprecbld(a,desc_a,p,info)
end if end if
if (iszv >= 1) then 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 ! Allocate and build the fine level preconditioner
! !
@ -162,6 +174,17 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! levels ! levels
! !
do i=2, iszv 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 ! 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',& call mld_check_def(p%baseprecv(i)%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_distr_ml_coarse_mat) & 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 end if
call init_baseprc_av(p%baseprecv(i),info) 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_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 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') case ('DIAG')
nlev_ = 1 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_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 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') case ('BJAC')
nlev_ = 1 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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') case ('AS')
nlev_ = 1 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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 ('ML') 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_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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 if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1 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_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 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
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
end do end do
ilev_ = nlev_ 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_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0 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 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
case default case default

181
mlprec/mld_zprecset.f90
Unescape Escape View File

@ -109,7 +109,8 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
endif endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
info = 3111 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 return
endif endif
@ -124,7 +125,7 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
! !
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& 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 p%baseprecv(ilev_)%iprcparm(what) = val
case default case default
write(0,*) name,': Error: invalid WHAT' write(0,*) name,': Error: invalid WHAT'
@ -135,7 +136,7 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,& & 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_) & mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_) case(mld_coarse_mat_)
@ -145,20 +146,38 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_) case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2 info = -2
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val 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_) case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2 info = -2
return return
end if end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val p%baseprecv(ilev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_) case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
@ -178,14 +197,14 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
! ilev not specified: set preconditioner parameters at all the appropriate ! ilev not specified: set preconditioner parameters at all the appropriate
! levels ! levels
! !
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,& & mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_) & mld_smoother_sweeps_)
do ilev_=1,nlev_-1 do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -195,7 +214,8 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
& mld_smoother_pos_,mld_aggr_eig_) & mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1 do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -203,28 +223,52 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
end do end do
case(mld_coarse_mat_) case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
& ': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_) case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' 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 info = -1
return return
end if end if
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_) case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smoother_sweeps_) = val
case(mld_coarse_fillin_) case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,&
&': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -314,117 +358,10 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
return return
endif 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) call mld_stringval(string,val,info)
if ((nlev_ > 1).and.(val==mld_noprec_)) then if (info == 0) call mld_precset(p,what,val,info,ilev=ilev)
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
end subroutine mld_zprecsetc 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 ! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel
! preconditioner. ! preconditioner.
! !
! Tasks 1, 3 and 4 may be selected when prec%iprcparm(smooth_sweeps_) = 1, ! Tasks 1, 3 and 4 may be selected when prec%iprcparm(mld_smoother_sweeps_) = 1,
! while task 2 is selected when prec%iprcparm(smooth_sweeps_) > 1. Furthermore ! 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 ! 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_), ! 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 ! 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='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of 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 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. ! in input is ignored.
! work - complex(psb_dpk_), dimension (:), target. ! work - complex(psb_dpk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data). ! 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 end if
endif 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) 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 goto 9999
endif 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. ! 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 tx = zzero
ty = 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 ! 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 ! 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 info = 10
call psb_errpush(info,name,& 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 goto 9999
endif 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='N','n' then op(K^(-1)) = K^(-1);
! if trans='T','t' then op(K^(-1)) = K^(-T) (transpose of 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 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. ! in input is ignored.
! work - complex(psb_dpk_), dimension (:), target. ! work - complex(psb_dpk_), dimension (:), target.
! Workspace. Its size must be at least 4*psb_cd_get_local_cols(desc_data). ! 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) :: mltype ! additive or multiplicative 2nd level prec
character(len=16) :: smthpos ! side: pre, post, both smoothing character(len=16) :: smthpos ! side: pre, post, both smoothing
character(len=16) :: cmat ! coarse mat 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 integer :: cfill ! Fill-in for factorization 1
real(psb_spk_) :: cthres ! Threshold for fact. 1 ILU(T) real(psb_spk_) :: cthres ! Threshold for fact. 1 ILU(T)
integer :: cjswp ! Jacobi sweeps 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_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_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_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_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info) 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 if (prec_choice%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv) call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv)
end if end if
@ -389,6 +391,7 @@ contains
call read_data(prec%smthpos,5) ! side: pre, post, both smoothing call read_data(prec%smthpos,5) ! side: pre, post, both smoothing
call read_data(prec%cmat,5) ! coarse mat call read_data(prec%cmat,5) ! coarse mat
call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK. 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%cfill,5) ! Fill-in for factorization 1
call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T) call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T)
call read_data(prec%cjswp,5) ! Jacobi sweeps 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%smthpos) ! side: pre, post, both smoothing
call psb_bcast(icontxt,prec%cmat) ! coarse mat call psb_bcast(icontxt,prec%cmat) ! coarse mat
call psb_bcast(icontxt,prec%csolve) ! Factorization type: ILU, SuperLU, UMFPACK. 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%cfill) ! Fill-in for factorization 1
call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T) call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T)
call psb_bcast(icontxt,prec%cjswp) ! Jacobi sweeps 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_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_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_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) call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
else else
call mld_precinit(pre,precs(pp)%lv1,info) call mld_precinit(pre,precs(pp)%lv1,info)

22
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) :: mltype ! additive or multiplicative 2nd level prec
character(len=16) :: smthpos ! side: pre, post, both smoothing character(len=16) :: smthpos ! side: pre, post, both smoothing
character(len=16) :: cmat ! coarse mat 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 integer :: cfill ! Fill-in for factorization 1
real(psb_dpk_) :: cthres ! Threshold for fact. 1 ILU(T) real(psb_dpk_) :: cthres ! Threshold for fact. 1 ILU(T)
integer :: cjswp ! Jacobi sweeps integer :: cjswp ! Jacobi sweeps
@ -78,10 +79,10 @@ program df_sample
type(mld_dprec_type) :: prec type(mld_dprec_type) :: prec
! dense matrices ! dense matrices
real(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:) real(psb_dpk_), allocatable, target :: aux_b(:,:), d(:)
real(kind(1.d0)), allocatable , save :: b_col(:), x_col(:), r_col(:), & real(psb_dpk_), allocatable , save :: b_col(:), x_col(:), r_col(:), &
& x_col_glob(:), r_col_glob(:) & x_col_glob(:), r_col_glob(:)
real(kind(1.d0)), pointer :: b_col_glob(:) real(psb_dpk_), pointer :: b_col_glob(:)
! communications data structure ! communications data structure
type(psb_desc_type):: desc_a type(psb_desc_type):: desc_a
@ -91,7 +92,7 @@ program df_sample
! solver paramters ! solver paramters
integer :: iter, itmax, ierr, itrace, ircode, ipart,& integer :: iter, itmax, ierr, itrace, ircode, ipart,&
& methd, istopc, irst,amatsize,precsize,descsize, nlv & methd, istopc, irst,amatsize,precsize,descsize, nlv
real(kind(1.d0)) :: err, eps real(psb_dpk_) :: err, eps
character(len=5) :: afmt character(len=5) :: afmt
character(len=20) :: name character(len=20) :: name
@ -100,7 +101,7 @@ program df_sample
! other variables ! other variables
integer :: i,info,j,m_problem integer :: i,info,j,m_problem
integer :: internal, m,ii,nnzero 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 &scale,resmx,resmxp
integer :: nrhs, nrow, n_row, dim, nv, ne integer :: nrhs, nrow, n_row, dim, nv, ne
integer, allocatable :: ivg(:), ipv(:) 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_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_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_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_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info) 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 if (prec_choice%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv) call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv)
end if end if
@ -389,6 +391,7 @@ contains
call read_data(prec%smthpos,5) ! side: pre, post, both smoothing call read_data(prec%smthpos,5) ! side: pre, post, both smoothing
call read_data(prec%cmat,5) ! coarse mat call read_data(prec%cmat,5) ! coarse mat
call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK. 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%cfill,5) ! Fill-in for factorization 1
call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T) call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T)
call read_data(prec%cjswp,5) ! Jacobi sweeps 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%smthpos) ! side: pre, post, both smoothing
call psb_bcast(icontxt,prec%cmat) ! coarse mat call psb_bcast(icontxt,prec%cmat) ! coarse mat
call psb_bcast(icontxt,prec%csolve) ! Factorization type: ILU, SuperLU, UMFPACK. 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%cfill) ! Fill-in for factorization 1
call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T) call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T)
call psb_bcast(icontxt,prec%cjswp) ! Jacobi sweeps 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 MULT ! Type of multilevel correction: ADD MULT
POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD) POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL 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) 0 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P) 1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps 4 ! Coarse level: Number of Jacobi sweeps

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 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 BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG
CSR ! Storage format CSR COO JAD CSR ! Storage format CSR COO JAD
@ -22,7 +22,8 @@ DEC ! Type of aggregation DEC SYMDEC GLB
MULT ! Type of multilevel correction: ADD MULT MULT ! Type of multilevel correction: ADD MULT
POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD) POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL 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) 0 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P) 1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps 4 ! Coarse level: Number of Jacobi sweeps

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 MULT ! Type of multilevel correction: ADD MULT
POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD) POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL 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) 0 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P) 1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps 4 ! Coarse level: Number of Jacobi sweeps

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 MULT ! Type of multilevel correction: ADD MULT
POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD) POST ! Side of multiplicative correction PRE POST BOTH (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL 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) 0 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P) 1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps 4 ! Coarse level: Number of Jacobi sweeps

12
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) :: mltype ! additive or multiplicative 2nd level prec
character(len=16) :: smthpos ! side: pre, post, both smoothing character(len=16) :: smthpos ! side: pre, post, both smoothing
character(len=16) :: cmat ! coarse mat 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 integer :: cfill ! Fill-in for factorization 1
real(psb_spk_) :: cthres ! Threshold for fact. 1 ILU(T) real(psb_spk_) :: cthres ! Threshold for fact. 1 ILU(T)
integer :: cjswp ! Jacobi sweeps 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_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_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_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_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info) 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 if (prec_choice%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv) call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv)
end if end if
@ -389,6 +391,7 @@ contains
call read_data(prec%smthpos,5) ! side: pre, post, both smoothing call read_data(prec%smthpos,5) ! side: pre, post, both smoothing
call read_data(prec%cmat,5) ! coarse mat call read_data(prec%cmat,5) ! coarse mat
call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK. 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%cfill,5) ! Fill-in for factorization 1
call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T) call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T)
call read_data(prec%cjswp,5) ! Jacobi sweeps 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%smthpos) ! side: pre, post, both smoothing
call psb_bcast(icontxt,prec%cmat) ! coarse mat call psb_bcast(icontxt,prec%cmat) ! coarse mat
call psb_bcast(icontxt,prec%csolve) ! Factorization type: ILU, SuperLU, UMFPACK. 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%cfill) ! Fill-in for factorization 1
call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T) call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T)
call psb_bcast(icontxt,prec%cjswp) ! Jacobi sweeps 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_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_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_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) call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
else else
call mld_precinit(pre,precs(pp)%lv1,info) call mld_precinit(pre,precs(pp)%lv1,info)

27
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) :: mltype ! additive or multiplicative 2nd level prec
character(len=16) :: smthpos ! side: pre, post, both smoothing character(len=16) :: smthpos ! side: pre, post, both smoothing
character(len=16) :: cmat ! coarse mat 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 integer :: cfill ! Fill-in for factorization 1
real(psb_dpk_) :: cthres ! Threshold for fact. 1 ILU(T) real(psb_dpk_) :: cthres ! Threshold for fact. 1 ILU(T)
integer :: cjswp ! Jacobi sweeps integer :: cjswp ! Jacobi sweeps
@ -78,10 +79,10 @@ program zf_sample
type(mld_zprec_type) :: prec type(mld_zprec_type) :: prec
! dense matrices ! dense matrices
complex(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:) complex(psb_dpk_), allocatable, target :: aux_b(:,:), d(:)
complex(kind(1.d0)), allocatable , save :: b_col(:), x_col(:), r_col(:), & complex(psb_dpk_), allocatable , save :: b_col(:), x_col(:), r_col(:), &
& x_col_glob(:), r_col_glob(:) & x_col_glob(:), r_col_glob(:)
complex(kind(1.d0)), pointer :: b_col_glob(:) complex(psb_dpk_), pointer :: b_col_glob(:)
! communications data structure ! communications data structure
type(psb_desc_type):: desc_a type(psb_desc_type):: desc_a
@ -91,7 +92,7 @@ program zf_sample
! solver paramters ! solver paramters
integer :: iter, itmax, ierr, itrace, ircode, ipart,& integer :: iter, itmax, ierr, itrace, ircode, ipart,&
& methd, istopc, irst,amatsize,precsize,descsize, nlv & methd, istopc, irst,amatsize,precsize,descsize, nlv
real(kind(1.d0)) :: err, eps real(psb_dpk_) :: err, eps
character(len=5) :: afmt character(len=5) :: afmt
character(len=20) :: name character(len=20) :: name
@ -100,7 +101,7 @@ program zf_sample
! other variables ! other variables
integer :: i,info,j,m_problem integer :: i,info,j,m_problem
integer :: internal, m,ii,nnzero 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 &scale,resmx,resmxp
integer :: nrhs, nrow, n_row, dim, nv, ne integer :: nrhs, nrow, n_row, dim, nv, ne
integer, allocatable :: ivg(:), ipv(:) 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_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_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_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_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info) 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 if (prec_choice%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv) call mld_precset(prec,mld_aggr_damp_,prec_choice%omega,info,ilev=nlv)
end if end if
@ -389,6 +391,7 @@ contains
call read_data(prec%smthpos,5) ! side: pre, post, both smoothing call read_data(prec%smthpos,5) ! side: pre, post, both smoothing
call read_data(prec%cmat,5) ! coarse mat call read_data(prec%cmat,5) ! coarse mat
call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK. 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%cfill,5) ! Fill-in for factorization 1
call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T) call read_data(prec%cthres,5) ! Threshold for fact. 1 ILU(T)
call read_data(prec%cjswp,5) ! Jacobi sweeps 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%smthpos) ! side: pre, post, both smoothing
call psb_bcast(icontxt,prec%cmat) ! coarse mat call psb_bcast(icontxt,prec%cmat) ! coarse mat
call psb_bcast(icontxt,prec%csolve) ! Factorization type: ILU, SuperLU, UMFPACK. 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%cfill) ! Fill-in for factorization 1
call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T) call psb_bcast(icontxt,prec%cthres) ! Threshold for fact. 1 ILU(T)
call psb_bcast(icontxt,prec%cjswp) ! Jacobi sweeps call psb_bcast(icontxt,prec%cjswp) ! Jacobi sweeps
@ -450,8 +454,3 @@ contains
write(iout, *) ' 0: block partition ' write(iout, *) ' 0: block partition '
end subroutine pr_usage end subroutine pr_usage
end program zf_sample 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_coarse_solve_,prectype%csolve,info)
call mld_precset(prec,mld_sub_fillin_,prectype%cfill,info,ilev=nlv) 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_fact_thrs_,prectype%cthres,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_smooth_sweeps_,prectype%cjswp,info,ilev=nlv) call mld_precset(prec,mld_smoother_sweeps_,prectype%cjswp,info,ilev=nlv)
if (prectype%omega>=0.0) then if (prectype%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prectype%omega,info,ilev=nlv) call mld_precset(prec,mld_aggr_damp_,prectype%omega,info,ilev=nlv)
end if 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_coarse_solve_,prectype%csolve,info)
call mld_precset(prec,mld_sub_fillin_,prectype%cfill,info,ilev=nlv) 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_fact_thrs_,prectype%cthres,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_smooth_sweeps_,prectype%cjswp,info,ilev=nlv) call mld_precset(prec,mld_smoother_sweeps_,prectype%cjswp,info,ilev=nlv)
if (prectype%omega>=0.0) then if (prectype%omega>=0.0) then
call mld_precset(prec,mld_aggr_damp_,prectype%omega,info,ilev=nlv) call mld_precset(prec,mld_aggr_damp_,prectype%omega,info,ilev=nlv)
end if end if

Write Preview
Loading…
Cancel
Save