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

New L1-BJAC smoother cleanups.

Browse Source
pizdaint-runs
Salvatore Filippone 5 years ago
parent 441c607c4a
commit 0854eee936
18 changed files with 313 additions and 107 deletions
Show Stats Download Patch File Download Diff File

5
mlprec/impl/level/mld_c_base_onelev_csetc.F90
Unescape Escape View File

@ -71,6 +71,7 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos,idx)
integer(psb_ipk_) :: ival integer(psb_ipk_) :: ival
type(mld_c_base_smoother_type) :: mld_c_base_smoother_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_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_as_smoother_type) :: mld_c_as_smoother_mold
type(mld_c_diag_solver_type) :: mld_c_diag_solver_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_l1_diag_solver_type) :: mld_c_l1_diag_solver_mold
@ -125,6 +126,10 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos,idx)
call lv%set(mld_c_jac_smoother_mold,info,pos=pos) 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) 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') case ('AS')
call lv%set(mld_c_as_smoother_mold,info,pos=pos) call lv%set(mld_c_as_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos)

5
mlprec/impl/level/mld_c_base_onelev_cseti.F90
Unescape Escape View File

@ -70,6 +70,7 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos,idx)
character(len=20) :: name='c_base_onelev_cseti' character(len=20) :: name='c_base_onelev_cseti'
type(mld_c_base_smoother_type) :: mld_c_base_smoother_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_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_as_smoother_type) :: mld_c_as_smoother_mold
type(mld_c_diag_solver_type) :: mld_c_diag_solver_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_l1_diag_solver_type) :: mld_c_l1_diag_solver_mold
@ -119,6 +120,10 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos,idx)
call lv%set(mld_c_jac_smoother_mold,info,pos=pos) 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) 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_) case (mld_as_)
call lv%set(mld_c_as_smoother_mold,info,pos=pos) call lv%set(mld_c_as_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos)

5
mlprec/impl/level/mld_s_base_onelev_csetc.F90
Unescape Escape View File

@ -71,6 +71,7 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos,idx)
integer(psb_ipk_) :: ival integer(psb_ipk_) :: ival
type(mld_s_base_smoother_type) :: mld_s_base_smoother_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_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_as_smoother_type) :: mld_s_as_smoother_mold
type(mld_s_diag_solver_type) :: mld_s_diag_solver_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_l1_diag_solver_type) :: mld_s_l1_diag_solver_mold
@ -125,6 +126,10 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos,idx)
call lv%set(mld_s_jac_smoother_mold,info,pos=pos) 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) 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') case ('AS')
call lv%set(mld_s_as_smoother_mold,info,pos=pos) call lv%set(mld_s_as_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos)

5
mlprec/impl/level/mld_s_base_onelev_cseti.F90
Unescape Escape View File

@ -70,6 +70,7 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos,idx)
character(len=20) :: name='s_base_onelev_cseti' character(len=20) :: name='s_base_onelev_cseti'
type(mld_s_base_smoother_type) :: mld_s_base_smoother_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_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_as_smoother_type) :: mld_s_as_smoother_mold
type(mld_s_diag_solver_type) :: mld_s_diag_solver_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_l1_diag_solver_type) :: mld_s_l1_diag_solver_mold
@ -119,6 +120,10 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos,idx)
call lv%set(mld_s_jac_smoother_mold,info,pos=pos) 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) 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_) case (mld_as_)
call lv%set(mld_s_as_smoother_mold,info,pos=pos) call lv%set(mld_s_as_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos)

5
mlprec/impl/level/mld_z_base_onelev_csetc.F90
Unescape Escape View File

@ -77,6 +77,7 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos,idx)
integer(psb_ipk_) :: ival integer(psb_ipk_) :: ival
type(mld_z_base_smoother_type) :: mld_z_base_smoother_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_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_as_smoother_type) :: mld_z_as_smoother_mold
type(mld_z_diag_solver_type) :: mld_z_diag_solver_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_l1_diag_solver_type) :: mld_z_l1_diag_solver_mold
@ -137,6 +138,10 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos,idx)
call lv%set(mld_z_jac_smoother_mold,info,pos=pos) 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) 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') case ('AS')
call lv%set(mld_z_as_smoother_mold,info,pos=pos) call lv%set(mld_z_as_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos)

5
mlprec/impl/level/mld_z_base_onelev_cseti.F90
Unescape Escape View File

