Benchmark version.

Originally it was introduced to handle cases where the stencil was
expanded by the smoothing and multiplication process, but the
critical step is handled in AGGR%BLD_MAP, this one can be discarded.

cbind/mlprec/mld_c_dprec.h

@@ -29,7 +29,7 @@ extern "C" {
   psb_i_t mld_c_dprecfree(mld_c_dprec *ph);
   psb_i_t mld_c_dprecbld_opt(psb_c_dspmat *ah, psb_c_descriptor *cdh, 
 			  mld_c_dprec *ph, const char *afmt);
-
+  psb_i_t mld_c_ddescr(mld_c_dprec *ph);
 
   psb_i_t mld_c_dkrylov(const char *method, psb_c_dspmat *ah, mld_c_dprec *ph, 
 		  psb_c_dvector *bh, psb_c_dvector *xh,

cbind/mlprec/mld_c_zprec.h

@@ -30,6 +30,7 @@ extern "C" {
   psb_i_t mld_c_zprecbld_opt(psb_c_zspmat *ah, psb_c_descriptor *cdh, 
 			  mld_c_zprec *ph, const char *afmt);
 
+  psb_i_t mld_c_zdescr(mld_c_zprec *ph);
 
   psb_i_t mld_c_zkrylov(const char *method, psb_c_zspmat *ah, mld_c_zprec *ph, 
 		  psb_c_zvector *bh, psb_c_zvector *xh,

cbind/mlprec/mld_dprec_cbind_mod.F90

@@ -8,7 +8,7 @@ module mld_dprec_cbind_mod
     type(c_ptr) :: item = c_null_ptr
   end type mld_c_dprec
 
-contains 
+contains
 
 #if 1
 #define MLDC_DEBUG(MSG) write(*,*) __FILE__,':',__LINE__,':',MSG
@@ -21,13 +21,13 @@ contains
 !#define MLDC_ERR_FILTER(INFO) min(0,INFO)
 #define MLDC_ERR_FILTER(INFO) (INFO)
 #define MLDC_ERR_HANDLE(INFO) if(INFO/=mld_success_)MLDC_ERROR("ERROR!")
-    
+
   function  mld_c_dprecinit(ictxt,ph,ptype) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_)  :: res   
+    implicit none
+
+    integer(psb_c_ipk_)  :: res
     type(mld_c_dprec)    :: ph
     integer(psb_c_ipk_), value :: ictxt
     character(c_char)     :: ptype(*)
@@ -36,20 +36,20 @@ contains
     character(len=80)     :: fptype
 
     res = -1
-    res = -1
-    if (c_associated(ph%item)) then 
-      return 
+    if (c_associated(ph%item)) then
+      res = 0
+      return
     end if
 
     allocate(precp,stat=info)
     if (info /= 0) return
-    
+
     ph%item = c_loc(precp)
 
     call stringc2f(ptype,fptype)
-    
-    call precp%init(ictxt,fptype,info) 
-     
+
+    call precp%init(ictxt,fptype,info)
+
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
     return
@@ -58,9 +58,9 @@ contains
   function  mld_c_dprecseti(ph,what,val) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type) :: ph
     character(c_char)     :: what(*)
     integer(psb_c_ipk_), value :: val
@@ -69,28 +69,28 @@ contains
     type(mld_dprec_type), pointer  :: precp
 
     res = -1
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
     call stringc2f(what,fwhat)
 
-    call mld_precset(precp,fwhat,val,info) 
-     
+    call mld_precset(precp,fwhat,val,info)
+
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
     return
   end function mld_c_dprecseti
-    
+
 
   function  mld_c_dprecsetr(ph,what,val) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type) :: ph
     character(c_char)     :: what(*)
     real(c_double), value :: val
@@ -99,27 +99,27 @@ contains
     type(mld_dprec_type), pointer  :: precp
 
     res = -1
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
     call stringc2f(what,fwhat)
 
-    call mld_precset(precp,fwhat,val,info) 
-     
+    call mld_precset(precp,fwhat,val,info)
+
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
     return
   end function mld_c_dprecsetr
-  
+
   function  mld_c_dprecsetc(ph,what,val) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type) :: ph
     character(c_char)     :: what(*), val(*)
     integer               :: info
@@ -127,17 +127,17 @@ contains
     type(mld_dprec_type), pointer  :: precp
 
     res = -1
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
     call stringc2f(what,fwhat)
     call stringc2f(val,fval)
 
-    call mld_precset(precp,fwhat,fval,info) 
-     
+    call mld_precset(precp,fwhat,fval,info)
+
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
     return
@@ -146,9 +146,9 @@ contains
   function  mld_c_dprecbld(ah,cdh,ph) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type)  :: ph,ah,cdh
     integer               :: info
     type(mld_dprec_type), pointer  :: precp
@@ -158,36 +158,36 @@ contains
 
     res = -1
 
-    if (c_associated(cdh%item)) then 
+    if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
-      return 
+      return
     end if
-    if (c_associated(ah%item)) then 
+    if (c_associated(ah%item)) then
       call c_f_pointer(ah%item,ap)
     else
-      return 
+      return
     end if
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
-    call mld_precbld(ap,descp,precp,info) 
+    call mld_precbld(ap,descp,precp,info)
 
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
 
     return
   end function mld_c_dprecbld
-    
+
   function  mld_c_dhierarchy_build(ah,cdh,ph) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type)  :: ph,ah,cdh
     integer               :: info
     type(mld_dprec_type), pointer  :: precp
@@ -197,23 +197,23 @@ contains
 
     res = -1
 
-    if (c_associated(cdh%item)) then 
+    if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
-      return 
+      return
     end if
-    if (c_associated(ah%item)) then 
+    if (c_associated(ah%item)) then
       call c_f_pointer(ah%item,ap)
     else
-      return 
+      return
     end if
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
-    call precp%hierarchy_build(ap,descp,info) 
+    call precp%hierarchy_build(ap,descp,info)
 
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
@@ -224,9 +224,9 @@ contains
   function  mld_c_dsmoothers_build(ah,cdh,ph) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type)  :: ph,ah,cdh
     integer               :: info
     type(mld_dprec_type), pointer  :: precp
@@ -236,30 +236,30 @@ contains
 
     res = -1
 
-    if (c_associated(cdh%item)) then 
+    if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
-      return 
+      return
     end if
-    if (c_associated(ah%item)) then 
+    if (c_associated(ah%item)) then
       call c_f_pointer(ah%item,ap)
     else
-      return 
+      return
     end if
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
-    call precp%smoothers_build(ap,descp,info) 
+    call precp%smoothers_build(ap,descp,info)
 
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
 
     return
   end function mld_c_dsmoothers_build
-    
+
   function  mld_c_dkrylov(methd,&
        & ah,ph,bh,xh,cdh,options) bind(c) result(res)
     use psb_base_mod
@@ -267,17 +267,17 @@ contains
     use psb_krylov_mod
     use psb_prec_cbind_mod
     use psb_dkrylov_cbind_mod
-    implicit none 
+    implicit none
     integer(psb_c_ipk_)          :: res
     type(psb_c_object_type) :: ah,cdh,ph,bh,xh
     character(c_char)       :: methd(*)
     type(solveroptions)     :: options
-    
+
     res= mld_c_dkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh,  &
          & itmax=options%itmax, iter=options%iter,&
          & itrace=options%itrace, istop=options%istop,&
          & irst=options%irst, err=options%err)
-    
+
   end function mld_c_dkrylov
 
 
@@ -289,7 +289,7 @@ contains
     use psb_objhandle_mod
     use psb_prec_cbind_mod
     use psb_base_string_cbind_mod
-    implicit none 
+    implicit none
     integer(psb_c_ipk_)          :: res
     type(psb_c_object_type) :: ah,cdh,ph,bh,xh
     integer(psb_c_ipk_), value :: itmax,itrace,irst,istop
@@ -307,33 +307,33 @@ contains
     real(kind(1.d0))      :: feps,ferr
 
     res = -1
-    if (c_associated(cdh%item)) then 
+    if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
-      return 
+      return
     end if
-    if (c_associated(xh%item)) then 
+    if (c_associated(xh%item)) then
       call c_f_pointer(xh%item,xp)
     else
-      return 
+      return
     end if
-    if (c_associated(bh%item)) then 
+    if (c_associated(bh%item)) then
       call c_f_pointer(bh%item,bp)
     else
-      return 
+      return
     end if
-    if (c_associated(ah%item)) then 
+    if (c_associated(ah%item)) then
       call c_f_pointer(ah%item,ap)
     else
-      return 
+      return
     end if
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
-    
+
     call stringc2f(methd,fmethd)
     feps    = eps
     fitmax  = itmax
@@ -348,34 +348,61 @@ contains
     iter = fiter
     err  = ferr
     res = min(info,0)
-    
+
   end function mld_c_dkrylov_opt
 
   function  mld_c_dprecfree(ph) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type) :: ph
     integer               :: info
     type(mld_dprec_type), pointer :: precp
     character(len=80)     :: fptype
 
     res = -1
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
-        
-    call precp%free(info) 
-     
+
+    call precp%free(info)
+
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
     return
   end function mld_c_dprecfree
 
-end module mld_dprec_cbind_mod
+  function mld_c_ddescr(ph) bind(c) result(res)
+   use psb_base_mod
+   use mld_prec_mod
+   implicit none
+ 
+   integer(psb_c_ipk_) :: res
+   type(psb_c_object_type) :: ph
+   integer               :: info
+   type(mld_dprec_type), pointer :: precp
+ 
+   res = -1
+   info = -1
+   if (c_associated(ph%item)) then
+     call c_f_pointer(ph%item,precp)
+   else
+     return
+   end if
+ 
+ 
+   call precp%descr()
+   call flush(output_unit)
+ 
+   info = 0
+   res = MLDC_ERR_FILTER(info)
+   MLDC_ERR_HANDLE(res)
+   return
+ end function mld_c_ddescr
 
+end module mld_dprec_cbind_mod

cbind/mlprec/mld_zprec_cbind_mod.F90

@@ -8,7 +8,7 @@ module mld_zprec_cbind_mod
     type(c_ptr) :: item = c_null_ptr
   end type mld_c_zprec
 
-contains 
+contains
 
 #if 1
 #define MLDC_DEBUG(MSG) write(*,*) __FILE__,':',__LINE__,':',MSG
@@ -21,13 +21,13 @@ contains
 !#define MLDC_ERR_FILTER(INFO) min(0,INFO)
 #define MLDC_ERR_FILTER(INFO) (INFO)
 #define MLDC_ERR_HANDLE(INFO) if(INFO/=mld_success_)MLDC_ERROR("ERROR!")
-    
+
   function  mld_c_zprecinit(ictxt,ph,ptype) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_)  :: res   
+    implicit none
+
+    integer(psb_c_ipk_)  :: res
     type(mld_c_zprec)    :: ph
     integer(psb_c_ipk_), value :: ictxt
     character(c_char)     :: ptype(*)
@@ -36,20 +36,20 @@ contains
     character(len=80)     :: fptype
 
     res = -1
-    res = -1
-    if (c_associated(ph%item)) then 
-      return 
+    if (c_associated(ph%item)) then
+      res = 0
+      return
     end if
 
     allocate(precp,stat=info)
     if (info /= 0) return
-    
+
     ph%item = c_loc(precp)
 
     call stringc2f(ptype,fptype)
-    
-    call precp%init(ictxt,fptype,info) 
-     
+
+    call precp%init(ictxt,fptype,info)
+
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
     return
@@ -58,9 +58,9 @@ contains
   function  mld_c_zprecseti(ph,what,val) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type) :: ph
     character(c_char)     :: what(*)
     integer(psb_c_ipk_), value :: val
@@ -69,28 +69,28 @@ contains
     type(mld_zprec_type), pointer  :: precp
 
     res = -1
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
     call stringc2f(what,fwhat)
 
-    call mld_precset(precp,fwhat,val,info) 
-     
+    call mld_precset(precp,fwhat,val,info)
+
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
     return
   end function mld_c_zprecseti
-    
+
 
   function  mld_c_zprecsetr(ph,what,val) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type) :: ph
     character(c_char)     :: what(*)
     real(c_double), value :: val
@@ -99,27 +99,27 @@ contains
     type(mld_zprec_type), pointer  :: precp
 
     res = -1
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
     call stringc2f(what,fwhat)
 
-    call mld_precset(precp,fwhat,val,info) 
-     
+    call mld_precset(precp,fwhat,val,info)
+
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
     return
   end function mld_c_zprecsetr
-  
+
   function  mld_c_zprecsetc(ph,what,val) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type) :: ph
     character(c_char)     :: what(*), val(*)
     integer               :: info
@@ -127,17 +127,17 @@ contains
     type(mld_zprec_type), pointer  :: precp
 
     res = -1
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
     call stringc2f(what,fwhat)
     call stringc2f(val,fval)
 
-    call mld_precset(precp,fwhat,fval,info) 
-     
+    call mld_precset(precp,fwhat,fval,info)
+
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
     return
@@ -146,9 +146,9 @@ contains
   function  mld_c_zprecbld(ah,cdh,ph) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type)  :: ph,ah,cdh
     integer               :: info
     type(mld_zprec_type), pointer  :: precp
@@ -158,36 +158,36 @@ contains
 
     res = -1
 
-    if (c_associated(cdh%item)) then 
+    if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
-      return 
+      return
     end if
-    if (c_associated(ah%item)) then 
+    if (c_associated(ah%item)) then
       call c_f_pointer(ah%item,ap)
     else
-      return 
+      return
     end if
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
-    call mld_precbld(ap,descp,precp,info) 
+    call mld_precbld(ap,descp,precp,info)
 
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
 
     return
   end function mld_c_zprecbld
-    
+
   function  mld_c_zhierarchy_build(ah,cdh,ph) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type)  :: ph,ah,cdh
     integer               :: info
     type(mld_zprec_type), pointer  :: precp
@@ -197,23 +197,23 @@ contains
 
     res = -1
 
-    if (c_associated(cdh%item)) then 
+    if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
-      return 
+      return
     end if
-    if (c_associated(ah%item)) then 
+    if (c_associated(ah%item)) then
       call c_f_pointer(ah%item,ap)
     else
-      return 
+      return
     end if
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
-    call precp%hierarchy_build(ap,descp,info) 
+    call precp%hierarchy_build(ap,descp,info)
 
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
@@ -224,9 +224,9 @@ contains
   function  mld_c_zsmoothers_build(ah,cdh,ph) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type)  :: ph,ah,cdh
     integer               :: info
     type(mld_zprec_type), pointer  :: precp
@@ -236,30 +236,30 @@ contains
 
     res = -1
 
-    if (c_associated(cdh%item)) then 
+    if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
-      return 
+      return
     end if
-    if (c_associated(ah%item)) then 
+    if (c_associated(ah%item)) then
       call c_f_pointer(ah%item,ap)
     else
-      return 
+      return
     end if
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
-    call precp%smoothers_build(ap,descp,info) 
+    call precp%smoothers_build(ap,descp,info)
 
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
 
     return
   end function mld_c_zsmoothers_build
-    
+
   function  mld_c_zkrylov(methd,&
        & ah,ph,bh,xh,cdh,options) bind(c) result(res)
     use psb_base_mod
@@ -267,17 +267,17 @@ contains
     use psb_krylov_mod
     use psb_prec_cbind_mod
     use psb_zkrylov_cbind_mod
-    implicit none 
+    implicit none
     integer(psb_c_ipk_)          :: res
     type(psb_c_object_type) :: ah,cdh,ph,bh,xh
     character(c_char)       :: methd(*)
     type(solveroptions)     :: options
-    
+
     res= mld_c_zkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh,  &
          & itmax=options%itmax, iter=options%iter,&
          & itrace=options%itrace, istop=options%istop,&
          & irst=options%irst, err=options%err)
-    
+
   end function mld_c_zkrylov
 
 
@@ -289,7 +289,7 @@ contains
     use psb_objhandle_mod
     use psb_prec_cbind_mod
     use psb_base_string_cbind_mod
-    implicit none 
+    implicit none
     integer(psb_c_ipk_)          :: res
     type(psb_c_object_type) :: ah,cdh,ph,bh,xh
     integer(psb_c_ipk_), value :: itmax,itrace,irst,istop
@@ -307,33 +307,33 @@ contains
     real(kind(1.d0))      :: feps,ferr
 
     res = -1
-    if (c_associated(cdh%item)) then 
+    if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
-      return 
+      return
     end if
-    if (c_associated(xh%item)) then 
+    if (c_associated(xh%item)) then
       call c_f_pointer(xh%item,xp)
     else
-      return 
+      return
     end if
-    if (c_associated(bh%item)) then 
+    if (c_associated(bh%item)) then
       call c_f_pointer(bh%item,bp)
     else
-      return 
+      return
     end if
-    if (c_associated(ah%item)) then 
+    if (c_associated(ah%item)) then
       call c_f_pointer(ah%item,ap)
     else
-      return 
+      return
     end if
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
-    
+
     call stringc2f(methd,fmethd)
     feps    = eps
     fitmax  = itmax
@@ -348,34 +348,61 @@ contains
     iter = fiter
     err  = ferr
     res = min(info,0)
-    
+
   end function mld_c_zkrylov_opt
 
   function  mld_c_zprecfree(ph) bind(c) result(res)
     use psb_base_mod
     use mld_prec_mod
-    implicit none 
-    
-    integer(psb_c_ipk_) :: res   
+    implicit none
+
+    integer(psb_c_ipk_) :: res
     type(psb_c_object_type) :: ph
     integer               :: info
     type(mld_zprec_type), pointer :: precp
     character(len=80)     :: fptype
 
     res = -1
-    if (c_associated(ph%item)) then 
+    if (c_associated(ph%item)) then
       call c_f_pointer(ph%item,precp)
     else
-      return 
+      return
     end if
 
-        
-    call precp%free(info) 
-     
+
+    call precp%free(info)
+
     res = MLDC_ERR_FILTER(info)
     MLDC_ERR_HANDLE(res)
     return
   end function mld_c_zprecfree
 
