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

mld2p4-smooth-2side:

Browse Source 
mlprec/impl/level/mld_d_base_onelev_csetc.f90
 mlprec/impl/level/mld_d_base_onelev_cseti.f90
 mlprec/impl/level/mld_d_base_onelev_csetr.f90
 mlprec/impl/level/mld_d_base_onelev_setc.f90
 mlprec/impl/level/mld_d_base_onelev_seti.f90
 mlprec/impl/level/mld_d_base_onelev_setr.f90
 mlprec/impl/mld_dcprecset.F90
 mlprec/impl/mld_dprecset.F90
 mlprec/impl/solver/mld_d_bwgs_solver_apply.f90
 mlprec/impl/solver/mld_d_bwgs_solver_apply_vect.f90
 mlprec/impl/solver/mld_d_bwgs_solver_bld.f90
 mlprec/mld_d_onelev_mod.f90


Defined BW Gauss-Seidel. Need to finish the SET methods before testing
on CG.
stopcriterion
Salvatore Filippone 9 years ago
parent d651141c7d
commit d747bc9aae
12 changed files with 167 additions and 151 deletions
Show Stats Download Patch File Download Diff File

5
mlprec/impl/level/mld_d_base_onelev_csetc.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_d_base_onelev_csetc(lv,what,val,info)
subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_csetc
@ -48,6 +48,7 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info)
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_onelev_csetc'
integer(psb_ipk_) :: ival
@ -58,7 +59,7 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info)
ival = lv%stringval(val)
if (ival >= 0) then
call lv%set(what,ival,info)
call lv%set(what,ival,info,pos=pos)
else
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)

3
mlprec/impl/level/mld_d_base_onelev_cseti.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_d_base_onelev_cseti(lv,what,val,info)
subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_cseti
@ -48,6 +48,7 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info)
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='d_base_onelev_cseti'

3
mlprec/impl/level/mld_d_base_onelev_csetr.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_d_base_onelev_csetr(lv,what,val,info)
subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_csetr
@ -48,6 +48,7 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info)
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_onelev_csetr'

5
mlprec/impl/level/mld_d_base_onelev_setc.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_d_base_onelev_setc(lv,what,val,info)
subroutine mld_d_base_onelev_setc(lv,what,val,info,pos)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_setc
@ -48,6 +48,7 @@ subroutine mld_d_base_onelev_setc(lv,what,val,info)
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_onelev_setc'
integer(psb_ipk_) :: ival
@ -58,7 +59,7 @@ subroutine mld_d_base_onelev_setc(lv,what,val,info)
ival = lv%stringval(val)
if (ival >= 0) then
call lv%set(what,ival,info)
call lv%set(what,ival,info,pos=pos)
else
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)

3
mlprec/impl/level/mld_d_base_onelev_seti.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_d_base_onelev_seti(lv,what,val,info)
subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_seti
@ -48,6 +48,7 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info)
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='d_base_onelev_seti'

3
mlprec/impl/level/mld_d_base_onelev_setr.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_d_base_onelev_setr(lv,what,val,info)
subroutine mld_d_base_onelev_setr(lv,what,val,info,pos)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_setr
@ -48,6 +48,7 @@ subroutine mld_d_base_onelev_setr(lv,what,val,info)
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_onelev_setr'

136
mlprec/impl/mld_dcprecset.F90
Unescape Escape View File