@ -76,6 +76,7 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos,idx)
character(len=20) :: name='z_base_onelev_cseti' character(len=20) :: name='z_base_onelev_cseti'
type(mld_z_base_smoother_type) :: mld_z_base_smoother_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_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_as_smoother_type) :: mld_z_as_smoother_mold
type(mld_z_diag_solver_type) :: mld_z_diag_solver_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_l1_diag_solver_type) :: mld_z_l1_diag_solver_mold
@ -131,6 +132,10 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos,idx)
call lv%set(mld_z_jac_smoother_mold,info,pos=pos) 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) 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_) case (mld_as_)
call lv%set(mld_z_as_smoother_mold,info,pos=pos) call lv%set(mld_z_as_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos) if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos)

2
mlprec/impl/mld_c_smoothers_bld.f90
Unescape Escape 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' & ' but the coarse matrix has been changed to replicated'
end if 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 if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) & write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',& & 'MLD2P4: Warning: original coarse solver was requested as ',&

16
mlprec/impl/mld_ccprecset.F90
Unescape Escape View File

@ -191,8 +191,8 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_) #elif defined(HAVE_MUMPS_)
@ -325,8 +325,8 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_) #elif defined(HAVE_MUMPS_)
@ -572,8 +572,8 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (psb_toupper(trim(string))) select case (psb_toupper(trim(string)))
case('BJAC') case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
#elif defined(HAVE_MUMPS_) #elif defined(HAVE_MUMPS_)
@ -688,8 +688,8 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (string) select case (string)
case('BJAC') case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
#elif defined(HAVE_MUMPS_) #elif defined(HAVE_MUMPS_)

2
mlprec/impl/mld_s_smoothers_bld.f90
Unescape Escape 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' & ' but the coarse matrix has been changed to replicated'
end if 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 if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) & write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',& & 'MLD2P4: Warning: original coarse solver was requested as ',&

16
mlprec/impl/mld_scprecset.F90
Unescape Escape View File

@ -191,8 +191,8 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_) #elif defined(HAVE_MUMPS_)
@ -325,8 +325,8 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_) #elif defined(HAVE_MUMPS_)
@ -572,8 +572,8 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (psb_toupper(trim(string))) select case (psb_toupper(trim(string)))
case('BJAC') case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
#elif defined(HAVE_MUMPS_) #elif defined(HAVE_MUMPS_)
@ -688,8 +688,8 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (string) select case (string)
case('BJAC') case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
#elif defined(HAVE_MUMPS_) #elif defined(HAVE_MUMPS_)

2
mlprec/impl/mld_z_smoothers_bld.f90
Unescape Escape 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' & ' but the coarse matrix has been changed to replicated'
end if 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 if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) & write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',& & 'MLD2P4: Warning: original coarse solver was requested as ',&

16
mlprec/impl/mld_zcprecset.F90
Unescape Escape View File

@ -197,8 +197,8 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_UMF_) #if defined(HAVE_UMF_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_) #elif defined(HAVE_SLU_)
@ -345,8 +345,8 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_,mld_l1_bjac_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',val,info,pos=pos)
#if defined(HAVE_UMF_) #if defined(HAVE_UMF_)
call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_) #elif defined(HAVE_SLU_)
@ -612,8 +612,8 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (psb_toupper(trim(string))) select case (psb_toupper(trim(string)))
case('BJAC') case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_UMF_) #if defined(HAVE_UMF_)
call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos)
#elif defined(HAVE_SLU_) #elif defined(HAVE_SLU_)
@ -742,8 +742,8 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
if (nlev_ > 1) then if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos) call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
select case (string) select case (string)
case('BJAC') case('BJAC', 'L1_BJAC')
call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',psb_toupper(trim(string)),info,pos=pos)
#if defined(HAVE_UMF_) #if defined(HAVE_UMF_)
call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos)
#elif defined(HAVE_SLU_) #elif defined(HAVE_SLU_)

59
mlprec/mld_c_jac_smoother.f90
Unescape Escape View File