-end module mld_zprec_cbind_mod
+  function mld_c_zdescr(ph) bind(c) result(res)
+   use psb_base_mod
+   use mld_prec_mod
+   implicit none
+ 
+   integer(psb_c_ipk_) :: res
+   type(psb_c_object_type) :: ph
+   integer               :: info
+   type(mld_zprec_type), pointer :: precp
+ 
+   res = -1
+   info = -1
+   if (c_associated(ph%item)) then
+     call c_f_pointer(ph%item,precp)
+   else
+     return
+   end if
+ 
+ 
+   call precp%descr()
+   call flush(output_unit)
+ 
+   info = 0
+   res = MLDC_ERR_FILTER(info)
+   MLDC_ERR_HANDLE(res)
+   return
+ end function mld_c_zdescr
 
+end module mld_zprec_cbind_mod

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,16 +125,41 @@ 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)
       if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
 
+    case ('GS','FWGS')
+      call lv%set(mld_c_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_c_gs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
+    case ('BWGS')
+      call lv%set(mld_c_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_c_bwgs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
     case ('FBGS')
       call lv%set(mld_c_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(mld_c_gs_solver_mold,info,pos='pre')
       call lv%set(mld_c_jac_smoother_mold,info,pos='post')
       if (info == 0) call lv%set(mld_c_bwgs_solver_mold,info,pos='post')
+    case ('L1-GS','L1-FWGS')
+      call lv%set(mld_c_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_c_gs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
+    case ('L1-BWGS')
+      call lv%set(mld_c_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_c_bwgs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)      
+    case ('L1-FBGS')
+      call lv%set(mld_c_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_c_gs_solver_mold,info,pos='pre')
+      call lv%set(mld_c_l1_jac_smoother_mold,info,pos='post')
+      if (info == 0) call lv%set(mld_c_bwgs_solver_mold,info,pos='post')
       
     case default
       !

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)

mlprec/impl/level/mld_c_base_onelev_dump.f90

@@ -146,13 +146,24 @@ subroutine mld_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
     end if
   end if
   
-  if (allocated(lv%sm)) then
-    call lv%sm%dump(icontxt,level,info,smoother=smoother, &
-         & solver=solver,prefix=trim(prefix_)//"_sm")
-  end if
-  if (allocated(lv%sm2a)) then
-    call lv%sm2a%dump(icontxt,level,info,smoother=smoother, &
-         & solver=solver,prefix=trim(prefix_)//"_sm2a")
+  if (level >= 2) then 
+    if (allocated(lv%sm)) then
+      call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
+    end if
+    if (allocated(lv%sm2a)) then
+      call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
+    end if
+  else
+    if (allocated(lv%sm)) then
+      call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
+    end if
+    if (allocated(lv%sm2a)) then
+      call lv%sm2a%dump(lv%base_desc,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
+    end if
   end if
   
 end subroutine mld_c_base_onelev_dump

mlprec/impl/level/mld_d_base_onelev_csetc.F90

@@ -75,15 +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_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
@@ -136,16 +137,41 @@ 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)
 
     case ('AS')
       call lv%set(mld_d_as_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
 
+    case ('GS','FWGS')
+      call lv%set(mld_d_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_d_gs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
+    case ('BWGS')
+      call lv%set(mld_d_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_d_bwgs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
     case ('FBGS')
       call lv%set(mld_d_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(mld_d_gs_solver_mold,info,pos='pre')
       call lv%set(mld_d_jac_smoother_mold,info,pos='post')
       if (info == 0) call lv%set(mld_d_bwgs_solver_mold,info,pos='post')
+    case ('L1-GS','L1-FWGS')
+      call lv%set(mld_d_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_d_gs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
+    case ('L1-BWGS')
+      call lv%set(mld_d_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_d_bwgs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)      
+    case ('L1-FBGS')
+      call lv%set(mld_d_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_d_gs_solver_mold,info,pos='pre')
+      call lv%set(mld_d_l1_jac_smoother_mold,info,pos='post')
+      if (info == 0) call lv%set(mld_d_bwgs_solver_mold,info,pos='post')
       
     case default
       !

mlprec/impl/level/mld_d_base_onelev_cseti.F90

@@ -74,15 +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_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
@@ -130,6 +131,10 @@ 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)
 
     case (mld_as_)
       call lv%set(mld_d_as_smoother_mold,info,pos=pos)

mlprec/impl/level/mld_d_base_onelev_dump.f90

@@ -146,13 +146,24 @@ subroutine mld_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
     end if
   end if
   
-  if (allocated(lv%sm)) then
-    call lv%sm%dump(icontxt,level,info,smoother=smoother, &
-         & solver=solver,prefix=trim(prefix_)//"_sm")
-  end if
-  if (allocated(lv%sm2a)) then
-    call lv%sm2a%dump(icontxt,level,info,smoother=smoother, &
-         & solver=solver,prefix=trim(prefix_)//"_sm2a")
+  if (level >= 2) then 
+    if (allocated(lv%sm)) then
+      call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
+    end if
+    if (allocated(lv%sm2a)) then
+      call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
+    end if
+  else
+    if (allocated(lv%sm)) then
+      call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
+    end if
+    if (allocated(lv%sm2a)) then
+      call lv%sm2a%dump(lv%base_desc,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
+    end if
   end if
   
 end subroutine mld_d_base_onelev_dump

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,16 +125,41 @@ 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)
       if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
 
+    case ('GS','FWGS')
+      call lv%set(mld_s_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_s_gs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
+    case ('BWGS')
+      call lv%set(mld_s_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_s_bwgs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
     case ('FBGS')
       call lv%set(mld_s_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(mld_s_gs_solver_mold,info,pos='pre')
       call lv%set(mld_s_jac_smoother_mold,info,pos='post')
       if (info == 0) call lv%set(mld_s_bwgs_solver_mold,info,pos='post')
+    case ('L1-GS','L1-FWGS')
+      call lv%set(mld_s_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_s_gs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
+    case ('L1-BWGS')
+      call lv%set(mld_s_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_s_bwgs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)      
+    case ('L1-FBGS')
+      call lv%set(mld_s_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_s_gs_solver_mold,info,pos='pre')
+      call lv%set(mld_s_l1_jac_smoother_mold,info,pos='post')
+      if (info == 0) call lv%set(mld_s_bwgs_solver_mold,info,pos='post')
       
     case default
       !

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)

mlprec/impl/level/mld_s_base_onelev_dump.f90

@@ -146,13 +146,24 @@ subroutine mld_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
     end if
   end if
   
-  if (allocated(lv%sm)) then
-    call lv%sm%dump(icontxt,level,info,smoother=smoother, &
-         & solver=solver,prefix=trim(prefix_)//"_sm")
-  end if
-  if (allocated(lv%sm2a)) then
-    call lv%sm2a%dump(icontxt,level,info,smoother=smoother, &
-         & solver=solver,prefix=trim(prefix_)//"_sm2a")
+  if (level >= 2) then 
+    if (allocated(lv%sm)) then
+      call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
+    end if
+    if (allocated(lv%sm2a)) then
+      call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
+    end if
+  else
+    if (allocated(lv%sm)) then
+      call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
+    end if
+    if (allocated(lv%sm2a)) then
+      call lv%sm2a%dump(lv%base_desc,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
+    end if
   end if
   
 end subroutine mld_s_base_onelev_dump

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,16 +137,41 @@ 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)
       if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
 
+    case ('GS','FWGS')
+      call lv%set(mld_z_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_z_gs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
+    case ('BWGS')
+      call lv%set(mld_z_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_z_bwgs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
     case ('FBGS')
       call lv%set(mld_z_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(mld_z_gs_solver_mold,info,pos='pre')
       call lv%set(mld_z_jac_smoother_mold,info,pos='post')
       if (info == 0) call lv%set(mld_z_bwgs_solver_mold,info,pos='post')
+    case ('L1-GS','L1-FWGS')
+      call lv%set(mld_z_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_z_gs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
+    case ('L1-BWGS')
+      call lv%set(mld_z_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_z_bwgs_solver_mold,info,pos='pre')
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)      
+    case ('L1-FBGS')
+      call lv%set(mld_z_l1_jac_smoother_mold,info,pos='pre')
+      if (info == 0) call lv%set(mld_z_gs_solver_mold,info,pos='pre')
+      call lv%set(mld_z_l1_jac_smoother_mold,info,pos='post')
+      if (info == 0) call lv%set(mld_z_bwgs_solver_mold,info,pos='post')
       
     case default
       !

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)

mlprec/impl/level/mld_z_base_onelev_dump.f90

@@ -146,13 +146,24 @@ subroutine mld_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
     end if
   end if
   
-  if (allocated(lv%sm)) then
-    call lv%sm%dump(icontxt,level,info,smoother=smoother, &
-         & solver=solver,prefix=trim(prefix_)//"_sm")
-  end if
-  if (allocated(lv%sm2a)) then
-    call lv%sm2a%dump(icontxt,level,info,smoother=smoother, &
-         & solver=solver,prefix=trim(prefix_)//"_sm2a")
+  if (level >= 2) then 
+    if (allocated(lv%sm)) then
+      call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
+    end if
+    if (allocated(lv%sm2a)) then
+      call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
+    end if
+  else
+    if (allocated(lv%sm)) then
+      call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
+    end if
+    if (allocated(lv%sm2a)) then
+      call lv%sm2a%dump(lv%base_desc,level,info,smoother=smoother, &
+           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
+    end if
   end if
   
 end subroutine mld_z_base_onelev_dump

mlprec/impl/mld_c_hierarchy_bld.f90

@@ -273,10 +273,12 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
   end if
 
   !
-  ! Finest level first; remember to fix base_a and base_desc
+  ! Finest level first; create a GEN_BLOCK
+  ! copy of the descriptor. 
   ! 
   prec%precv(1)%base_a    => a
-  prec%precv(1)%base_desc => desc_a
+  call psb_cd_renum_block(desc_a,prec%precv(1)%desc_ac,info)
+  prec%precv(1)%base_desc => prec%precv(1)%desc_ac
   newsz = 0
   array_build_loop: do i=2, iszv
     !
@@ -317,7 +319,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
 
     if (debug_level >= psb_debug_outer_) &
          & write(debug_unit,*) me,' ',trim(name),&
-         & 'Return from ',i,' call to mlprcbld ',info      
+         & 'Return from ',i,' call to bld_tprol', info      
     !
     ! Save op_prol just in case
     !
@@ -334,9 +336,9 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
       sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
     end if
     prec%precv(i)%szratio = sizeratio
-    if (iaggsize <= casize) then
-      newsz = i      
-    end if
+
+    if (iaggsize <= casize) newsz = i      
+    if (i == iszv)          newsz = i
 
     if (i>2) then
       if (sizeratio < mnaggratio) then
@@ -440,7 +442,10 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
     ! Restart
     iszv = newsz
     ! Fix the pointers, but the level 1 should
-    ! be already OK
+    ! be treated differently
+    if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
+      prec%precv(1)%base_desc => prec%precv(1)%desc_ac
+    end if
     do i=2, iszv 
       prec%precv(i)%base_a       => prec%precv(i)%ac
       prec%precv(i)%base_desc    => prec%precv(i)%desc_ac
@@ -449,11 +454,6 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
     end do
   end if
 
-  ! Does the coarsening need backfix on descriptors? 
-  do i=2, iszv 
-    if (info == psb_success_) call prec%precv(i)%backfix(prec%precv(i-1),info)    
-  end do
-  
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_internal_error_,name,&
          & a_err='Internal hierarchy build' )
@@ -478,7 +478,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
 
 contains
   subroutine save_smoothers(level,save1, save2,info)
-    type(mld_c_onelev_type), intent(in) :: level
+    type(mld_c_onelev_type), intent(inout) :: level
     class(mld_c_base_smoother_type), allocatable , intent(inout) :: save1, save2
     integer(psb_ipk_), intent(out) :: info
 
@@ -493,15 +493,19 @@ contains
       if (info  == 0) deallocate(save2,stat=info)
       if (info /= 0) return
     end if
-    allocate(save1, source=level%sm,stat=info) 
-    if ((info == 0).and.allocated(level%sm2a)) allocate(save2, source=level%sm2a,stat=info) 
-
+    allocate(save1, mold=level%sm,stat=info)
+    if (info == 0) call level%sm%clone_settings(save1,info)
+    if ((info == 0).and.allocated(level%sm2a)) then
+      allocate(save2, mold=level%sm2a,stat=info) 
+      if (info == 0) call level%sm2a%clone_settings(save2,info)
+    end if
+    
     return
   end subroutine save_smoothers
 
   subroutine restore_smoothers(level,save1, save2,info)
     type(mld_c_onelev_type), intent(inout), target :: level
-    class(mld_c_base_smoother_type), allocatable, intent(in) :: save1, save2
+    class(mld_c_base_smoother_type), allocatable, intent(inout) :: save1, save2
     integer(psb_ipk_), intent(out) :: info
 
     info  = 0
@@ -511,7 +515,8 @@ contains
       if (info  == 0) deallocate(level%sm,stat=info)
     end if
     if (allocated(save1)) then
-      if (info  == 0) allocate(level%sm,source=save1,stat=info)
+      if (info  == 0) allocate(level%sm,mold=save1,stat=info)
+      if (info == 0) call save1%clone_settings(level%sm,info)
     end if
     
     if (info /= 0) return
@@ -521,7 +526,8 @@ contains
       if (info  == 0) deallocate(level%sm2a,stat=info)
     end if
     if (allocated(save2)) then
-      if (info  == 0) allocate(level%sm2a,source=save2,stat=info)
+      if (info  == 0) allocate(level%sm2a,mold=save2,stat=info)
+      if (info == 0) call save2%clone_settings(level%sm2a,info)
       if (info  == 0) level%sm2 => level%sm2a
     else
       if (allocated(level%sm)) level%sm2 => level%sm

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_, mld_gs_, mld_fbgs_, mld_l1_gs_,mld_l1_fbgs_)
       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

@@ -188,75 +188,75 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos,idx)
           info = -2
           return
         end if
-      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)
+        if (nlev_ > 1) then 
+          call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
+          select case (val) 
+          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)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
 #else
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
 #endif
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
-        case(mld_slu_)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
+          case(mld_slu_)
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
-        case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
-        case(mld_mumps_)
+          case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+          case(mld_mumps_)
 #if defined(HAVE_MUMPS_)          
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
-       case(mld_umf_)
+         case(mld_umf_)
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
           
-        case(mld_sludist_)
+          case(mld_sludist_)
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
           case(mld_jac_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
@@ -267,6 +267,18 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',mld_l1_diag_scale_,info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_gs_,mld_fbgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_bwgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_bwgs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_l1_gs_,mld_l1_fbgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_l1_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
           end select
           
         endif
@@ -325,8 +337,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_)
@@ -401,6 +413,18 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',mld_l1_diag_scale_,info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_gs_,mld_fbgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_bwgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_bwgs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_l1_gs_,mld_l1_fbgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_l1_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
         end select
       endif
 
@@ -569,75 +593,75 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           info = -2
           return
         end if
-      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)
+        if (nlev_ > 1) then 
+          call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
+          select case (psb_toupper(trim(string))) 
+          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)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
 #else
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
 #endif
-          call p%precv(nlev_)%set('COARSE_MAT','dist',info)
-        case('SLU')
+            call p%precv(nlev_)%set('COARSE_MAT','dist',info)
+          case('SLU')
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
-        case('ILU','MILU','ILUT')
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','bjac',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
-        case('MUMPS')
+          case('ILU','MILU','ILUT')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','bjac',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+          case('MUMPS')
 #if defined(HAVE_MUMPS_)          
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC'_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
-       case('UMF')
+         case('UMF')
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
           
-        case('SLUDIST')
+          case('SLUDIST')
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
           case('JAC','JACOBI')
             call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
@@ -648,6 +672,18 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE','L1-DIAG',info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('GS','FWGS','FBGS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('BWGS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','BWGS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('L1-GS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','L1-BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)          
           end select
           
         endif
@@ -687,9 +723,9 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
     case('COARSE_SOLVE')
       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)
+        select case (psb_toupper(trim(string)))
+        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_)
@@ -759,11 +795,22 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE','DIAG',info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
-
         case('L1-JACOBI')
           call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE','L1-DIAG',info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('GS','FWGS','FBGS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('BWGS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','BWGS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('L1-GS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','L1-BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)          
         end select
       endif
 

mlprec/impl/mld_cprecinit.F90

@@ -50,10 +50,15 @@
 !
 !    'DIAG', 'JACOBI' - diagonal/Jacobi           
 !
+!    'L1-DIAG', 'L1-JACOBI' - diagonal/Jacobi  with L1 norm correction
+!
 !    'GS', 'FBGS'     - Hybrid Gauss-Seidel, also symmetrized
 !                       
 !    'BJAC'           - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks
+!                       
+!    'L1-BJAC'        - block Jacobi preconditioner, with ILU(0)
+!                       on the local blocks and L1 correction for off-diag blocks
 !
 !    'AS'             - Additive Schwarz (AS), with
 !                       overlap 1 and ILU(0) on the local submatrices
@@ -121,7 +126,7 @@ subroutine mld_cprecinit(ictxt,prec,ptype,info)
   prec%ictxt = ictxt
   prec%ag_data%min_coarse_size = -1
 
-  select case(psb_toupper(ptype(1:len_trim(ptype))))
+  select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE') 
     nlev_ = 1
     ilev_ = 1
@@ -140,6 +145,15 @@ subroutine mld_cprecinit(ictxt,prec,ptype,info)
     allocate(mld_c_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
     call prec%precv(ilev_)%default()
 
+  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI') 
+    nlev_ = 1
+    ilev_ = 1
+    allocate(prec%precv(nlev_),stat=info) 
+    allocate(mld_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    if (info /= psb_success_) return
+    allocate(mld_c_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    call prec%precv(ilev_)%default()
+
   case ('GS','FWGS') 
     nlev_ = 1
     ilev_ = 1
@@ -174,6 +188,15 @@ subroutine mld_cprecinit(ictxt,prec,ptype,info)
     allocate(mld_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
     call prec%precv(ilev_)%default()
 
+  case ('L1-BJAC','L1_BJAC') 
+    nlev_ = 1
+    ilev_ = 1
+    allocate(prec%precv(nlev_),stat=info) 
+    allocate(mld_c_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    if (info /= psb_success_) return
+    allocate(mld_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    call prec%precv(ilev_)%default()
+
   case ('AS')
     nlev_ = 1
     ilev_ = 1
@@ -202,8 +225,7 @@ subroutine mld_cprecinit(ictxt,prec,ptype,info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-    !call prec%precv(nlev_)%default()
-
+    
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'

mlprec/impl/mld_d_hierarchy_bld.f90

@@ -273,10 +273,12 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
   end if
 
   !
-  ! Finest level first; remember to fix base_a and base_desc
+  ! Finest level first; create a GEN_BLOCK
+  ! copy of the descriptor. 
   ! 
   prec%precv(1)%base_a    => a
-  prec%precv(1)%base_desc => desc_a
+  call psb_cd_renum_block(desc_a,prec%precv(1)%desc_ac,info)
+  prec%precv(1)%base_desc => prec%precv(1)%desc_ac
   newsz = 0
   array_build_loop: do i=2, iszv
     !
@@ -317,7 +319,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
 
     if (debug_level >= psb_debug_outer_) &
          & write(debug_unit,*) me,' ',trim(name),&
-         & 'Return from ',i,' call to mlprcbld ',info      
+         & 'Return from ',i,' call to bld_tprol', info      
     !
     ! Save op_prol just in case
     !
@@ -334,9 +336,9 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
       sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
     end if
     prec%precv(i)%szratio = sizeratio
-    if (iaggsize <= casize) then
-      newsz = i      
-    end if
+
+    if (iaggsize <= casize) newsz = i      
+    if (i == iszv)          newsz = i
 
     if (i>2) then
       if (sizeratio < mnaggratio) then
@@ -440,7 +442,10 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
     ! Restart
     iszv = newsz
     ! Fix the pointers, but the level 1 should
-    ! be already OK
+    ! be treated differently
+    if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
+      prec%precv(1)%base_desc => prec%precv(1)%desc_ac
+    end if
     do i=2, iszv 
       prec%precv(i)%base_a       => prec%precv(i)%ac
       prec%precv(i)%base_desc    => prec%precv(i)%desc_ac
@@ -449,11 +454,6 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
     end do
   end if
 
-  ! Does the coarsening need backfix on descriptors? 
-  do i=2, iszv 
-    if (info == psb_success_) call prec%precv(i)%backfix(prec%precv(i-1),info)    
-  end do
-  
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_internal_error_,name,&
          & a_err='Internal hierarchy build' )
@@ -478,7 +478,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
 
 contains
   subroutine save_smoothers(level,save1, save2,info)
-    type(mld_d_onelev_type), intent(in) :: level
+    type(mld_d_onelev_type), intent(inout) :: level
     class(mld_d_base_smoother_type), allocatable , intent(inout) :: save1, save2
     integer(psb_ipk_), intent(out) :: info
 
@@ -493,15 +493,19 @@ contains
       if (info  == 0) deallocate(save2,stat=info)
       if (info /= 0) return
     end if
-    allocate(save1, source=level%sm,stat=info) 
-    if ((info == 0).and.allocated(level%sm2a)) allocate(save2, source=level%sm2a,stat=info) 
-
+    allocate(save1, mold=level%sm,stat=info)
+    if (info == 0) call level%sm%clone_settings(save1,info)
+    if ((info == 0).and.allocated(level%sm2a)) then
+      allocate(save2, mold=level%sm2a,stat=info) 
+      if (info == 0) call level%sm2a%clone_settings(save2,info)
+    end if
+    
     return
   end subroutine save_smoothers
 
   subroutine restore_smoothers(level,save1, save2,info)
     type(mld_d_onelev_type), intent(inout), target :: level
-    class(mld_d_base_smoother_type), allocatable, intent(in) :: save1, save2
+    class(mld_d_base_smoother_type), allocatable, intent(inout) :: save1, save2
     integer(psb_ipk_), intent(out) :: info
 
     info  = 0
@@ -511,7 +515,8 @@ contains
       if (info  == 0) deallocate(level%sm,stat=info)
     end if
     if (allocated(save1)) then
-      if (info  == 0) allocate(level%sm,source=save1,stat=info)
+      if (info  == 0) allocate(level%sm,mold=save1,stat=info)
+      if (info == 0) call save1%clone_settings(level%sm,info)
     end if
     
     if (info /= 0) return
@@ -521,7 +526,8 @@ contains
       if (info  == 0) deallocate(level%sm2a,stat=info)
     end if
     if (allocated(save2)) then
-      if (info  == 0) allocate(level%sm2a,source=save2,stat=info)
+      if (info  == 0) allocate(level%sm2a,mold=save2,stat=info)
+      if (info == 0) call save2%clone_settings(level%sm2a,info)
       if (info  == 0) level%sm2 => level%sm2a
     else
       if (allocated(level%sm)) level%sm2 => level%sm

mlprec/impl/mld_d_smoothers_bld.f90

@@ -256,7 +256,7 @@ subroutine mld_d_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_, mld_gs_, mld_fbgs_, mld_l1_gs_,mld_l1_fbgs_)
       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_dcprecset.F90

@@ -194,89 +194,89 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
           info = -2
           return
         end if
-      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)
+        if (nlev_ > 1) then 
+          call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
+          select case (val) 
+          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)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos)
 #elif 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_)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
 #else
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
 #endif
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
-        case(mld_slu_)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
+          case(mld_slu_)
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
-        case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
-        case(mld_mumps_)
+          case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+          case(mld_mumps_)
 #if defined(HAVE_MUMPS_)          
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
-       case(mld_umf_)
+         case(mld_umf_)
 #if defined(HAVE_UMF_)  
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
           
-        case(mld_sludist_)
+          case(mld_sludist_)
 #if defined(HAVE_SLUDIST_) 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #elif defined(HAVE_UMF_)  
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
           case(mld_jac_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
@@ -287,6 +287,18 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',mld_l1_diag_scale_,info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_gs_,mld_fbgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_bwgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_bwgs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_l1_gs_,mld_l1_fbgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_l1_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
           end select
           
         endif
@@ -345,8 +357,8 @@ subroutine mld_dcprecseti(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_)
@@ -435,6 +447,18 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',mld_l1_diag_scale_,info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_gs_,mld_fbgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_bwgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_bwgs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_l1_gs_,mld_l1_fbgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_l1_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
         end select
       endif
 
@@ -609,89 +633,88 @@ subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           info = -2
           return
         end if
-      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)
+        if (nlev_ > 1) then 
+          call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
+          select case (psb_toupper(trim(string))) 
+          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)
+            call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos)
 #elif 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_)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
 #else
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
 #endif
-          call p%precv(nlev_)%set('COARSE_MAT','dist',info)
-        case('SLU')
+            call p%precv(nlev_)%set('COARSE_MAT','dist',info)
+          case('SLU')
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
-        case('ILU','MILU','ILUT')
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','bjac',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
-        case('MUMPS')
+          case('ILU','MILU','ILUT')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','bjac',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+          case('MUMPS')
 #if defined(HAVE_MUMPS_)          
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC'_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
-       case('UMF')
+         case('UMF')
 #if defined(HAVE_UMF_)  
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
-#endif
-          
-        case('SLUDIST')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+#endif          
+          case('SLUDIST')
 #if defined(HAVE_SLUDIST_) 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #elif defined(HAVE_UMF_)  
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
           case('JAC','JACOBI')
             call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
@@ -702,6 +725,18 @@ subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE','L1-DIAG',info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('GS','FWGS','FBGS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('BWGS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','BWGS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('L1-GS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','L1-BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)          
           end select
           
         endif
@@ -741,9 +776,9 @@ subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
     case('COARSE_SOLVE')
       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)
+        select case (psb_toupper(trim(string)))
+        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_)
@@ -827,11 +862,22 @@ subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE','DIAG',info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
-
         case('L1-JACOBI')
           call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE','L1-DIAG',info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('GS','FWGS','FBGS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('BWGS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','BWGS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('L1-GS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','L1-BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)          
         end select
       endif
 

mlprec/impl/mld_dprecinit.F90

@@ -50,10 +50,15 @@
 !
 !    'DIAG', 'JACOBI' - diagonal/Jacobi           
 !
+!    'L1-DIAG', 'L1-JACOBI' - diagonal/Jacobi  with L1 norm correction
+!
 !    'GS', 'FBGS'     - Hybrid Gauss-Seidel, also symmetrized
 !                       
 !    'BJAC'           - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks
+!                       
+!    'L1-BJAC'        - block Jacobi preconditioner, with ILU(0)
+!                       on the local blocks and L1 correction for off-diag blocks
 !
 !    'AS'             - Additive Schwarz (AS), with
 !                       overlap 1 and ILU(0) on the local submatrices
@@ -124,7 +129,7 @@ subroutine mld_dprecinit(ictxt,prec,ptype,info)
   prec%ictxt = ictxt
   prec%ag_data%min_coarse_size = -1
 
-  select case(psb_toupper(ptype(1:len_trim(ptype))))
+  select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE') 
     nlev_ = 1
     ilev_ = 1
@@ -143,6 +148,15 @@ subroutine mld_dprecinit(ictxt,prec,ptype,info)
     allocate(mld_d_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
     call prec%precv(ilev_)%default()
 
+  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI') 
+    nlev_ = 1
+    ilev_ = 1
+    allocate(prec%precv(nlev_),stat=info) 
+    allocate(mld_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    if (info /= psb_success_) return
+    allocate(mld_d_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    call prec%precv(ilev_)%default()
+
   case ('GS','FWGS') 
     nlev_ = 1
     ilev_ = 1
@@ -177,6 +191,15 @@ subroutine mld_dprecinit(ictxt,prec,ptype,info)
     allocate(mld_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
     call prec%precv(ilev_)%default()
 
+  case ('L1-BJAC','L1_BJAC') 
+    nlev_ = 1
+    ilev_ = 1
+    allocate(prec%precv(nlev_),stat=info) 
+    allocate(mld_d_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    if (info /= psb_success_) return
+    allocate(mld_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    call prec%precv(ilev_)%default()
+
   case ('AS')
     nlev_ = 1
     ilev_ = 1
@@ -207,8 +230,7 @@ subroutine mld_dprecinit(ictxt,prec,ptype,info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-    !call prec%precv(nlev_)%default()
-
+    
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'

mlprec/impl/mld_s_hierarchy_bld.f90

@@ -273,10 +273,12 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
   end if
 
   !
-  ! Finest level first; remember to fix base_a and base_desc
+  ! Finest level first; create a GEN_BLOCK
+  ! copy of the descriptor. 
   ! 
   prec%precv(1)%base_a    => a
-  prec%precv(1)%base_desc => desc_a
+  call psb_cd_renum_block(desc_a,prec%precv(1)%desc_ac,info)
+  prec%precv(1)%base_desc => prec%precv(1)%desc_ac
   newsz = 0
   array_build_loop: do i=2, iszv
     !
@@ -317,7 +319,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
 
     if (debug_level >= psb_debug_outer_) &
          & write(debug_unit,*) me,' ',trim(name),&
-         & 'Return from ',i,' call to mlprcbld ',info      
+         & 'Return from ',i,' call to bld_tprol', info      
     !
     ! Save op_prol just in case
     !
@@ -334,9 +336,9 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
       sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
     end if
     prec%precv(i)%szratio = sizeratio
-    if (iaggsize <= casize) then
-      newsz = i      
-    end if
+
+    if (iaggsize <= casize) newsz = i      
+    if (i == iszv)          newsz = i
 
     if (i>2) then
       if (sizeratio < mnaggratio) then
@@ -440,7 +442,10 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
     ! Restart
     iszv = newsz
     ! Fix the pointers, but the level 1 should
-    ! be already OK
+    ! be treated differently
+    if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
+      prec%precv(1)%base_desc => prec%precv(1)%desc_ac
+    end if
     do i=2, iszv 
       prec%precv(i)%base_a       => prec%precv(i)%ac
       prec%precv(i)%base_desc    => prec%precv(i)%desc_ac
@@ -449,11 +454,6 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
     end do
   end if
 
-  ! Does the coarsening need backfix on descriptors? 
-  do i=2, iszv 
-    if (info == psb_success_) call prec%precv(i)%backfix(prec%precv(i-1),info)    
-  end do
-  
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_internal_error_,name,&
          & a_err='Internal hierarchy build' )
@@ -478,7 +478,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
 
 contains
   subroutine save_smoothers(level,save1, save2,info)
-    type(mld_s_onelev_type), intent(in) :: level
+    type(mld_s_onelev_type), intent(inout) :: level
     class(mld_s_base_smoother_type), allocatable , intent(inout) :: save1, save2
     integer(psb_ipk_), intent(out) :: info
 
@@ -493,15 +493,19 @@ contains
       if (info  == 0) deallocate(save2,stat=info)
       if (info /= 0) return
     end if
-    allocate(save1, source=level%sm,stat=info) 
-    if ((info == 0).and.allocated(level%sm2a)) allocate(save2, source=level%sm2a,stat=info) 
-
+    allocate(save1, mold=level%sm,stat=info)
+    if (info == 0) call level%sm%clone_settings(save1,info)
+    if ((info == 0).and.allocated(level%sm2a)) then
+      allocate(save2, mold=level%sm2a,stat=info) 
+      if (info == 0) call level%sm2a%clone_settings(save2,info)
+    end if
+    
     return
   end subroutine save_smoothers
 
   subroutine restore_smoothers(level,save1, save2,info)
     type(mld_s_onelev_type), intent(inout), target :: level
-    class(mld_s_base_smoother_type), allocatable, intent(in) :: save1, save2
+    class(mld_s_base_smoother_type), allocatable, intent(inout) :: save1, save2
     integer(psb_ipk_), intent(out) :: info
 
     info  = 0
@@ -511,7 +515,8 @@ contains
       if (info  == 0) deallocate(level%sm,stat=info)
     end if
     if (allocated(save1)) then
-      if (info  == 0) allocate(level%sm,source=save1,stat=info)
+      if (info  == 0) allocate(level%sm,mold=save1,stat=info)
+      if (info == 0) call save1%clone_settings(level%sm,info)
     end if
     
     if (info /= 0) return
@@ -521,7 +526,8 @@ contains
       if (info  == 0) deallocate(level%sm2a,stat=info)
     end if
     if (allocated(save2)) then
-      if (info  == 0) allocate(level%sm2a,source=save2,stat=info)
+      if (info  == 0) allocate(level%sm2a,mold=save2,stat=info)
+      if (info == 0) call save2%clone_settings(level%sm2a,info)
       if (info  == 0) level%sm2 => level%sm2a
     else
       if (allocated(level%sm)) level%sm2 => level%sm

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_, mld_gs_, mld_fbgs_, mld_l1_gs_,mld_l1_fbgs_)
       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

@@ -188,75 +188,75 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos,idx)
           info = -2
           return
         end if
-      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)
+        if (nlev_ > 1) then 
+          call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
+          select case (val) 
+          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)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
 #else
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
 #endif
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
-        case(mld_slu_)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
+          case(mld_slu_)
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
-        case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
-        case(mld_mumps_)
+          case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+          case(mld_mumps_)
 #if defined(HAVE_MUMPS_)          
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
-       case(mld_umf_)
+         case(mld_umf_)
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
           
-        case(mld_sludist_)
+          case(mld_sludist_)
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
           case(mld_jac_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
@@ -267,6 +267,18 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',mld_l1_diag_scale_,info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_gs_,mld_fbgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_bwgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_bwgs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_l1_gs_,mld_l1_fbgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_l1_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
           end select
           
         endif
@@ -325,8 +337,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_)
@@ -401,6 +413,18 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',mld_l1_diag_scale_,info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_gs_,mld_fbgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_bwgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_bwgs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_l1_gs_,mld_l1_fbgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_l1_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
         end select
       endif
 
@@ -569,75 +593,75 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           info = -2
           return
         end if
-      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)
+        if (nlev_ > 1) then 
+          call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
+          select case (psb_toupper(trim(string))) 
+          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)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
 #else
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
 #endif
-          call p%precv(nlev_)%set('COARSE_MAT','dist',info)
-        case('SLU')
+            call p%precv(nlev_)%set('COARSE_MAT','dist',info)
+          case('SLU')
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
-        case('ILU','MILU','ILUT')
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','bjac',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
-        case('MUMPS')
+          case('ILU','MILU','ILUT')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','bjac',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+          case('MUMPS')
 #if defined(HAVE_MUMPS_)          
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC'_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
-       case('UMF')
+         case('UMF')
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
           
-        case('SLUDIST')
+          case('SLUDIST')
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
           case('JAC','JACOBI')
             call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
@@ -648,6 +672,18 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE','L1-DIAG',info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('GS','FWGS','FBGS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('BWGS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','BWGS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('L1-GS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','L1-BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)          
           end select
           
         endif
@@ -687,9 +723,9 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
     case('COARSE_SOLVE')
       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)
+        select case (psb_toupper(trim(string)))
+        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_)
@@ -759,11 +795,22 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE','DIAG',info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
-
         case('L1-JACOBI')
           call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE','L1-DIAG',info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('GS','FWGS','FBGS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('BWGS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','BWGS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('L1-GS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','L1-BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)          
         end select
       endif
 

mlprec/impl/mld_sprecinit.F90

@@ -50,10 +50,15 @@
 !
 !    'DIAG', 'JACOBI' - diagonal/Jacobi           
 !
+!    'L1-DIAG', 'L1-JACOBI' - diagonal/Jacobi  with L1 norm correction
+!
 !    'GS', 'FBGS'     - Hybrid Gauss-Seidel, also symmetrized
 !                       
 !    'BJAC'           - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks
+!                       
+!    'L1-BJAC'        - block Jacobi preconditioner, with ILU(0)
+!                       on the local blocks and L1 correction for off-diag blocks
 !
 !    'AS'             - Additive Schwarz (AS), with
 !                       overlap 1 and ILU(0) on the local submatrices
@@ -121,7 +126,7 @@ subroutine mld_sprecinit(ictxt,prec,ptype,info)
   prec%ictxt = ictxt
   prec%ag_data%min_coarse_size = -1
 
-  select case(psb_toupper(ptype(1:len_trim(ptype))))
+  select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE') 
     nlev_ = 1
     ilev_ = 1
@@ -140,6 +145,15 @@ subroutine mld_sprecinit(ictxt,prec,ptype,info)
     allocate(mld_s_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
     call prec%precv(ilev_)%default()
 
+  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI') 
+    nlev_ = 1
+    ilev_ = 1
+    allocate(prec%precv(nlev_),stat=info) 
+    allocate(mld_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    if (info /= psb_success_) return
+    allocate(mld_s_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    call prec%precv(ilev_)%default()
+
   case ('GS','FWGS') 
     nlev_ = 1
     ilev_ = 1
@@ -174,6 +188,15 @@ subroutine mld_sprecinit(ictxt,prec,ptype,info)
     allocate(mld_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
     call prec%precv(ilev_)%default()
 
+  case ('L1-BJAC','L1_BJAC') 
+    nlev_ = 1
+    ilev_ = 1
+    allocate(prec%precv(nlev_),stat=info) 
+    allocate(mld_s_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    if (info /= psb_success_) return
+    allocate(mld_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    call prec%precv(ilev_)%default()
+
   case ('AS')
     nlev_ = 1
     ilev_ = 1
@@ -202,8 +225,7 @@ subroutine mld_sprecinit(ictxt,prec,ptype,info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-    !call prec%precv(nlev_)%default()
-
+    
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'

mlprec/impl/mld_z_hierarchy_bld.f90

@@ -273,10 +273,12 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
   end if
 
   !
-  ! Finest level first; remember to fix base_a and base_desc
+  ! Finest level first; create a GEN_BLOCK
+  ! copy of the descriptor. 
   ! 
   prec%precv(1)%base_a    => a
-  prec%precv(1)%base_desc => desc_a
+  call psb_cd_renum_block(desc_a,prec%precv(1)%desc_ac,info)
+  prec%precv(1)%base_desc => prec%precv(1)%desc_ac
   newsz = 0
   array_build_loop: do i=2, iszv
     !
@@ -317,7 +319,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
 
     if (debug_level >= psb_debug_outer_) &
          & write(debug_unit,*) me,' ',trim(name),&
-         & 'Return from ',i,' call to mlprcbld ',info      
+         & 'Return from ',i,' call to bld_tprol', info      
     !
     ! Save op_prol just in case
     !
@@ -334,9 +336,9 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
       sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
     end if
     prec%precv(i)%szratio = sizeratio
-    if (iaggsize <= casize) then
-      newsz = i      
-    end if
+
+    if (iaggsize <= casize) newsz = i      
+    if (i == iszv)          newsz = i
 
     if (i>2) then
       if (sizeratio < mnaggratio) then
@@ -440,7 +442,10 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
     ! Restart
     iszv = newsz
     ! Fix the pointers, but the level 1 should
-    ! be already OK
+    ! be treated differently
+    if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
+      prec%precv(1)%base_desc => prec%precv(1)%desc_ac
+    end if
     do i=2, iszv 
       prec%precv(i)%base_a       => prec%precv(i)%ac
       prec%precv(i)%base_desc    => prec%precv(i)%desc_ac
@@ -449,11 +454,6 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
     end do
   end if
 
-  ! Does the coarsening need backfix on descriptors? 
-  do i=2, iszv 
-    if (info == psb_success_) call prec%precv(i)%backfix(prec%precv(i-1),info)    
-  end do
-  
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_internal_error_,name,&
          & a_err='Internal hierarchy build' )
@@ -478,7 +478,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
 
 contains
   subroutine save_smoothers(level,save1, save2,info)
-    type(mld_z_onelev_type), intent(in) :: level
+    type(mld_z_onelev_type), intent(inout) :: level
     class(mld_z_base_smoother_type), allocatable , intent(inout) :: save1, save2
     integer(psb_ipk_), intent(out) :: info
 
@@ -493,15 +493,19 @@ contains
       if (info  == 0) deallocate(save2,stat=info)
       if (info /= 0) return
     end if
-    allocate(save1, source=level%sm,stat=info) 
-    if ((info == 0).and.allocated(level%sm2a)) allocate(save2, source=level%sm2a,stat=info) 
-
+    allocate(save1, mold=level%sm,stat=info)
+    if (info == 0) call level%sm%clone_settings(save1,info)
+    if ((info == 0).and.allocated(level%sm2a)) then
+      allocate(save2, mold=level%sm2a,stat=info) 
+      if (info == 0) call level%sm2a%clone_settings(save2,info)
+    end if
+    
     return
   end subroutine save_smoothers
 
   subroutine restore_smoothers(level,save1, save2,info)
     type(mld_z_onelev_type), intent(inout), target :: level
-    class(mld_z_base_smoother_type), allocatable, intent(in) :: save1, save2
+    class(mld_z_base_smoother_type), allocatable, intent(inout) :: save1, save2
     integer(psb_ipk_), intent(out) :: info
 
     info  = 0
@@ -511,7 +515,8 @@ contains
       if (info  == 0) deallocate(level%sm,stat=info)
     end if
     if (allocated(save1)) then
-      if (info  == 0) allocate(level%sm,source=save1,stat=info)
+      if (info  == 0) allocate(level%sm,mold=save1,stat=info)
+      if (info == 0) call save1%clone_settings(level%sm,info)
     end if
     
     if (info /= 0) return
@@ -521,7 +526,8 @@ contains
       if (info  == 0) deallocate(level%sm2a,stat=info)
     end if
     if (allocated(save2)) then
-      if (info  == 0) allocate(level%sm2a,source=save2,stat=info)
+      if (info  == 0) allocate(level%sm2a,mold=save2,stat=info)
+      if (info == 0) call save2%clone_settings(level%sm2a,info)
       if (info  == 0) level%sm2 => level%sm2a
     else
       if (allocated(level%sm)) level%sm2 => level%sm

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_, mld_gs_, mld_fbgs_, mld_l1_gs_,mld_l1_fbgs_)
       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

@@ -194,89 +194,89 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
           info = -2
           return
         end if
-      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)
+        if (nlev_ > 1) then 
+          call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
+          select case (val) 
+          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)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos)
 #elif 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_)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
 #else
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
 #endif
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
-        case(mld_slu_)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
+          case(mld_slu_)
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
-        case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
-        case(mld_mumps_)
+          case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+          case(mld_mumps_)
 #if defined(HAVE_MUMPS_)          
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
-       case(mld_umf_)
+         case(mld_umf_)
 #if defined(HAVE_UMF_)  
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
           
-        case(mld_sludist_)
+          case(mld_sludist_)
 #if defined(HAVE_SLUDIST_) 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #elif defined(HAVE_UMF_)  
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_umf_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_slu_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_mumps_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
 #endif
           case(mld_jac_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
@@ -287,6 +287,18 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',mld_l1_diag_scale_,info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_gs_,mld_fbgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_bwgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_bwgs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+          case(mld_l1_gs_,mld_l1_fbgs_)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_l1_bjac_,info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
           end select
           
         endif
@@ -345,8 +357,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_)
@@ -435,6 +447,18 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',mld_l1_diag_scale_,info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_gs_,mld_fbgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_bwgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_bwgs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
+        case(mld_l1_gs_,mld_l1_fbgs_)
+          call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_l1_bjac_,info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE',mld_gs_,info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
         end select
       endif
 
@@ -609,89 +633,88 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           info = -2
           return
         end if
-      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)
+        if (nlev_ > 1) then 
+          call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
+          select case (psb_toupper(trim(string))) 
+          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)
+            call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos)
 #elif 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_)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
 #else
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
 #endif
-          call p%precv(nlev_)%set('COARSE_MAT','dist',info)
-        case('SLU')
+            call p%precv(nlev_)%set('COARSE_MAT','dist',info)
+          case('SLU')
 #if defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
-        case('ILU','MILU','ILUT')
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','bjac',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
-        case('MUMPS')
+          case('ILU','MILU','ILUT')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','bjac',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+          case('MUMPS')
 #if defined(HAVE_MUMPS_)          
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC'_,info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
-       case('UMF')
+         case('UMF')
 #if defined(HAVE_UMF_)  
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
-#endif
-          
-        case('SLUDIST')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+#endif          
+          case('SLUDIST')
 #if defined(HAVE_SLUDIST_) 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE',string,info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #elif defined(HAVE_UMF_)  
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','UMF',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_SLU_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','SLU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','REPL',info,pos=pos)
 #elif defined(HAVE_MUMPS_)
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','MUMPS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #else 
-          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
-          call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
-          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','ILU',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
 #endif
           case('JAC','JACOBI')
             call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
@@ -702,6 +725,18 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE','L1-DIAG',info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('GS','FWGS','FBGS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('BWGS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','BWGS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+          case('L1-GS')
+            call p%precv(nlev_)%set('SMOOTHER_TYPE','L1-BJAC',info,pos=pos)
+            call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+            call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)          
           end select
           
         endif
@@ -741,9 +776,9 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
     case('COARSE_SOLVE')
       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)
+        select case (psb_toupper(trim(string)))
+        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_)
@@ -827,11 +862,22 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE','DIAG',info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
-
         case('L1-JACOBI')
           call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE','L1-DIAG',info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('GS','FWGS','FBGS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('BWGS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','BWGS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)
+        case('L1-GS')
+          call p%precv(nlev_)%set('SMOOTHER_TYPE','L1-BJAC',info,pos=pos)
+          call p%precv(nlev_)%set('SUB_SOLVE','GS',info,pos=pos)
+          call p%precv(nlev_)%set('COARSE_MAT','DIST',info,pos=pos)          
         end select
       endif
 

mlprec/impl/mld_zprecinit.F90

@@ -50,10 +50,15 @@
 !
 !    'DIAG', 'JACOBI' - diagonal/Jacobi           
 !
+!    'L1-DIAG', 'L1-JACOBI' - diagonal/Jacobi  with L1 norm correction
+!
 !    'GS', 'FBGS'     - Hybrid Gauss-Seidel, also symmetrized
 !                       
 !    'BJAC'           - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks
+!                       
+!    'L1-BJAC'        - block Jacobi preconditioner, with ILU(0)
+!                       on the local blocks and L1 correction for off-diag blocks
 !
 !    'AS'             - Additive Schwarz (AS), with
 !                       overlap 1 and ILU(0) on the local submatrices
@@ -124,7 +129,7 @@ subroutine mld_zprecinit(ictxt,prec,ptype,info)
   prec%ictxt = ictxt
   prec%ag_data%min_coarse_size = -1
 
-  select case(psb_toupper(ptype(1:len_trim(ptype))))
+  select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE') 
     nlev_ = 1
     ilev_ = 1
@@ -143,6 +148,15 @@ subroutine mld_zprecinit(ictxt,prec,ptype,info)
     allocate(mld_z_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
     call prec%precv(ilev_)%default()
 
+  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI') 
+    nlev_ = 1
+    ilev_ = 1
+    allocate(prec%precv(nlev_),stat=info) 
+    allocate(mld_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    if (info /= psb_success_) return
+    allocate(mld_z_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    call prec%precv(ilev_)%default()
+
   case ('GS','FWGS') 
     nlev_ = 1
     ilev_ = 1
@@ -177,6 +191,15 @@ subroutine mld_zprecinit(ictxt,prec,ptype,info)
     allocate(mld_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
     call prec%precv(ilev_)%default()
 
+  case ('L1-BJAC','L1_BJAC') 
+    nlev_ = 1
+    ilev_ = 1
+    allocate(prec%precv(nlev_),stat=info) 
+    allocate(mld_z_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    if (info /= psb_success_) return
+    allocate(mld_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    call prec%precv(ilev_)%default()
+
   case ('AS')
     nlev_ = 1
     ilev_ = 1
@@ -207,8 +230,7 @@ subroutine mld_zprecinit(ictxt,prec,ptype,info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-    !call prec%precv(nlev_)%default()
-
+    
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'

mlprec/impl/smoother/Makefile

@@ -12,6 +12,8 @@ mld_c_as_smoother_apply_vect.o \
 mld_c_as_smoother_bld.o \
 mld_c_as_smoother_check.o \
 mld_c_as_smoother_clone.o \
+mld_c_as_smoother_clone_settings.o \
+mld_c_as_smoother_clear_data.o \
 mld_c_as_smoother_cnv.o \
 mld_c_as_smoother_csetc.o \
 mld_c_as_smoother_cseti.o \
@@ -26,6 +28,8 @@ mld_c_base_smoother_apply_vect.o \
 mld_c_base_smoother_bld.o \
 mld_c_base_smoother_check.o \
 mld_c_base_smoother_clone.o \
+mld_c_base_smoother_clone_settings.o \
+mld_c_base_smoother_clear_data.o \
 mld_c_base_smoother_cnv.o \
 mld_c_base_smoother_csetc.o \
 mld_c_base_smoother_cseti.o \
@@ -39,15 +43,22 @@ mld_c_jac_smoother_bld.o \
 mld_c_jac_smoother_descr.o \
 mld_c_jac_smoother_dmp.o \
 mld_c_jac_smoother_clone.o \
+mld_c_jac_smoother_clone_settings.o \
+mld_c_jac_smoother_clear_data.o \
 mld_c_jac_smoother_cnv.o \
 mld_c_jac_smoother_csetc.o \
 mld_c_jac_smoother_cseti.o \
 mld_c_jac_smoother_csetr.o \
+mld_c_l1_jac_smoother_bld.o \
+mld_c_l1_jac_smoother_descr.o \
+mld_c_l1_jac_smoother_clone.o \
 mld_d_as_smoother_apply.o \
 mld_d_as_smoother_apply_vect.o \
 mld_d_as_smoother_bld.o \
 mld_d_as_smoother_check.o \
 mld_d_as_smoother_clone.o \
+mld_d_as_smoother_clone_settings.o \
+mld_d_as_smoother_clear_data.o \
 mld_d_as_smoother_cnv.o \
 mld_d_as_smoother_csetc.o \
 mld_d_as_smoother_cseti.o \
@@ -62,6 +73,8 @@ mld_d_base_smoother_apply_vect.o \
 mld_d_base_smoother_bld.o \
 mld_d_base_smoother_check.o \
 mld_d_base_smoother_clone.o \
+mld_d_base_smoother_clone_settings.o \
+mld_d_base_smoother_clear_data.o \
 mld_d_base_smoother_cnv.o \
 mld_d_base_smoother_csetc.o \
 mld_d_base_smoother_cseti.o \
@@ -75,15 +88,22 @@ mld_d_jac_smoother_bld.o \
 mld_d_jac_smoother_descr.o \
 mld_d_jac_smoother_dmp.o \
 mld_d_jac_smoother_clone.o \
+mld_d_jac_smoother_clone_settings.o \
+mld_d_jac_smoother_clear_data.o \
 mld_d_jac_smoother_cnv.o \
 mld_d_jac_smoother_csetc.o \
 mld_d_jac_smoother_cseti.o \
 mld_d_jac_smoother_csetr.o \
+mld_d_l1_jac_smoother_bld.o \
+mld_d_l1_jac_smoother_descr.o \
+mld_d_l1_jac_smoother_clone.o \
 mld_s_as_smoother_apply.o \
 mld_s_as_smoother_apply_vect.o \
 mld_s_as_smoother_bld.o \
 mld_s_as_smoother_check.o \
 mld_s_as_smoother_clone.o \
+mld_s_as_smoother_clone_settings.o \
+mld_s_as_smoother_clear_data.o \
 mld_s_as_smoother_cnv.o \
 mld_s_as_smoother_csetc.o \
 mld_s_as_smoother_cseti.o \
@@ -98,6 +118,8 @@ mld_s_base_smoother_apply_vect.o \
 mld_s_base_smoother_bld.o \
 mld_s_base_smoother_check.o \
 mld_s_base_smoother_clone.o \
+mld_s_base_smoother_clone_settings.o \
+mld_s_base_smoother_clear_data.o \
 mld_s_base_smoother_cnv.o \
 mld_s_base_smoother_csetc.o \
 mld_s_base_smoother_cseti.o \
@@ -111,15 +133,22 @@ mld_s_jac_smoother_bld.o \
 mld_s_jac_smoother_descr.o \
 mld_s_jac_smoother_dmp.o \
 mld_s_jac_smoother_clone.o \
+mld_s_jac_smoother_clone_settings.o \
+mld_s_jac_smoother_clear_data.o \
 mld_s_jac_smoother_cnv.o \
 mld_s_jac_smoother_csetc.o \
 mld_s_jac_smoother_cseti.o \
 mld_s_jac_smoother_csetr.o \
+mld_s_l1_jac_smoother_bld.o \
+mld_s_l1_jac_smoother_descr.o \
+mld_s_l1_jac_smoother_clone.o \
 mld_z_as_smoother_apply.o \
 mld_z_as_smoother_apply_vect.o \
 mld_z_as_smoother_bld.o \
 mld_z_as_smoother_check.o \
 mld_z_as_smoother_clone.o \
+mld_z_as_smoother_clone_settings.o \
+mld_z_as_smoother_clear_data.o \
 mld_z_as_smoother_cnv.o \
 mld_z_as_smoother_csetc.o \
 mld_z_as_smoother_cseti.o \
@@ -134,6 +163,8 @@ mld_z_base_smoother_apply_vect.o \
 mld_z_base_smoother_bld.o \
 mld_z_base_smoother_check.o \
 mld_z_base_smoother_clone.o \
+mld_z_base_smoother_clone_settings.o \
+mld_z_base_smoother_clear_data.o \
 mld_z_base_smoother_cnv.o \
 mld_z_base_smoother_csetc.o \
 mld_z_base_smoother_cseti.o \
@@ -147,10 +178,15 @@ mld_z_jac_smoother_bld.o \
 mld_z_jac_smoother_descr.o \
 mld_z_jac_smoother_dmp.o \
 mld_z_jac_smoother_clone.o \
+mld_z_jac_smoother_clone_settings.o \
+mld_z_jac_smoother_clear_data.o \
 mld_z_jac_smoother_cnv.o \
 mld_z_jac_smoother_csetc.o \
 mld_z_jac_smoother_cseti.o \
-mld_z_jac_smoother_csetr.o
+mld_z_jac_smoother_csetr.o \
+mld_z_l1_jac_smoother_bld.o \
+mld_z_l1_jac_smoother_descr.o \
+mld_z_l1_jac_smoother_clone.o \
 
 LIBNAME=libmld_prec.a
 

mlprec/impl/smoother/mld_c_as_smoother_clear_data.f90

@@ -0,0 +1,70 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_c_as_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_c_as_smoother, mld_protect_name =>  mld_c_as_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_c_as_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='c_as_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  call sm%nd%free()
+  sm%nd_nnz_tot = 0 
+  call sm%desc_data%free(info)
+  if ((info==0).and.allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+  end if
+  if (info /= 0) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_c_as_smoother_clear_data

mlprec/impl/smoother/mld_c_as_smoother_clone_settings.f90

@@ -0,0 +1,95 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               asd on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_c_as_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_c_as_smoother, mld_protect_name =>  mld_c_as_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_c_as_smoother_type), intent(inout)              :: sm
+  class(mld_c_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='c_as_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  
+  select type(smout)
+  class is(mld_c_as_smoother_type)
+    smout%novr  = sm%novr
+    smout%restr = sm%restr
+    smout%prol  = sm%prol
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  class default
+    info = psb_err_internal_error_
+  end select
+  
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_c_as_smoother_clone_settings

mlprec/impl/smoother/mld_c_as_smoother_dmp.f90

@@ -35,21 +35,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_c_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_dmp
   implicit none 
   class(mld_c_as_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)               :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)               :: level
   integer(psb_ipk_), intent(out)              :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  logical :: smoother_, global_num_ 
   !  len of prefix_ 
 
   info = 0
@@ -59,7 +60,7 @@ subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   else
     prefix_ = "dump_smth_c"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
   if (present(smoother)) then 
@@ -67,11 +68,18 @@ subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   else
     smoother_ = .false. 
   end if
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   lname = len_trim(prefix_)
   fname = trim(prefix_)
   write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
   lname = lname + 5
-
+  if (global_num_) then
+    write(0,*) iam,' Warning: no global num with AS smoothers dump'
+  end if
   if (smoother_) then 
     write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
     if (sm%nd%is_asb()) &
@@ -79,6 +87,6 @@ subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   end if
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_c_as_smoother_dmp

mlprec/impl/smoother/mld_c_base_smoother_clear_data.f90

@@ -0,0 +1,67 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_c_base_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_c_base_smoother_mod, mld_protect_name =>  mld_c_base_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_c_base_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='c_base_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  if (allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+    if (info /= 0) then
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_c_base_smoother_clear_data

mlprec/impl/smoother/mld_c_base_smoother_clone.f90

@@ -45,7 +45,7 @@ subroutine mld_c_base_smoother_clone(sm,smout,info)
   class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
   integer(psb_ipk_), intent(out)                 :: info
   integer(psb_ipk_)  :: err_act
-  character(len=20) :: name='d_base_smoother_clone'
+  character(len=20) :: name='c_base_smoother_clone'
 
   call psb_erractionsave(err_act)
 

mlprec/impl/smoother/mld_c_base_smoother_clone_settings.f90

@@ -0,0 +1,89 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_c_base_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_c_base_smoother_mod, mld_protect_name =>  mld_c_base_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_c_base_smoother_type), intent(inout)              :: sm
+  class(mld_c_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='c_base_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info=psb_success_
+  if (same_type_as(sm,smout)) then
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  else
+    info = psb_err_internal_error_
+  end if
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_c_base_smoother_clone_settings

mlprec/impl/smoother/mld_c_base_smoother_cnv.f90

@@ -48,7 +48,7 @@ subroutine mld_c_base_smoother_cnv(sm,info,amold,vmold,imold)
   class(psb_c_base_vect_type), intent(in), optional  :: vmold
   class(psb_i_base_vect_type), intent(in), optional  :: imold
   integer(psb_ipk_) :: err_act
-  character(len=20) :: name='d_base_smoother_cnv'
+  character(len=20) :: name='c_base_smoother_cnv'
 
   call psb_erractionsave(err_act)
 

mlprec/impl/smoother/mld_c_base_smoother_dmp.f90

@@ -35,21 +35,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_c_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_c_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_c_base_smoother_mod, mld_protect_name =>  mld_c_base_smoother_dmp
   implicit none 
   class(mld_c_base_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)              :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)              :: level
   integer(psb_ipk_), intent(out)             :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  logical :: smoother_, global_num_
   !  len of prefix_ 
 
   info = 0
@@ -59,9 +60,14 @@ subroutine mld_c_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
   else
     prefix_ = "dump_smth_c"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   if (present(smoother)) then 
     smoother_ = smoother
   else
@@ -74,6 +80,6 @@ subroutine mld_c_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
 
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_c_base_smoother_dmp

mlprec/impl/smoother/mld_c_jac_smoother_bld.f90

@@ -51,9 +51,8 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
   class(psb_c_base_vect_type), intent(in), optional  :: vmold
   class(psb_i_base_vect_type), intent(in), optional  :: imold
   ! Local variables
+  type(psb_cspmat_type) :: tmpa
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
-  complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
-  type(psb_c_coo_sparse_mat) :: tmpcoo
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='c_jac_smoother_bld', ch_err
 
@@ -79,12 +78,17 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
     call sm%nd%free()
     sm%pa => a
     sm%nd_nnz_tot = nztota
+    call psb_sum(ictxt,sm%nd_nnz_tot)
+    call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
 
   class default
     if (smsv%is_global()) then
       ! Do not put anything into SM%ND since the solver
       ! is acting globally.
+      call sm%nd%free()
       sm%nd_nnz_tot = 0
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
     else
       call a%csclip(sm%nd,info,&
            & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@@ -98,6 +102,10 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
         endif
       end if
       sm%nd_nnz_tot = sm%nd%get_nzeros()
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
     end if
   end select
   if (info /= psb_success_) then
@@ -105,15 +113,7 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
          & a_err='clip & psb_spcnv csr 4')
     goto 9999
   end if
-  call psb_sum(ictxt,sm%nd_nnz_tot)
 
-
-  call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,&
-         & a_err='solver build')
-    goto 9999
-  end if
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),' end'
 

mlprec/impl/smoother/mld_c_jac_smoother_clear_data.f90

@@ -0,0 +1,70 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_c_jac_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_c_jac_smoother, mld_protect_name =>  mld_c_jac_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_c_jac_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='c_jac_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  call sm%nd%free()
+  sm%nd_nnz_tot = 0
+  sm%pa         => null()
+  if ((info==0).and.allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+  end if
+  if (info /= 0) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_c_jac_smoother_clear_data

mlprec/impl/smoother/mld_c_jac_smoother_clone.f90

@@ -1,15 +1,15 @@
-!  
-!   
+!
+!
 !                             MLD2P4  version 2.2
 !    MultiLevel Domain Decomposition Parallel Preconditioners Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!    
-!    (C) Copyright 2008-2018 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Daniela di Serafino   
-!   
+!
+!    (C) Copyright 2008-2018
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Daniela di Serafino
+!
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
 !    are met:
@@ -21,7 +21,7 @@
 !      3. The name of the MLD2P4 group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
-!   
+!
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -33,10 +33,10 @@
 !    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
+!
+!
 subroutine mld_c_jac_smoother_clone(sm,smout,info)
-  
+
   use psb_base_mod
   use mld_c_jac_smoother, mld_protect_name => mld_c_jac_smoother_clone
 
@@ -59,14 +59,19 @@ subroutine mld_c_jac_smoother_clone(sm,smout,info)
   end if
   if (info == psb_success_) &
        & allocate(mld_c_jac_smoother_type :: smout, stat=info)
-  if (info /= 0) then 
+  if (info /= 0) then
     info = psb_err_alloc_dealloc_
-    goto 9999 
+    goto 9999
   end if
 
   select type(smo => smout)
   type is (mld_c_jac_smoother_type)
     smo%nd_nnz_tot = sm%nd_nnz_tot
+    smo%checkres   = sm%checkres
+    smo%printres   = sm%printres
+    smo%checkiter  = sm%checkiter
+    smo%printiter  = sm%printiter
+    smo%tol        = sm%tol
     call sm%nd%clone(smo%nd,info)
     if ((info==psb_success_).and.(allocated(sm%sv))) then
       allocate(smout%sv,mold=sm%sv,stat=info)

mlprec/impl/smoother/mld_c_jac_smoother_clone_settings.f90

@@ -0,0 +1,101 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               asd on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_c_jac_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_c_jac_smoother, mld_protect_name =>  mld_c_jac_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_c_jac_smoother_type), intent(inout)              :: sm
+  class(mld_c_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='c_jac_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  
+  select type(smout)
+  class is(mld_c_jac_smoother_type)
+
+    smout%pa => null()
+    smout%nd_nnz_tot = 0
+    smout%checkres   = sm%checkres
+    smout%printres   = sm%printres
+    smout%checkiter  = sm%checkiter
+    smout%printiter  = sm%printiter
+    smout%tol        = sm%tol
+
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  class default
+    info = psb_err_internal_error_
+  end select
+  
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_c_jac_smoother_clone_settings

mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90

@@ -59,7 +59,7 @@ subroutine mld_c_jac_smoother_cnv(sm,info,amold,vmold,imold)
 
 
   if (info == psb_success_) then
-    if ((.not.associated(sm%pa)).and.(sm%nd%is_asb())) then
+    if (sm%nd%is_asb()) then
       if (present(amold)) then 
         call sm%nd%cscnv(info,&
              & mold=amold,dupl=psb_dupl_add_)

mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90

@@ -52,22 +52,27 @@ subroutine mld_c_jac_smoother_csetc(sm,what,val,info,idx)
   info = psb_success_
   call psb_erractionsave(err_act)
 
-
-  select case(psb_toupper(what))
-  case('SMOOTHER_STOP')
-    if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then
-      sm%checkres   = .true.
-    else
-      sm%checkres   = .false.
-    end if
-  case('SMOOTHER_TRACE')
-    if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then
-      sm%printres   = .true.
-    else
-      sm%printres   = .false.
-    end if
-  case default
-    call sm%mld_c_base_smoother_type%set(what,val,info,idx=idx)
+  select case(psb_toupper(trim(what)))
+    case('SMOOTHER_STOP')
+      select case(psb_toupper(trim(val)))
+      case('T','TRUE')
+        sm%checkres   = .true.
+      case('F','FALSE')
+        sm%checkres   = .false.
+      case default
+        write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"'
+      end select
+    case('SMOOTHER_TRACE')
+      select case(psb_toupper(trim(val)))
+      case('T','TRUE')
+        sm%printres   = .true.
+      case('F','FALSE')
+        sm%printres   = .false.
+      case default
+        write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"'
+      end select
+    case default
+      call sm%mld_c_base_smoother_type%set(what,val,info,idx=idx)
   end select
 
   if (info /= psb_success_) then

mlprec/impl/smoother/mld_c_jac_smoother_dmp.f90

@@ -35,21 +35,23 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_c_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_c_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_c_jac_smoother, mld_protect_nam => mld_c_jac_smoother_dmp
   implicit none 
   class(mld_c_jac_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)               :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)               :: level
   integer(psb_ipk_), intent(out)              :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  integer(psb_lpk_), allocatable :: iv(:)
+  logical :: smoother_, global_num_
   !  len of prefix_ 
 
   info = 0
@@ -59,7 +61,7 @@ subroutine mld_c_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
   else
     prefix_ = "dump_smth_c"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
   if (present(smoother)) then 
@@ -67,6 +69,11 @@ subroutine mld_c_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
   else
     smoother_ = .false. 
   end if
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   lname = len_trim(prefix_)
   fname = trim(prefix_)
   write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
@@ -74,11 +81,17 @@ subroutine mld_c_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
 
   if (smoother_) then 
     write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
-    if (sm%nd%is_asb()) &
-         & call sm%nd%print(fname,head=head)
+    if (global_num_) then
+      iv = desc%get_global_indices(owned=.false.)      
+      if (sm%nd%is_asb()) &
+           & call sm%nd%print(fname,head=head,iv=iv)
+    else
+      if (sm%nd%is_asb()) &
+           & call sm%nd%print(fname,head=head)
+    end if
   end if
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_c_jac_smoother_dmp

mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90

@@ -0,0 +1,176 @@
+!
+!
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!
+!    (C) Copyright 2008-2018
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Daniela di Serafino
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
+
+  use psb_base_mod
+  use mld_c_diag_solver
+  use mld_c_jac_smoother, mld_protect_name => mld_c_l1_jac_smoother_bld
+  Implicit None
+
+  ! Arguments
+  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
+  ! Local variables
+  integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
+  real(psb_spk_), allocatable  :: arwsum(:)
+  type(psb_cspmat_type)      :: tmpa
+  integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
+  character(len=20) :: name='c_l1_jac_smoother_bld', ch_err
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+  ictxt       = desc_a%get_context()
+  call psb_info(ictxt, me, np)
+  if (debug_level >= psb_debug_outer_) &
+       & write(debug_unit,*) me,' ',trim(name),' start'
+
+
+  n_row  = desc_a%get_local_rows()
+  n_col  = desc_a%get_local_cols()
+  nrow_a = a%get_nrows()
+  nztota = a%get_nzeros()
+
+  if( sm%checkres ) sm%pa => a
+
+  select type (smsv => sm%sv)
+  class is (mld_c_diag_solver_type)
+    call sm%nd%free()
+    sm%pa => a
+    sm%nd_nnz_tot = nztota
+    
+    call psb_sum(ictxt,sm%nd_nnz_tot)
+    call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
+
+  class default
+    if (smsv%is_global()) then
+      ! Do not put anything into SM%ND since the solver
+      ! is acting globally.
+      call sm%nd%free()
+      sm%nd_nnz_tot = 0
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
+    else
+
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      
+      call a%csclip(sm%nd,info,&
+           & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
+      
+      arwsum = sm%nd%arwsum(info)
+      
+      call combine_dl1(-sone,arwsum,sm%nd,info)
+      call combine_dl1(sone,arwsum,tmpa,info)
+      
+      sm%nd_nnz_tot = sm%nd%get_nzeros()
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+
+      call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
+
+      if (info == psb_success_) then
+        if (present(amold)) then
+          call sm%nd%cscnv(info,&
+               & mold=amold,dupl=psb_dupl_add_)
+        else
+          call sm%nd%cscnv(info,&
+               & type='csr',dupl=psb_dupl_add_)
+        endif
+      end if
+    end if
+  end select
+  if (info /= psb_success_) then
+    call psb_errpush(psb_err_from_subroutine_,name,&
+         & a_err='clip & psb_spcnv csr 4')
+    goto 9999
+  end if
+
+
+  if (info /= psb_success_) then
+    call psb_errpush(psb_err_from_subroutine_,name,&
+         & a_err='solver build')
+    goto 9999
+  end if
+  if (debug_level >= psb_debug_outer_) &
+       & write(debug_unit,*) me,' ',trim(name),' end'
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+  
+contains
+  
+  subroutine combine_dl1(alpha,dl1,mat,info)
+    implicit none
+    real(psb_spk_), intent(in) ::  alpha, dl1(:)
+    type(psb_cspmat_type), intent(inout) :: mat
+    integer(psb_ipk_), intent(out) :: info 
+    !
+    integer(psb_ipk_) :: k, nz, nrm, dp
+    type(psb_c_coo_sparse_mat) :: tcoo
+
+    call mat%mv_to(tcoo)
+    nz = tcoo%get_nzeros()
+    nrm = min(size(dl1),tcoo%get_nrows(),tcoo%get_ncols())
+!!$    write(0,*) 'Check on combine_dl1: ',nrm, tcoo%get_nrows(),tcoo%get_ncols(), nz
+    call tcoo%ensure_size(nz+nrm)
+    call tcoo%set_dupl(psb_dupl_add_)
+    do k=1,nrm
+      if (dl1(k) /= szero) then
+        nz = nz + 1
+        tcoo%ia(nz)  = k
+        tcoo%ja(nz)  = k
+        tcoo%val(nz) = alpha*dl1(k)
+      end if
+    end do
+    call tcoo%set_nzeros(nz)
+    call tcoo%fix(info)
+    call mat%mv_from(tcoo)
+  end subroutine combine_dl1
+
+
+end subroutine mld_c_l1_jac_smoother_bld

mlprec/impl/smoother/mld_c_l1_jac_smoother_clone.f90

@@ -0,0 +1,93 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_c_l1_jac_smoother_clone(sm,smout,info)
+  
+  use psb_base_mod
+  use mld_c_jac_smoother, mld_protect_name => mld_c_l1_jac_smoother_clone
+
+  Implicit None
+
+  ! Arguments
+  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
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(smout)) then
+    call smout%free(info)
+    if (info == psb_success_) deallocate(smout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(mld_c_l1_jac_smoother_type :: smout, stat=info)
+  if (info /= 0) then 
+    info = psb_err_alloc_dealloc_
+    goto 9999 
+  end if
+
+  select type(smo => smout)
+  type is (mld_c_l1_jac_smoother_type)
+    smo%nd_nnz_tot = sm%nd_nnz_tot
+    smo%checkres   = sm%checkres
+    smo%printres   = sm%printres
+    smo%checkiter  = sm%checkiter
+    smo%printiter  = sm%printiter
+    smo%tol        = sm%tol
+    call sm%nd%clone(smo%nd,info)
+    if ((info==psb_success_).and.(allocated(sm%sv))) then
+      allocate(smout%sv,mold=sm%sv,stat=info)
+      if (info == psb_success_) call sm%sv%clone(smo%sv,info)
+    end if
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_c_l1_jac_smoother_clone

mlprec/impl/smoother/mld_c_l1_jac_smoother_descr.f90

@@ -0,0 +1,103 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_c_l1_jac_smoother_descr(sm,info,iout,coarse)
+
+  use psb_base_mod
+  use mld_c_diag_solver
+  use mld_c_jac_smoother, mld_protect_name => mld_c_l1_jac_smoother_descr
+  use mld_c_diag_solver
+  use mld_c_gs_solver
+
+  Implicit None
+
+  ! Arguments
+  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
+
+  ! Local variables
+  integer(psb_ipk_)      :: err_act
+  character(len=20), parameter :: name='mld_c_l1_jac_smoother_descr'
+  integer(psb_ipk_)      :: iout_
+  logical      :: coarse_
+
+  call psb_erractionsave(err_act)
+  info = psb_success_
+  if (present(coarse)) then 
+    coarse_ = coarse
+  else
+    coarse_ = .false.
+  end if
+  if (present(iout)) then 
+    iout_ = iout 
+  else
+    iout_ = psb_out_unit
+  endif
+
+  if (.not.coarse_) then
+    if (allocated(sm%sv)) then
+      select type(smv=>sm%sv)
+      class is (mld_c_diag_solver_type)
+        write(iout_,*) '  Point Jacobi  '
+        write(iout_,*) '       Local diagonal:'
+        call smv%descr(info,iout_,coarse=coarse)        
+      class is (mld_c_bwgs_solver_type)
+        write(iout_,*) '  L1-Hybrid Backward Gauss-Seidel  '
+      class is (mld_c_gs_solver_type)
+        write(iout_,*) '  L1-Hybrid Forward Gauss-Seidel  '
+      class default
+        write(iout_,*) '  L1-Block Jacobi  '
+        write(iout_,*) '       Local solver details:'
+        call smv%descr(info,iout_,coarse=coarse)
+      end select
+      
+    else
+      write(iout_,*) '  L1-Block Jacobi  '
+    end if
+  else
+    if (allocated(sm%sv)) then 
+      call sm%sv%descr(info,iout_,coarse=coarse)
+    end if
+  end if
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine mld_c_l1_jac_smoother_descr

mlprec/impl/smoother/mld_d_as_smoother_clear_data.f90

@@ -0,0 +1,70 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_d_as_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_d_as_smoother, mld_protect_name =>  mld_d_as_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_d_as_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='d_as_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  call sm%nd%free()
+  sm%nd_nnz_tot = 0 
+  call sm%desc_data%free(info)
+  if ((info==0).and.allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+  end if
+  if (info /= 0) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_d_as_smoother_clear_data

mlprec/impl/smoother/mld_d_as_smoother_clone_settings.f90

@@ -0,0 +1,95 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               asd on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_d_as_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_d_as_smoother, mld_protect_name =>  mld_d_as_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_d_as_smoother_type), intent(inout)              :: sm
+  class(mld_d_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='d_as_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  
+  select type(smout)
+  class is(mld_d_as_smoother_type)
+    smout%novr  = sm%novr
+    smout%restr = sm%restr
+    smout%prol  = sm%prol
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  class default
+    info = psb_err_internal_error_
+  end select
+  
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_d_as_smoother_clone_settings

mlprec/impl/smoother/mld_d_as_smoother_dmp.f90

@@ -35,21 +35,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_d_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_dmp
   implicit none 
   class(mld_d_as_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)               :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)               :: level
   integer(psb_ipk_), intent(out)              :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  logical :: smoother_, global_num_ 
   !  len of prefix_ 
 
   info = 0
@@ -59,7 +60,7 @@ subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   else
     prefix_ = "dump_smth_d"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
   if (present(smoother)) then 
@@ -67,11 +68,18 @@ subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   else
     smoother_ = .false. 
   end if
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   lname = len_trim(prefix_)
   fname = trim(prefix_)
   write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
   lname = lname + 5
-
+  if (global_num_) then
+    write(0,*) iam,' Warning: no global num with AS smoothers dump'
+  end if
   if (smoother_) then 
     write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
     if (sm%nd%is_asb()) &
@@ -79,6 +87,6 @@ subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   end if
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_d_as_smoother_dmp

mlprec/impl/smoother/mld_d_base_smoother_clear_data.f90

@@ -0,0 +1,67 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_d_base_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_d_base_smoother_mod, mld_protect_name =>  mld_d_base_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_d_base_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='d_base_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  if (allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+    if (info /= 0) then
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_d_base_smoother_clear_data

mlprec/impl/smoother/mld_d_base_smoother_clone_settings.f90

@@ -0,0 +1,89 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_d_base_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_d_base_smoother_mod, mld_protect_name =>  mld_d_base_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_d_base_smoother_type), intent(inout)              :: sm
+  class(mld_d_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='d_base_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info=psb_success_
+  if (same_type_as(sm,smout)) then
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  else
+    info = psb_err_internal_error_
+  end if
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_d_base_smoother_clone_settings

mlprec/impl/smoother/mld_d_base_smoother_dmp.f90

@@ -35,21 +35,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_d_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_d_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_d_base_smoother_mod, mld_protect_name =>  mld_d_base_smoother_dmp
   implicit none 
   class(mld_d_base_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)              :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)              :: level
   integer(psb_ipk_), intent(out)             :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  logical :: smoother_, global_num_
   !  len of prefix_ 
 
   info = 0
@@ -59,9 +60,14 @@ subroutine mld_d_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
   else
     prefix_ = "dump_smth_d"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   if (present(smoother)) then 
     smoother_ = smoother
   else
@@ -74,6 +80,6 @@ subroutine mld_d_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
 
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_d_base_smoother_dmp

mlprec/impl/smoother/mld_d_jac_smoother_bld.f90

@@ -51,9 +51,8 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
   class(psb_d_base_vect_type), intent(in), optional  :: vmold
   class(psb_i_base_vect_type), intent(in), optional  :: imold
   ! Local variables
+  type(psb_dspmat_type) :: tmpa
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
-  real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
-  type(psb_d_coo_sparse_mat) :: tmpcoo
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='d_jac_smoother_bld', ch_err
 
@@ -79,12 +78,17 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
     call sm%nd%free()
     sm%pa => a
     sm%nd_nnz_tot = nztota
+    call psb_sum(ictxt,sm%nd_nnz_tot)
+    call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
 
   class default
     if (smsv%is_global()) then
       ! Do not put anything into SM%ND since the solver
       ! is acting globally.
+      call sm%nd%free()
       sm%nd_nnz_tot = 0
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
     else
       call a%csclip(sm%nd,info,&
            & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@@ -98,6 +102,10 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
         endif
       end if
       sm%nd_nnz_tot = sm%nd%get_nzeros()
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
     end if
   end select
   if (info /= psb_success_) then
@@ -105,15 +113,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
          & a_err='clip & psb_spcnv csr 4')
     goto 9999
   end if
-  call psb_sum(ictxt,sm%nd_nnz_tot)
 
-
-  call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,&
-         & a_err='solver build')
-    goto 9999
-  end if
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),' end'
 

mlprec/impl/smoother/mld_d_jac_smoother_clear_data.f90

@@ -0,0 +1,70 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_d_jac_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_d_jac_smoother, mld_protect_name =>  mld_d_jac_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_d_jac_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='d_jac_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  call sm%nd%free()
+  sm%nd_nnz_tot = 0
+  sm%pa         => null()
+  if ((info==0).and.allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+  end if
+  if (info /= 0) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_d_jac_smoother_clear_data

mlprec/impl/smoother/mld_d_jac_smoother_clone.f90

@@ -1,15 +1,15 @@
-!  
-!   
+!
+!
 !                             MLD2P4  version 2.2
 !    MultiLevel Domain Decomposition Parallel Preconditioners Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!    
-!    (C) Copyright 2008-2018 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Daniela di Serafino   
-!   
+!
+!    (C) Copyright 2008-2018
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Daniela di Serafino
+!
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
 !    are met:
@@ -21,7 +21,7 @@
 !      3. The name of the MLD2P4 group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
-!   
+!
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -33,10 +33,10 @@
 !    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
+!
+!
 subroutine mld_d_jac_smoother_clone(sm,smout,info)
-  
+
   use psb_base_mod
   use mld_d_jac_smoother, mld_protect_name => mld_d_jac_smoother_clone
 
@@ -59,14 +59,19 @@ subroutine mld_d_jac_smoother_clone(sm,smout,info)
   end if
   if (info == psb_success_) &
        & allocate(mld_d_jac_smoother_type :: smout, stat=info)
-  if (info /= 0) then 
+  if (info /= 0) then
     info = psb_err_alloc_dealloc_
-    goto 9999 
+    goto 9999
   end if
 
   select type(smo => smout)
   type is (mld_d_jac_smoother_type)
     smo%nd_nnz_tot = sm%nd_nnz_tot
+    smo%checkres   = sm%checkres
+    smo%printres   = sm%printres
+    smo%checkiter  = sm%checkiter
+    smo%printiter  = sm%printiter
+    smo%tol        = sm%tol
     call sm%nd%clone(smo%nd,info)
     if ((info==psb_success_).and.(allocated(sm%sv))) then
       allocate(smout%sv,mold=sm%sv,stat=info)

mlprec/impl/smoother/mld_d_jac_smoother_clone_settings.f90

@@ -0,0 +1,101 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               asd on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_d_jac_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_d_jac_smoother, mld_protect_name =>  mld_d_jac_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_d_jac_smoother_type), intent(inout)              :: sm
+  class(mld_d_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='d_jac_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  
+  select type(smout)
+  class is(mld_d_jac_smoother_type)
+
+    smout%pa => null()
+    smout%nd_nnz_tot = 0
+    smout%checkres   = sm%checkres
+    smout%printres   = sm%printres
+    smout%checkiter  = sm%checkiter
+    smout%printiter  = sm%printiter
+    smout%tol        = sm%tol
+
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  class default
+    info = psb_err_internal_error_
+  end select
+  
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_d_jac_smoother_clone_settings

mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90

@@ -59,7 +59,7 @@ subroutine mld_d_jac_smoother_cnv(sm,info,amold,vmold,imold)
 
 
   if (info == psb_success_) then
-    if ((.not.associated(sm%pa)).and.(sm%nd%is_asb())) then
+    if (sm%nd%is_asb()) then
       if (present(amold)) then 
         call sm%nd%cscnv(info,&
              & mold=amold,dupl=psb_dupl_add_)

mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90

@@ -52,22 +52,27 @@ subroutine mld_d_jac_smoother_csetc(sm,what,val,info,idx)
   info = psb_success_
   call psb_erractionsave(err_act)
 
-
-  select case(psb_toupper(what))
-  case('SMOOTHER_STOP')
-    if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then
-      sm%checkres   = .true.
-    else
-      sm%checkres   = .false.
-    end if
-  case('SMOOTHER_TRACE')
-    if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then
-      sm%printres   = .true.
-    else
-      sm%printres   = .false.
-    end if
-  case default
-    call sm%mld_d_base_smoother_type%set(what,val,info,idx=idx)
+  select case(psb_toupper(trim(what)))
+    case('SMOOTHER_STOP')
+      select case(psb_toupper(trim(val)))
+      case('T','TRUE')
+        sm%checkres   = .true.
+      case('F','FALSE')
+        sm%checkres   = .false.
+      case default
+        write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"'
+      end select
+    case('SMOOTHER_TRACE')
+      select case(psb_toupper(trim(val)))
+      case('T','TRUE')
+        sm%printres   = .true.
+      case('F','FALSE')
+        sm%printres   = .false.
+      case default
+        write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"'
+      end select
+    case default
+      call sm%mld_d_base_smoother_type%set(what,val,info,idx=idx)
   end select
 
   if (info /= psb_success_) then

mlprec/impl/smoother/mld_d_jac_smoother_dmp.f90

@@ -35,21 +35,23 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_d_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_d_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_d_jac_smoother, mld_protect_nam => mld_d_jac_smoother_dmp
   implicit none 
   class(mld_d_jac_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)               :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)               :: level
   integer(psb_ipk_), intent(out)              :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  integer(psb_lpk_), allocatable :: iv(:)
+  logical :: smoother_, global_num_
   !  len of prefix_ 
 
   info = 0
@@ -59,7 +61,7 @@ subroutine mld_d_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
   else
     prefix_ = "dump_smth_d"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
   if (present(smoother)) then 
@@ -67,6 +69,11 @@ subroutine mld_d_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
   else
     smoother_ = .false. 
   end if
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   lname = len_trim(prefix_)
   fname = trim(prefix_)
   write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
@@ -74,11 +81,17 @@ subroutine mld_d_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
 
   if (smoother_) then 
     write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
-    if (sm%nd%is_asb()) &
-         & call sm%nd%print(fname,head=head)
+    if (global_num_) then
+      iv = desc%get_global_indices(owned=.false.)      
+      if (sm%nd%is_asb()) &
+           & call sm%nd%print(fname,head=head,iv=iv)
+    else
+      if (sm%nd%is_asb()) &
+           & call sm%nd%print(fname,head=head)
+    end if
   end if
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_d_jac_smoother_dmp

mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90

@@ -0,0 +1,176 @@
+!
+!
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!
+!    (C) Copyright 2008-2018
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Daniela di Serafino
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
+
+  use psb_base_mod
+  use mld_d_diag_solver
+  use mld_d_jac_smoother, mld_protect_name => mld_d_l1_jac_smoother_bld
+  Implicit None
+
+  ! Arguments
+  type(psb_dspmat_type), intent(in), target          :: a
+  Type(psb_desc_type), Intent(inout)                 :: desc_a
+  class(mld_d_l1_jac_smoother_type), intent(inout)      :: sm
+  integer(psb_ipk_), intent(out)                     :: info
+  class(psb_d_base_sparse_mat), intent(in), optional :: amold
+  class(psb_d_base_vect_type), intent(in), optional  :: vmold
+  class(psb_i_base_vect_type), intent(in), optional  :: imold
+  ! Local variables
+  integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
+  real(psb_dpk_), allocatable  :: arwsum(:)
+  type(psb_dspmat_type)      :: tmpa
+  integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
+  character(len=20) :: name='d_l1_jac_smoother_bld', ch_err
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+  ictxt       = desc_a%get_context()
+  call psb_info(ictxt, me, np)
+  if (debug_level >= psb_debug_outer_) &
+       & write(debug_unit,*) me,' ',trim(name),' start'
+
+
+  n_row  = desc_a%get_local_rows()
+  n_col  = desc_a%get_local_cols()
+  nrow_a = a%get_nrows()
+  nztota = a%get_nzeros()
+
+  if( sm%checkres ) sm%pa => a
+
+  select type (smsv => sm%sv)
+  class is (mld_d_diag_solver_type)
+    call sm%nd%free()
+    sm%pa => a
+    sm%nd_nnz_tot = nztota
+    
+    call psb_sum(ictxt,sm%nd_nnz_tot)
+    call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
+
+  class default
+    if (smsv%is_global()) then
+      ! Do not put anything into SM%ND since the solver
+      ! is acting globally.
+      call sm%nd%free()
+      sm%nd_nnz_tot = 0
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
+    else
+
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      
+      call a%csclip(sm%nd,info,&
+           & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
+      
+      arwsum = sm%nd%arwsum(info)
+      
+      call combine_dl1(-done,arwsum,sm%nd,info)
+      call combine_dl1(done,arwsum,tmpa,info)
+      
+      sm%nd_nnz_tot = sm%nd%get_nzeros()
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+
+      call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
+
+      if (info == psb_success_) then
+        if (present(amold)) then
+          call sm%nd%cscnv(info,&
+               & mold=amold,dupl=psb_dupl_add_)
+        else
+          call sm%nd%cscnv(info,&
+               & type='csr',dupl=psb_dupl_add_)
+        endif
+      end if
+    end if
+  end select
+  if (info /= psb_success_) then
+    call psb_errpush(psb_err_from_subroutine_,name,&
+         & a_err='clip & psb_spcnv csr 4')
+    goto 9999
+  end if
+
+
+  if (info /= psb_success_) then
+    call psb_errpush(psb_err_from_subroutine_,name,&
+         & a_err='solver build')
+    goto 9999
+  end if
+  if (debug_level >= psb_debug_outer_) &
+       & write(debug_unit,*) me,' ',trim(name),' end'
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+  
+contains
+  
+  subroutine combine_dl1(alpha,dl1,mat,info)
+    implicit none
+    real(psb_dpk_), intent(in) ::  alpha, dl1(:)
+    type(psb_dspmat_type), intent(inout) :: mat
+    integer(psb_ipk_), intent(out) :: info 
+    !
+    integer(psb_ipk_) :: k, nz, nrm, dp
+    type(psb_d_coo_sparse_mat) :: tcoo
+
+    call mat%mv_to(tcoo)
+    nz = tcoo%get_nzeros()
+    nrm = min(size(dl1),tcoo%get_nrows(),tcoo%get_ncols())
+!!$    write(0,*) 'Check on combine_dl1: ',nrm, tcoo%get_nrows(),tcoo%get_ncols(), nz
+    call tcoo%ensure_size(nz+nrm)
+    call tcoo%set_dupl(psb_dupl_add_)
+    do k=1,nrm
+      if (dl1(k) /= dzero) then
+        nz = nz + 1
+        tcoo%ia(nz)  = k
+        tcoo%ja(nz)  = k
+        tcoo%val(nz) = alpha*dl1(k)
+      end if
+    end do
+    call tcoo%set_nzeros(nz)
+    call tcoo%fix(info)
+    call mat%mv_from(tcoo)
+  end subroutine combine_dl1
+
+
+end subroutine mld_d_l1_jac_smoother_bld

mlprec/impl/smoother/mld_d_l1_jac_smoother_clone.f90

@@ -0,0 +1,93 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_d_l1_jac_smoother_clone(sm,smout,info)
+  
+  use psb_base_mod
+  use mld_d_jac_smoother, mld_protect_name => mld_d_l1_jac_smoother_clone
+
+  Implicit None
+
+  ! Arguments
+  class(mld_d_l1_jac_smoother_type), intent(inout)               :: sm
+  class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(smout)) then
+    call smout%free(info)
+    if (info == psb_success_) deallocate(smout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(mld_d_l1_jac_smoother_type :: smout, stat=info)
+  if (info /= 0) then 
+    info = psb_err_alloc_dealloc_
+    goto 9999 
+  end if
+
+  select type(smo => smout)
+  type is (mld_d_l1_jac_smoother_type)
+    smo%nd_nnz_tot = sm%nd_nnz_tot
+    smo%checkres   = sm%checkres
+    smo%printres   = sm%printres
+    smo%checkiter  = sm%checkiter
+    smo%printiter  = sm%printiter
+    smo%tol        = sm%tol
+    call sm%nd%clone(smo%nd,info)
+    if ((info==psb_success_).and.(allocated(sm%sv))) then
+      allocate(smout%sv,mold=sm%sv,stat=info)
+      if (info == psb_success_) call sm%sv%clone(smo%sv,info)
+    end if
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_d_l1_jac_smoother_clone

mlprec/impl/smoother/mld_d_l1_jac_smoother_descr.f90

@@ -0,0 +1,103 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_d_l1_jac_smoother_descr(sm,info,iout,coarse)
+
+  use psb_base_mod
+  use mld_d_diag_solver
+  use mld_d_jac_smoother, mld_protect_name => mld_d_l1_jac_smoother_descr
+  use mld_d_diag_solver
+  use mld_d_gs_solver
+
+  Implicit None
+
+  ! Arguments
+  class(mld_d_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
+
+  ! Local variables
+  integer(psb_ipk_)      :: err_act
+  character(len=20), parameter :: name='mld_d_l1_jac_smoother_descr'
+  integer(psb_ipk_)      :: iout_
+  logical      :: coarse_
+
+  call psb_erractionsave(err_act)
+  info = psb_success_
+  if (present(coarse)) then 
+    coarse_ = coarse
+  else
+    coarse_ = .false.
+  end if
+  if (present(iout)) then 
+    iout_ = iout 
+  else
+    iout_ = psb_out_unit
+  endif
+
+  if (.not.coarse_) then
+    if (allocated(sm%sv)) then
+      select type(smv=>sm%sv)
+      class is (mld_d_diag_solver_type)
+        write(iout_,*) '  Point Jacobi  '
+        write(iout_,*) '       Local diagonal:'
+        call smv%descr(info,iout_,coarse=coarse)        
+      class is (mld_d_bwgs_solver_type)
+        write(iout_,*) '  L1-Hybrid Backward Gauss-Seidel  '
+      class is (mld_d_gs_solver_type)
+        write(iout_,*) '  L1-Hybrid Forward Gauss-Seidel  '
+      class default
+        write(iout_,*) '  L1-Block Jacobi  '
+        write(iout_,*) '       Local solver details:'
+        call smv%descr(info,iout_,coarse=coarse)
+      end select
+      
+    else
+      write(iout_,*) '  L1-Block Jacobi  '
+    end if
+  else
+    if (allocated(sm%sv)) then 
+      call sm%sv%descr(info,iout_,coarse=coarse)
+    end if
+  end if
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine mld_d_l1_jac_smoother_descr

mlprec/impl/smoother/mld_s_as_smoother_clear_data.f90

@@ -0,0 +1,70 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_s_as_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_s_as_smoother, mld_protect_name =>  mld_s_as_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_s_as_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='s_as_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  call sm%nd%free()
+  sm%nd_nnz_tot = 0 
+  call sm%desc_data%free(info)
+  if ((info==0).and.allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+  end if
+  if (info /= 0) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_s_as_smoother_clear_data

mlprec/impl/smoother/mld_s_as_smoother_clone_settings.f90

@@ -0,0 +1,95 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               asd on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_s_as_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_s_as_smoother, mld_protect_name =>  mld_s_as_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_s_as_smoother_type), intent(inout)              :: sm
+  class(mld_s_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='s_as_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  
+  select type(smout)
+  class is(mld_s_as_smoother_type)
+    smout%novr  = sm%novr
+    smout%restr = sm%restr
+    smout%prol  = sm%prol
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  class default
+    info = psb_err_internal_error_
+  end select
+  
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_s_as_smoother_clone_settings

mlprec/impl/smoother/mld_s_as_smoother_dmp.f90

@@ -35,21 +35,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_s_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_dmp
   implicit none 
   class(mld_s_as_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)               :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)               :: level
   integer(psb_ipk_), intent(out)              :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  logical :: smoother_, global_num_ 
   !  len of prefix_ 
 
   info = 0
@@ -59,7 +60,7 @@ subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   else
     prefix_ = "dump_smth_s"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
   if (present(smoother)) then 
@@ -67,11 +68,18 @@ subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   else
     smoother_ = .false. 
   end if
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   lname = len_trim(prefix_)
   fname = trim(prefix_)
   write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
   lname = lname + 5
-
+  if (global_num_) then
+    write(0,*) iam,' Warning: no global num with AS smoothers dump'
+  end if
   if (smoother_) then 
     write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
     if (sm%nd%is_asb()) &
@@ -79,6 +87,6 @@ subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   end if
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_s_as_smoother_dmp

mlprec/impl/smoother/mld_s_base_smoother_clear_data.f90

@@ -0,0 +1,67 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_s_base_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_s_base_smoother_mod, mld_protect_name =>  mld_s_base_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_s_base_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='s_base_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  if (allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+    if (info /= 0) then
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_s_base_smoother_clear_data

mlprec/impl/smoother/mld_s_base_smoother_clone.f90

@@ -45,7 +45,7 @@ subroutine mld_s_base_smoother_clone(sm,smout,info)
   class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
   integer(psb_ipk_), intent(out)                 :: info
   integer(psb_ipk_)  :: err_act
-  character(len=20) :: name='d_base_smoother_clone'
+  character(len=20) :: name='s_base_smoother_clone'
 
   call psb_erractionsave(err_act)
 

mlprec/impl/smoother/mld_s_base_smoother_clone_settings.f90

@@ -0,0 +1,89 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_s_base_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_s_base_smoother_mod, mld_protect_name =>  mld_s_base_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_s_base_smoother_type), intent(inout)              :: sm
+  class(mld_s_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='s_base_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info=psb_success_
+  if (same_type_as(sm,smout)) then
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  else
+    info = psb_err_internal_error_
+  end if
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_s_base_smoother_clone_settings

mlprec/impl/smoother/mld_s_base_smoother_cnv.f90

@@ -48,7 +48,7 @@ subroutine mld_s_base_smoother_cnv(sm,info,amold,vmold,imold)
   class(psb_s_base_vect_type), intent(in), optional  :: vmold
   class(psb_i_base_vect_type), intent(in), optional  :: imold
   integer(psb_ipk_) :: err_act
-  character(len=20) :: name='d_base_smoother_cnv'
+  character(len=20) :: name='s_base_smoother_cnv'
 
   call psb_erractionsave(err_act)
 

mlprec/impl/smoother/mld_s_base_smoother_dmp.f90

@@ -35,21 +35,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_s_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_s_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_s_base_smoother_mod, mld_protect_name =>  mld_s_base_smoother_dmp
   implicit none 
   class(mld_s_base_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)              :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)              :: level
   integer(psb_ipk_), intent(out)             :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  logical :: smoother_, global_num_
   !  len of prefix_ 
 
   info = 0
@@ -59,9 +60,14 @@ subroutine mld_s_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
   else
     prefix_ = "dump_smth_s"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   if (present(smoother)) then 
     smoother_ = smoother
   else
@@ -74,6 +80,6 @@ subroutine mld_s_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
 
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_s_base_smoother_dmp

mlprec/impl/smoother/mld_s_jac_smoother_bld.f90

@@ -51,9 +51,8 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
   class(psb_s_base_vect_type), intent(in), optional  :: vmold
   class(psb_i_base_vect_type), intent(in), optional  :: imold
   ! Local variables
+  type(psb_sspmat_type) :: tmpa
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
-  real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
-  type(psb_s_coo_sparse_mat) :: tmpcoo
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='s_jac_smoother_bld', ch_err
 
@@ -79,12 +78,17 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
     call sm%nd%free()
     sm%pa => a
     sm%nd_nnz_tot = nztota
+    call psb_sum(ictxt,sm%nd_nnz_tot)
+    call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
 
   class default
     if (smsv%is_global()) then
       ! Do not put anything into SM%ND since the solver
       ! is acting globally.
+      call sm%nd%free()
       sm%nd_nnz_tot = 0
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
     else
       call a%csclip(sm%nd,info,&
            & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@@ -98,6 +102,10 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
         endif
       end if
       sm%nd_nnz_tot = sm%nd%get_nzeros()
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
     end if
   end select
   if (info /= psb_success_) then
@@ -105,15 +113,7 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
          & a_err='clip & psb_spcnv csr 4')
     goto 9999
   end if
-  call psb_sum(ictxt,sm%nd_nnz_tot)
 
-
-  call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,&
-         & a_err='solver build')
-    goto 9999
-  end if
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),' end'
 

mlprec/impl/smoother/mld_s_jac_smoother_clear_data.f90

@@ -0,0 +1,70 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_s_jac_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_s_jac_smoother, mld_protect_name =>  mld_s_jac_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_s_jac_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='s_jac_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  call sm%nd%free()
+  sm%nd_nnz_tot = 0
+  sm%pa         => null()
+  if ((info==0).and.allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+  end if
+  if (info /= 0) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_s_jac_smoother_clear_data

mlprec/impl/smoother/mld_s_jac_smoother_clone.f90

@@ -1,15 +1,15 @@
-!  
-!   
+!
+!
 !                             MLD2P4  version 2.2
 !    MultiLevel Domain Decomposition Parallel Preconditioners Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!    
-!    (C) Copyright 2008-2018 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Daniela di Serafino   
-!   
+!
+!    (C) Copyright 2008-2018
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Daniela di Serafino
+!
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
 !    are met:
@@ -21,7 +21,7 @@
 !      3. The name of the MLD2P4 group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
-!   
+!
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -33,10 +33,10 @@
 !    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
+!
+!
 subroutine mld_s_jac_smoother_clone(sm,smout,info)
-  
+
   use psb_base_mod
   use mld_s_jac_smoother, mld_protect_name => mld_s_jac_smoother_clone
 
@@ -59,14 +59,19 @@ subroutine mld_s_jac_smoother_clone(sm,smout,info)
   end if
   if (info == psb_success_) &
        & allocate(mld_s_jac_smoother_type :: smout, stat=info)
-  if (info /= 0) then 
+  if (info /= 0) then
     info = psb_err_alloc_dealloc_
-    goto 9999 
+    goto 9999
   end if
 
   select type(smo => smout)
   type is (mld_s_jac_smoother_type)
     smo%nd_nnz_tot = sm%nd_nnz_tot
+    smo%checkres   = sm%checkres
+    smo%printres   = sm%printres
+    smo%checkiter  = sm%checkiter
+    smo%printiter  = sm%printiter
+    smo%tol        = sm%tol
     call sm%nd%clone(smo%nd,info)
     if ((info==psb_success_).and.(allocated(sm%sv))) then
       allocate(smout%sv,mold=sm%sv,stat=info)

mlprec/impl/smoother/mld_s_jac_smoother_clone_settings.f90

@@ -0,0 +1,101 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               asd on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_s_jac_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_s_jac_smoother, mld_protect_name =>  mld_s_jac_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_s_jac_smoother_type), intent(inout)              :: sm
+  class(mld_s_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='s_jac_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  
+  select type(smout)
+  class is(mld_s_jac_smoother_type)
+
+    smout%pa => null()
+    smout%nd_nnz_tot = 0
+    smout%checkres   = sm%checkres
+    smout%printres   = sm%printres
+    smout%checkiter  = sm%checkiter
+    smout%printiter  = sm%printiter
+    smout%tol        = sm%tol
+
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  class default
+    info = psb_err_internal_error_
+  end select
+  
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_s_jac_smoother_clone_settings

mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90

@@ -59,7 +59,7 @@ subroutine mld_s_jac_smoother_cnv(sm,info,amold,vmold,imold)
 
 
   if (info == psb_success_) then
-    if ((.not.associated(sm%pa)).and.(sm%nd%is_asb())) then
+    if (sm%nd%is_asb()) then
       if (present(amold)) then 
         call sm%nd%cscnv(info,&
              & mold=amold,dupl=psb_dupl_add_)

mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90

@@ -52,22 +52,27 @@ subroutine mld_s_jac_smoother_csetc(sm,what,val,info,idx)
   info = psb_success_
   call psb_erractionsave(err_act)
 
-
-  select case(psb_toupper(what))
-  case('SMOOTHER_STOP')
-    if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then
-      sm%checkres   = .true.
-    else
-      sm%checkres   = .false.
-    end if
-  case('SMOOTHER_TRACE')
-    if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then
-      sm%printres   = .true.
-    else
-      sm%printres   = .false.
-    end if
-  case default
-    call sm%mld_s_base_smoother_type%set(what,val,info,idx=idx)
+  select case(psb_toupper(trim(what)))
+    case('SMOOTHER_STOP')
+      select case(psb_toupper(trim(val)))
+      case('T','TRUE')
+        sm%checkres   = .true.
+      case('F','FALSE')
+        sm%checkres   = .false.
+      case default
+        write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"'
+      end select
+    case('SMOOTHER_TRACE')
+      select case(psb_toupper(trim(val)))
+      case('T','TRUE')
+        sm%printres   = .true.
+      case('F','FALSE')
+        sm%printres   = .false.
+      case default
+        write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"'
+      end select
+    case default
+      call sm%mld_s_base_smoother_type%set(what,val,info,idx=idx)
   end select
 
   if (info /= psb_success_) then

mlprec/impl/smoother/mld_s_jac_smoother_dmp.f90

@@ -35,21 +35,23 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_s_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_s_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_s_jac_smoother, mld_protect_nam => mld_s_jac_smoother_dmp
   implicit none 
   class(mld_s_jac_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)               :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)               :: level
   integer(psb_ipk_), intent(out)              :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  integer(psb_lpk_), allocatable :: iv(:)
+  logical :: smoother_, global_num_
   !  len of prefix_ 
 
   info = 0
@@ -59,7 +61,7 @@ subroutine mld_s_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
   else
     prefix_ = "dump_smth_s"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
   if (present(smoother)) then 
@@ -67,6 +69,11 @@ subroutine mld_s_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
   else
     smoother_ = .false. 
   end if
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   lname = len_trim(prefix_)
   fname = trim(prefix_)
   write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
@@ -74,11 +81,17 @@ subroutine mld_s_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
 
   if (smoother_) then 
     write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
-    if (sm%nd%is_asb()) &
-         & call sm%nd%print(fname,head=head)
+    if (global_num_) then
+      iv = desc%get_global_indices(owned=.false.)      
+      if (sm%nd%is_asb()) &
+           & call sm%nd%print(fname,head=head,iv=iv)
+    else
+      if (sm%nd%is_asb()) &
+           & call sm%nd%print(fname,head=head)
+    end if
   end if
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_s_jac_smoother_dmp

mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90

@@ -0,0 +1,176 @@
+!
+!
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!
+!    (C) Copyright 2008-2018
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Daniela di Serafino
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
+
+  use psb_base_mod
+  use mld_s_diag_solver
+  use mld_s_jac_smoother, mld_protect_name => mld_s_l1_jac_smoother_bld
+  Implicit None
+
+  ! Arguments
+  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
+  ! Local variables
+  integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
+  real(psb_spk_), allocatable  :: arwsum(:)
+  type(psb_sspmat_type)      :: tmpa
+  integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
+  character(len=20) :: name='s_l1_jac_smoother_bld', ch_err
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+  ictxt       = desc_a%get_context()
+  call psb_info(ictxt, me, np)
+  if (debug_level >= psb_debug_outer_) &
+       & write(debug_unit,*) me,' ',trim(name),' start'
+
+
+  n_row  = desc_a%get_local_rows()
+  n_col  = desc_a%get_local_cols()
+  nrow_a = a%get_nrows()
+  nztota = a%get_nzeros()
+
+  if( sm%checkres ) sm%pa => a
+
+  select type (smsv => sm%sv)
+  class is (mld_s_diag_solver_type)
+    call sm%nd%free()
+    sm%pa => a
+    sm%nd_nnz_tot = nztota
+    
+    call psb_sum(ictxt,sm%nd_nnz_tot)
+    call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
+
+  class default
+    if (smsv%is_global()) then
+      ! Do not put anything into SM%ND since the solver
+      ! is acting globally.
+      call sm%nd%free()
+      sm%nd_nnz_tot = 0
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
+    else
+
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      
+      call a%csclip(sm%nd,info,&
+           & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
+      
+      arwsum = sm%nd%arwsum(info)
+      
+      call combine_dl1(-sone,arwsum,sm%nd,info)
+      call combine_dl1(sone,arwsum,tmpa,info)
+      
+      sm%nd_nnz_tot = sm%nd%get_nzeros()
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+
+      call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
+
+      if (info == psb_success_) then
+        if (present(amold)) then
+          call sm%nd%cscnv(info,&
+               & mold=amold,dupl=psb_dupl_add_)
+        else
+          call sm%nd%cscnv(info,&
+               & type='csr',dupl=psb_dupl_add_)
+        endif
+      end if
+    end if
+  end select
+  if (info /= psb_success_) then
+    call psb_errpush(psb_err_from_subroutine_,name,&
+         & a_err='clip & psb_spcnv csr 4')
+    goto 9999
+  end if
+
+
+  if (info /= psb_success_) then
+    call psb_errpush(psb_err_from_subroutine_,name,&
+         & a_err='solver build')
+    goto 9999
+  end if
+  if (debug_level >= psb_debug_outer_) &
+       & write(debug_unit,*) me,' ',trim(name),' end'
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+  
+contains
+  
+  subroutine combine_dl1(alpha,dl1,mat,info)
+    implicit none
+    real(psb_spk_), intent(in) ::  alpha, dl1(:)
+    type(psb_sspmat_type), intent(inout) :: mat
+    integer(psb_ipk_), intent(out) :: info 
+    !
+    integer(psb_ipk_) :: k, nz, nrm, dp
+    type(psb_s_coo_sparse_mat) :: tcoo
+
+    call mat%mv_to(tcoo)
+    nz = tcoo%get_nzeros()
+    nrm = min(size(dl1),tcoo%get_nrows(),tcoo%get_ncols())
+!!$    write(0,*) 'Check on combine_dl1: ',nrm, tcoo%get_nrows(),tcoo%get_ncols(), nz
+    call tcoo%ensure_size(nz+nrm)
+    call tcoo%set_dupl(psb_dupl_add_)
+    do k=1,nrm
+      if (dl1(k) /= szero) then
+        nz = nz + 1
+        tcoo%ia(nz)  = k
+        tcoo%ja(nz)  = k
+        tcoo%val(nz) = alpha*dl1(k)
+      end if
+    end do
+    call tcoo%set_nzeros(nz)
+    call tcoo%fix(info)
+    call mat%mv_from(tcoo)
+  end subroutine combine_dl1
+
+
+end subroutine mld_s_l1_jac_smoother_bld

mlprec/impl/smoother/mld_s_l1_jac_smoother_clone.f90

@@ -0,0 +1,93 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_s_l1_jac_smoother_clone(sm,smout,info)
+  
+  use psb_base_mod
+  use mld_s_jac_smoother, mld_protect_name => mld_s_l1_jac_smoother_clone
+
+  Implicit None
+
+  ! Arguments
+  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
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(smout)) then
+    call smout%free(info)
+    if (info == psb_success_) deallocate(smout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(mld_s_l1_jac_smoother_type :: smout, stat=info)
+  if (info /= 0) then 
+    info = psb_err_alloc_dealloc_
+    goto 9999 
+  end if
+
+  select type(smo => smout)
+  type is (mld_s_l1_jac_smoother_type)
+    smo%nd_nnz_tot = sm%nd_nnz_tot
+    smo%checkres   = sm%checkres
+    smo%printres   = sm%printres
+    smo%checkiter  = sm%checkiter
+    smo%printiter  = sm%printiter
+    smo%tol        = sm%tol
+    call sm%nd%clone(smo%nd,info)
+    if ((info==psb_success_).and.(allocated(sm%sv))) then
+      allocate(smout%sv,mold=sm%sv,stat=info)
+      if (info == psb_success_) call sm%sv%clone(smo%sv,info)
+    end if
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_s_l1_jac_smoother_clone

mlprec/impl/smoother/mld_s_l1_jac_smoother_descr.f90

@@ -0,0 +1,103 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_s_l1_jac_smoother_descr(sm,info,iout,coarse)
+
+  use psb_base_mod
+  use mld_s_diag_solver
+  use mld_s_jac_smoother, mld_protect_name => mld_s_l1_jac_smoother_descr
+  use mld_s_diag_solver
+  use mld_s_gs_solver
+
+  Implicit None
+
+  ! Arguments
+  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
+
+  ! Local variables
+  integer(psb_ipk_)      :: err_act
+  character(len=20), parameter :: name='mld_s_l1_jac_smoother_descr'
+  integer(psb_ipk_)      :: iout_
+  logical      :: coarse_
+
+  call psb_erractionsave(err_act)
+  info = psb_success_
+  if (present(coarse)) then 
+    coarse_ = coarse
+  else
+    coarse_ = .false.
+  end if
+  if (present(iout)) then 
+    iout_ = iout 
+  else
+    iout_ = psb_out_unit
+  endif
+
+  if (.not.coarse_) then
+    if (allocated(sm%sv)) then
+      select type(smv=>sm%sv)
+      class is (mld_s_diag_solver_type)
+        write(iout_,*) '  Point Jacobi  '
+        write(iout_,*) '       Local diagonal:'
+        call smv%descr(info,iout_,coarse=coarse)        
+      class is (mld_s_bwgs_solver_type)
+        write(iout_,*) '  L1-Hybrid Backward Gauss-Seidel  '
+      class is (mld_s_gs_solver_type)
+        write(iout_,*) '  L1-Hybrid Forward Gauss-Seidel  '
+      class default
+        write(iout_,*) '  L1-Block Jacobi  '
+        write(iout_,*) '       Local solver details:'
+        call smv%descr(info,iout_,coarse=coarse)
+      end select
+      
+    else
+      write(iout_,*) '  L1-Block Jacobi  '
+    end if
+  else
+    if (allocated(sm%sv)) then 
+      call sm%sv%descr(info,iout_,coarse=coarse)
+    end if
+  end if
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine mld_s_l1_jac_smoother_descr

mlprec/impl/smoother/mld_z_as_smoother_clear_data.f90

@@ -0,0 +1,70 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_z_as_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_z_as_smoother, mld_protect_name =>  mld_z_as_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_z_as_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='z_as_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  call sm%nd%free()
+  sm%nd_nnz_tot = 0 
+  call sm%desc_data%free(info)
+  if ((info==0).and.allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+  end if
+  if (info /= 0) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_z_as_smoother_clear_data

mlprec/impl/smoother/mld_z_as_smoother_clone_settings.f90

@@ -0,0 +1,95 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               asd on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_z_as_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_z_as_smoother, mld_protect_name =>  mld_z_as_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_z_as_smoother_type), intent(inout)              :: sm
+  class(mld_z_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='z_as_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  
+  select type(smout)
+  class is(mld_z_as_smoother_type)
+    smout%novr  = sm%novr
+    smout%restr = sm%restr
+    smout%prol  = sm%prol
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  class default
+    info = psb_err_internal_error_
+  end select
+  
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_z_as_smoother_clone_settings

mlprec/impl/smoother/mld_z_as_smoother_dmp.f90

@@ -35,21 +35,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_z_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_dmp
   implicit none 
   class(mld_z_as_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)               :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)               :: level
   integer(psb_ipk_), intent(out)              :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  logical :: smoother_, global_num_ 
   !  len of prefix_ 
 
   info = 0
@@ -59,7 +60,7 @@ subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   else
     prefix_ = "dump_smth_z"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
   if (present(smoother)) then 
@@ -67,11 +68,18 @@ subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   else
     smoother_ = .false. 
   end if
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   lname = len_trim(prefix_)
   fname = trim(prefix_)
   write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
   lname = lname + 5
-
+  if (global_num_) then
+    write(0,*) iam,' Warning: no global num with AS smoothers dump'
+  end if
   if (smoother_) then 
     write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
     if (sm%nd%is_asb()) &
@@ -79,6 +87,6 @@ subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
   end if
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_z_as_smoother_dmp

mlprec/impl/smoother/mld_z_base_smoother_clear_data.f90

@@ -0,0 +1,67 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_z_base_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_z_base_smoother_mod, mld_protect_name =>  mld_z_base_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_z_base_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='z_base_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  if (allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+    if (info /= 0) then
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_z_base_smoother_clear_data

mlprec/impl/smoother/mld_z_base_smoother_clone.f90

@@ -45,7 +45,7 @@ subroutine mld_z_base_smoother_clone(sm,smout,info)
   class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
   integer(psb_ipk_), intent(out)                 :: info
   integer(psb_ipk_)  :: err_act
-  character(len=20) :: name='d_base_smoother_clone'
+  character(len=20) :: name='z_base_smoother_clone'
 
   call psb_erractionsave(err_act)
 

mlprec/impl/smoother/mld_z_base_smoother_clone_settings.f90

@@ -0,0 +1,89 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_z_base_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_z_base_smoother_mod, mld_protect_name =>  mld_z_base_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_z_base_smoother_type), intent(inout)              :: sm
+  class(mld_z_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='z_base_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info=psb_success_
+  if (same_type_as(sm,smout)) then
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  else
+    info = psb_err_internal_error_
+  end if
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_z_base_smoother_clone_settings

mlprec/impl/smoother/mld_z_base_smoother_cnv.f90

@@ -48,7 +48,7 @@ subroutine mld_z_base_smoother_cnv(sm,info,amold,vmold,imold)
   class(psb_z_base_vect_type), intent(in), optional  :: vmold
   class(psb_i_base_vect_type), intent(in), optional  :: imold
   integer(psb_ipk_) :: err_act
-  character(len=20) :: name='d_base_smoother_cnv'
+  character(len=20) :: name='z_base_smoother_cnv'
 
   call psb_erractionsave(err_act)
 

mlprec/impl/smoother/mld_z_base_smoother_dmp.f90

@@ -35,21 +35,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_z_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_z_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_z_base_smoother_mod, mld_protect_name =>  mld_z_base_smoother_dmp
   implicit none 
   class(mld_z_base_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)              :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)              :: level
   integer(psb_ipk_), intent(out)             :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  logical :: smoother_, global_num_
   !  len of prefix_ 
 
   info = 0
@@ -59,9 +60,14 @@ subroutine mld_z_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
   else
     prefix_ = "dump_smth_z"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   if (present(smoother)) then 
     smoother_ = smoother
   else
@@ -74,6 +80,6 @@ subroutine mld_z_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
 
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_z_base_smoother_dmp

mlprec/impl/smoother/mld_z_jac_smoother_bld.f90

@@ -51,9 +51,8 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
   class(psb_z_base_vect_type), intent(in), optional  :: vmold
   class(psb_i_base_vect_type), intent(in), optional  :: imold
   ! Local variables
+  type(psb_zspmat_type) :: tmpa
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
-  complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
-  type(psb_z_coo_sparse_mat) :: tmpcoo
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='z_jac_smoother_bld', ch_err
 
@@ -79,12 +78,17 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
     call sm%nd%free()
     sm%pa => a
     sm%nd_nnz_tot = nztota
+    call psb_sum(ictxt,sm%nd_nnz_tot)
+    call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
 
   class default
     if (smsv%is_global()) then
       ! Do not put anything into SM%ND since the solver
       ! is acting globally.
+      call sm%nd%free()
       sm%nd_nnz_tot = 0
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
     else
       call a%csclip(sm%nd,info,&
            & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@@ -98,6 +102,10 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
         endif
       end if
       sm%nd_nnz_tot = sm%nd%get_nzeros()
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
     end if
   end select
   if (info /= psb_success_) then
@@ -105,15 +113,7 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
          & a_err='clip & psb_spcnv csr 4')
     goto 9999
   end if
-  call psb_sum(ictxt,sm%nd_nnz_tot)
 
-
-  call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,&
-         & a_err='solver build')
-    goto 9999
-  end if
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),' end'
 

mlprec/impl/smoother/mld_z_jac_smoother_clear_data.f90

@@ -0,0 +1,70 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_z_jac_smoother_clear_data(sm,info)
+  
+  use psb_base_mod
+  use mld_z_jac_smoother, mld_protect_name =>  mld_z_jac_smoother_clear_data
+  Implicit None
+  ! Arguments
+  class(mld_z_jac_smoother_type), intent(inout) :: sm
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='z_jac_smoother_clear_data'
+
+  call psb_erractionsave(err_act)
+
+  info = 0
+  call sm%nd%free()
+  sm%nd_nnz_tot = 0
+  sm%pa         => null()
+  if ((info==0).and.allocated(sm%sv)) then
+    call sm%sv%clear_data(info)
+  end if
+  if (info /= 0) then
+    info = psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_z_jac_smoother_clear_data

mlprec/impl/smoother/mld_z_jac_smoother_clone.f90

@@ -1,15 +1,15 @@
-!  
-!   
+!
+!
 !                             MLD2P4  version 2.2
 !    MultiLevel Domain Decomposition Parallel Preconditioners Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!    
-!    (C) Copyright 2008-2018 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Daniela di Serafino   
-!   
+!
+!    (C) Copyright 2008-2018
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Daniela di Serafino
+!
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
 !    are met:
@@ -21,7 +21,7 @@
 !      3. The name of the MLD2P4 group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
-!   
+!
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -33,10 +33,10 @@
 !    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
+!
+!
 subroutine mld_z_jac_smoother_clone(sm,smout,info)
-  
+
   use psb_base_mod
   use mld_z_jac_smoother, mld_protect_name => mld_z_jac_smoother_clone
 
@@ -59,14 +59,19 @@ subroutine mld_z_jac_smoother_clone(sm,smout,info)
   end if
   if (info == psb_success_) &
        & allocate(mld_z_jac_smoother_type :: smout, stat=info)
-  if (info /= 0) then 
+  if (info /= 0) then
     info = psb_err_alloc_dealloc_
-    goto 9999 
+    goto 9999
   end if
 
   select type(smo => smout)
   type is (mld_z_jac_smoother_type)
     smo%nd_nnz_tot = sm%nd_nnz_tot
+    smo%checkres   = sm%checkres
+    smo%printres   = sm%printres
+    smo%checkiter  = sm%checkiter
+    smo%printiter  = sm%printiter
+    smo%tol        = sm%tol
     call sm%nd%clone(smo%nd,info)
     if ((info==psb_success_).and.(allocated(sm%sv))) then
       allocate(smout%sv,mold=sm%sv,stat=info)

mlprec/impl/smoother/mld_z_jac_smoother_clone_settings.f90

@@ -0,0 +1,101 @@
+!  
+!   
+!                             MLD2P4  version 2.2
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               asd on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2008-2018 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Daniela di Serafino   
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine mld_z_jac_smoother_clone_settings(sm,smout,info)
+
+  use psb_base_mod
+  use mld_z_jac_smoother, mld_protect_name =>  mld_z_jac_smoother_clone_settings
+  Implicit None
+  ! Arguments
+  class(mld_z_jac_smoother_type), intent(inout)              :: sm
+  class(mld_z_base_smoother_type), intent(inout) :: smout
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_)  :: err_act
+  character(len=20) :: name='z_jac_smoother_clone_settings'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  
+  select type(smout)
+  class is(mld_z_jac_smoother_type)
+
+    smout%pa => null()
+    smout%nd_nnz_tot = 0
+    smout%checkres   = sm%checkres
+    smout%printres   = sm%printres
+    smout%checkiter  = sm%checkiter
+    smout%printiter  = sm%printiter
+    smout%tol        = sm%tol
+
+    if (allocated(smout%sv)) then
+      if (.not.same_type_as(sm%sv,smout%sv)) then
+        call smout%sv%free(info)
+        if (info == 0) deallocate(smout%sv,stat=info)
+      end if
+    end if
+    if (info /= 0) then
+      info = psb_err_internal_error_
+    else
+      if (allocated(smout%sv)) then
+        if (same_type_as(sm%sv,smout%sv)) then
+          call sm%sv%clone_settings(smout%sv,info)
+        else
+          info = psb_err_internal_error_
+        end if
+      else
+        allocate(smout%sv,mold=sm%sv,stat=info)
+        if (info == 0) call sm%sv%clone_settings(smout%sv,info)
+        if (info /= 0) info = psb_err_internal_error_
+      end if
+    end if
+  class default
+    info = psb_err_internal_error_
+  end select
+  
+  if (info /= 0) then
+    call psb_errpush(info,name) 
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+end subroutine mld_z_jac_smoother_clone_settings

mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90

@@ -59,7 +59,7 @@ subroutine mld_z_jac_smoother_cnv(sm,info,amold,vmold,imold)
 
 
   if (info == psb_success_) then
-    if ((.not.associated(sm%pa)).and.(sm%nd%is_asb())) then
+    if (sm%nd%is_asb()) then
       if (present(amold)) then 
         call sm%nd%cscnv(info,&
              & mold=amold,dupl=psb_dupl_add_)

mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90

@@ -52,22 +52,27 @@ subroutine mld_z_jac_smoother_csetc(sm,what,val,info,idx)
   info = psb_success_
   call psb_erractionsave(err_act)
 
-
-  select case(psb_toupper(what))
-  case('SMOOTHER_STOP')
-    if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then
-      sm%checkres   = .true.
-    else
-      sm%checkres   = .false.
-    end if
-  case('SMOOTHER_TRACE')
-    if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then
-      sm%printres   = .true.
-    else
-      sm%printres   = .false.
-    end if
-  case default
-    call sm%mld_z_base_smoother_type%set(what,val,info,idx=idx)
+  select case(psb_toupper(trim(what)))
+    case('SMOOTHER_STOP')
+      select case(psb_toupper(trim(val)))
+      case('T','TRUE')
+        sm%checkres   = .true.
+      case('F','FALSE')
+        sm%checkres   = .false.
+      case default
+        write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"'
+      end select
+    case('SMOOTHER_TRACE')
+      select case(psb_toupper(trim(val)))
+      case('T','TRUE')
+        sm%printres   = .true.
+      case('F','FALSE')
+        sm%printres   = .false.
+      case default
+        write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"'
+      end select
+    case default
+      call sm%mld_z_base_smoother_type%set(what,val,info,idx=idx)
   end select
 
   if (info /= psb_success_) then

mlprec/impl/smoother/mld_z_jac_smoother_dmp.f90

@@ -35,21 +35,23 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine mld_z_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
+subroutine mld_z_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
   
   use psb_base_mod
   use mld_z_jac_smoother, mld_protect_nam => mld_z_jac_smoother_dmp
   implicit none 
   class(mld_z_jac_smoother_type), intent(in) :: sm
-  integer(psb_ipk_), intent(in)               :: ictxt,level
+  type(psb_desc_type), intent(in)               :: desc
+  integer(psb_ipk_), intent(in)               :: level
   integer(psb_ipk_), intent(out)              :: info
   character(len=*), intent(in), optional :: prefix, head
-  logical, optional, intent(in)    :: smoother, solver
+  logical, optional, intent(in)    :: smoother, solver, global_num
   integer(psb_ipk_)  :: i, j, il1, iln, lname, lev
-  integer(psb_ipk_)  :: icontxt,iam, np
+  integer(psb_ipk_)  :: ictxt,iam, np
   character(len=80)  :: prefix_
   character(len=120) :: fname ! len should be at least 20 more than
-  logical :: smoother_
+  integer(psb_lpk_), allocatable :: iv(:)
+  logical :: smoother_, global_num_
   !  len of prefix_ 
 
   info = 0
@@ -59,7 +61,7 @@ subroutine mld_z_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
   else
     prefix_ = "dump_smth_z"
   end if
-
+  ictxt = desc%get_context()
   call psb_info(ictxt,iam,np)
 
   if (present(smoother)) then 
@@ -67,6 +69,11 @@ subroutine mld_z_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
   else
     smoother_ = .false. 
   end if
+  if (present(global_num)) then 
+    global_num_ = global_num
+  else
+    global_num_ = .false. 
+  end if
   lname = len_trim(prefix_)
   fname = trim(prefix_)
   write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
@@ -74,11 +81,17 @@ subroutine mld_z_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
 
   if (smoother_) then 
     write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
-    if (sm%nd%is_asb()) &
-         & call sm%nd%print(fname,head=head)
+    if (global_num_) then
+      iv = desc%get_global_indices(owned=.false.)      
+      if (sm%nd%is_asb()) &
+           & call sm%nd%print(fname,head=head,iv=iv)
+    else
+      if (sm%nd%is_asb()) &
+           & call sm%nd%print(fname,head=head)
+    end if
   end if
   ! At base level do nothing for the smoother
   if (allocated(sm%sv)) &
-       & call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix)
+       & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
 
 end subroutine mld_z_jac_smoother_dmp