@ -152,28 +152,28 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos)
!
select case(psb_toupper(trim(what)))
case('SMOOTHER_TYPE')
call onelev_set_smoother(p%precv(ilev_),val,info)
call onelev_set_smoother(p%precv(ilev_),val,info,pos=pos)
case('SUB_SOLVE')
call onelev_set_solver(p%precv(ilev_),val,info)
call onelev_set_solver(p%precv(ilev_),val,info,pos=pos)
case('SMOOTHER_SWEEPS','ML_TYPE','AGGR_ALG','AGGR_ORD',&
& 'AGGR_KIND','SMOOTHER_POS','AGGR_OMEGA_ALG',&
& 'AGGR_EIG','SMOOTHER_SWEEPS_PRE',&
& 'SMOOTHER_SWEEPS_POST',&
& 'SUB_RESTR','SUB_PROL', &
& 'SUB_REN','SUB_OVR','SUB_FILLIN')
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
case default
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end select
else if (ilev_ > 1) then
select case(psb_toupper(what))
case('SMOOTHER_TYPE')
call onelev_set_smoother(p%precv(ilev_),val,info)
call onelev_set_smoother(p%precv(ilev_),val,info,pos=pos)
case('SUB_SOLVE')
call onelev_set_solver(p%precv(ilev_),val,info)
call onelev_set_solver(p%precv(ilev_),val,info,pos=pos)
case('SMOOTHER_SWEEPS','ML_TYPE','AGGR_ALG','AGGR_ORD',&
& 'AGGR_KIND','SMOOTHER_POS','AGGR_OMEGA_ALG',&
& 'AGGR_EIG','SMOOTHER_SWEEPS_PRE',&
@ -181,7 +181,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos)
& 'SUB_RESTR','SUB_PROL', &
& 'SUB_REN','SUB_OVR','SUB_FILLIN',&
& 'COARSE_MAT')
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
case('COARSE_SUBSOLVE')
if (ilev_ /= nlev_) then
@ -190,7 +190,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos)
info = -2
return
end if
call onelev_set_solver(p%precv(ilev_),val,info)
call onelev_set_solver(p%precv(ilev_),val,info,pos=pos)
case('COARSE_SOLVE')
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
@ -200,36 +200,36 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos)
end if
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info)
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),val,info)
call onelev_set_smoother(p%precv(nlev_),val,info,pos=pos)
#if defined(HAVE_UMF_)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call onelev_set_solver(p%precv(nlev_),mld_mumps_,info)
call onelev_set_solver(p%precv(nlev_),mld_mumps_,info,pos=pos)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),val,info)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),val,info)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
case(mld_mumps_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),val,info)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
case(mld_jac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
end select
endif
@ -240,7 +240,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos)
info = -2
return
end if
call p%precv(nlev_)%set('SMOOTHER_SWEEPS',val,info)
call p%precv(nlev_)%set('SMOOTHER_SWEEPS',val,info,pos=pos)
case('COARSE_FILLIN')
if (ilev_ /= nlev_) then
@ -249,9 +249,9 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos)
info = -2
return
end if
call p%precv(nlev_)%set('SUB_FILLIN',val,info)
call p%precv(nlev_)%set('SUB_FILLIN',val,info,pos=pos)
case default
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end select
endif
@ -271,24 +271,24 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos)
info = -1
return
endif
call onelev_set_solver(p%precv(ilev_),val,info)
call onelev_set_solver(p%precv(ilev_),val,info,pos=pos)
end do
case('SUB_RESTR','SUB_PROL',&
& 'SUB_REN','SUB_OVR','SUB_FILLIN')
do ilev_=1,max(1,nlev_-1)
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
case('SMOOTHER_SWEEPS')
do ilev_=1,max(1,nlev_-1)
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
case('SMOOTHER_TYPE')
do ilev_=1,max(1,nlev_-1)
call onelev_set_smoother(p%precv(ilev_),val,info)
call onelev_set_smoother(p%precv(ilev_),val,info,pos=pos)
end do
case('ML_TYPE','AGGR_ALG','AGGR_ORD','AGGR_KIND',&
@ -296,69 +296,69 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos)
& 'SMOOTHER_POS','AGGR_OMEGA_ALG',&
& 'AGGR_EIG','AGGR_FILTER')
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
case('COARSE_MAT')
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_MAT',val,info)
call p%precv(nlev_)%set('COARSE_MAT',val,info,pos=pos)
end if
case('COARSE_SOLVE')
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info)
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
#if defined(HAVE_UMF_)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call onelev_set_solver(p%precv(nlev_),mld_mumps_,info)
call onelev_set_solver(p%precv(nlev_),mld_mumps_,info,pos=pos)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),val,info)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),val,info)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
case(mld_mumps_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),val,info)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
case(mld_jac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
end select
endif
case('COARSE_SUBSOLVE')
if (nlev_ > 1) then
call onelev_set_solver(p%precv(nlev_),val,info)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
endif
case('COARSE_SWEEPS')
if (nlev_ > 1) then
call p%precv(nlev_)%set('SMOOTHER_SWEEPS',val,info)
call p%precv(nlev_)%set('SMOOTHER_SWEEPS',val,info,pos=pos)
end if
case('COARSE_FILLIN')
if (nlev_ > 1) then
call p%precv(nlev_)%set('SUB_FILLIN',val,info)
call p%precv(nlev_)%set('SUB_FILLIN',val,info,pos=pos)
end if
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
end select
@ -366,10 +366,11 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos)
contains
subroutine onelev_set_smoother(level,val,info)
subroutine onelev_set_smoother(level,val,info,pos)
type(mld_d_onelev_type), intent(inout) :: level
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
info = psb_success_
!
@ -463,10 +464,11 @@ contains
end subroutine onelev_set_smoother
subroutine onelev_set_solver(level,val,info)
subroutine onelev_set_solver(level,val,info,pos)
type(mld_d_onelev_type), intent(inout) :: level
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
info = psb_success_
!
@ -759,9 +761,9 @@ subroutine mld_dcprecsetc(p,what,string,info,ilev,pos)
val = mld_stringval(string)
if (val >=0) then
call p%set(what,val,info,ilev=ilev)
call p%set(what,val,info,ilev=ilev,pos=pos)
else
call p%precv(ilev_)%set(what,string,info)
call p%precv(ilev_)%set(what,string,info,pos=pos)
end if
end subroutine mld_dcprecsetc
@ -855,7 +857,7 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,pos)
!
if (present(ilev)) then
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
else if (.not.present(ilev)) then
!
@ -865,19 +867,19 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,pos)
select case(psb_toupper(what))
case('COARSE_ILUTHRS')
ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info)
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info,pos=pos)
case('AGGR_THRESH')
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_THRESH',thr,info)
call p%precv(ilev_)%set('AGGR_THRESH',thr,info,pos=pos)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
end select

