From 0854eee936ce6c3d9cee515443d817fa8029eff0 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 5 May 2020 18:28:23 +0200 Subject: [PATCH] New L1-BJAC smoother cleanups. --- mlprec/impl/level/mld_c_base_onelev_csetc.F90 | 23 +++++--- mlprec/impl/level/mld_c_base_onelev_cseti.F90 | 23 +++++--- mlprec/impl/level/mld_d_base_onelev_csetc.F90 | 22 +++---- mlprec/impl/level/mld_d_base_onelev_cseti.F90 | 22 +++---- mlprec/impl/level/mld_s_base_onelev_csetc.F90 | 23 +++++--- mlprec/impl/level/mld_s_base_onelev_cseti.F90 | 23 +++++--- mlprec/impl/level/mld_z_base_onelev_csetc.F90 | 23 +++++--- mlprec/impl/level/mld_z_base_onelev_cseti.F90 | 23 +++++--- mlprec/impl/mld_c_smoothers_bld.f90 | 2 +- mlprec/impl/mld_ccprecset.F90 | 16 ++--- mlprec/impl/mld_s_smoothers_bld.f90 | 2 +- mlprec/impl/mld_scprecset.F90 | 16 ++--- mlprec/impl/mld_z_smoothers_bld.f90 | 2 +- mlprec/impl/mld_zcprecset.F90 | 16 ++--- mlprec/mld_c_jac_smoother.f90 | 59 +++++++++++++++++++ mlprec/mld_d_jac_smoother.f90 | 7 +-- mlprec/mld_s_jac_smoother.f90 | 59 +++++++++++++++++++ mlprec/mld_z_jac_smoother.f90 | 59 +++++++++++++++++++ 18 files changed, 313 insertions(+), 107 deletions(-) diff --git a/mlprec/impl/level/mld_c_base_onelev_csetc.F90 b/mlprec/impl/level/mld_c_base_onelev_csetc.F90 index 6abfeb5c..6c5b07e7 100644 --- a/mlprec/impl/level/mld_c_base_onelev_csetc.F90 +++ b/mlprec/impl/level/mld_c_base_onelev_csetc.F90 @@ -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) diff --git a/mlprec/impl/level/mld_c_base_onelev_cseti.F90 b/mlprec/impl/level/mld_c_base_onelev_cseti.F90 index bd69afa3..b497b184 100644 --- a/mlprec/impl/level/mld_c_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_c_base_onelev_cseti.F90 @@ -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) diff --git a/mlprec/impl/level/mld_d_base_onelev_csetc.F90 b/mlprec/impl/level/mld_d_base_onelev_csetc.F90 index 543184ef..6531894c 100644 --- a/mlprec/impl/level/mld_d_base_onelev_csetc.F90 +++ b/mlprec/impl/level/mld_d_base_onelev_csetc.F90 @@ -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) diff --git a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 index dcc643f6..f18df8e2 100644 --- a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 @@ -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) diff --git a/mlprec/impl/level/mld_s_base_onelev_csetc.F90 b/mlprec/impl/level/mld_s_base_onelev_csetc.F90 index 796d92d3..8a3de9f8 100644 --- a/mlprec/impl/level/mld_s_base_onelev_csetc.F90 +++ b/mlprec/impl/level/mld_s_base_onelev_csetc.F90 @@ -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) diff --git a/mlprec/impl/level/mld_s_base_onelev_cseti.F90 b/mlprec/impl/level/mld_s_base_onelev_cseti.F90 index 159dedc9..a0caa325 100644 --- a/mlprec/impl/level/mld_s_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_s_base_onelev_cseti.F90 @@ -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) diff --git a/mlprec/impl/level/mld_z_base_onelev_csetc.F90 b/mlprec/impl/level/mld_z_base_onelev_csetc.F90 index 9817c9d0..cc4c3e35 100644 --- a/mlprec/impl/level/mld_z_base_onelev_csetc.F90 +++ b/mlprec/impl/level/mld_z_base_onelev_csetc.F90 @@ -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) diff --git a/mlprec/impl/level/mld_z_base_onelev_cseti.F90 b/mlprec/impl/level/mld_z_base_onelev_cseti.F90 index 7fe56152..3ce2e08f 100644 --- a/mlprec/impl/level/mld_z_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_z_base_onelev_cseti.F90 @@ -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) diff --git a/mlprec/impl/mld_c_smoothers_bld.f90 b/mlprec/impl/mld_c_smoothers_bld.f90 index dd4bede7..d1ffe1d4 100644 --- a/mlprec/impl/mld_c_smoothers_bld.f90 +++ b/mlprec/impl/mld_c_smoothers_bld.f90 @@ -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 ',& diff --git a/mlprec/impl/mld_ccprecset.F90 b/mlprec/impl/mld_ccprecset.F90 index 5652a9e7..f97ffa0a 100644 --- a/mlprec/impl/mld_ccprecset.F90 +++ b/mlprec/impl/mld_ccprecset.F90 @@ -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_) diff --git a/mlprec/impl/mld_s_smoothers_bld.f90 b/mlprec/impl/mld_s_smoothers_bld.f90 index a0ec8fbd..2348825b 100644 --- a/mlprec/impl/mld_s_smoothers_bld.f90 +++ b/mlprec/impl/mld_s_smoothers_bld.f90 @@ -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 ',& diff --git a/mlprec/impl/mld_scprecset.F90 b/mlprec/impl/mld_scprecset.F90 index 2b90e4f7..44d961f4 100644 --- a/mlprec/impl/mld_scprecset.F90 +++ b/mlprec/impl/mld_scprecset.F90 @@ -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_) diff --git a/mlprec/impl/mld_z_smoothers_bld.f90 b/mlprec/impl/mld_z_smoothers_bld.f90 index 5a51ffb1..e8fa4c09 100644 --- a/mlprec/impl/mld_z_smoothers_bld.f90 +++ b/mlprec/impl/mld_z_smoothers_bld.f90 @@ -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 ',& diff --git a/mlprec/impl/mld_zcprecset.F90 b/mlprec/impl/mld_zcprecset.F90 index 2a4d69b2..97b9b772 100644 --- a/mlprec/impl/mld_zcprecset.F90 +++ b/mlprec/impl/mld_zcprecset.F90 @@ -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_) diff --git a/mlprec/mld_c_jac_smoother.f90 b/mlprec/mld_c_jac_smoother.f90 index bf0cc250..39b63d07 100644 --- a/mlprec/mld_c_jac_smoother.f90 +++ b/mlprec/mld_c_jac_smoother.f90 @@ -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 diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index 4149f341..45871afb 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -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 diff --git a/mlprec/mld_s_jac_smoother.f90 b/mlprec/mld_s_jac_smoother.f90 index 98b44700..bed7c140 100644 --- a/mlprec/mld_s_jac_smoother.f90 +++ b/mlprec/mld_s_jac_smoother.f90 @@ -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 diff --git a/mlprec/mld_z_jac_smoother.f90 b/mlprec/mld_z_jac_smoother.f90 index 52b4fa29..950bc077 100644 --- a/mlprec/mld_z_jac_smoother.f90 +++ b/mlprec/mld_z_jac_smoother.f90 @@ -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