mld2p4-2:

mlprec/mld_c_jac_smoother.f03
 mlprec/mld_d_jac_smoother.f03
 mlprec/mld_dprecset.F90
 mlprec/mld_s_jac_smoother.f03
 mlprec/mld_sprecset.F90
 mlprec/mld_z_jac_smoother.f03

Check in Jacobi smoother for empty non-diagonal part, and force 1
sweep in that case.

mlprec/mld_c_jac_smoother.f03

@@ -52,6 +52,7 @@ module mld_c_jac_smoother
     !    class(mld_c_base_solver_type), allocatable :: sv
     !    
     type(psb_cspmat_type) :: nd
+    integer               :: nnz_nd_tot
   contains
     procedure, pass(sm) :: build => c_jac_smoother_bld
     procedure, pass(sm) :: apply => c_jac_smoother_apply
@@ -136,7 +137,7 @@ contains
       end if
     endif
 
-    if (sweeps == 1) then 
+    if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then 
 
       call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) 
 
@@ -239,7 +240,7 @@ contains
     character, intent(in)                          :: upd
     integer, intent(out)                           :: info
     ! Local variables
-    integer :: n_row,n_col, nrow_a, nztota
+    integer :: n_row,n_col, nrow_a, nztota, nzeros
     complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
     integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
     character(len=20)  :: name='d_jac_smoother_bld', ch_err
@@ -273,7 +274,9 @@ contains
       call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4')
       goto 9999
     end if
-
+    nzeros = sm%nd%get_nzeros()
+    call psb_sum(ictxt,nzeros)
+    sm%nnz_nd_tot = nzeros
     if (debug_level >= psb_debug_outer_) &
          & write(debug_unit,*) me,' ',trim(name),' end'
 

mlprec/mld_d_jac_smoother.f03

@@ -52,6 +52,7 @@ module mld_d_jac_smoother
     !    class(mld_d_base_solver_type), allocatable :: sv
     !    
     type(psb_dspmat_type) :: nd
+    integer               :: nnz_nd_tot
   contains
     procedure, pass(sm) :: build => d_jac_smoother_bld
     procedure, pass(sm) :: apply => d_jac_smoother_apply
@@ -136,7 +137,7 @@ contains
       end if
     endif
 
-    if (sweeps == 1) then 
+    if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then 
 
       call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) 
 
@@ -239,7 +240,7 @@ contains
     character, intent(in)                          :: upd
     integer, intent(out)                           :: info
     ! Local variables
-    integer :: n_row,n_col, nrow_a, nztota
+    integer :: n_row,n_col, nrow_a, nztota, nzeros
     real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
     integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
     character(len=20)  :: name='d_jac_smoother_bld', ch_err
@@ -273,7 +274,9 @@ contains
       call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4')
       goto 9999
     end if
-
+    nzeros = sm%nd%get_nzeros()
+    call psb_sum(ictxt,nzeros)
+    sm%nnz_nd_tot = nzeros
     if (debug_level >= psb_debug_outer_) &
          & write(debug_unit,*) me,' ',trim(name),' end'
 

mlprec/mld_dprecset.F90

@@ -103,7 +103,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
 
   if (.not.allocated(p%precv)) then 
     info = 3111
-    write(0,*) name,': Error: uninitialized preconditioner,',&
+    write(psb_err_unit,*) name,': Error: uninitialized preconditioner,',&
          &' should call MLD_PRECINIT'
     return 
   endif
@@ -117,7 +117,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
 
   if ((ilev_<1).or.(ilev_ > nlev_)) then 
     info = -1
-    write(0,*) name,': Error: invalid ILEV/NLEV combination',ilev_, nlev_
+    write(psb_err_unit,*) name,': Error: invalid ILEV/NLEV combination',ilev_, nlev_
     return
   endif
 
@@ -350,6 +350,10 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
 
   endif
 
+  do ilev_=1, nlev_
+    write(0,*) 'Check on mld_dprecseti level ',ilev_,' ',allocated(p%precv(ilev_)%sm)
+  end do
+
 end subroutine mld_dprecseti
 
 subroutine mld_dprecsetsm(p,what,val,info,ilev)

mlprec/mld_s_jac_smoother.f03

@@ -52,6 +52,7 @@ module mld_s_jac_smoother
     !    class(mld_s_base_solver_type), allocatable :: sv
     !    
     type(psb_sspmat_type) :: nd
+    integer               :: nnz_nd_tot
   contains
     procedure, pass(sm) :: build => s_jac_smoother_bld
     procedure, pass(sm) :: apply => s_jac_smoother_apply
@@ -136,7 +137,7 @@ contains
       end if
     endif
 
-    if (sweeps == 1) then 
+    if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then 
 
       call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) 
 
@@ -239,7 +240,7 @@ contains
     character, intent(in)                          :: upd
     integer, intent(out)                           :: info
     ! Local variables
-    integer :: n_row,n_col, nrow_a, nztota
+    integer :: n_row,n_col, nrow_a, nztota, nzeros
     real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
     integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
     character(len=20)  :: name='d_jac_smoother_bld', ch_err
@@ -273,7 +274,9 @@ contains
       call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4')
       goto 9999
     end if
-
+    nzeros = sm%nd%get_nzeros()
+    call psb_sum(ictxt,nzeros)
+    sm%nnz_nd_tot = nzeros
     if (debug_level >= psb_debug_outer_) &
          & write(debug_unit,*) me,' ',trim(name),' end'
 

mlprec/mld_sprecset.F90

@@ -350,6 +350,10 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
 
   endif
 
+  do ilev_=1, nlev_
+    write(0,*) 'Check on mld_sprecseti level ',ilev_,' ',allocated(p%precv(ilev_)%sm)
+  end do
+
 end subroutine mld_sprecseti
 
 subroutine mld_sprecsetsm(p,what,val,info,ilev)

mlprec/mld_z_jac_smoother.f03

@@ -52,6 +52,7 @@ module mld_z_jac_smoother
     !    class(mld_z_base_solver_type), allocatable :: sv
     !    
     type(psb_zspmat_type) :: nd
+    integer               :: nnz_nd_tot
   contains
     procedure, pass(sm) :: build => z_jac_smoother_bld
     procedure, pass(sm) :: apply => z_jac_smoother_apply
@@ -136,7 +137,7 @@ contains
       end if
     endif
 
-    if (sweeps == 1) then 
+    if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then 
 
       call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) 
 
@@ -239,7 +240,7 @@ contains
     character, intent(in)                          :: upd
     integer, intent(out)                           :: info
     ! Local variables
-    integer :: n_row,n_col, nrow_a, nztota
+    integer :: n_row,n_col, nrow_a, nztota, nzeros
     complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
     integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
     character(len=20)  :: name='d_jac_smoother_bld', ch_err
@@ -273,7 +274,9 @@ contains
       call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4')
       goto 9999
     end if
-
+    nzeros = sm%nd%get_nzeros()
+    call psb_sum(ictxt,nzeros)
+    sm%nnz_nd_tot = nzeros
     if (debug_level >= psb_debug_outer_) &
          & write(debug_unit,*) me,' ',trim(name),' end'