126
mlprec/impl/mld_dprecset.F90
Unescape Escape View File

@ -153,34 +153,34 @@ subroutine mld_dprecseti(p,what,val,info,ilev,pos)
!
select case(what)
case(mld_smoother_type_)
call onelev_set_smoother(p%precv(ilev_),val,info)
call onelev_set_smoother(p%precv(ilev_),val,info,pos=pos)
case(mld_sub_solve_)
call onelev_set_solver(p%precv(ilev_),val,info)
call onelev_set_solver(p%precv(ilev_),val,info,pos=pos)
case(mld_smoother_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_ord_,&
& mld_aggr_kind_,mld_smoother_pos_,mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_smoother_sweeps_pre_,mld_smoother_sweeps_post_,&
& mld_sub_restr_,mld_sub_prol_, &
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_)
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
case default
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end select
else if (ilev_ > 1) then
select case(what)
case(mld_smoother_type_)
call onelev_set_smoother(p%precv(ilev_),val,info)
call onelev_set_smoother(p%precv(ilev_),val,info,pos=pos)
case(mld_sub_solve_)
call onelev_set_solver(p%precv(ilev_),val,info)
call onelev_set_solver(p%precv(ilev_),val,info,pos=pos)
case(mld_smoother_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_ord_,&
& mld_aggr_kind_,mld_smoother_pos_,mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_smoother_sweeps_pre_,mld_smoother_sweeps_post_,&
& mld_sub_restr_,mld_sub_prol_, &
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_coarse_mat_)
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then
@ -189,7 +189,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev,pos)
info = -2
return
end if
call onelev_set_solver(p%precv(ilev_),val,info)
call onelev_set_solver(p%precv(ilev_),val,info,pos=pos)
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
@ -199,32 +199,32 @@ subroutine mld_dprecseti(p,what,val,info,ilev,pos)
end if
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_coarse_solve_,val,info)
call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),val,info)
call onelev_set_smoother(p%precv(nlev_),val,info,pos=pos)
#if defined(HAVE_UMF_)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call onelev_set_solver(p%precv(nlev_),mld_mumps_,info)
call onelev_set_solver(p%precv(nlev_),mld_mumps_,info,pos=pos)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),val,info)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),val,info)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_jac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
end select
endif
@ -235,7 +235,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev,pos)
info = -2
return
end if
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info)
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos)
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
@ -244,9 +244,9 @@ subroutine mld_dprecseti(p,what,val,info,ilev,pos)
info = -2
return
end if
call p%precv(nlev_)%set(mld_sub_fillin_,val,info)
call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos)
case default
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end select
endif
@ -266,24 +266,24 @@ subroutine mld_dprecseti(p,what,val,info,ilev,pos)
info = -1
return
endif
call onelev_set_solver(p%precv(ilev_),val,info)
call onelev_set_solver(p%precv(ilev_),val,info,pos=pos)
end do
case(mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_)
do ilev_=1,max(1,nlev_-1)
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
case(mld_smoother_sweeps_)
do ilev_=1,max(1,nlev_-1)
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
case(mld_smoother_type_)
do ilev_=1,max(1,nlev_-1)
call onelev_set_smoother(p%precv(ilev_),val,info)
call onelev_set_smoother(p%precv(ilev_),val,info,pos=pos)
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_ord_,mld_aggr_kind_,&
@ -291,67 +291,67 @@ subroutine mld_dprecseti(p,what,val,info,ilev,pos)
& mld_smoother_pos_,mld_aggr_omega_alg_,&
& mld_aggr_eig_,mld_aggr_filter_)
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
case(mld_coarse_mat_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_coarse_mat_,val,info)
call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos)
end if
case(mld_coarse_solve_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_coarse_solve_,val,info)
call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
#if defined(HAVE_UMF_)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info,pos=pos)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),val,info)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_sludist_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),val,info)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_mumps_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),val,info)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_jac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info,pos=pos)
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
end select
endif
case(mld_coarse_subsolve_)
if (nlev_ > 1) then
call onelev_set_solver(p%precv(nlev_),val,info)
call onelev_set_solver(p%precv(nlev_),val,info,pos=pos)
endif
case(mld_coarse_sweeps_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info)
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos)
end if
case(mld_coarse_fillin_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_sub_fillin_,val,info)
call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos)
end if
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
end select
@ -359,10 +359,11 @@ subroutine mld_dprecseti(p,what,val,info,ilev,pos)
contains
subroutine onelev_set_smoother(level,val,info)
subroutine onelev_set_smoother(level,val,info,pos)
type(mld_d_onelev_type), intent(inout) :: level
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
info = psb_success_
!
@ -456,10 +457,11 @@ contains
end subroutine onelev_set_smoother
subroutine onelev_set_solver(level,val,info)
subroutine onelev_set_solver(level,val,info,pos)
type(mld_d_onelev_type), intent(inout) :: level
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
info = psb_success_
!
@ -983,7 +985,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev,pos)
endif
val = mld_stringval(string)
if (val >=0) call p%set(what,val,info,ilev=ilev)
if (val >=0) call p%set(what,val,info,ilev=ilev,pos=pos)
end subroutine mld_dprecsetc
@ -1077,7 +1079,7 @@ subroutine mld_dprecsetr(p,what,val,info,ilev,pos)
!
if (present(ilev)) then
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
else if (.not.present(ilev)) then
!
@ -1087,19 +1089,19 @@ subroutine mld_dprecsetr(p,what,val,info,ilev,pos)
select case(what)
case(mld_coarse_iluthrs_)
ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info)
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos)
case(mld_aggr_thresh_)
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info,pos=pos)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info)
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
end select

