From 3f334d48879475a2d07b92e3a56333d56e499821 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 16 Nov 2010 14:00:08 +0000 Subject: [PATCH] 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 | 9 ++++++--- mlprec/mld_d_jac_smoother.f03 | 9 ++++++--- mlprec/mld_dprecset.F90 | 8 ++++++-- mlprec/mld_s_jac_smoother.f03 | 9 ++++++--- mlprec/mld_sprecset.F90 | 4 ++++ mlprec/mld_z_jac_smoother.f03 | 9 ++++++--- 6 files changed, 34 insertions(+), 14 deletions(-) diff --git a/mlprec/mld_c_jac_smoother.f03 b/mlprec/mld_c_jac_smoother.f03 index a7701e9c..ff413321 100644 --- a/mlprec/mld_c_jac_smoother.f03 +++ b/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' diff --git a/mlprec/mld_d_jac_smoother.f03 b/mlprec/mld_d_jac_smoother.f03 index 0c30c1c9..3a111e70 100644 --- a/mlprec/mld_d_jac_smoother.f03 +++ b/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' diff --git a/mlprec/mld_dprecset.F90 b/mlprec/mld_dprecset.F90 index c16499bb..984949f9 100644 --- a/mlprec/mld_dprecset.F90 +++ b/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) diff --git a/mlprec/mld_s_jac_smoother.f03 b/mlprec/mld_s_jac_smoother.f03 index 5f528761..6c048376 100644 --- a/mlprec/mld_s_jac_smoother.f03 +++ b/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' diff --git a/mlprec/mld_sprecset.F90 b/mlprec/mld_sprecset.F90 index b6ab8c25..1f2ebaa2 100644 --- a/mlprec/mld_sprecset.F90 +++ b/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) diff --git a/mlprec/mld_z_jac_smoother.f03 b/mlprec/mld_z_jac_smoother.f03 index 3518dd20..a256011d 100644 --- a/mlprec/mld_z_jac_smoother.f03 +++ b/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'