fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-20 21:02:35 +00:00
Code Issues Packages Projects Releases Wiki Activity

New L1-BJAC smoother cleanups.

Browse Source
This commit is contained in:
Salvatore Filippone
2020-05-05 18:28:23 +02:00
parent 441c607c4a
commit 0854eee936
18 changed files with 313 additions and 107 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/level/mld_c_base_onelev_csetc.F90
+14 -9
View File
@@ -69,15 +69,16 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos,idx)
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='c_base_onelev_csetc'
integer(psb_ipk_) :: ival
type(mld_c_base_smoother_type) :: mld_c_base_smoother_mold
type(mld_c_jac_smoother_type) :: mld_c_jac_smoother_mold
type(mld_c_as_smoother_type) :: mld_c_as_smoother_mold
type(mld_c_diag_solver_type) :: mld_c_diag_solver_mold
type(mld_c_l1_diag_solver_type) :: mld_c_l1_diag_solver_mold
type(mld_c_ilu_solver_type) :: mld_c_ilu_solver_mold
type(mld_c_id_solver_type) :: mld_c_id_solver_mold
type(mld_c_gs_solver_type) :: mld_c_gs_solver_mold
type(mld_c_bwgs_solver_type) :: mld_c_bwgs_solver_mold
type(mld_c_base_smoother_type) :: mld_c_base_smoother_mold
type(mld_c_jac_smoother_type) :: mld_c_jac_smoother_mold
type(mld_c_l1_jac_smoother_type) :: mld_c_l1_jac_smoother_mold
type(mld_c_as_smoother_type) :: mld_c_as_smoother_mold
type(mld_c_diag_solver_type) :: mld_c_diag_solver_mold
type(mld_c_l1_diag_solver_type) :: mld_c_l1_diag_solver_mold
type(mld_c_ilu_solver_type) :: mld_c_ilu_solver_mold
type(mld_c_id_solver_type) :: mld_c_id_solver_mold
type(mld_c_gs_solver_type) :: mld_c_gs_solver_mold
type(mld_c_bwgs_solver_type) :: mld_c_bwgs_solver_mold
#if defined(HAVE_SLU_)
type(mld_c_slu_solver_type) :: mld_c_slu_solver_mold
#endif
@@ -124,6 +125,10 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('BJAC')
call lv%set(mld_c_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
case ('L1-BJAC')
call lv%set(mld_c_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
case ('AS')
call lv%set(mld_c_as_smoother_mold,info,pos=pos)
mlprec/impl/level/mld_c_base_onelev_cseti.F90
+14 -9
View File
@@ -68,15 +68,16 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos,idx)
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='c_base_onelev_cseti'
type(mld_c_base_smoother_type) :: mld_c_base_smoother_mold
type(mld_c_jac_smoother_type) :: mld_c_jac_smoother_mold
type(mld_c_as_smoother_type) :: mld_c_as_smoother_mold
type(mld_c_diag_solver_type) :: mld_c_diag_solver_mold
type(mld_c_l1_diag_solver_type) :: mld_c_l1_diag_solver_mold
type(mld_c_ilu_solver_type) :: mld_c_ilu_solver_mold
type(mld_c_id_solver_type) :: mld_c_id_solver_mold
type(mld_c_gs_solver_type) :: mld_c_gs_solver_mold
type(mld_c_bwgs_solver_type) :: mld_c_bwgs_solver_mold
type(mld_c_base_smoother_type) :: mld_c_base_smoother_mold
type(mld_c_jac_smoother_type) :: mld_c_jac_smoother_mold
type(mld_c_l1_jac_smoother_type) :: mld_c_l1_jac_smoother_mold
type(mld_c_as_smoother_type) :: mld_c_as_smoother_mold
type(mld_c_diag_solver_type) :: mld_c_diag_solver_mold
type(mld_c_l1_diag_solver_type) :: mld_c_l1_diag_solver_mold
type(mld_c_ilu_solver_type) :: mld_c_ilu_solver_mold
type(mld_c_id_solver_type) :: mld_c_id_solver_mold
type(mld_c_gs_solver_type) :: mld_c_gs_solver_mold
type(mld_c_bwgs_solver_type) :: mld_c_bwgs_solver_mold
#if defined(HAVE_SLU_)
type(mld_c_slu_solver_type) :: mld_c_slu_solver_mold
#endif
@@ -118,6 +119,10 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos,idx)
case (mld_bjac_)
call lv%set(mld_c_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
case (mld_l1_bjac_)
call lv%set(mld_c_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
case (mld_as_)
call lv%set(mld_c_as_smoother_mold,info,pos=pos)
mlprec/impl/level/mld_d_base_onelev_csetc.F90
+11 -11
View File
@@ -75,16 +75,16 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos,idx)
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_csetc'
integer(psb_ipk_) :: ival
type(mld_d_base_smoother_type) :: mld_d_base_smoother_mold
type(mld_d_jac_smoother_type) :: mld_d_jac_smoother_mold
type(mld_d_l1_jac_smoother_type) :: mld_d_l1_jac_smoother_mold
type(mld_d_as_smoother_type) :: mld_d_as_smoother_mold
type(mld_d_diag_solver_type) :: mld_d_diag_solver_mold
type(mld_d_l1_diag_solver_type) :: mld_d_l1_diag_solver_mold
type(mld_d_ilu_solver_type) :: mld_d_ilu_solver_mold
type(mld_d_id_solver_type) :: mld_d_id_solver_mold
type(mld_d_gs_solver_type) :: mld_d_gs_solver_mold
type(mld_d_bwgs_solver_type) :: mld_d_bwgs_solver_mold
type(mld_d_base_smoother_type) :: mld_d_base_smoother_mold
type(mld_d_jac_smoother_type) :: mld_d_jac_smoother_mold
type(mld_d_l1_jac_smoother_type) :: mld_d_l1_jac_smoother_mold
type(mld_d_as_smoother_type) :: mld_d_as_smoother_mold
type(mld_d_diag_solver_type) :: mld_d_diag_solver_mold
type(mld_d_l1_diag_solver_type) :: mld_d_l1_diag_solver_mold
type(mld_d_ilu_solver_type) :: mld_d_ilu_solver_mold
type(mld_d_id_solver_type) :: mld_d_id_solver_mold
type(mld_d_gs_solver_type) :: mld_d_gs_solver_mold
type(mld_d_bwgs_solver_type) :: mld_d_bwgs_solver_mold
#if defined(HAVE_UMF_)
type(mld_d_umf_solver_type) :: mld_d_umf_solver_mold
#endif
@@ -137,7 +137,7 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('BJAC')
call lv%set(mld_d_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
case ('L1-BJAC')
call lv%set(mld_d_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
mlprec/impl/level/mld_d_base_onelev_cseti.F90
+11 -11
View File
@@ -74,16 +74,16 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos,idx)
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_cseti'
type(mld_d_base_smoother_type) :: mld_d_base_smoother_mold
type(mld_d_jac_smoother_type) :: mld_d_jac_smoother_mold
type(mld_d_l1_jac_smoother_type) :: mld_d_l1_jac_smoother_mold
type(mld_d_as_smoother_type) :: mld_d_as_smoother_mold
type(mld_d_diag_solver_type) :: mld_d_diag_solver_mold
type(mld_d_l1_diag_solver_type) :: mld_d_l1_diag_solver_mold
type(mld_d_ilu_solver_type) :: mld_d_ilu_solver_mold
type(mld_d_id_solver_type) :: mld_d_id_solver_mold
type(mld_d_gs_solver_type) :: mld_d_gs_solver_mold
type(mld_d_bwgs_solver_type) :: mld_d_bwgs_solver_mold
type(mld_d_base_smoother_type) :: mld_d_base_smoother_mold
type(mld_d_jac_smoother_type) :: mld_d_jac_smoother_mold
type(mld_d_l1_jac_smoother_type) :: mld_d_l1_jac_smoother_mold
type(mld_d_as_smoother_type) :: mld_d_as_smoother_mold
type(mld_d_diag_solver_type) :: mld_d_diag_solver_mold
type(mld_d_l1_diag_solver_type) :: mld_d_l1_diag_solver_mold
type(mld_d_ilu_solver_type) :: mld_d_ilu_solver_mold
type(mld_d_id_solver_type) :: mld_d_id_solver_mold
type(mld_d_gs_solver_type) :: mld_d_gs_solver_mold
type(mld_d_bwgs_solver_type) :: mld_d_bwgs_solver_mold
#if defined(HAVE_UMF_)
type(mld_d_umf_solver_type) :: mld_d_umf_solver_mold
#endif
@@ -131,7 +131,7 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos,idx)
case (mld_bjac_)
call lv%set(mld_d_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
case (mld_l1_bjac_)
call lv%set(mld_d_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
mlprec/impl/level/mld_s_base_onelev_csetc.F90
+14 -9
View File
@@ -69,15 +69,16 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos,idx)
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='s_base_onelev_csetc'
integer(psb_ipk_) :: ival
type(mld_s_base_smoother_type) :: mld_s_base_smoother_mold
type(mld_s_jac_smoother_type) :: mld_s_jac_smoother_mold
type(mld_s_as_smoother_type) :: mld_s_as_smoother_mold
type(mld_s_diag_solver_type) :: mld_s_diag_solver_mold
type(mld_s_l1_diag_solver_type) :: mld_s_l1_diag_solver_mold
type(mld_s_ilu_solver_type) :: mld_s_ilu_solver_mold
type(mld_s_id_solver_type) :: mld_s_id_solver_mold
type(mld_s_gs_solver_type) :: mld_s_gs_solver_mold
type(mld_s_bwgs_solver_type) :: mld_s_bwgs_solver_mold
type(mld_s_base_smoother_type) :: mld_s_base_smoother_mold
type(mld_s_jac_smoother_type) :: mld_s_jac_smoother_mold
type(mld_s_l1_jac_smoother_type) :: mld_s_l1_jac_smoother_mold
type(mld_s_as_smoother_type) :: mld_s_as_smoother_mold
type(mld_s_diag_solver_type) :: mld_s_diag_solver_mold
type(mld_s_l1_diag_solver_type) :: mld_s_l1_diag_solver_mold
type(mld_s_ilu_solver_type) :: mld_s_ilu_solver_mold
type(mld_s_id_solver_type) :: mld_s_id_solver_mold
type(mld_s_gs_solver_type) :: mld_s_gs_solver_mold
type(mld_s_bwgs_solver_type) :: mld_s_bwgs_solver_mold
#if defined(HAVE_SLU_)
type(mld_s_slu_solver_type) :: mld_s_slu_solver_mold
#endif
@@ -124,6 +125,10 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('BJAC')
call lv%set(mld_s_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
case ('L1-BJAC')
call lv%set(mld_s_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
case ('AS')
call lv%set(mld_s_as_smoother_mold,info,pos=pos)
mlprec/impl/level/mld_s_base_onelev_cseti.F90
+14 -9
View File
@@ -68,15 +68,16 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos,idx)
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='s_base_onelev_cseti'
type(mld_s_base_smoother_type) :: mld_s_base_smoother_mold
type(mld_s_jac_smoother_type) :: mld_s_jac_smoother_mold
type(mld_s_as_smoother_type) :: mld_s_as_smoother_mold
type(mld_s_diag_solver_type) :: mld_s_diag_solver_mold
type(mld_s_l1_diag_solver_type) :: mld_s_l1_diag_solver_mold
type(mld_s_ilu_solver_type) :: mld_s_ilu_solver_mold
type(mld_s_id_solver_type) :: mld_s_id_solver_mold
type(mld_s_gs_solver_type) :: mld_s_gs_solver_mold
type(mld_s_bwgs_solver_type) :: mld_s_bwgs_solver_mold
type(mld_s_base_smoother_type) :: mld_s_base_smoother_mold
type(mld_s_jac_smoother_type) :: mld_s_jac_smoother_mold
type(mld_s_l1_jac_smoother_type) :: mld_s_l1_jac_smoother_mold
type(mld_s_as_smoother_type) :: mld_s_as_smoother_mold
type(mld_s_diag_solver_type) :: mld_s_diag_solver_mold
type(mld_s_l1_diag_solver_type) :: mld_s_l1_diag_solver_mold
type(mld_s_ilu_solver_type) :: mld_s_ilu_solver_mold
type(mld_s_id_solver_type) :: mld_s_id_solver_mold
type(mld_s_gs_solver_type) :: mld_s_gs_solver_mold
type(mld_s_bwgs_solver_type) :: mld_s_bwgs_solver_mold
#if defined(HAVE_SLU_)
type(mld_s_slu_solver_type) :: mld_s_slu_solver_mold
#endif
@@ -118,6 +119,10 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos,idx)
case (mld_bjac_)
call lv%set(mld_s_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
case (mld_l1_bjac_)
call lv%set(mld_s_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
case (mld_as_)
call lv%set(mld_s_as_smoother_mold,info,pos=pos)
mlprec/impl/level/mld_z_base_onelev_csetc.F90
+14 -9
View File
@@ -75,15 +75,16 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos,idx)
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='z_base_onelev_csetc'
integer(psb_ipk_) :: ival
type(mld_z_base_smoother_type) :: mld_z_base_smoother_mold
type(mld_z_jac_smoother_type) :: mld_z_jac_smoother_mold
type(mld_z_as_smoother_type) :: mld_z_as_smoother_mold
type(mld_z_diag_solver_type) :: mld_z_diag_solver_mold
type(mld_z_l1_diag_solver_type) :: mld_z_l1_diag_solver_mold
type(mld_z_ilu_solver_type) :: mld_z_ilu_solver_mold
type(mld_z_id_solver_type) :: mld_z_id_solver_mold
type(mld_z_gs_solver_type) :: mld_z_gs_solver_mold
type(mld_z_bwgs_solver_type) :: mld_z_bwgs_solver_mold
type(mld_z_base_smoother_type) :: mld_z_base_smoother_mold
type(mld_z_jac_smoother_type) :: mld_z_jac_smoother_mold
type(mld_z_l1_jac_smoother_type) :: mld_z_l1_jac_smoother_mold
type(mld_z_as_smoother_type) :: mld_z_as_smoother_mold
type(mld_z_diag_solver_type) :: mld_z_diag_solver_mold
type(mld_z_l1_diag_solver_type) :: mld_z_l1_diag_solver_mold
type(mld_z_ilu_solver_type) :: mld_z_ilu_solver_mold
type(mld_z_id_solver_type) :: mld_z_id_solver_mold
type(mld_z_gs_solver_type) :: mld_z_gs_solver_mold
type(mld_z_bwgs_solver_type) :: mld_z_bwgs_solver_mold
#if defined(HAVE_UMF_)
type(mld_z_umf_solver_type) :: mld_z_umf_solver_mold
#endif
@@ -136,6 +137,10 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('BJAC')
call lv%set(mld_z_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
case ('L1-BJAC')
call lv%set(mld_z_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
case ('AS')
call lv%set(mld_z_as_smoother_mold,info,pos=pos)
mlprec/impl/level/mld_z_base_onelev_cseti.F90
+14 -9
View File
@@ -74,15 +74,16 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos,idx)
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='z_base_onelev_cseti'
type(mld_z_base_smoother_type) :: mld_z_base_smoother_mold
type(mld_z_jac_smoother_type) :: mld_z_jac_smoother_mold
type(mld_z_as_smoother_type) :: mld_z_as_smoother_mold
type(mld_z_diag_solver_type) :: mld_z_diag_solver_mold
type(mld_z_l1_diag_solver_type) :: mld_z_l1_diag_solver_mold
type(mld_z_ilu_solver_type) :: mld_z_ilu_solver_mold
type(mld_z_id_solver_type) :: mld_z_id_solver_mold
type(mld_z_gs_solver_type) :: mld_z_gs_solver_mold
type(mld_z_bwgs_solver_type) :: mld_z_bwgs_solver_mold
type(mld_z_base_smoother_type) :: mld_z_base_smoother_mold
type(mld_z_jac_smoother_type) :: mld_z_jac_smoother_mold
type(mld_z_l1_jac_smoother_type) :: mld_z_l1_jac_smoother_mold
type(mld_z_as_smoother_type) :: mld_z_as_smoother_mold
type(mld_z_diag_solver_type) :: mld_z_diag_solver_mold
type(mld_z_l1_diag_solver_type) :: mld_z_l1_diag_solver_mold
type(mld_z_ilu_solver_type) :: mld_z_ilu_solver_mold
type(mld_z_id_solver_type) :: mld_z_id_solver_mold
type(mld_z_gs_solver_type) :: mld_z_gs_solver_mold
type(mld_z_bwgs_solver_type) :: mld_z_bwgs_solver_mold
#if defined(HAVE_UMF_)
type(mld_z_umf_solver_type) :: mld_z_umf_solver_mold
#endif
@@ -130,6 +131,10 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos,idx)
case (mld_bjac_)
call lv%set(mld_z_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
case (mld_l1_bjac_)
call lv%set(mld_z_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
case (mld_as_)
call lv%set(mld_z_as_smoother_mold,info,pos=pos)
mlprec/impl/mld_c_smoothers_bld.f90
+1 -1
View File
@@ -256,7 +256,7 @@ subroutine mld_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
& ' but the coarse matrix has been changed to replicated'
end if
case(mld_bjac_,mld_jac_, mld_l1_jac_)
case(mld_bjac_,mld_l1_bjac_,mld_jac_, mld_l1_jac_)
if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
mlprec/impl/mld_ccprecset.F90
+8 -8
View File
@@ -191,8 +191,8 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
@@ -325,8 +325,8 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
@@ -572,8 +572,8 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (psb_toupper(trim(string)))
case('BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
#elif defined(HAVE_MUMPS_)
@@ -688,8 +688,8 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (string)
case('BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
#elif defined(HAVE_MUMPS_)
mlprec/impl/mld_s_smoothers_bld.f90
+1 -1
View File
@@ -256,7 +256,7 @@ subroutine mld_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
& ' but the coarse matrix has been changed to replicated'
end if
case(mld_bjac_,mld_jac_, mld_l1_jac_)
case(mld_bjac_,mld_l1_bjac_,mld_jac_, mld_l1_jac_)
if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
mlprec/impl/mld_scprecset.F90
+8 -8
View File
@@ -191,8 +191,8 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
@@ -325,8 +325,8 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
@@ -572,8 +572,8 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (psb_toupper(trim(string)))
case('BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
#elif defined(HAVE_MUMPS_)
@@ -688,8 +688,8 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (string)
case('BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
#elif defined(HAVE_MUMPS_)
mlprec/impl/mld_z_smoothers_bld.f90
+1 -1
View File
@@ -256,7 +256,7 @@ subroutine mld_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
& ' but the coarse matrix has been changed to replicated'
end if
case(mld_bjac_,mld_jac_, mld_l1_jac_)
case(mld_bjac_,mld_l1_bjac_,mld_jac_, mld_l1_jac_)
if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
mlprec/impl/mld_zcprecset.F90
+8 -8
View File
@@ -197,8 +197,8 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_)
@@ -345,8 +345,8 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_)
@@ -612,8 +612,8 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (psb_toupper(trim(string)))
case('BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos)
#elif defined(HAVE_SLU_)
@@ -742,8 +742,8 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (string)
case('BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos)
#elif defined(HAVE_SLU_)
mlprec/mld_c_jac_smoother.f90
+59
View File
@@ -86,11 +86,20 @@ module mld_c_jac_smoother
procedure, nopass :: get_id => c_jac_smoother_get_id
end type mld_c_jac_smoother_type
type, extends(mld_c_jac_smoother_type) :: mld_c_l1_jac_smoother_type
contains
procedure, pass(sm) :: build => mld_c_l1_jac_smoother_bld
procedure, pass(sm) :: clone => mld_c_l1_jac_smoother_clone
procedure, pass(sm) :: descr => mld_c_l1_jac_smoother_descr
procedure, nopass :: get_fmt => c_l1_jac_smoother_get_fmt
procedure, nopass :: get_id => c_l1_jac_smoother_get_id
end type mld_c_l1_jac_smoother_type
private :: c_jac_smoother_free, &
& c_jac_smoother_sizeof, c_jac_smoother_get_nzeros, &
& c_jac_smoother_get_fmt, c_jac_smoother_get_id, &
& c_jac_smoother_get_wrksize
private :: c_l1_jac_smoother_get_fmt, c_l1_jac_smoother_get_id
interface
@@ -237,6 +246,42 @@ module mld_c_jac_smoother
end subroutine mld_c_jac_smoother_csetr
end interface
interface
subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
import :: psb_desc_type, mld_c_l1_jac_smoother_type, psb_c_vect_type, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(mld_c_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine mld_c_l1_jac_smoother_bld
end interface
interface
subroutine mld_c_l1_jac_smoother_clone(sm,smout,info)
import :: mld_c_l1_jac_smoother_type, &
& mld_c_base_smoother_type, psb_ipk_
class(mld_c_l1_jac_smoother_type), intent(inout) :: sm
class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_l1_jac_smoother_clone
end interface
interface
subroutine mld_c_l1_jac_smoother_descr(sm,info,iout,coarse)
import :: mld_c_l1_jac_smoother_type, psb_ipk_
class(mld_c_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine mld_c_l1_jac_smoother_descr
end interface
contains
@@ -352,4 +397,18 @@ contains
val = mld_jac_
end function c_jac_smoother_get_id
function c_l1_jac_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "L1-Jacobi smoother"
end function c_l1_jac_smoother_get_fmt
function c_l1_jac_smoother_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = mld_l1_jac_
end function c_l1_jac_smoother_get_id
end module mld_c_jac_smoother
mlprec/mld_d_jac_smoother.f90
+3 -4
View File
@@ -95,7 +95,6 @@ module mld_d_jac_smoother
procedure, nopass :: get_id => d_l1_jac_smoother_get_id
end type mld_d_l1_jac_smoother_type
private :: d_jac_smoother_free, &
& d_jac_smoother_sizeof, d_jac_smoother_get_nzeros, &
& d_jac_smoother_get_fmt, d_jac_smoother_get_id, &
@@ -247,9 +246,10 @@ module mld_d_jac_smoother
end subroutine mld_d_jac_smoother_csetr
end interface
interface
subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
import :: psb_desc_type, mld_d_l1_jac_smoother_type, psb_d_vect_type, psb_dpk_, &
import :: psb_desc_type, mld_d_l1_jac_smoother_type, psb_d_vect_type, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a
@@ -264,7 +264,7 @@ module mld_d_jac_smoother
interface
subroutine mld_d_l1_jac_smoother_clone(sm,smout,info)
import :: mld_d_l1_jac_smoother_type, psb_dpk_, &
import :: mld_d_l1_jac_smoother_type, &
& mld_d_base_smoother_type, psb_ipk_
class(mld_d_l1_jac_smoother_type), intent(inout) :: sm
class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
@@ -282,7 +282,6 @@ module mld_d_jac_smoother
end subroutine mld_d_l1_jac_smoother_descr
end interface
contains
mlprec/mld_s_jac_smoother.f90
+59
View File
@@ -86,11 +86,20 @@ module mld_s_jac_smoother
procedure, nopass :: get_id => s_jac_smoother_get_id
end type mld_s_jac_smoother_type
type, extends(mld_s_jac_smoother_type) :: mld_s_l1_jac_smoother_type
contains
procedure, pass(sm) :: build => mld_s_l1_jac_smoother_bld
procedure, pass(sm) :: clone => mld_s_l1_jac_smoother_clone
procedure, pass(sm) :: descr => mld_s_l1_jac_smoother_descr
procedure, nopass :: get_fmt => s_l1_jac_smoother_get_fmt
procedure, nopass :: get_id => s_l1_jac_smoother_get_id
end type mld_s_l1_jac_smoother_type
private :: s_jac_smoother_free, &
& s_jac_smoother_sizeof, s_jac_smoother_get_nzeros, &
& s_jac_smoother_get_fmt, s_jac_smoother_get_id, &
& s_jac_smoother_get_wrksize
private :: s_l1_jac_smoother_get_fmt, s_l1_jac_smoother_get_id
interface
@@ -237,6 +246,42 @@ module mld_s_jac_smoother
end subroutine mld_s_jac_smoother_csetr
end interface
interface
subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
import :: psb_desc_type, mld_s_l1_jac_smoother_type, psb_s_vect_type, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(mld_s_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine mld_s_l1_jac_smoother_bld
end interface
interface
subroutine mld_s_l1_jac_smoother_clone(sm,smout,info)
import :: mld_s_l1_jac_smoother_type, &
& mld_s_base_smoother_type, psb_ipk_
class(mld_s_l1_jac_smoother_type), intent(inout) :: sm
class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_l1_jac_smoother_clone
end interface
interface
subroutine mld_s_l1_jac_smoother_descr(sm,info,iout,coarse)
import :: mld_s_l1_jac_smoother_type, psb_ipk_
class(mld_s_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine mld_s_l1_jac_smoother_descr
end interface
contains
@@ -352,4 +397,18 @@ contains
val = mld_jac_
end function s_jac_smoother_get_id
function s_l1_jac_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "L1-Jacobi smoother"
end function s_l1_jac_smoother_get_fmt
function s_l1_jac_smoother_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = mld_l1_jac_
end function s_l1_jac_smoother_get_id
end module mld_s_jac_smoother
mlprec/mld_z_jac_smoother.f90
+59
View File
@@ -86,11 +86,20 @@ module mld_z_jac_smoother
procedure, nopass :: get_id => z_jac_smoother_get_id
end type mld_z_jac_smoother_type
type, extends(mld_z_jac_smoother_type) :: mld_z_l1_jac_smoother_type
contains
procedure, pass(sm) :: build => mld_z_l1_jac_smoother_bld
procedure, pass(sm) :: clone => mld_z_l1_jac_smoother_clone
procedure, pass(sm) :: descr => mld_z_l1_jac_smoother_descr
procedure, nopass :: get_fmt => z_l1_jac_smoother_get_fmt
procedure, nopass :: get_id => z_l1_jac_smoother_get_id
end type mld_z_l1_jac_smoother_type
private :: z_jac_smoother_free, &
& z_jac_smoother_sizeof, z_jac_smoother_get_nzeros, &
& z_jac_smoother_get_fmt, z_jac_smoother_get_id, &
& z_jac_smoother_get_wrksize
private :: z_l1_jac_smoother_get_fmt, z_l1_jac_smoother_get_id
interface
@@ -237,6 +246,42 @@ module mld_z_jac_smoother
end subroutine mld_z_jac_smoother_csetr
end interface
interface
subroutine mld_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
import :: psb_desc_type, mld_z_l1_jac_smoother_type, psb_z_vect_type, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(mld_z_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine mld_z_l1_jac_smoother_bld
end interface
interface
subroutine mld_z_l1_jac_smoother_clone(sm,smout,info)
import :: mld_z_l1_jac_smoother_type, &
& mld_z_base_smoother_type, psb_ipk_
class(mld_z_l1_jac_smoother_type), intent(inout) :: sm
class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_l1_jac_smoother_clone
end interface
interface
subroutine mld_z_l1_jac_smoother_descr(sm,info,iout,coarse)
import :: mld_z_l1_jac_smoother_type, psb_ipk_
class(mld_z_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine mld_z_l1_jac_smoother_descr
end interface
contains
@@ -352,4 +397,18 @@ contains
val = mld_jac_
end function z_jac_smoother_get_id
function z_l1_jac_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "L1-Jacobi smoother"
end function z_l1_jac_smoother_get_fmt
function z_l1_jac_smoother_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = mld_l1_jac_
end function z_l1_jac_smoother_get_id
end module mld_z_jac_smoother