6
mlprec/impl/solver/mld_d_bwgs_solver_apply.f90
Unescape Escape View File

@ -127,10 +127,10 @@ subroutine mld_d_bwgs_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
call psb_geaxpby(done,y,dzero,xit,desc_data,info)
do itx=1,sv%sweeps
call psb_geaxpby(done,x,dzero,wv,desc_data,info)
! Update with U. The off-diagonal block is taken care
! Update with L. The off-diagonal block is taken care
! from the Jacobi smoother, hence this is purely local.
call psb_spmm(-done,sv%u,xit,done,wv,desc_data,info,doswap=.false.)
call psb_spsm(done,sv%l,wv,dzero,xit,desc_data,info)
call psb_spmm(-done,sv%l,xit,done,wv,desc_data,info,doswap=.false.)
call psb_spsm(done,sv%u,wv,dzero,xit,desc_data,info)
!!$ temp = xit%get_vect()
!!$ write(0,*) me,'GS Iteration ',itx,':',temp(1:n_row)
end do

6
mlprec/impl/solver/mld_d_bwgs_solver_apply_vect.f90
Unescape Escape View File

@ -130,10 +130,10 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
call psb_geaxpby(done,y,dzero,xit,desc_data,info)
do itx=1,sv%sweeps
call psb_geaxpby(done,x,dzero,wv,desc_data,info)
! Update with U. The off-diagonal block is taken care
! Update with L. The off-diagonal block is taken care
! from the Jacobi smoother, hence this is purely local.
call psb_spmm(-done,sv%u,xit,done,wv,desc_data,info,doswap=.false.)
call psb_spsm(done,sv%l,wv,dzero,xit,desc_data,info)
call psb_spmm(-done,sv%l,xit,done,wv,desc_data,info,doswap=.false.)
call psb_spsm(done,sv%u,wv,dzero,xit,desc_data,info)
!!$ temp = xit%get_vect()
!!$ write(0,*) me,'GS Iteration ',itx,':',temp(1:n_row)
end do

