From d747bc9aae2af876913b62d38cb982a81f131456 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 12 May 2016 16:01:28 +0000 Subject: [PATCH] mld2p4-smooth-2side: 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. --- mlprec/impl/level/mld_d_base_onelev_csetc.f90 | 5 +- mlprec/impl/level/mld_d_base_onelev_cseti.f90 | 3 +- mlprec/impl/level/mld_d_base_onelev_csetr.f90 | 3 +- mlprec/impl/level/mld_d_base_onelev_setc.f90 | 5 +- mlprec/impl/level/mld_d_base_onelev_seti.f90 | 3 +- mlprec/impl/level/mld_d_base_onelev_setr.f90 | 3 +- mlprec/impl/mld_dcprecset.F90 | 136 +++++++++--------- mlprec/impl/mld_dprecset.F90 | 126 ++++++++-------- .../impl/solver/mld_d_bwgs_solver_apply.f90 | 6 +- .../solver/mld_d_bwgs_solver_apply_vect.f90 | 6 +- mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 | 4 +- mlprec/mld_d_onelev_mod.f90 | 18 ++- 12 files changed, 167 insertions(+), 151 deletions(-) diff --git a/mlprec/impl/level/mld_d_base_onelev_csetc.f90 b/mlprec/impl/level/mld_d_base_onelev_csetc.f90 index c645120c..5af8dcef 100644 --- a/mlprec/impl/level/mld_d_base_onelev_csetc.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_csetc.f90 @@ -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) diff --git a/mlprec/impl/level/mld_d_base_onelev_cseti.f90 b/mlprec/impl/level/mld_d_base_onelev_cseti.f90 index a2e3255b..1406df7e 100644 --- a/mlprec/impl/level/mld_d_base_onelev_cseti.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_cseti.f90 @@ -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' diff --git a/mlprec/impl/level/mld_d_base_onelev_csetr.f90 b/mlprec/impl/level/mld_d_base_onelev_csetr.f90 index bb35507f..c7cac4fa 100644 --- a/mlprec/impl/level/mld_d_base_onelev_csetr.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_csetr.f90 @@ -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' diff --git a/mlprec/impl/level/mld_d_base_onelev_setc.f90 b/mlprec/impl/level/mld_d_base_onelev_setc.f90 index 417dcf78..8ff585cc 100644 --- a/mlprec/impl/level/mld_d_base_onelev_setc.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_setc.f90 @@ -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) diff --git a/mlprec/impl/level/mld_d_base_onelev_seti.f90 b/mlprec/impl/level/mld_d_base_onelev_seti.f90 index 4e27cbca..e459a58f 100644 --- a/mlprec/impl/level/mld_d_base_onelev_seti.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_seti.f90 @@ -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' diff --git a/mlprec/impl/level/mld_d_base_onelev_setr.f90 b/mlprec/impl/level/mld_d_base_onelev_setr.f90 index 8695c9a5..a7fe376f 100644 --- a/mlprec/impl/level/mld_d_base_onelev_setr.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_setr.f90 @@ -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' diff --git a/mlprec/impl/mld_dcprecset.F90 b/mlprec/impl/mld_dcprecset.F90 index 48ab7f17..db11961b 100644 --- a/mlprec/impl/mld_dcprecset.F90 +++ b/mlprec/impl/mld_dcprecset.F90 @@ -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 diff --git a/mlprec/impl/mld_dprecset.F90 b/mlprec/impl/mld_dprecset.F90 index 36551520..60ae1fd6 100644 --- a/mlprec/impl/mld_dprecset.F90 +++ b/mlprec/impl/mld_dprecset.F90 @@ -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 diff --git a/mlprec/impl/solver/mld_d_bwgs_solver_apply.f90 b/mlprec/impl/solver/mld_d_bwgs_solver_apply.f90 index 075e4f52..408f4a31 100644 --- a/mlprec/impl/solver/mld_d_bwgs_solver_apply.f90 +++ b/mlprec/impl/solver/mld_d_bwgs_solver_apply.f90 @@ -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 diff --git a/mlprec/impl/solver/mld_d_bwgs_solver_apply_vect.f90 b/mlprec/impl/solver/mld_d_bwgs_solver_apply_vect.f90 index f0ab056f..6ec2ca50 100644 --- a/mlprec/impl/solver/mld_d_bwgs_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_d_bwgs_solver_apply_vect.f90 @@ -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 diff --git a/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 index 7547cd38..569eb35a 100644 --- a/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 @@ -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 diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index fe7a29c8..82d8575a 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -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