From f59c8169145dd054555f5882ca6c123e7953d210 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 2 Aug 2019 09:28:44 +0100 Subject: [PATCH] Fix handling of is_global for SYM%ND --- .../impl/smoother/mld_c_as_smoother_cnv.f90 | 2 +- .../impl/smoother/mld_c_jac_smoother_bld.f90 | 32 +++++++++++-------- .../impl/smoother/mld_c_jac_smoother_cnv.f90 | 10 +++--- .../impl/smoother/mld_d_as_smoother_cnv.f90 | 2 +- .../impl/smoother/mld_d_jac_smoother_bld.f90 | 32 +++++++++++-------- .../impl/smoother/mld_d_jac_smoother_cnv.f90 | 10 +++--- .../impl/smoother/mld_s_as_smoother_cnv.f90 | 2 +- .../impl/smoother/mld_s_jac_smoother_bld.f90 | 32 +++++++++++-------- .../impl/smoother/mld_s_jac_smoother_cnv.f90 | 10 +++--- .../impl/smoother/mld_z_as_smoother_cnv.f90 | 2 +- .../impl/smoother/mld_z_jac_smoother_bld.f90 | 32 +++++++++++-------- .../impl/smoother/mld_z_jac_smoother_cnv.f90 | 10 +++--- 12 files changed, 104 insertions(+), 72 deletions(-) diff --git a/mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 index a45259ea..9dfc7af2 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 @@ -70,7 +70,7 @@ subroutine mld_c_as_smoother_cnv(sm,info,amold,vmold,imold) if (info == psb_success_) then if (present(amold)) then - call sm%nd%cscnv(info,& + if (sm%nd%is_asb()) call sm%nd%cscnv(info,& & mold=amold,dupl=psb_dupl_add_) end if end if diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 index 9e057643..ac504cff 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 @@ -53,6 +53,7 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) ! Local variables 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 @@ -67,7 +68,7 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) n_row = desc_a%get_local_rows() - + n_col = desc_a%get_local_cols() nrow_a = a%get_nrows() nztota = a%get_nzeros() select type (smsv => sm%sv) @@ -77,19 +78,24 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) sm%nnz_nd_tot = nztota class default - call a%csclip(sm%nd,info,& - & jmin=nrow_a+1,rscale=.false.,cscale=.false.) - 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 + if (smsv%is_global()) then + ! Do not put anything into SM%ND since the solver + ! is acting globally. + sm%nnz_nd_tot = 0 + else + call a%csclip(sm%nd,info,& + & jmin=nrow_a+1,rscale=.false.,cscale=.false.) + 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 + sm%nnz_nd_tot = sm%nd%get_nzeros() end if - sm%nnz_nd_tot = sm%nd%get_nzeros() - end select if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 index 06a78b53..2c706a76 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 +++ b/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)) then + if ((.not.associated(sm%pa)).and.(sm%nd%is_asb())) then if (present(amold)) then call sm%nd%cscnv(info,& & mold=amold,dupl=psb_dupl_add_) @@ -69,9 +69,11 @@ subroutine mld_c_jac_smoother_cnv(sm,info,amold,vmold,imold) endif end if end if - - if (allocated(sm%sv)) & - & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + + if (info == psb_success_) then + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + end if if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& & a_err='solver cnv') diff --git a/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 index ce761966..d1c5f5df 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 @@ -70,7 +70,7 @@ subroutine mld_d_as_smoother_cnv(sm,info,amold,vmold,imold) if (info == psb_success_) then if (present(amold)) then - call sm%nd%cscnv(info,& + if (sm%nd%is_asb()) call sm%nd%cscnv(info,& & mold=amold,dupl=psb_dupl_add_) end if end if diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 index 3f443330..156da119 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 @@ -53,6 +53,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) ! Local variables 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 @@ -67,7 +68,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) n_row = desc_a%get_local_rows() - + n_col = desc_a%get_local_cols() nrow_a = a%get_nrows() nztota = a%get_nzeros() select type (smsv => sm%sv) @@ -77,19 +78,24 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) sm%nnz_nd_tot = nztota class default - call a%csclip(sm%nd,info,& - & jmin=nrow_a+1,rscale=.false.,cscale=.false.) - 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 + if (smsv%is_global()) then + ! Do not put anything into SM%ND since the solver + ! is acting globally. + sm%nnz_nd_tot = 0 + else + call a%csclip(sm%nd,info,& + & jmin=nrow_a+1,rscale=.false.,cscale=.false.) + 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 + sm%nnz_nd_tot = sm%nd%get_nzeros() end if - sm%nnz_nd_tot = sm%nd%get_nzeros() - end select if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90 index 22a90d83..8f562447 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90 +++ b/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)) then + if ((.not.associated(sm%pa)).and.(sm%nd%is_asb())) then if (present(amold)) then call sm%nd%cscnv(info,& & mold=amold,dupl=psb_dupl_add_) @@ -69,9 +69,11 @@ subroutine mld_d_jac_smoother_cnv(sm,info,amold,vmold,imold) endif end if end if - - if (allocated(sm%sv)) & - & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + + if (info == psb_success_) then + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + end if if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& & a_err='solver cnv') diff --git a/mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 index a71dc5fe..80ac089b 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 @@ -70,7 +70,7 @@ subroutine mld_s_as_smoother_cnv(sm,info,amold,vmold,imold) if (info == psb_success_) then if (present(amold)) then - call sm%nd%cscnv(info,& + if (sm%nd%is_asb()) call sm%nd%cscnv(info,& & mold=amold,dupl=psb_dupl_add_) end if end if diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 index cfc48cff..f8ab3f15 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 @@ -53,6 +53,7 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) ! Local variables 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 @@ -67,7 +68,7 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) n_row = desc_a%get_local_rows() - + n_col = desc_a%get_local_cols() nrow_a = a%get_nrows() nztota = a%get_nzeros() select type (smsv => sm%sv) @@ -77,19 +78,24 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) sm%nnz_nd_tot = nztota class default - call a%csclip(sm%nd,info,& - & jmin=nrow_a+1,rscale=.false.,cscale=.false.) - 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 + if (smsv%is_global()) then + ! Do not put anything into SM%ND since the solver + ! is acting globally. + sm%nnz_nd_tot = 0 + else + call a%csclip(sm%nd,info,& + & jmin=nrow_a+1,rscale=.false.,cscale=.false.) + 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 + sm%nnz_nd_tot = sm%nd%get_nzeros() end if - sm%nnz_nd_tot = sm%nd%get_nzeros() - end select if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 index e2be39df..a73be5c6 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 +++ b/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)) then + if ((.not.associated(sm%pa)).and.(sm%nd%is_asb())) then if (present(amold)) then call sm%nd%cscnv(info,& & mold=amold,dupl=psb_dupl_add_) @@ -69,9 +69,11 @@ subroutine mld_s_jac_smoother_cnv(sm,info,amold,vmold,imold) endif end if end if - - if (allocated(sm%sv)) & - & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + + if (info == psb_success_) then + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + end if if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& & a_err='solver cnv') diff --git a/mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 index 716fb2a7..21a7d4aa 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 @@ -70,7 +70,7 @@ subroutine mld_z_as_smoother_cnv(sm,info,amold,vmold,imold) if (info == psb_success_) then if (present(amold)) then - call sm%nd%cscnv(info,& + if (sm%nd%is_asb()) call sm%nd%cscnv(info,& & mold=amold,dupl=psb_dupl_add_) end if end if diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 index 0e518c14..772b4db4 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 @@ -53,6 +53,7 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) ! Local variables 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 @@ -67,7 +68,7 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) n_row = desc_a%get_local_rows() - + n_col = desc_a%get_local_cols() nrow_a = a%get_nrows() nztota = a%get_nzeros() select type (smsv => sm%sv) @@ -77,19 +78,24 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) sm%nnz_nd_tot = nztota class default - call a%csclip(sm%nd,info,& - & jmin=nrow_a+1,rscale=.false.,cscale=.false.) - 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 + if (smsv%is_global()) then + ! Do not put anything into SM%ND since the solver + ! is acting globally. + sm%nnz_nd_tot = 0 + else + call a%csclip(sm%nd,info,& + & jmin=nrow_a+1,rscale=.false.,cscale=.false.) + 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 + sm%nnz_nd_tot = sm%nd%get_nzeros() end if - sm%nnz_nd_tot = sm%nd%get_nzeros() - end select if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 index f749e085..847d6c6d 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 +++ b/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)) then + if ((.not.associated(sm%pa)).and.(sm%nd%is_asb())) then if (present(amold)) then call sm%nd%cscnv(info,& & mold=amold,dupl=psb_dupl_add_) @@ -69,9 +69,11 @@ subroutine mld_z_jac_smoother_cnv(sm,info,amold,vmold,imold) endif end if end if - - if (allocated(sm%sv)) & - & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + + if (info == psb_success_) then + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + end if if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& & a_err='solver cnv')