4
mlprec/impl/solver/mld_d_bwgs_solver_bld.f90
Unescape Escape View File

@ -81,8 +81,8 @@ subroutine mld_d_bwgs_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold)
! This cuts out the off-diagonal part, because it's supposed to
! be handled by the outer Jacobi smoother.
!
call a%tril(sv%l,info)
call a%triu(sv%u,info,diag=1,jmax=nrow_a)
call a%tril(sv%l,info,diag=-1)
call a%triu(sv%u,info,jmax=nrow_a)
else

18
mlprec/mld_d_onelev_mod.f90
Unescape Escape View File

@ -214,7 +214,7 @@ module mld_d_onelev_mod
end interface
interface
subroutine mld_d_base_onelev_seti(lv,what,val,info)
subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
@ -225,11 +225,12 @@ module mld_d_onelev_mod
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine mld_d_base_onelev_seti
end interface
interface
subroutine mld_d_base_onelev_setc(lv,what,val,info)
subroutine mld_d_base_onelev_setc(lv,what,val,info,pos)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
@ -239,11 +240,12 @@ module mld_d_onelev_mod
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine mld_d_base_onelev_setc
end interface
interface
subroutine mld_d_base_onelev_setr(lv,what,val,info)
subroutine mld_d_base_onelev_setr(lv,what,val,info,pos)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
@ -253,12 +255,13 @@ module mld_d_onelev_mod
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine mld_d_base_onelev_setr
end interface
interface
subroutine mld_d_base_onelev_cseti(lv,what,val,info)
subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
@ -269,11 +272,12 @@ module mld_d_onelev_mod
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine mld_d_base_onelev_cseti
end interface
interface
subroutine mld_d_base_onelev_csetc(lv,what,val,info)
subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
@ -283,11 +287,12 @@ module mld_d_onelev_mod
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine mld_d_base_onelev_csetc
end interface
interface
subroutine mld_d_base_onelev_csetr(lv,what,val,info)
subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
@ -297,6 +302,7 @@ module mld_d_onelev_mod
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine mld_d_base_onelev_csetr
end interface

Write Preview
Loading…
Cancel
Save