@ -86,11 +86,20 @@ module mld_c_jac_smoother
procedure, nopass :: get_id => c_jac_smoother_get_id procedure, nopass :: get_id => c_jac_smoother_get_id
end type mld_c_jac_smoother_type 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, & private :: c_jac_smoother_free, &
& c_jac_smoother_sizeof, c_jac_smoother_get_nzeros, & & c_jac_smoother_sizeof, c_jac_smoother_get_nzeros, &
& c_jac_smoother_get_fmt, c_jac_smoother_get_id, & & c_jac_smoother_get_fmt, c_jac_smoother_get_id, &
& c_jac_smoother_get_wrksize & c_jac_smoother_get_wrksize
private :: c_l1_jac_smoother_get_fmt, c_l1_jac_smoother_get_id
interface interface
@ -237,6 +246,42 @@ module mld_c_jac_smoother
end subroutine mld_c_jac_smoother_csetr end subroutine mld_c_jac_smoother_csetr
end interface 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 contains
@ -352,4 +397,18 @@ contains
val = mld_jac_ val = mld_jac_
end function c_jac_smoother_get_id 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 end module mld_c_jac_smoother

7
mlprec/mld_d_jac_smoother.f90
Unescape Escape View File

@ -95,7 +95,6 @@ module mld_d_jac_smoother
procedure, nopass :: get_id => d_l1_jac_smoother_get_id procedure, nopass :: get_id => d_l1_jac_smoother_get_id
end type mld_d_l1_jac_smoother_type end type mld_d_l1_jac_smoother_type
private :: d_jac_smoother_free, & private :: d_jac_smoother_free, &
& d_jac_smoother_sizeof, d_jac_smoother_get_nzeros, & & d_jac_smoother_sizeof, d_jac_smoother_get_nzeros, &
& d_jac_smoother_get_fmt, d_jac_smoother_get_id, & & 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 subroutine mld_d_jac_smoother_csetr
end interface end interface
interface interface
subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) 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_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(in), target :: a
@ -264,7 +264,7 @@ module mld_d_jac_smoother
interface interface
subroutine mld_d_l1_jac_smoother_clone(sm,smout,info) 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_ & mld_d_base_smoother_type, psb_ipk_
class(mld_d_l1_jac_smoother_type), intent(inout) :: sm class(mld_d_l1_jac_smoother_type), intent(inout) :: sm
class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout 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 subroutine mld_d_l1_jac_smoother_descr
end interface end interface
contains contains

59
mlprec/mld_s_jac_smoother.f90
Unescape Escape View File

@ -86,11 +86,20 @@ module mld_s_jac_smoother
procedure, nopass :: get_id => s_jac_smoother_get_id procedure, nopass :: get_id => s_jac_smoother_get_id
end type mld_s_jac_smoother_type 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, & private :: s_jac_smoother_free, &
& s_jac_smoother_sizeof, s_jac_smoother_get_nzeros, & & s_jac_smoother_sizeof, s_jac_smoother_get_nzeros, &
& s_jac_smoother_get_fmt, s_jac_smoother_get_id, & & s_jac_smoother_get_fmt, s_jac_smoother_get_id, &
& s_jac_smoother_get_wrksize & s_jac_smoother_get_wrksize
private :: s_l1_jac_smoother_get_fmt, s_l1_jac_smoother_get_id
interface interface
@ -237,6 +246,42 @@ module mld_s_jac_smoother
end subroutine mld_s_jac_smoother_csetr end subroutine mld_s_jac_smoother_csetr
end interface 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 contains
@ -352,4 +397,18 @@ contains
val = mld_jac_ val = mld_jac_
end function s_jac_smoother_get_id 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 end module mld_s_jac_smoother

59
mlprec/mld_z_jac_smoother.f90
Unescape Escape View File

@ -86,11 +86,20 @@ module mld_z_jac_smoother
procedure, nopass :: get_id => z_jac_smoother_get_id procedure, nopass :: get_id => z_jac_smoother_get_id
end type mld_z_jac_smoother_type 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, & private :: z_jac_smoother_free, &
& z_jac_smoother_sizeof, z_jac_smoother_get_nzeros, & & z_jac_smoother_sizeof, z_jac_smoother_get_nzeros, &
& z_jac_smoother_get_fmt, z_jac_smoother_get_id, & & z_jac_smoother_get_fmt, z_jac_smoother_get_id, &
& z_jac_smoother_get_wrksize & z_jac_smoother_get_wrksize
private :: z_l1_jac_smoother_get_fmt, z_l1_jac_smoother_get_id
interface interface
@ -237,6 +246,42 @@ module mld_z_jac_smoother
end subroutine mld_z_jac_smoother_csetr end subroutine mld_z_jac_smoother_csetr
end interface 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 contains
@ -352,4 +397,18 @@ contains
val = mld_jac_ val = mld_jac_
end function z_jac_smoother_get_id 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 end module mld_z_jac_smoother

Write Preview
Loading…
Cancel
Save