From 108b4dd00df84abc62c5aff9e33072728855c4cd Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 26 May 2020 17:34:03 +0200 Subject: [PATCH 1/8] Fixes for L1-JAC vs Gauss-Seidel --- .../smoother/mld_c_l1_jac_smoother_bld.f90 | 16 +------- .../smoother/mld_d_l1_jac_smoother_bld.f90 | 16 +------- .../smoother/mld_s_l1_jac_smoother_bld.f90 | 16 +------- .../smoother/mld_z_l1_jac_smoother_bld.f90 | 16 +------- mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 | 40 ++++++++++++++++++- mlprec/impl/solver/mld_c_gs_solver_bld.f90 | 39 ++++++++++++++++++ mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 | 40 ++++++++++++++++++- mlprec/impl/solver/mld_d_gs_solver_bld.f90 | 39 ++++++++++++++++++ mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 | 40 ++++++++++++++++++- mlprec/impl/solver/mld_s_gs_solver_bld.f90 | 39 ++++++++++++++++++ mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 | 40 ++++++++++++++++++- mlprec/impl/solver/mld_z_gs_solver_bld.f90 | 39 ++++++++++++++++++ mlprec/mld_c_base_solver_mod.f90 | 14 ++++++- mlprec/mld_c_gs_solver.f90 | 14 +++++++ mlprec/mld_d_base_solver_mod.f90 | 14 ++++++- mlprec/mld_d_gs_solver.f90 | 14 +++++++ mlprec/mld_s_base_solver_mod.f90 | 14 ++++++- mlprec/mld_s_gs_solver.f90 | 14 +++++++ mlprec/mld_z_base_solver_mod.f90 | 14 ++++++- mlprec/mld_z_gs_solver.f90 | 14 +++++++ 20 files changed, 428 insertions(+), 64 deletions(-) diff --git a/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 index 1d62c051..db6582ed 100644 --- a/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 @@ -108,21 +108,9 @@ subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) sm%nd_nnz_tot = sm%nd%get_nzeros() call psb_sum(ictxt,sm%nd_nnz_tot) arwsum = sm%nd%arwsum(info) + if (info == 0) call sm%sv%set_xtra_d(arwsum) call a%csclip(tmpa,info,& - & jmax=nrow_a,rscale=.false.,cscale=.false.) - call tmpa%mv_to(tmpcoo) - call tmpcoo%set_dupl(psb_dupl_add_) - nz = tmpcoo%get_nzeros() - call tmpcoo%reallocate(nz+n_row) - do i=1, n_row - tmpcoo%ia(nz+i) = i - tmpcoo%ja(nz+i) = i - tmpcoo%val(nz+i) = arwsum(i) - end do - call tmpcoo%set_nzeros(nz+n_row) - call tmpcoo%fix(info) - call tmpcoo%mv_to_fmt(tmpcsr,info) - call tmpa%mv_from(tmpcsr) + & jmax=nrow_a,rscale=.false.,cscale=.false.) call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold) end if end select diff --git a/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 index c3b22d47..149a34c0 100644 --- a/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 @@ -108,21 +108,9 @@ subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) sm%nd_nnz_tot = sm%nd%get_nzeros() call psb_sum(ictxt,sm%nd_nnz_tot) arwsum = sm%nd%arwsum(info) + if (info == 0) call sm%sv%set_xtra_d(arwsum) call a%csclip(tmpa,info,& - & jmax=nrow_a,rscale=.false.,cscale=.false.) - call tmpa%mv_to(tmpcoo) - call tmpcoo%set_dupl(psb_dupl_add_) - nz = tmpcoo%get_nzeros() - call tmpcoo%reallocate(nz+n_row) - do i=1, n_row - tmpcoo%ia(nz+i) = i - tmpcoo%ja(nz+i) = i - tmpcoo%val(nz+i) = arwsum(i) - end do - call tmpcoo%set_nzeros(nz+n_row) - call tmpcoo%fix(info) - call tmpcoo%mv_to_fmt(tmpcsr,info) - call tmpa%mv_from(tmpcsr) + & jmax=nrow_a,rscale=.false.,cscale=.false.) call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold) end if end select diff --git a/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 index 2bd3cea3..36abf0e5 100644 --- a/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 @@ -108,21 +108,9 @@ subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) sm%nd_nnz_tot = sm%nd%get_nzeros() call psb_sum(ictxt,sm%nd_nnz_tot) arwsum = sm%nd%arwsum(info) + if (info == 0) call sm%sv%set_xtra_d(arwsum) call a%csclip(tmpa,info,& - & jmax=nrow_a,rscale=.false.,cscale=.false.) - call tmpa%mv_to(tmpcoo) - call tmpcoo%set_dupl(psb_dupl_add_) - nz = tmpcoo%get_nzeros() - call tmpcoo%reallocate(nz+n_row) - do i=1, n_row - tmpcoo%ia(nz+i) = i - tmpcoo%ja(nz+i) = i - tmpcoo%val(nz+i) = arwsum(i) - end do - call tmpcoo%set_nzeros(nz+n_row) - call tmpcoo%fix(info) - call tmpcoo%mv_to_fmt(tmpcsr,info) - call tmpa%mv_from(tmpcsr) + & jmax=nrow_a,rscale=.false.,cscale=.false.) call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold) end if end select diff --git a/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 index 48411ce2..a0ccd4c6 100644 --- a/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 @@ -108,21 +108,9 @@ subroutine mld_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) sm%nd_nnz_tot = sm%nd%get_nzeros() call psb_sum(ictxt,sm%nd_nnz_tot) arwsum = sm%nd%arwsum(info) + if (info == 0) call sm%sv%set_xtra_d(arwsum) call a%csclip(tmpa,info,& - & jmax=nrow_a,rscale=.false.,cscale=.false.) - call tmpa%mv_to(tmpcoo) - call tmpcoo%set_dupl(psb_dupl_add_) - nz = tmpcoo%get_nzeros() - call tmpcoo%reallocate(nz+n_row) - do i=1, n_row - tmpcoo%ia(nz+i) = i - tmpcoo%ja(nz+i) = i - tmpcoo%val(nz+i) = arwsum(i) - end do - call tmpcoo%set_nzeros(nz+n_row) - call tmpcoo%fix(info) - call tmpcoo%mv_to_fmt(tmpcsr,info) - call tmpa%mv_from(tmpcsr) + & jmax=nrow_a,rscale=.false.,cscale=.false.) call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold) end if end select diff --git a/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 index 408b0ba9..9e5427b1 100644 --- a/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 @@ -79,7 +79,45 @@ subroutine mld_c_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=-ione,jmax=nrow_a,u=sv%u) - + ! + ! Is this an L1-GS solver? + ! + if (allocated(sv%xtra)) then + block + integer(psb_ipk_) :: k, nz, nrm + type(psb_c_coo_sparse_mat) :: tcoo + ! + ! For BWGS: LX = L - D, UX = U + D + ! + call sv%l%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = -sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%l%mv_from(tcoo) + + call sv%u%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%u%mv_from(tcoo) + end block + end if else info = psb_err_missing_override_method_ diff --git a/mlprec/impl/solver/mld_c_gs_solver_bld.f90 b/mlprec/impl/solver/mld_c_gs_solver_bld.f90 index 37117275..babca9be 100644 --- a/mlprec/impl/solver/mld_c_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_gs_solver_bld.f90 @@ -77,6 +77,45 @@ subroutine mld_c_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=izero,jmax=nrow_a,u=sv%u) + ! + ! Is this an L1-GS solver? + ! + if (allocated(sv%xtra)) then + block + integer(psb_ipk_) :: k, nz, nrm, dp + type(psb_c_coo_sparse_mat) :: tcoo + ! + ! For GS: LX = L + D, UX = U - D + ! + call sv%l%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%l%mv_from(tcoo) + + call sv%u%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = -sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%u%mv_from(tcoo) + end block + end if else diff --git a/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 index d6964cab..3001c937 100644 --- a/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 @@ -79,7 +79,45 @@ subroutine mld_d_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=-ione,jmax=nrow_a,u=sv%u) - + ! + ! Is this an L1-GS solver? + ! + if (allocated(sv%xtra)) then + block + integer(psb_ipk_) :: k, nz, nrm + type(psb_d_coo_sparse_mat) :: tcoo + ! + ! For BWGS: LX = L - D, UX = U + D + ! + call sv%l%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = -sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%l%mv_from(tcoo) + + call sv%u%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%u%mv_from(tcoo) + end block + end if else info = psb_err_missing_override_method_ diff --git a/mlprec/impl/solver/mld_d_gs_solver_bld.f90 b/mlprec/impl/solver/mld_d_gs_solver_bld.f90 index 5357d294..510e33ae 100644 --- a/mlprec/impl/solver/mld_d_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_gs_solver_bld.f90 @@ -77,6 +77,45 @@ subroutine mld_d_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=izero,jmax=nrow_a,u=sv%u) + ! + ! Is this an L1-GS solver? + ! + if (allocated(sv%xtra)) then + block + integer(psb_ipk_) :: k, nz, nrm, dp + type(psb_d_coo_sparse_mat) :: tcoo + ! + ! For GS: LX = L + D, UX = U - D + ! + call sv%l%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%l%mv_from(tcoo) + + call sv%u%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = -sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%u%mv_from(tcoo) + end block + end if else diff --git a/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 index d8312abc..cf68ac5b 100644 --- a/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 @@ -79,7 +79,45 @@ subroutine mld_s_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=-ione,jmax=nrow_a,u=sv%u) - + ! + ! Is this an L1-GS solver? + ! + if (allocated(sv%xtra)) then + block + integer(psb_ipk_) :: k, nz, nrm + type(psb_s_coo_sparse_mat) :: tcoo + ! + ! For BWGS: LX = L - D, UX = U + D + ! + call sv%l%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = -sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%l%mv_from(tcoo) + + call sv%u%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%u%mv_from(tcoo) + end block + end if else info = psb_err_missing_override_method_ diff --git a/mlprec/impl/solver/mld_s_gs_solver_bld.f90 b/mlprec/impl/solver/mld_s_gs_solver_bld.f90 index d6e07ac0..086136b1 100644 --- a/mlprec/impl/solver/mld_s_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_gs_solver_bld.f90 @@ -77,6 +77,45 @@ subroutine mld_s_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=izero,jmax=nrow_a,u=sv%u) + ! + ! Is this an L1-GS solver? + ! + if (allocated(sv%xtra)) then + block + integer(psb_ipk_) :: k, nz, nrm, dp + type(psb_s_coo_sparse_mat) :: tcoo + ! + ! For GS: LX = L + D, UX = U - D + ! + call sv%l%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%l%mv_from(tcoo) + + call sv%u%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = -sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%u%mv_from(tcoo) + end block + end if else diff --git a/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 index e02d53fb..7e58bb27 100644 --- a/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 @@ -79,7 +79,45 @@ subroutine mld_z_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=-ione,jmax=nrow_a,u=sv%u) - + ! + ! Is this an L1-GS solver? + ! + if (allocated(sv%xtra)) then + block + integer(psb_ipk_) :: k, nz, nrm + type(psb_z_coo_sparse_mat) :: tcoo + ! + ! For BWGS: LX = L - D, UX = U + D + ! + call sv%l%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = -sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%l%mv_from(tcoo) + + call sv%u%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%u%mv_from(tcoo) + end block + end if else info = psb_err_missing_override_method_ diff --git a/mlprec/impl/solver/mld_z_gs_solver_bld.f90 b/mlprec/impl/solver/mld_z_gs_solver_bld.f90 index dad76c87..5403ac44 100644 --- a/mlprec/impl/solver/mld_z_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_gs_solver_bld.f90 @@ -77,6 +77,45 @@ subroutine mld_z_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=izero,jmax=nrow_a,u=sv%u) + ! + ! Is this an L1-GS solver? + ! + if (allocated(sv%xtra)) then + block + integer(psb_ipk_) :: k, nz, nrm, dp + type(psb_z_coo_sparse_mat) :: tcoo + ! + ! For GS: LX = L + D, UX = U - D + ! + call sv%l%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%l%mv_from(tcoo) + + call sv%u%mv_to(tcoo) + nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) + nz = tcoo%get_nzeros() + call tcoo%ensure_size(nz+nrm) + call tcoo%set_dupl(psb_dupl_add_) + do k=1,nrm + tcoo%ia(nz+k) = k + tcoo%ja(nz+k) = k + tcoo%val(nz+k) = -sv%xtra(k) + end do + call tcoo%set_nzeros(nz+nrm) + call tcoo%fix(info) + call sv%u%mv_from(tcoo) + end block + end if else diff --git a/mlprec/mld_c_base_solver_mod.f90 b/mlprec/mld_c_base_solver_mod.f90 index bc250976..6f787086 100644 --- a/mlprec/mld_c_base_solver_mod.f90 +++ b/mlprec/mld_c_base_solver_mod.f90 @@ -112,12 +112,14 @@ module mld_c_base_solver_mod procedure, nopass :: get_id => c_base_solver_get_id procedure, nopass :: is_iterative => c_base_solver_is_iterative procedure, pass(sv) :: is_global => c_base_solver_is_global + procedure, pass(sv) :: set_xtra_d => c_base_solver_set_xtra_d end type mld_c_base_solver_type private :: c_base_solver_sizeof, c_base_solver_default,& & c_base_solver_get_nzeros, c_base_solver_get_fmt, & & c_base_solver_is_iterative, c_base_solver_get_id, & - & c_base_solver_get_wrksize, c_base_solver_is_global + & c_base_solver_get_wrksize, c_base_solver_is_global, & + & c_base_solver_set_xtra_d interface @@ -418,4 +420,14 @@ contains val = 0 end function c_base_solver_get_wrksize + subroutine c_base_solver_set_xtra_d(sv,d) + implicit none + ! Arguments + class(mld_c_base_solver_type), intent(inout) :: sv + real(psb_spk_), intent(in) :: d(:) + ! Do nothing for base version + + return + end subroutine c_base_solver_set_xtra_d + end module mld_c_base_solver_mod diff --git a/mlprec/mld_c_gs_solver.f90 b/mlprec/mld_c_gs_solver.f90 index 4940b1e2..3dd8e558 100644 --- a/mlprec/mld_c_gs_solver.f90 +++ b/mlprec/mld_c_gs_solver.f90 @@ -59,6 +59,7 @@ module mld_c_gs_solver type(psb_cspmat_type) :: l, u integer(psb_ipk_) :: sweeps real(psb_spk_) :: eps + real(psb_spk_), allocatable :: xtra(:) contains procedure, pass(sv) :: dump => mld_c_gs_solver_dmp procedure, pass(sv) :: check => c_gs_solver_check @@ -77,6 +78,7 @@ module mld_c_gs_solver procedure, pass(sv) :: default => c_gs_solver_default procedure, pass(sv) :: sizeof => c_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => c_gs_solver_get_nzeros + procedure, pass(sv) :: set_xtra_d => c_gs_solver_set_xtra_d procedure, nopass :: get_wrksz => c_gs_solver_get_wrksize procedure, nopass :: get_fmt => c_gs_solver_get_fmt procedure, nopass :: get_id => c_gs_solver_get_id @@ -585,4 +587,16 @@ contains val = 2 end function c_gs_solver_get_wrksize + + subroutine c_gs_solver_set_xtra_d(sv,d) + implicit none + ! Arguments + class(mld_c_gs_solver_type), intent(inout) :: sv + real(psb_spk_), intent(in) :: d(:) + + sv%xtra = d + + return + end subroutine c_gs_solver_set_xtra_d + end module mld_c_gs_solver diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index 9a56ce6b..4c6162a4 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -112,12 +112,14 @@ module mld_d_base_solver_mod procedure, nopass :: get_id => d_base_solver_get_id procedure, nopass :: is_iterative => d_base_solver_is_iterative procedure, pass(sv) :: is_global => d_base_solver_is_global + procedure, pass(sv) :: set_xtra_d => d_base_solver_set_xtra_d end type mld_d_base_solver_type private :: d_base_solver_sizeof, d_base_solver_default,& & d_base_solver_get_nzeros, d_base_solver_get_fmt, & & d_base_solver_is_iterative, d_base_solver_get_id, & - & d_base_solver_get_wrksize, d_base_solver_is_global + & d_base_solver_get_wrksize, d_base_solver_is_global, & + & d_base_solver_set_xtra_d interface @@ -418,4 +420,14 @@ contains val = 0 end function d_base_solver_get_wrksize + subroutine d_base_solver_set_xtra_d(sv,d) + implicit none + ! Arguments + class(mld_d_base_solver_type), intent(inout) :: sv + real(psb_dpk_), intent(in) :: d(:) + ! Do nothing for base version + + return + end subroutine d_base_solver_set_xtra_d + end module mld_d_base_solver_mod diff --git a/mlprec/mld_d_gs_solver.f90 b/mlprec/mld_d_gs_solver.f90 index 213eab55..cfc250a7 100644 --- a/mlprec/mld_d_gs_solver.f90 +++ b/mlprec/mld_d_gs_solver.f90 @@ -59,6 +59,7 @@ module mld_d_gs_solver type(psb_dspmat_type) :: l, u integer(psb_ipk_) :: sweeps real(psb_dpk_) :: eps + real(psb_dpk_), allocatable :: xtra(:) contains procedure, pass(sv) :: dump => mld_d_gs_solver_dmp procedure, pass(sv) :: check => d_gs_solver_check @@ -77,6 +78,7 @@ module mld_d_gs_solver procedure, pass(sv) :: default => d_gs_solver_default procedure, pass(sv) :: sizeof => d_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => d_gs_solver_get_nzeros + procedure, pass(sv) :: set_xtra_d => d_gs_solver_set_xtra_d procedure, nopass :: get_wrksz => d_gs_solver_get_wrksize procedure, nopass :: get_fmt => d_gs_solver_get_fmt procedure, nopass :: get_id => d_gs_solver_get_id @@ -585,4 +587,16 @@ contains val = 2 end function d_gs_solver_get_wrksize + + subroutine d_gs_solver_set_xtra_d(sv,d) + implicit none + ! Arguments + class(mld_d_gs_solver_type), intent(inout) :: sv + real(psb_dpk_), intent(in) :: d(:) + + sv%xtra = d + + return + end subroutine d_gs_solver_set_xtra_d + end module mld_d_gs_solver diff --git a/mlprec/mld_s_base_solver_mod.f90 b/mlprec/mld_s_base_solver_mod.f90 index 3df02c35..c3bead00 100644 --- a/mlprec/mld_s_base_solver_mod.f90 +++ b/mlprec/mld_s_base_solver_mod.f90 @@ -112,12 +112,14 @@ module mld_s_base_solver_mod procedure, nopass :: get_id => s_base_solver_get_id procedure, nopass :: is_iterative => s_base_solver_is_iterative procedure, pass(sv) :: is_global => s_base_solver_is_global + procedure, pass(sv) :: set_xtra_d => s_base_solver_set_xtra_d end type mld_s_base_solver_type private :: s_base_solver_sizeof, s_base_solver_default,& & s_base_solver_get_nzeros, s_base_solver_get_fmt, & & s_base_solver_is_iterative, s_base_solver_get_id, & - & s_base_solver_get_wrksize, s_base_solver_is_global + & s_base_solver_get_wrksize, s_base_solver_is_global, & + & s_base_solver_set_xtra_d interface @@ -418,4 +420,14 @@ contains val = 0 end function s_base_solver_get_wrksize + subroutine s_base_solver_set_xtra_d(sv,d) + implicit none + ! Arguments + class(mld_s_base_solver_type), intent(inout) :: sv + real(psb_spk_), intent(in) :: d(:) + ! Do nothing for base version + + return + end subroutine s_base_solver_set_xtra_d + end module mld_s_base_solver_mod diff --git a/mlprec/mld_s_gs_solver.f90 b/mlprec/mld_s_gs_solver.f90 index 9059ff58..1cbb2728 100644 --- a/mlprec/mld_s_gs_solver.f90 +++ b/mlprec/mld_s_gs_solver.f90 @@ -59,6 +59,7 @@ module mld_s_gs_solver type(psb_sspmat_type) :: l, u integer(psb_ipk_) :: sweeps real(psb_spk_) :: eps + real(psb_spk_), allocatable :: xtra(:) contains procedure, pass(sv) :: dump => mld_s_gs_solver_dmp procedure, pass(sv) :: check => s_gs_solver_check @@ -77,6 +78,7 @@ module mld_s_gs_solver procedure, pass(sv) :: default => s_gs_solver_default procedure, pass(sv) :: sizeof => s_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => s_gs_solver_get_nzeros + procedure, pass(sv) :: set_xtra_d => s_gs_solver_set_xtra_d procedure, nopass :: get_wrksz => s_gs_solver_get_wrksize procedure, nopass :: get_fmt => s_gs_solver_get_fmt procedure, nopass :: get_id => s_gs_solver_get_id @@ -585,4 +587,16 @@ contains val = 2 end function s_gs_solver_get_wrksize + + subroutine s_gs_solver_set_xtra_d(sv,d) + implicit none + ! Arguments + class(mld_s_gs_solver_type), intent(inout) :: sv + real(psb_spk_), intent(in) :: d(:) + + sv%xtra = d + + return + end subroutine s_gs_solver_set_xtra_d + end module mld_s_gs_solver diff --git a/mlprec/mld_z_base_solver_mod.f90 b/mlprec/mld_z_base_solver_mod.f90 index 3988d97e..18ab9d4e 100644 --- a/mlprec/mld_z_base_solver_mod.f90 +++ b/mlprec/mld_z_base_solver_mod.f90 @@ -112,12 +112,14 @@ module mld_z_base_solver_mod procedure, nopass :: get_id => z_base_solver_get_id procedure, nopass :: is_iterative => z_base_solver_is_iterative procedure, pass(sv) :: is_global => z_base_solver_is_global + procedure, pass(sv) :: set_xtra_d => z_base_solver_set_xtra_d end type mld_z_base_solver_type private :: z_base_solver_sizeof, z_base_solver_default,& & z_base_solver_get_nzeros, z_base_solver_get_fmt, & & z_base_solver_is_iterative, z_base_solver_get_id, & - & z_base_solver_get_wrksize, z_base_solver_is_global + & z_base_solver_get_wrksize, z_base_solver_is_global, & + & z_base_solver_set_xtra_d interface @@ -418,4 +420,14 @@ contains val = 0 end function z_base_solver_get_wrksize + subroutine z_base_solver_set_xtra_d(sv,d) + implicit none + ! Arguments + class(mld_z_base_solver_type), intent(inout) :: sv + real(psb_dpk_), intent(in) :: d(:) + ! Do nothing for base version + + return + end subroutine z_base_solver_set_xtra_d + end module mld_z_base_solver_mod diff --git a/mlprec/mld_z_gs_solver.f90 b/mlprec/mld_z_gs_solver.f90 index b3d3f21c..15ffbec0 100644 --- a/mlprec/mld_z_gs_solver.f90 +++ b/mlprec/mld_z_gs_solver.f90 @@ -59,6 +59,7 @@ module mld_z_gs_solver type(psb_zspmat_type) :: l, u integer(psb_ipk_) :: sweeps real(psb_dpk_) :: eps + real(psb_dpk_), allocatable :: xtra(:) contains procedure, pass(sv) :: dump => mld_z_gs_solver_dmp procedure, pass(sv) :: check => z_gs_solver_check @@ -77,6 +78,7 @@ module mld_z_gs_solver procedure, pass(sv) :: default => z_gs_solver_default procedure, pass(sv) :: sizeof => z_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => z_gs_solver_get_nzeros + procedure, pass(sv) :: set_xtra_d => z_gs_solver_set_xtra_d procedure, nopass :: get_wrksz => z_gs_solver_get_wrksize procedure, nopass :: get_fmt => z_gs_solver_get_fmt procedure, nopass :: get_id => z_gs_solver_get_id @@ -585,4 +587,16 @@ contains val = 2 end function z_gs_solver_get_wrksize + + subroutine z_gs_solver_set_xtra_d(sv,d) + implicit none + ! Arguments + class(mld_z_gs_solver_type), intent(inout) :: sv + real(psb_dpk_), intent(in) :: d(:) + + sv%xtra = d + + return + end subroutine z_gs_solver_set_xtra_d + end module mld_z_gs_solver From adc5aebd6b4e9d20345d43eac920e0f3f51a8c24 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 27 May 2020 10:50:06 +0200 Subject: [PATCH 2/8] In L1-GS only add nonzero D1 entries. --- mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 | 22 +++++++++++++------- mlprec/impl/solver/mld_c_gs_solver_bld.f90 | 22 +++++++++++++------- mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 | 22 +++++++++++++------- mlprec/impl/solver/mld_d_gs_solver_bld.f90 | 22 +++++++++++++------- mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 | 22 +++++++++++++------- mlprec/impl/solver/mld_s_gs_solver_bld.f90 | 22 +++++++++++++------- mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 | 22 +++++++++++++------- mlprec/impl/solver/mld_z_gs_solver_bld.f90 | 22 +++++++++++++------- 8 files changed, 112 insertions(+), 64 deletions(-) diff --git a/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 index 9e5427b1..6e95e810 100644 --- a/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 @@ -95,11 +95,14 @@ subroutine mld_c_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = -sv%xtra(k) + if (sv%xtra(k) /= szero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = -sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%l%mv_from(tcoo) @@ -109,11 +112,14 @@ subroutine mld_c_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = sv%xtra(k) + if (sv%xtra(k) /= szero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%u%mv_from(tcoo) end block diff --git a/mlprec/impl/solver/mld_c_gs_solver_bld.f90 b/mlprec/impl/solver/mld_c_gs_solver_bld.f90 index babca9be..44ef6238 100644 --- a/mlprec/impl/solver/mld_c_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_gs_solver_bld.f90 @@ -93,11 +93,14 @@ subroutine mld_c_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = sv%xtra(k) + if (sv%xtra(k) /= szero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%l%mv_from(tcoo) @@ -107,11 +110,14 @@ subroutine mld_c_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = -sv%xtra(k) + if (sv%xtra(k) /= szero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = -sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%u%mv_from(tcoo) end block diff --git a/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 index 3001c937..be169157 100644 --- a/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 @@ -95,11 +95,14 @@ subroutine mld_d_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = -sv%xtra(k) + if (sv%xtra(k) /= dzero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = -sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%l%mv_from(tcoo) @@ -109,11 +112,14 @@ subroutine mld_d_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = sv%xtra(k) + if (sv%xtra(k) /= dzero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%u%mv_from(tcoo) end block diff --git a/mlprec/impl/solver/mld_d_gs_solver_bld.f90 b/mlprec/impl/solver/mld_d_gs_solver_bld.f90 index 510e33ae..86863a78 100644 --- a/mlprec/impl/solver/mld_d_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_gs_solver_bld.f90 @@ -93,11 +93,14 @@ subroutine mld_d_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = sv%xtra(k) + if (sv%xtra(k) /= dzero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%l%mv_from(tcoo) @@ -107,11 +110,14 @@ subroutine mld_d_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = -sv%xtra(k) + if (sv%xtra(k) /= dzero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = -sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%u%mv_from(tcoo) end block diff --git a/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 index cf68ac5b..2da1aadc 100644 --- a/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 @@ -95,11 +95,14 @@ subroutine mld_s_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = -sv%xtra(k) + if (sv%xtra(k) /= szero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = -sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%l%mv_from(tcoo) @@ -109,11 +112,14 @@ subroutine mld_s_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = sv%xtra(k) + if (sv%xtra(k) /= szero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%u%mv_from(tcoo) end block diff --git a/mlprec/impl/solver/mld_s_gs_solver_bld.f90 b/mlprec/impl/solver/mld_s_gs_solver_bld.f90 index 086136b1..476dd245 100644 --- a/mlprec/impl/solver/mld_s_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_gs_solver_bld.f90 @@ -93,11 +93,14 @@ subroutine mld_s_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = sv%xtra(k) + if (sv%xtra(k) /= szero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%l%mv_from(tcoo) @@ -107,11 +110,14 @@ subroutine mld_s_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = -sv%xtra(k) + if (sv%xtra(k) /= szero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = -sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%u%mv_from(tcoo) end block diff --git a/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 index 7e58bb27..f763219d 100644 --- a/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 @@ -95,11 +95,14 @@ subroutine mld_z_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = -sv%xtra(k) + if (sv%xtra(k) /= dzero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = -sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%l%mv_from(tcoo) @@ -109,11 +112,14 @@ subroutine mld_z_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = sv%xtra(k) + if (sv%xtra(k) /= dzero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%u%mv_from(tcoo) end block diff --git a/mlprec/impl/solver/mld_z_gs_solver_bld.f90 b/mlprec/impl/solver/mld_z_gs_solver_bld.f90 index 5403ac44..ed249b38 100644 --- a/mlprec/impl/solver/mld_z_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_gs_solver_bld.f90 @@ -93,11 +93,14 @@ subroutine mld_z_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = sv%xtra(k) + if (sv%xtra(k) /= dzero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%l%mv_from(tcoo) @@ -107,11 +110,14 @@ subroutine mld_z_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call tcoo%ensure_size(nz+nrm) call tcoo%set_dupl(psb_dupl_add_) do k=1,nrm - tcoo%ia(nz+k) = k - tcoo%ja(nz+k) = k - tcoo%val(nz+k) = -sv%xtra(k) + if (sv%xtra(k) /= dzero) then + nz = nz + 1 + tcoo%ia(nz) = k + tcoo%ja(nz) = k + tcoo%val(nz) = -sv%xtra(k) + end if end do - call tcoo%set_nzeros(nz+nrm) + call tcoo%set_nzeros(nz) call tcoo%fix(info) call sv%u%mv_from(tcoo) end block From d249042ea28978f9d86a72aea2bf46ccf4509054 Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Wed, 27 May 2020 14:58:40 +0200 Subject: [PATCH 3/8] Modified implementation for residual check/print --- .../smoother/mld_c_jac_smoother_clone.f90 | 35 ++++++++++-------- .../smoother/mld_c_jac_smoother_csetc.f90 | 37 +++++++++++-------- .../smoother/mld_d_jac_smoother_clone.f90 | 35 ++++++++++-------- .../smoother/mld_d_jac_smoother_csetc.f90 | 37 +++++++++++-------- .../smoother/mld_s_jac_smoother_clone.f90 | 35 ++++++++++-------- .../smoother/mld_s_jac_smoother_csetc.f90 | 37 +++++++++++-------- .../smoother/mld_z_jac_smoother_clone.f90 | 35 ++++++++++-------- .../smoother/mld_z_jac_smoother_csetc.f90 | 37 +++++++++++-------- 8 files changed, 164 insertions(+), 124 deletions(-) diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_clone.f90 index 74bb5769..f17f50a6 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_clone.f90 +++ b/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) diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90 index 87072c88..b021e074 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90 +++ b/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 diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_clone.f90 index 74e75f07..caa88534 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_clone.f90 +++ b/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) diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90 index 647a80cf..aba40147 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90 +++ b/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 diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_clone.f90 index e311a601..a0b6c349 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_clone.f90 +++ b/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) diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90 index 154e4cc9..4f88efbd 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90 +++ b/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 diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_clone.f90 index 19eeacda..5e2b54f8 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_clone.f90 +++ b/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) diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90 index 1867df87..9e9cc0f9 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90 +++ b/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 From 7fe0eb85802e96f460ff4350a1d2103177c54e33 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 27 May 2020 17:31:09 +0200 Subject: [PATCH 4/8] New L1-JAC implementation. --- .../smoother/mld_c_l1_jac_smoother_bld.f90 | 57 +++++++++++++++---- .../smoother/mld_d_l1_jac_smoother_bld.f90 | 57 +++++++++++++++---- .../smoother/mld_s_l1_jac_smoother_bld.f90 | 57 +++++++++++++++---- .../smoother/mld_z_l1_jac_smoother_bld.f90 | 57 +++++++++++++++---- 4 files changed, 188 insertions(+), 40 deletions(-) diff --git a/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 index db6582ed..bc547907 100644 --- a/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 @@ -53,10 +53,8 @@ subroutine mld_c_l1_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_), allocatable :: arwsum(:) - type(psb_c_coo_sparse_mat) :: tmpcoo - type(psb_c_csr_sparse_mat) :: tmpcsr type(psb_cspmat_type) :: tmpa - integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level, nz + 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_ @@ -94,8 +92,23 @@ subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) 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,& @@ -105,13 +118,6 @@ subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) & type='csr',dupl=psb_dupl_add_) endif end if - sm%nd_nnz_tot = sm%nd%get_nzeros() - call psb_sum(ictxt,sm%nd_nnz_tot) - arwsum = sm%nd%arwsum(info) - if (info == 0) call sm%sv%set_xtra_d(arwsum) - 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 @@ -135,5 +141,36 @@ subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) 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 diff --git a/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 index 149a34c0..c52a7a21 100644 --- a/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 @@ -53,10 +53,8 @@ subroutine mld_d_l1_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_), allocatable :: arwsum(:) - type(psb_d_coo_sparse_mat) :: tmpcoo - type(psb_d_csr_sparse_mat) :: tmpcsr type(psb_dspmat_type) :: tmpa - integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level, nz + 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_ @@ -94,8 +92,23 @@ subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) 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,& @@ -105,13 +118,6 @@ subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) & type='csr',dupl=psb_dupl_add_) endif end if - sm%nd_nnz_tot = sm%nd%get_nzeros() - call psb_sum(ictxt,sm%nd_nnz_tot) - arwsum = sm%nd%arwsum(info) - if (info == 0) call sm%sv%set_xtra_d(arwsum) - 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 @@ -135,5 +141,36 @@ subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) 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 diff --git a/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 index 36abf0e5..02ac842d 100644 --- a/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 @@ -53,10 +53,8 @@ subroutine mld_s_l1_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_), allocatable :: arwsum(:) - type(psb_s_coo_sparse_mat) :: tmpcoo - type(psb_s_csr_sparse_mat) :: tmpcsr type(psb_sspmat_type) :: tmpa - integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level, nz + 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_ @@ -94,8 +92,23 @@ subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) 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,& @@ -105,13 +118,6 @@ subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) & type='csr',dupl=psb_dupl_add_) endif end if - sm%nd_nnz_tot = sm%nd%get_nzeros() - call psb_sum(ictxt,sm%nd_nnz_tot) - arwsum = sm%nd%arwsum(info) - if (info == 0) call sm%sv%set_xtra_d(arwsum) - 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 @@ -135,5 +141,36 @@ subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) 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 diff --git a/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 index a0ccd4c6..e52854fc 100644 --- a/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 @@ -53,10 +53,8 @@ subroutine mld_z_l1_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_), allocatable :: arwsum(:) - type(psb_z_coo_sparse_mat) :: tmpcoo - type(psb_z_csr_sparse_mat) :: tmpcsr type(psb_zspmat_type) :: tmpa - integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level, nz + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level character(len=20) :: name='z_l1_jac_smoother_bld', ch_err info=psb_success_ @@ -94,8 +92,23 @@ subroutine mld_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) 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,& @@ -105,13 +118,6 @@ subroutine mld_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) & type='csr',dupl=psb_dupl_add_) endif end if - sm%nd_nnz_tot = sm%nd%get_nzeros() - call psb_sum(ictxt,sm%nd_nnz_tot) - arwsum = sm%nd%arwsum(info) - if (info == 0) call sm%sv%set_xtra_d(arwsum) - 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 @@ -135,5 +141,36 @@ subroutine mld_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) 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_zspmat_type), intent(inout) :: mat + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: k, nz, nrm, dp + type(psb_z_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_z_l1_jac_smoother_bld From 6259514cd1a961848edb6cb5b2996ec63d3020c1 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 28 May 2020 10:48:01 +0200 Subject: [PATCH 5/8] Remove temporary implementation of L1 --- .../smoother/mld_c_l1_jac_smoother_bld.f90 | 2 +- .../smoother/mld_d_l1_jac_smoother_bld.f90 | 2 +- .../smoother/mld_s_l1_jac_smoother_bld.f90 | 2 +- .../smoother/mld_z_l1_jac_smoother_bld.f90 | 2 +- mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 | 50 +------------------ mlprec/impl/solver/mld_c_gs_solver_bld.f90 | 45 ----------------- mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 | 50 +------------------ mlprec/impl/solver/mld_d_gs_solver_bld.f90 | 45 ----------------- mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 | 50 +------------------ mlprec/impl/solver/mld_s_gs_solver_bld.f90 | 45 ----------------- mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 | 50 +------------------ mlprec/impl/solver/mld_z_gs_solver_bld.f90 | 45 ----------------- mlprec/mld_c_base_solver_mod.f90 | 14 +----- mlprec/mld_c_gs_solver.f90 | 14 ------ mlprec/mld_d_base_solver_mod.f90 | 14 +----- mlprec/mld_d_gs_solver.f90 | 14 ------ mlprec/mld_s_base_solver_mod.f90 | 14 +----- mlprec/mld_s_gs_solver.f90 | 14 ------ mlprec/mld_z_base_solver_mod.f90 | 14 +----- mlprec/mld_z_gs_solver.f90 | 14 ------ 20 files changed, 16 insertions(+), 484 deletions(-) diff --git a/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 index bc547907..2c27b0e7 100644 --- a/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90 @@ -156,7 +156,7 @@ contains 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 +!!$ 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 diff --git a/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 index c52a7a21..efa5932c 100644 --- a/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90 @@ -156,7 +156,7 @@ contains 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 +!!$ 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 diff --git a/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 index 02ac842d..116a01e1 100644 --- a/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90 @@ -156,7 +156,7 @@ contains 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 +!!$ 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 diff --git a/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 index e52854fc..9a467f9e 100644 --- a/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90 @@ -156,7 +156,7 @@ contains 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 +!!$ 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 diff --git a/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 index 6e95e810..4771eee2 100644 --- a/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_bwgs_solver_bld.f90 @@ -70,60 +70,14 @@ subroutine mld_c_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) nrow_a = a%get_nrows() nztota = a%get_nzeros() -!!$ if (present(b)) then -!!$ nztota = nztota + b%get_nzeros() -!!$ end if + if (sv%eps <= dzero) then ! ! This cuts out the off-diagonal part, because it's supposed to ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=-ione,jmax=nrow_a,u=sv%u) - ! - ! Is this an L1-GS solver? - ! - if (allocated(sv%xtra)) then - block - integer(psb_ipk_) :: k, nz, nrm - type(psb_c_coo_sparse_mat) :: tcoo - ! - ! For BWGS: LX = L - D, UX = U + D - ! - call sv%l%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= szero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = -sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%l%mv_from(tcoo) - - call sv%u%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= szero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%u%mv_from(tcoo) - end block - end if + else info = psb_err_missing_override_method_ diff --git a/mlprec/impl/solver/mld_c_gs_solver_bld.f90 b/mlprec/impl/solver/mld_c_gs_solver_bld.f90 index 44ef6238..37117275 100644 --- a/mlprec/impl/solver/mld_c_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_gs_solver_bld.f90 @@ -77,51 +77,6 @@ subroutine mld_c_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=izero,jmax=nrow_a,u=sv%u) - ! - ! Is this an L1-GS solver? - ! - if (allocated(sv%xtra)) then - block - integer(psb_ipk_) :: k, nz, nrm, dp - type(psb_c_coo_sparse_mat) :: tcoo - ! - ! For GS: LX = L + D, UX = U - D - ! - call sv%l%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= szero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%l%mv_from(tcoo) - - call sv%u%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= szero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = -sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%u%mv_from(tcoo) - end block - end if else diff --git a/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 index be169157..decea6b1 100644 --- a/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_bwgs_solver_bld.f90 @@ -70,60 +70,14 @@ subroutine mld_d_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) nrow_a = a%get_nrows() nztota = a%get_nzeros() -!!$ if (present(b)) then -!!$ nztota = nztota + b%get_nzeros() -!!$ end if + if (sv%eps <= dzero) then ! ! This cuts out the off-diagonal part, because it's supposed to ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=-ione,jmax=nrow_a,u=sv%u) - ! - ! Is this an L1-GS solver? - ! - if (allocated(sv%xtra)) then - block - integer(psb_ipk_) :: k, nz, nrm - type(psb_d_coo_sparse_mat) :: tcoo - ! - ! For BWGS: LX = L - D, UX = U + D - ! - call sv%l%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= dzero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = -sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%l%mv_from(tcoo) - - call sv%u%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= dzero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%u%mv_from(tcoo) - end block - end if + else info = psb_err_missing_override_method_ diff --git a/mlprec/impl/solver/mld_d_gs_solver_bld.f90 b/mlprec/impl/solver/mld_d_gs_solver_bld.f90 index 86863a78..5357d294 100644 --- a/mlprec/impl/solver/mld_d_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_gs_solver_bld.f90 @@ -77,51 +77,6 @@ subroutine mld_d_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=izero,jmax=nrow_a,u=sv%u) - ! - ! Is this an L1-GS solver? - ! - if (allocated(sv%xtra)) then - block - integer(psb_ipk_) :: k, nz, nrm, dp - type(psb_d_coo_sparse_mat) :: tcoo - ! - ! For GS: LX = L + D, UX = U - D - ! - call sv%l%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= dzero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%l%mv_from(tcoo) - - call sv%u%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= dzero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = -sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%u%mv_from(tcoo) - end block - end if else diff --git a/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 index 2da1aadc..fe682caa 100644 --- a/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_bwgs_solver_bld.f90 @@ -70,60 +70,14 @@ subroutine mld_s_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) nrow_a = a%get_nrows() nztota = a%get_nzeros() -!!$ if (present(b)) then -!!$ nztota = nztota + b%get_nzeros() -!!$ end if + if (sv%eps <= dzero) then ! ! This cuts out the off-diagonal part, because it's supposed to ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=-ione,jmax=nrow_a,u=sv%u) - ! - ! Is this an L1-GS solver? - ! - if (allocated(sv%xtra)) then - block - integer(psb_ipk_) :: k, nz, nrm - type(psb_s_coo_sparse_mat) :: tcoo - ! - ! For BWGS: LX = L - D, UX = U + D - ! - call sv%l%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= szero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = -sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%l%mv_from(tcoo) - - call sv%u%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= szero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%u%mv_from(tcoo) - end block - end if + else info = psb_err_missing_override_method_ diff --git a/mlprec/impl/solver/mld_s_gs_solver_bld.f90 b/mlprec/impl/solver/mld_s_gs_solver_bld.f90 index 476dd245..d6e07ac0 100644 --- a/mlprec/impl/solver/mld_s_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_gs_solver_bld.f90 @@ -77,51 +77,6 @@ subroutine mld_s_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=izero,jmax=nrow_a,u=sv%u) - ! - ! Is this an L1-GS solver? - ! - if (allocated(sv%xtra)) then - block - integer(psb_ipk_) :: k, nz, nrm, dp - type(psb_s_coo_sparse_mat) :: tcoo - ! - ! For GS: LX = L + D, UX = U - D - ! - call sv%l%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= szero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%l%mv_from(tcoo) - - call sv%u%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= szero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = -sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%u%mv_from(tcoo) - end block - end if else diff --git a/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 b/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 index f763219d..28f9e404 100644 --- a/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_bwgs_solver_bld.f90 @@ -70,60 +70,14 @@ subroutine mld_z_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) nrow_a = a%get_nrows() nztota = a%get_nzeros() -!!$ if (present(b)) then -!!$ nztota = nztota + b%get_nzeros() -!!$ end if + if (sv%eps <= dzero) then ! ! This cuts out the off-diagonal part, because it's supposed to ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=-ione,jmax=nrow_a,u=sv%u) - ! - ! Is this an L1-GS solver? - ! - if (allocated(sv%xtra)) then - block - integer(psb_ipk_) :: k, nz, nrm - type(psb_z_coo_sparse_mat) :: tcoo - ! - ! For BWGS: LX = L - D, UX = U + D - ! - call sv%l%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= dzero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = -sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%l%mv_from(tcoo) - - call sv%u%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= dzero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%u%mv_from(tcoo) - end block - end if + else info = psb_err_missing_override_method_ diff --git a/mlprec/impl/solver/mld_z_gs_solver_bld.f90 b/mlprec/impl/solver/mld_z_gs_solver_bld.f90 index ed249b38..dad76c87 100644 --- a/mlprec/impl/solver/mld_z_gs_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_gs_solver_bld.f90 @@ -77,51 +77,6 @@ subroutine mld_z_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! be handled by the outer Jacobi smoother. ! call a%tril(sv%l,info,diag=izero,jmax=nrow_a,u=sv%u) - ! - ! Is this an L1-GS solver? - ! - if (allocated(sv%xtra)) then - block - integer(psb_ipk_) :: k, nz, nrm, dp - type(psb_z_coo_sparse_mat) :: tcoo - ! - ! For GS: LX = L + D, UX = U - D - ! - call sv%l%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= dzero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%l%mv_from(tcoo) - - call sv%u%mv_to(tcoo) - nrm = min(psb_size(sv%xtra),tcoo%get_nrows(),tcoo%get_ncols()) - nz = tcoo%get_nzeros() - call tcoo%ensure_size(nz+nrm) - call tcoo%set_dupl(psb_dupl_add_) - do k=1,nrm - if (sv%xtra(k) /= dzero) then - nz = nz + 1 - tcoo%ia(nz) = k - tcoo%ja(nz) = k - tcoo%val(nz) = -sv%xtra(k) - end if - end do - call tcoo%set_nzeros(nz) - call tcoo%fix(info) - call sv%u%mv_from(tcoo) - end block - end if else diff --git a/mlprec/mld_c_base_solver_mod.f90 b/mlprec/mld_c_base_solver_mod.f90 index 6f787086..bc250976 100644 --- a/mlprec/mld_c_base_solver_mod.f90 +++ b/mlprec/mld_c_base_solver_mod.f90 @@ -112,14 +112,12 @@ module mld_c_base_solver_mod procedure, nopass :: get_id => c_base_solver_get_id procedure, nopass :: is_iterative => c_base_solver_is_iterative procedure, pass(sv) :: is_global => c_base_solver_is_global - procedure, pass(sv) :: set_xtra_d => c_base_solver_set_xtra_d end type mld_c_base_solver_type private :: c_base_solver_sizeof, c_base_solver_default,& & c_base_solver_get_nzeros, c_base_solver_get_fmt, & & c_base_solver_is_iterative, c_base_solver_get_id, & - & c_base_solver_get_wrksize, c_base_solver_is_global, & - & c_base_solver_set_xtra_d + & c_base_solver_get_wrksize, c_base_solver_is_global interface @@ -420,14 +418,4 @@ contains val = 0 end function c_base_solver_get_wrksize - subroutine c_base_solver_set_xtra_d(sv,d) - implicit none - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - real(psb_spk_), intent(in) :: d(:) - ! Do nothing for base version - - return - end subroutine c_base_solver_set_xtra_d - end module mld_c_base_solver_mod diff --git a/mlprec/mld_c_gs_solver.f90 b/mlprec/mld_c_gs_solver.f90 index 3dd8e558..4940b1e2 100644 --- a/mlprec/mld_c_gs_solver.f90 +++ b/mlprec/mld_c_gs_solver.f90 @@ -59,7 +59,6 @@ module mld_c_gs_solver type(psb_cspmat_type) :: l, u integer(psb_ipk_) :: sweeps real(psb_spk_) :: eps - real(psb_spk_), allocatable :: xtra(:) contains procedure, pass(sv) :: dump => mld_c_gs_solver_dmp procedure, pass(sv) :: check => c_gs_solver_check @@ -78,7 +77,6 @@ module mld_c_gs_solver procedure, pass(sv) :: default => c_gs_solver_default procedure, pass(sv) :: sizeof => c_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => c_gs_solver_get_nzeros - procedure, pass(sv) :: set_xtra_d => c_gs_solver_set_xtra_d procedure, nopass :: get_wrksz => c_gs_solver_get_wrksize procedure, nopass :: get_fmt => c_gs_solver_get_fmt procedure, nopass :: get_id => c_gs_solver_get_id @@ -587,16 +585,4 @@ contains val = 2 end function c_gs_solver_get_wrksize - - subroutine c_gs_solver_set_xtra_d(sv,d) - implicit none - ! Arguments - class(mld_c_gs_solver_type), intent(inout) :: sv - real(psb_spk_), intent(in) :: d(:) - - sv%xtra = d - - return - end subroutine c_gs_solver_set_xtra_d - end module mld_c_gs_solver diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index 4c6162a4..9a56ce6b 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -112,14 +112,12 @@ module mld_d_base_solver_mod procedure, nopass :: get_id => d_base_solver_get_id procedure, nopass :: is_iterative => d_base_solver_is_iterative procedure, pass(sv) :: is_global => d_base_solver_is_global - procedure, pass(sv) :: set_xtra_d => d_base_solver_set_xtra_d end type mld_d_base_solver_type private :: d_base_solver_sizeof, d_base_solver_default,& & d_base_solver_get_nzeros, d_base_solver_get_fmt, & & d_base_solver_is_iterative, d_base_solver_get_id, & - & d_base_solver_get_wrksize, d_base_solver_is_global, & - & d_base_solver_set_xtra_d + & d_base_solver_get_wrksize, d_base_solver_is_global interface @@ -420,14 +418,4 @@ contains val = 0 end function d_base_solver_get_wrksize - subroutine d_base_solver_set_xtra_d(sv,d) - implicit none - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - real(psb_dpk_), intent(in) :: d(:) - ! Do nothing for base version - - return - end subroutine d_base_solver_set_xtra_d - end module mld_d_base_solver_mod diff --git a/mlprec/mld_d_gs_solver.f90 b/mlprec/mld_d_gs_solver.f90 index cfc250a7..213eab55 100644 --- a/mlprec/mld_d_gs_solver.f90 +++ b/mlprec/mld_d_gs_solver.f90 @@ -59,7 +59,6 @@ module mld_d_gs_solver type(psb_dspmat_type) :: l, u integer(psb_ipk_) :: sweeps real(psb_dpk_) :: eps - real(psb_dpk_), allocatable :: xtra(:) contains procedure, pass(sv) :: dump => mld_d_gs_solver_dmp procedure, pass(sv) :: check => d_gs_solver_check @@ -78,7 +77,6 @@ module mld_d_gs_solver procedure, pass(sv) :: default => d_gs_solver_default procedure, pass(sv) :: sizeof => d_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => d_gs_solver_get_nzeros - procedure, pass(sv) :: set_xtra_d => d_gs_solver_set_xtra_d procedure, nopass :: get_wrksz => d_gs_solver_get_wrksize procedure, nopass :: get_fmt => d_gs_solver_get_fmt procedure, nopass :: get_id => d_gs_solver_get_id @@ -587,16 +585,4 @@ contains val = 2 end function d_gs_solver_get_wrksize - - subroutine d_gs_solver_set_xtra_d(sv,d) - implicit none - ! Arguments - class(mld_d_gs_solver_type), intent(inout) :: sv - real(psb_dpk_), intent(in) :: d(:) - - sv%xtra = d - - return - end subroutine d_gs_solver_set_xtra_d - end module mld_d_gs_solver diff --git a/mlprec/mld_s_base_solver_mod.f90 b/mlprec/mld_s_base_solver_mod.f90 index c3bead00..3df02c35 100644 --- a/mlprec/mld_s_base_solver_mod.f90 +++ b/mlprec/mld_s_base_solver_mod.f90 @@ -112,14 +112,12 @@ module mld_s_base_solver_mod procedure, nopass :: get_id => s_base_solver_get_id procedure, nopass :: is_iterative => s_base_solver_is_iterative procedure, pass(sv) :: is_global => s_base_solver_is_global - procedure, pass(sv) :: set_xtra_d => s_base_solver_set_xtra_d end type mld_s_base_solver_type private :: s_base_solver_sizeof, s_base_solver_default,& & s_base_solver_get_nzeros, s_base_solver_get_fmt, & & s_base_solver_is_iterative, s_base_solver_get_id, & - & s_base_solver_get_wrksize, s_base_solver_is_global, & - & s_base_solver_set_xtra_d + & s_base_solver_get_wrksize, s_base_solver_is_global interface @@ -420,14 +418,4 @@ contains val = 0 end function s_base_solver_get_wrksize - subroutine s_base_solver_set_xtra_d(sv,d) - implicit none - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - real(psb_spk_), intent(in) :: d(:) - ! Do nothing for base version - - return - end subroutine s_base_solver_set_xtra_d - end module mld_s_base_solver_mod diff --git a/mlprec/mld_s_gs_solver.f90 b/mlprec/mld_s_gs_solver.f90 index 1cbb2728..9059ff58 100644 --- a/mlprec/mld_s_gs_solver.f90 +++ b/mlprec/mld_s_gs_solver.f90 @@ -59,7 +59,6 @@ module mld_s_gs_solver type(psb_sspmat_type) :: l, u integer(psb_ipk_) :: sweeps real(psb_spk_) :: eps - real(psb_spk_), allocatable :: xtra(:) contains procedure, pass(sv) :: dump => mld_s_gs_solver_dmp procedure, pass(sv) :: check => s_gs_solver_check @@ -78,7 +77,6 @@ module mld_s_gs_solver procedure, pass(sv) :: default => s_gs_solver_default procedure, pass(sv) :: sizeof => s_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => s_gs_solver_get_nzeros - procedure, pass(sv) :: set_xtra_d => s_gs_solver_set_xtra_d procedure, nopass :: get_wrksz => s_gs_solver_get_wrksize procedure, nopass :: get_fmt => s_gs_solver_get_fmt procedure, nopass :: get_id => s_gs_solver_get_id @@ -587,16 +585,4 @@ contains val = 2 end function s_gs_solver_get_wrksize - - subroutine s_gs_solver_set_xtra_d(sv,d) - implicit none - ! Arguments - class(mld_s_gs_solver_type), intent(inout) :: sv - real(psb_spk_), intent(in) :: d(:) - - sv%xtra = d - - return - end subroutine s_gs_solver_set_xtra_d - end module mld_s_gs_solver diff --git a/mlprec/mld_z_base_solver_mod.f90 b/mlprec/mld_z_base_solver_mod.f90 index 18ab9d4e..3988d97e 100644 --- a/mlprec/mld_z_base_solver_mod.f90 +++ b/mlprec/mld_z_base_solver_mod.f90 @@ -112,14 +112,12 @@ module mld_z_base_solver_mod procedure, nopass :: get_id => z_base_solver_get_id procedure, nopass :: is_iterative => z_base_solver_is_iterative procedure, pass(sv) :: is_global => z_base_solver_is_global - procedure, pass(sv) :: set_xtra_d => z_base_solver_set_xtra_d end type mld_z_base_solver_type private :: z_base_solver_sizeof, z_base_solver_default,& & z_base_solver_get_nzeros, z_base_solver_get_fmt, & & z_base_solver_is_iterative, z_base_solver_get_id, & - & z_base_solver_get_wrksize, z_base_solver_is_global, & - & z_base_solver_set_xtra_d + & z_base_solver_get_wrksize, z_base_solver_is_global interface @@ -420,14 +418,4 @@ contains val = 0 end function z_base_solver_get_wrksize - subroutine z_base_solver_set_xtra_d(sv,d) - implicit none - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - real(psb_dpk_), intent(in) :: d(:) - ! Do nothing for base version - - return - end subroutine z_base_solver_set_xtra_d - end module mld_z_base_solver_mod diff --git a/mlprec/mld_z_gs_solver.f90 b/mlprec/mld_z_gs_solver.f90 index 15ffbec0..b3d3f21c 100644 --- a/mlprec/mld_z_gs_solver.f90 +++ b/mlprec/mld_z_gs_solver.f90 @@ -59,7 +59,6 @@ module mld_z_gs_solver type(psb_zspmat_type) :: l, u integer(psb_ipk_) :: sweeps real(psb_dpk_) :: eps - real(psb_dpk_), allocatable :: xtra(:) contains procedure, pass(sv) :: dump => mld_z_gs_solver_dmp procedure, pass(sv) :: check => z_gs_solver_check @@ -78,7 +77,6 @@ module mld_z_gs_solver procedure, pass(sv) :: default => z_gs_solver_default procedure, pass(sv) :: sizeof => z_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => z_gs_solver_get_nzeros - procedure, pass(sv) :: set_xtra_d => z_gs_solver_set_xtra_d procedure, nopass :: get_wrksz => z_gs_solver_get_wrksize procedure, nopass :: get_fmt => z_gs_solver_get_fmt procedure, nopass :: get_id => z_gs_solver_get_id @@ -587,16 +585,4 @@ contains val = 2 end function z_gs_solver_get_wrksize - - subroutine z_gs_solver_set_xtra_d(sv,d) - implicit none - ! Arguments - class(mld_z_gs_solver_type), intent(inout) :: sv - real(psb_dpk_), intent(in) :: d(:) - - sv%xtra = d - - return - end subroutine z_gs_solver_set_xtra_d - end module mld_z_gs_solver From 9c95835ed5f8d667be4fff076d4998a177c09eeb Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 28 May 2020 13:12:17 +0200 Subject: [PATCH 6/8] Fix clone for L1_JAC --- mlprec/impl/smoother/mld_c_l1_jac_smoother_clone.f90 | 5 +++++ mlprec/impl/smoother/mld_d_l1_jac_smoother_clone.f90 | 5 +++++ mlprec/impl/smoother/mld_s_l1_jac_smoother_clone.f90 | 5 +++++ mlprec/impl/smoother/mld_z_l1_jac_smoother_clone.f90 | 5 +++++ 4 files changed, 20 insertions(+) diff --git a/mlprec/impl/smoother/mld_c_l1_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_c_l1_jac_smoother_clone.f90 index cbd80b81..3e6d38b0 100644 --- a/mlprec/impl/smoother/mld_c_l1_jac_smoother_clone.f90 +++ b/mlprec/impl/smoother/mld_c_l1_jac_smoother_clone.f90 @@ -67,6 +67,11 @@ subroutine mld_c_l1_jac_smoother_clone(sm,smout,info) 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) diff --git a/mlprec/impl/smoother/mld_d_l1_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_d_l1_jac_smoother_clone.f90 index 3ecf3ee3..b2237d5c 100644 --- a/mlprec/impl/smoother/mld_d_l1_jac_smoother_clone.f90 +++ b/mlprec/impl/smoother/mld_d_l1_jac_smoother_clone.f90 @@ -67,6 +67,11 @@ subroutine mld_d_l1_jac_smoother_clone(sm,smout,info) 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) diff --git a/mlprec/impl/smoother/mld_s_l1_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_s_l1_jac_smoother_clone.f90 index d15baa85..fefcbaaf 100644 --- a/mlprec/impl/smoother/mld_s_l1_jac_smoother_clone.f90 +++ b/mlprec/impl/smoother/mld_s_l1_jac_smoother_clone.f90 @@ -67,6 +67,11 @@ subroutine mld_s_l1_jac_smoother_clone(sm,smout,info) 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) diff --git a/mlprec/impl/smoother/mld_z_l1_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_z_l1_jac_smoother_clone.f90 index 02e83d99..c83a8a5f 100644 --- a/mlprec/impl/smoother/mld_z_l1_jac_smoother_clone.f90 +++ b/mlprec/impl/smoother/mld_z_l1_jac_smoother_clone.f90 @@ -67,6 +67,11 @@ subroutine mld_z_l1_jac_smoother_clone(sm,smout,info) select type(smo => smout) type is (mld_z_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) From 2894a0944bea4032e6b6b3f6ddf09f4cfbea0c99 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 28 May 2020 17:50:37 +0200 Subject: [PATCH 7/8] Implement global_num for smoother%dmp. --- mlprec/impl/level/mld_c_base_onelev_dump.f90 | 8 ++--- mlprec/impl/level/mld_d_base_onelev_dump.f90 | 8 ++--- mlprec/impl/level/mld_s_base_onelev_dump.f90 | 8 ++--- mlprec/impl/level/mld_z_base_onelev_dump.f90 | 8 ++--- .../impl/smoother/mld_c_as_smoother_dmp.f90 | 22 +++++++++----- .../impl/smoother/mld_c_base_smoother_dmp.f90 | 18 ++++++++---- .../impl/smoother/mld_c_jac_smoother_dmp.f90 | 29 ++++++++++++++----- .../impl/smoother/mld_d_as_smoother_dmp.f90 | 22 +++++++++----- .../impl/smoother/mld_d_base_smoother_dmp.f90 | 18 ++++++++---- .../impl/smoother/mld_d_jac_smoother_dmp.f90 | 29 ++++++++++++++----- .../impl/smoother/mld_s_as_smoother_dmp.f90 | 22 +++++++++----- .../impl/smoother/mld_s_base_smoother_dmp.f90 | 18 ++++++++---- .../impl/smoother/mld_s_jac_smoother_dmp.f90 | 29 ++++++++++++++----- .../impl/smoother/mld_z_as_smoother_dmp.f90 | 22 +++++++++----- .../impl/smoother/mld_z_base_smoother_dmp.f90 | 18 ++++++++---- .../impl/smoother/mld_z_jac_smoother_dmp.f90 | 29 ++++++++++++++----- mlprec/mld_c_as_smoother.f90 | 6 ++-- mlprec/mld_c_base_smoother_mod.f90 | 6 ++-- mlprec/mld_c_jac_smoother.f90 | 6 ++-- mlprec/mld_d_as_smoother.f90 | 6 ++-- mlprec/mld_d_base_smoother_mod.f90 | 6 ++-- mlprec/mld_d_jac_smoother.f90 | 6 ++-- mlprec/mld_s_as_smoother.f90 | 6 ++-- mlprec/mld_s_base_smoother_mod.f90 | 6 ++-- mlprec/mld_s_jac_smoother.f90 | 6 ++-- mlprec/mld_z_as_smoother.f90 | 6 ++-- mlprec/mld_z_base_smoother_mod.f90 | 6 ++-- mlprec/mld_z_jac_smoother.f90 | 6 ++-- 28 files changed, 244 insertions(+), 136 deletions(-) diff --git a/mlprec/impl/level/mld_c_base_onelev_dump.f90 b/mlprec/impl/level/mld_c_base_onelev_dump.f90 index 0013ac36..30d3e7fe 100644 --- a/mlprec/impl/level/mld_c_base_onelev_dump.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_dump.f90 @@ -147,12 +147,12 @@ subroutine mld_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,& end if if (allocated(lv%sm)) then - call lv%sm%dump(icontxt,level,info,smoother=smoother, & - & solver=solver,prefix=trim(prefix_)//"_sm") + 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(icontxt,level,info,smoother=smoother, & - & solver=solver,prefix=trim(prefix_)//"_sm2a") + call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, & + & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num) end if end subroutine mld_c_base_onelev_dump diff --git a/mlprec/impl/level/mld_d_base_onelev_dump.f90 b/mlprec/impl/level/mld_d_base_onelev_dump.f90 index 8ec2fc6f..a49f5b6d 100644 --- a/mlprec/impl/level/mld_d_base_onelev_dump.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_dump.f90 @@ -147,12 +147,12 @@ subroutine mld_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,& end if if (allocated(lv%sm)) then - call lv%sm%dump(icontxt,level,info,smoother=smoother, & - & solver=solver,prefix=trim(prefix_)//"_sm") + 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(icontxt,level,info,smoother=smoother, & - & solver=solver,prefix=trim(prefix_)//"_sm2a") + call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, & + & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num) end if end subroutine mld_d_base_onelev_dump diff --git a/mlprec/impl/level/mld_s_base_onelev_dump.f90 b/mlprec/impl/level/mld_s_base_onelev_dump.f90 index 43b9e93e..36ef4341 100644 --- a/mlprec/impl/level/mld_s_base_onelev_dump.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_dump.f90 @@ -147,12 +147,12 @@ subroutine mld_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,& end if if (allocated(lv%sm)) then - call lv%sm%dump(icontxt,level,info,smoother=smoother, & - & solver=solver,prefix=trim(prefix_)//"_sm") + 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(icontxt,level,info,smoother=smoother, & - & solver=solver,prefix=trim(prefix_)//"_sm2a") + call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, & + & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num) end if end subroutine mld_s_base_onelev_dump diff --git a/mlprec/impl/level/mld_z_base_onelev_dump.f90 b/mlprec/impl/level/mld_z_base_onelev_dump.f90 index acde72f3..87c6bca1 100644 --- a/mlprec/impl/level/mld_z_base_onelev_dump.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_dump.f90 @@ -147,12 +147,12 @@ subroutine mld_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,& end if if (allocated(lv%sm)) then - call lv%sm%dump(icontxt,level,info,smoother=smoother, & - & solver=solver,prefix=trim(prefix_)//"_sm") + 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(icontxt,level,info,smoother=smoother, & - & solver=solver,prefix=trim(prefix_)//"_sm2a") + call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, & + & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num) end if end subroutine mld_z_base_onelev_dump diff --git a/mlprec/impl/smoother/mld_c_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_c_as_smoother_dmp.f90 index ada54775..5c662299 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_dmp.f90 +++ b/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()) & diff --git a/mlprec/impl/smoother/mld_c_base_smoother_dmp.f90 b/mlprec/impl/smoother/mld_c_base_smoother_dmp.f90 index 5ab50a52..9ef2a05e 100644 --- a/mlprec/impl/smoother/mld_c_base_smoother_dmp.f90 +++ b/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 diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_dmp.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_dmp.f90 index bfa05ed4..6581e740 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_dmp.f90 +++ b/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,8 +81,14 @@ 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)) & diff --git a/mlprec/impl/smoother/mld_d_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_d_as_smoother_dmp.f90 index 5929b06d..f274a93a 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_dmp.f90 +++ b/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()) & diff --git a/mlprec/impl/smoother/mld_d_base_smoother_dmp.f90 b/mlprec/impl/smoother/mld_d_base_smoother_dmp.f90 index 900a91ed..e8db6ea9 100644 --- a/mlprec/impl/smoother/mld_d_base_smoother_dmp.f90 +++ b/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 diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_dmp.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_dmp.f90 index 811cee25..3ce48469 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_dmp.f90 +++ b/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,8 +81,14 @@ 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)) & diff --git a/mlprec/impl/smoother/mld_s_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_s_as_smoother_dmp.f90 index f35859b7..15d7a322 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_dmp.f90 +++ b/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()) & diff --git a/mlprec/impl/smoother/mld_s_base_smoother_dmp.f90 b/mlprec/impl/smoother/mld_s_base_smoother_dmp.f90 index a9fcf074..34ff44cd 100644 --- a/mlprec/impl/smoother/mld_s_base_smoother_dmp.f90 +++ b/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 diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_dmp.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_dmp.f90 index e1c14975..cafe8bd9 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_dmp.f90 +++ b/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,8 +81,14 @@ 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)) & diff --git a/mlprec/impl/smoother/mld_z_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_z_as_smoother_dmp.f90 index ecf10467..fd13cba6 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_dmp.f90 +++ b/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()) & diff --git a/mlprec/impl/smoother/mld_z_base_smoother_dmp.f90 b/mlprec/impl/smoother/mld_z_base_smoother_dmp.f90 index 27f83a56..f96c17d8 100644 --- a/mlprec/impl/smoother/mld_z_base_smoother_dmp.f90 +++ b/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 diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_dmp.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_dmp.f90 index 1c4f3f24..39d0a5be 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_dmp.f90 +++ b/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,8 +81,14 @@ 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)) & diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90 index dd7bec53..017e1520 100644 --- a/mlprec/mld_c_as_smoother.f90 +++ b/mlprec/mld_c_as_smoother.f90 @@ -291,17 +291,17 @@ module mld_c_as_smoother end interface interface - 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) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & psb_spk_, mld_c_as_smoother_type, psb_epk_, psb_desc_type, & & psb_ipk_ implicit none class(mld_c_as_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_c_as_smoother_dmp end interface diff --git a/mlprec/mld_c_base_smoother_mod.f90 b/mlprec/mld_c_base_smoother_mod.f90 index 0a80f1b9..b7c8cd0a 100644 --- a/mlprec/mld_c_base_smoother_mod.f90 +++ b/mlprec/mld_c_base_smoother_mod.f90 @@ -285,16 +285,16 @@ module mld_c_base_smoother_mod end interface interface - 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) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & mld_c_base_smoother_type, psb_ipk_ class(mld_c_base_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_c_base_smoother_dmp end interface diff --git a/mlprec/mld_c_jac_smoother.f90 b/mlprec/mld_c_jac_smoother.f90 index df30aed0..c9303889 100644 --- a/mlprec/mld_c_jac_smoother.f90 +++ b/mlprec/mld_c_jac_smoother.f90 @@ -175,17 +175,17 @@ module mld_c_jac_smoother end interface interface - 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) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & psb_spk_, mld_c_jac_smoother_type, psb_epk_, psb_desc_type, & & psb_ipk_ implicit none class(mld_c_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_c_jac_smoother_dmp end interface diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index c544b3c5..a560706a 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -291,17 +291,17 @@ module mld_d_as_smoother end interface interface - 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) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dpk_, mld_d_as_smoother_type, psb_epk_, psb_desc_type, & & psb_ipk_ implicit none class(mld_d_as_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_d_as_smoother_dmp end interface diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90 index 755a982d..1db243a2 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -285,16 +285,16 @@ module mld_d_base_smoother_mod end interface interface - 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) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_smoother_type, psb_ipk_ class(mld_d_base_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_d_base_smoother_dmp end interface diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index a312333f..25bbed4b 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -175,17 +175,17 @@ module mld_d_jac_smoother end interface interface - 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) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dpk_, mld_d_jac_smoother_type, psb_epk_, psb_desc_type, & & psb_ipk_ implicit none class(mld_d_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_d_jac_smoother_dmp end interface diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90 index 0165f6bb..318cb72d 100644 --- a/mlprec/mld_s_as_smoother.f90 +++ b/mlprec/mld_s_as_smoother.f90 @@ -291,17 +291,17 @@ module mld_s_as_smoother end interface interface - 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) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & psb_spk_, mld_s_as_smoother_type, psb_epk_, psb_desc_type, & & psb_ipk_ implicit none class(mld_s_as_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_s_as_smoother_dmp end interface diff --git a/mlprec/mld_s_base_smoother_mod.f90 b/mlprec/mld_s_base_smoother_mod.f90 index 9d5e7b67..9bef3fcf 100644 --- a/mlprec/mld_s_base_smoother_mod.f90 +++ b/mlprec/mld_s_base_smoother_mod.f90 @@ -285,16 +285,16 @@ module mld_s_base_smoother_mod end interface interface - 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) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & mld_s_base_smoother_type, psb_ipk_ class(mld_s_base_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_s_base_smoother_dmp end interface diff --git a/mlprec/mld_s_jac_smoother.f90 b/mlprec/mld_s_jac_smoother.f90 index 278f997d..cbe6fead 100644 --- a/mlprec/mld_s_jac_smoother.f90 +++ b/mlprec/mld_s_jac_smoother.f90 @@ -175,17 +175,17 @@ module mld_s_jac_smoother end interface interface - 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) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & psb_spk_, mld_s_jac_smoother_type, psb_epk_, psb_desc_type, & & psb_ipk_ implicit none class(mld_s_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_s_jac_smoother_dmp end interface diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90 index d2e7b8b1..146dcb9e 100644 --- a/mlprec/mld_z_as_smoother.f90 +++ b/mlprec/mld_z_as_smoother.f90 @@ -291,17 +291,17 @@ module mld_z_as_smoother end interface interface - 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) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & & psb_dpk_, mld_z_as_smoother_type, psb_epk_, psb_desc_type, & & psb_ipk_ implicit none class(mld_z_as_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_z_as_smoother_dmp end interface diff --git a/mlprec/mld_z_base_smoother_mod.f90 b/mlprec/mld_z_base_smoother_mod.f90 index 4d61e26d..867664ba 100644 --- a/mlprec/mld_z_base_smoother_mod.f90 +++ b/mlprec/mld_z_base_smoother_mod.f90 @@ -285,16 +285,16 @@ module mld_z_base_smoother_mod end interface interface - 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) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & mld_z_base_smoother_type, psb_ipk_ class(mld_z_base_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_z_base_smoother_dmp end interface diff --git a/mlprec/mld_z_jac_smoother.f90 b/mlprec/mld_z_jac_smoother.f90 index f9eeda76..628636b7 100644 --- a/mlprec/mld_z_jac_smoother.f90 +++ b/mlprec/mld_z_jac_smoother.f90 @@ -175,17 +175,17 @@ module mld_z_jac_smoother end interface interface - 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) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & & psb_dpk_, mld_z_jac_smoother_type, psb_epk_, psb_desc_type, & & psb_ipk_ implicit none class(mld_z_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(in) :: ictxt + 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 end subroutine mld_z_jac_smoother_dmp end interface From 49259c79b3e71ef199667b05f7b03b00af754e60 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 29 May 2020 11:30:19 +0200 Subject: [PATCH 8/8] Introduced solver%dump GLOBAL_NUM for in-house solvers --- mlprec/impl/level/mld_c_base_onelev_dump.f90 | 25 ++++++--- mlprec/impl/level/mld_d_base_onelev_dump.f90 | 25 ++++++--- mlprec/impl/level/mld_s_base_onelev_dump.f90 | 25 ++++++--- mlprec/impl/level/mld_z_base_onelev_dump.f90 | 25 ++++++--- .../impl/smoother/mld_c_as_smoother_dmp.f90 | 2 +- .../impl/smoother/mld_c_base_smoother_dmp.f90 | 2 +- .../impl/smoother/mld_c_jac_smoother_dmp.f90 | 2 +- .../impl/smoother/mld_d_as_smoother_dmp.f90 | 2 +- .../impl/smoother/mld_d_base_smoother_dmp.f90 | 2 +- .../impl/smoother/mld_d_jac_smoother_dmp.f90 | 2 +- .../impl/smoother/mld_s_as_smoother_dmp.f90 | 2 +- .../impl/smoother/mld_s_base_smoother_dmp.f90 | 2 +- .../impl/smoother/mld_s_jac_smoother_dmp.f90 | 2 +- .../impl/smoother/mld_z_as_smoother_dmp.f90 | 2 +- .../impl/smoother/mld_z_base_smoother_dmp.f90 | 2 +- .../impl/smoother/mld_z_jac_smoother_dmp.f90 | 2 +- mlprec/impl/solver/mld_c_base_solver_dmp.f90 | 11 ++-- mlprec/impl/solver/mld_c_diag_solver_dmp.f90 | 20 ++++--- mlprec/impl/solver/mld_c_gs_solver_dmp.f90 | 44 ++++++++++----- mlprec/impl/solver/mld_c_ilu_solver_dmp.f90 | 55 +++++++++++++------ mlprec/impl/solver/mld_d_base_solver_dmp.f90 | 11 ++-- mlprec/impl/solver/mld_d_diag_solver_dmp.f90 | 20 ++++--- mlprec/impl/solver/mld_d_gs_solver_dmp.f90 | 44 ++++++++++----- mlprec/impl/solver/mld_d_ilu_solver_dmp.f90 | 55 +++++++++++++------ mlprec/impl/solver/mld_s_base_solver_dmp.f90 | 11 ++-- mlprec/impl/solver/mld_s_diag_solver_dmp.f90 | 20 ++++--- mlprec/impl/solver/mld_s_gs_solver_dmp.f90 | 44 ++++++++++----- mlprec/impl/solver/mld_s_ilu_solver_dmp.f90 | 55 +++++++++++++------ mlprec/impl/solver/mld_z_base_solver_dmp.f90 | 11 ++-- mlprec/impl/solver/mld_z_diag_solver_dmp.f90 | 20 ++++--- mlprec/impl/solver/mld_z_gs_solver_dmp.f90 | 44 ++++++++++----- mlprec/impl/solver/mld_z_ilu_solver_dmp.f90 | 55 +++++++++++++------ mlprec/mld_c_base_solver_mod.f90 | 6 +- mlprec/mld_c_diag_solver.f90 | 12 ++-- mlprec/mld_c_gs_solver.f90 | 6 +- mlprec/mld_c_ilu_solver.f90 | 6 +- mlprec/mld_d_base_solver_mod.f90 | 6 +- mlprec/mld_d_diag_solver.f90 | 12 ++-- mlprec/mld_d_gs_solver.f90 | 6 +- mlprec/mld_d_ilu_solver.f90 | 6 +- mlprec/mld_s_base_solver_mod.f90 | 6 +- mlprec/mld_s_diag_solver.f90 | 12 ++-- mlprec/mld_s_gs_solver.f90 | 6 +- mlprec/mld_s_ilu_solver.f90 | 6 +- mlprec/mld_z_base_solver_mod.f90 | 6 +- mlprec/mld_z_diag_solver.f90 | 12 ++-- mlprec/mld_z_gs_solver.f90 | 6 +- mlprec/mld_z_ilu_solver.f90 | 6 +- 48 files changed, 492 insertions(+), 272 deletions(-) diff --git a/mlprec/impl/level/mld_c_base_onelev_dump.f90 b/mlprec/impl/level/mld_c_base_onelev_dump.f90 index 30d3e7fe..a4751e5c 100644 --- a/mlprec/impl/level/mld_c_base_onelev_dump.f90 +++ b/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(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) + 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 diff --git a/mlprec/impl/level/mld_d_base_onelev_dump.f90 b/mlprec/impl/level/mld_d_base_onelev_dump.f90 index a49f5b6d..e974b8ee 100644 --- a/mlprec/impl/level/mld_d_base_onelev_dump.f90 +++ b/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(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) + 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 diff --git a/mlprec/impl/level/mld_s_base_onelev_dump.f90 b/mlprec/impl/level/mld_s_base_onelev_dump.f90 index 36ef4341..931d8599 100644 --- a/mlprec/impl/level/mld_s_base_onelev_dump.f90 +++ b/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(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) + 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 diff --git a/mlprec/impl/level/mld_z_base_onelev_dump.f90 b/mlprec/impl/level/mld_z_base_onelev_dump.f90 index 87c6bca1..a7676b1c 100644 --- a/mlprec/impl/level/mld_z_base_onelev_dump.f90 +++ b/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(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) + 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 diff --git a/mlprec/impl/smoother/mld_c_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_c_as_smoother_dmp.f90 index 5c662299..4265d486 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_dmp.f90 @@ -87,6 +87,6 @@ subroutine mld_c_as_smoother_dmp(sm,desc,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 diff --git a/mlprec/impl/smoother/mld_c_base_smoother_dmp.f90 b/mlprec/impl/smoother/mld_c_base_smoother_dmp.f90 index 9ef2a05e..ffb008bb 100644 --- a/mlprec/impl/smoother/mld_c_base_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_c_base_smoother_dmp.f90 @@ -80,6 +80,6 @@ subroutine mld_c_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solve ! 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 diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_dmp.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_dmp.f90 index 6581e740..79540aee 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_dmp.f90 @@ -92,6 +92,6 @@ subroutine mld_c_jac_smoother_dmp(sm,desc,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_jac_smoother_dmp diff --git a/mlprec/impl/smoother/mld_d_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_d_as_smoother_dmp.f90 index f274a93a..566fde76 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_dmp.f90 @@ -87,6 +87,6 @@ subroutine mld_d_as_smoother_dmp(sm,desc,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 diff --git a/mlprec/impl/smoother/mld_d_base_smoother_dmp.f90 b/mlprec/impl/smoother/mld_d_base_smoother_dmp.f90 index e8db6ea9..bc836eff 100644 --- a/mlprec/impl/smoother/mld_d_base_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_d_base_smoother_dmp.f90 @@ -80,6 +80,6 @@ subroutine mld_d_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solve ! 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 diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_dmp.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_dmp.f90 index 3ce48469..72f20bbd 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_dmp.f90 @@ -92,6 +92,6 @@ subroutine mld_d_jac_smoother_dmp(sm,desc,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_jac_smoother_dmp diff --git a/mlprec/impl/smoother/mld_s_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_s_as_smoother_dmp.f90 index 15d7a322..00a6dd77 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_dmp.f90 @@ -87,6 +87,6 @@ subroutine mld_s_as_smoother_dmp(sm,desc,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 diff --git a/mlprec/impl/smoother/mld_s_base_smoother_dmp.f90 b/mlprec/impl/smoother/mld_s_base_smoother_dmp.f90 index 34ff44cd..14f2ac9e 100644 --- a/mlprec/impl/smoother/mld_s_base_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_s_base_smoother_dmp.f90 @@ -80,6 +80,6 @@ subroutine mld_s_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solve ! 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 diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_dmp.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_dmp.f90 index cafe8bd9..c58c7074 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_dmp.f90 @@ -92,6 +92,6 @@ subroutine mld_s_jac_smoother_dmp(sm,desc,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_jac_smoother_dmp diff --git a/mlprec/impl/smoother/mld_z_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_z_as_smoother_dmp.f90 index fd13cba6..42ed5828 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_dmp.f90 @@ -87,6 +87,6 @@ subroutine mld_z_as_smoother_dmp(sm,desc,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 diff --git a/mlprec/impl/smoother/mld_z_base_smoother_dmp.f90 b/mlprec/impl/smoother/mld_z_base_smoother_dmp.f90 index f96c17d8..e17246d5 100644 --- a/mlprec/impl/smoother/mld_z_base_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_z_base_smoother_dmp.f90 @@ -80,6 +80,6 @@ subroutine mld_z_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solve ! 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 diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_dmp.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_dmp.f90 index 39d0a5be..dec5aed5 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_dmp.f90 @@ -92,6 +92,6 @@ subroutine mld_z_jac_smoother_dmp(sm,desc,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_jac_smoother_dmp diff --git a/mlprec/impl/solver/mld_c_base_solver_dmp.f90 b/mlprec/impl/solver/mld_c_base_solver_dmp.f90 index 530a7ce4..dd23bc36 100644 --- a/mlprec/impl/solver/mld_c_base_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_dmp.f90 @@ -35,18 +35,19 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_c_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_dmp implicit none class(mld_c_base_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -59,7 +60,7 @@ subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else prefix_ = "dump_slv_c" end if - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then diff --git a/mlprec/impl/solver/mld_c_diag_solver_dmp.f90 b/mlprec/impl/solver/mld_c_diag_solver_dmp.f90 index beb2a1eb..0d7f5047 100644 --- a/mlprec/impl/solver/mld_c_diag_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_c_diag_solver_dmp.f90 @@ -35,18 +35,19 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_c_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_dmp implicit none class(mld_c_diag_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -54,6 +55,7 @@ subroutine mld_c_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) info = 0 + ictxt = desc%get_context() call psb_info(ictxt,iam,np) @@ -81,18 +83,19 @@ subroutine mld_c_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) end if end subroutine mld_c_diag_solver_dmp -subroutine mld_c_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_c_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_c_l1_diag_solver, mld_protect_name => mld_c_l1_diag_solver_dmp implicit none class(mld_c_l1_diag_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -100,6 +103,7 @@ subroutine mld_c_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) info = 0 + ictxt = desc%get_context() call psb_info(ictxt,iam,np) diff --git a/mlprec/impl/solver/mld_c_gs_solver_dmp.f90 b/mlprec/impl/solver/mld_c_gs_solver_dmp.f90 index 3459e594..4da0c5dd 100644 --- a/mlprec/impl/solver/mld_c_gs_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_c_gs_solver_dmp.f90 @@ -35,26 +35,28 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_c_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_c_gs_solver, mld_protect_name => mld_c_gs_solver_dmp implicit none class(mld_c_gs_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ + integer(psb_lpk_), allocatable :: iv(:) + logical :: solver_, global_num_ ! len of prefix_ info = 0 - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then @@ -62,6 +64,11 @@ subroutine mld_c_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else solver_ = .false. end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if if (solver_) then if (present(prefix)) then @@ -73,14 +80,23 @@ subroutine mld_c_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) fname = trim(prefix_) write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam lname = lname + 5 - - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' - if (sv%l%is_asb()) & - & call sv%l%print(fname,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' - if (sv%u%is_asb()) & - & call sv%u%print(fname,head=head) - + + if (global_num_) then + iv = desc%get_global_indices(owned=.false.) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head,iv=iv) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head,iv=iv) + else + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head) + end if end if end subroutine mld_c_gs_solver_dmp diff --git a/mlprec/impl/solver/mld_c_ilu_solver_dmp.f90 b/mlprec/impl/solver/mld_c_ilu_solver_dmp.f90 index 61e7d1f1..11586e9d 100644 --- a/mlprec/impl/solver/mld_c_ilu_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_c_ilu_solver_dmp.f90 @@ -35,26 +35,28 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) - +subroutine mld_c_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + use psb_base_mod use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_dmp implicit none class(mld_c_ilu_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ + logical :: solver_, global_num_ + integer(psb_lpk_), allocatable :: iv(:) ! len of prefix_ info = 0 - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then @@ -62,6 +64,12 @@ subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else solver_ = .false. end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if + if (solver_) then if (present(prefix)) then @@ -73,17 +81,32 @@ subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) fname = trim(prefix_) write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam lname = lname + 5 + + if (global_num_) then + iv = desc%get_global_indices(owned=.false.) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' - if (sv%l%is_asb()) & - & call sv%l%print(fname,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' - if (allocated(sv%d)) & - & call psb_geprt(fname,sv%d,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' - if (sv%u%is_asb()) & - & call sv%u%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head,iv=iv) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head,iv=iv) + + else + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head) + end if end if end subroutine mld_c_ilu_solver_dmp diff --git a/mlprec/impl/solver/mld_d_base_solver_dmp.f90 b/mlprec/impl/solver/mld_d_base_solver_dmp.f90 index fbbb5208..fd6e3242 100644 --- a/mlprec/impl/solver/mld_d_base_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_dmp.f90 @@ -35,18 +35,19 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_d_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_dmp implicit none class(mld_d_base_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -59,7 +60,7 @@ subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else prefix_ = "dump_slv_d" end if - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then diff --git a/mlprec/impl/solver/mld_d_diag_solver_dmp.f90 b/mlprec/impl/solver/mld_d_diag_solver_dmp.f90 index c6119c1a..50244998 100644 --- a/mlprec/impl/solver/mld_d_diag_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_d_diag_solver_dmp.f90 @@ -35,18 +35,19 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_d_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_dmp implicit none class(mld_d_diag_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -54,6 +55,7 @@ subroutine mld_d_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) info = 0 + ictxt = desc%get_context() call psb_info(ictxt,iam,np) @@ -81,18 +83,19 @@ subroutine mld_d_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) end if end subroutine mld_d_diag_solver_dmp -subroutine mld_d_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_d_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_d_l1_diag_solver, mld_protect_name => mld_d_l1_diag_solver_dmp implicit none class(mld_d_l1_diag_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -100,6 +103,7 @@ subroutine mld_d_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) info = 0 + ictxt = desc%get_context() call psb_info(ictxt,iam,np) diff --git a/mlprec/impl/solver/mld_d_gs_solver_dmp.f90 b/mlprec/impl/solver/mld_d_gs_solver_dmp.f90 index f1d3b5cb..b1037f49 100644 --- a/mlprec/impl/solver/mld_d_gs_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_d_gs_solver_dmp.f90 @@ -35,26 +35,28 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_d_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_d_gs_solver, mld_protect_name => mld_d_gs_solver_dmp implicit none class(mld_d_gs_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ + integer(psb_lpk_), allocatable :: iv(:) + logical :: solver_, global_num_ ! len of prefix_ info = 0 - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then @@ -62,6 +64,11 @@ subroutine mld_d_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else solver_ = .false. end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if if (solver_) then if (present(prefix)) then @@ -73,14 +80,23 @@ subroutine mld_d_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) fname = trim(prefix_) write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam lname = lname + 5 - - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' - if (sv%l%is_asb()) & - & call sv%l%print(fname,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' - if (sv%u%is_asb()) & - & call sv%u%print(fname,head=head) - + + if (global_num_) then + iv = desc%get_global_indices(owned=.false.) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head,iv=iv) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head,iv=iv) + else + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head) + end if end if end subroutine mld_d_gs_solver_dmp diff --git a/mlprec/impl/solver/mld_d_ilu_solver_dmp.f90 b/mlprec/impl/solver/mld_d_ilu_solver_dmp.f90 index 0a4c9b43..8ab7f36c 100644 --- a/mlprec/impl/solver/mld_d_ilu_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_d_ilu_solver_dmp.f90 @@ -35,26 +35,28 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) - +subroutine mld_d_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + use psb_base_mod use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_dmp implicit none class(mld_d_ilu_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ + logical :: solver_, global_num_ + integer(psb_lpk_), allocatable :: iv(:) ! len of prefix_ info = 0 - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then @@ -62,6 +64,12 @@ subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else solver_ = .false. end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if + if (solver_) then if (present(prefix)) then @@ -73,17 +81,32 @@ subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) fname = trim(prefix_) write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam lname = lname + 5 + + if (global_num_) then + iv = desc%get_global_indices(owned=.false.) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' - if (sv%l%is_asb()) & - & call sv%l%print(fname,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' - if (allocated(sv%d)) & - & call psb_geprt(fname,sv%d,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' - if (sv%u%is_asb()) & - & call sv%u%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head,iv=iv) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head,iv=iv) + + else + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head) + end if end if end subroutine mld_d_ilu_solver_dmp diff --git a/mlprec/impl/solver/mld_s_base_solver_dmp.f90 b/mlprec/impl/solver/mld_s_base_solver_dmp.f90 index 77ae6492..ffe0141f 100644 --- a/mlprec/impl/solver/mld_s_base_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_dmp.f90 @@ -35,18 +35,19 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_s_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_dmp implicit none class(mld_s_base_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -59,7 +60,7 @@ subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else prefix_ = "dump_slv_s" end if - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then diff --git a/mlprec/impl/solver/mld_s_diag_solver_dmp.f90 b/mlprec/impl/solver/mld_s_diag_solver_dmp.f90 index b201e712..d6143349 100644 --- a/mlprec/impl/solver/mld_s_diag_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_s_diag_solver_dmp.f90 @@ -35,18 +35,19 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_s_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_dmp implicit none class(mld_s_diag_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -54,6 +55,7 @@ subroutine mld_s_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) info = 0 + ictxt = desc%get_context() call psb_info(ictxt,iam,np) @@ -81,18 +83,19 @@ subroutine mld_s_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) end if end subroutine mld_s_diag_solver_dmp -subroutine mld_s_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_s_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_s_l1_diag_solver, mld_protect_name => mld_s_l1_diag_solver_dmp implicit none class(mld_s_l1_diag_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -100,6 +103,7 @@ subroutine mld_s_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) info = 0 + ictxt = desc%get_context() call psb_info(ictxt,iam,np) diff --git a/mlprec/impl/solver/mld_s_gs_solver_dmp.f90 b/mlprec/impl/solver/mld_s_gs_solver_dmp.f90 index 33af39a7..911d0104 100644 --- a/mlprec/impl/solver/mld_s_gs_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_s_gs_solver_dmp.f90 @@ -35,26 +35,28 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_s_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_s_gs_solver, mld_protect_name => mld_s_gs_solver_dmp implicit none class(mld_s_gs_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ + integer(psb_lpk_), allocatable :: iv(:) + logical :: solver_, global_num_ ! len of prefix_ info = 0 - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then @@ -62,6 +64,11 @@ subroutine mld_s_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else solver_ = .false. end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if if (solver_) then if (present(prefix)) then @@ -73,14 +80,23 @@ subroutine mld_s_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) fname = trim(prefix_) write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam lname = lname + 5 - - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' - if (sv%l%is_asb()) & - & call sv%l%print(fname,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' - if (sv%u%is_asb()) & - & call sv%u%print(fname,head=head) - + + if (global_num_) then + iv = desc%get_global_indices(owned=.false.) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head,iv=iv) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head,iv=iv) + else + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head) + end if end if end subroutine mld_s_gs_solver_dmp diff --git a/mlprec/impl/solver/mld_s_ilu_solver_dmp.f90 b/mlprec/impl/solver/mld_s_ilu_solver_dmp.f90 index 5da73209..f388bbc5 100644 --- a/mlprec/impl/solver/mld_s_ilu_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_s_ilu_solver_dmp.f90 @@ -35,26 +35,28 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) - +subroutine mld_s_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + use psb_base_mod use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_dmp implicit none class(mld_s_ilu_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ + logical :: solver_, global_num_ + integer(psb_lpk_), allocatable :: iv(:) ! len of prefix_ info = 0 - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then @@ -62,6 +64,12 @@ subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else solver_ = .false. end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if + if (solver_) then if (present(prefix)) then @@ -73,17 +81,32 @@ subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) fname = trim(prefix_) write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam lname = lname + 5 + + if (global_num_) then + iv = desc%get_global_indices(owned=.false.) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' - if (sv%l%is_asb()) & - & call sv%l%print(fname,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' - if (allocated(sv%d)) & - & call psb_geprt(fname,sv%d,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' - if (sv%u%is_asb()) & - & call sv%u%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head,iv=iv) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head,iv=iv) + + else + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head) + end if end if end subroutine mld_s_ilu_solver_dmp diff --git a/mlprec/impl/solver/mld_z_base_solver_dmp.f90 b/mlprec/impl/solver/mld_z_base_solver_dmp.f90 index a85cd64c..1d54ee84 100644 --- a/mlprec/impl/solver/mld_z_base_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_dmp.f90 @@ -35,18 +35,19 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_z_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_dmp implicit none class(mld_z_base_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -59,7 +60,7 @@ subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else prefix_ = "dump_slv_z" end if - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then diff --git a/mlprec/impl/solver/mld_z_diag_solver_dmp.f90 b/mlprec/impl/solver/mld_z_diag_solver_dmp.f90 index 78663f21..5f52b8ff 100644 --- a/mlprec/impl/solver/mld_z_diag_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_z_diag_solver_dmp.f90 @@ -35,18 +35,19 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_z_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_dmp implicit none class(mld_z_diag_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -54,6 +55,7 @@ subroutine mld_z_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) info = 0 + ictxt = desc%get_context() call psb_info(ictxt,iam,np) @@ -81,18 +83,19 @@ subroutine mld_z_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) end if end subroutine mld_z_diag_solver_dmp -subroutine mld_z_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_z_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_z_l1_diag_solver, mld_protect_name => mld_z_l1_diag_solver_dmp implicit none class(mld_z_l1_diag_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ @@ -100,6 +103,7 @@ subroutine mld_z_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) info = 0 + ictxt = desc%get_context() call psb_info(ictxt,iam,np) diff --git a/mlprec/impl/solver/mld_z_gs_solver_dmp.f90 b/mlprec/impl/solver/mld_z_gs_solver_dmp.f90 index 3449cdd1..3f5908a9 100644 --- a/mlprec/impl/solver/mld_z_gs_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_z_gs_solver_dmp.f90 @@ -35,26 +35,28 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) +subroutine mld_z_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) use psb_base_mod use mld_z_gs_solver, mld_protect_name => mld_z_gs_solver_dmp implicit none class(mld_z_gs_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ + integer(psb_lpk_), allocatable :: iv(:) + logical :: solver_, global_num_ ! len of prefix_ info = 0 - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then @@ -62,6 +64,11 @@ subroutine mld_z_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else solver_ = .false. end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if if (solver_) then if (present(prefix)) then @@ -73,14 +80,23 @@ subroutine mld_z_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) fname = trim(prefix_) write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam lname = lname + 5 - - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' - if (sv%l%is_asb()) & - & call sv%l%print(fname,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' - if (sv%u%is_asb()) & - & call sv%u%print(fname,head=head) - + + if (global_num_) then + iv = desc%get_global_indices(owned=.false.) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head,iv=iv) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head,iv=iv) + else + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head) + end if end if end subroutine mld_z_gs_solver_dmp diff --git a/mlprec/impl/solver/mld_z_ilu_solver_dmp.f90 b/mlprec/impl/solver/mld_z_ilu_solver_dmp.f90 index 8c40336d..a9a10ca4 100644 --- a/mlprec/impl/solver/mld_z_ilu_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_z_ilu_solver_dmp.f90 @@ -35,26 +35,28 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) - +subroutine mld_z_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + use psb_base_mod use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_dmp implicit none class(mld_z_ilu_solver_type), intent(in) :: sv - 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) :: solver + logical, optional, intent(in) :: 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 :: solver_ + logical :: solver_, global_num_ + integer(psb_lpk_), allocatable :: iv(:) ! len of prefix_ info = 0 - + ictxt = desc%get_context() call psb_info(ictxt,iam,np) if (present(solver)) then @@ -62,6 +64,12 @@ subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) else solver_ = .false. end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if + if (solver_) then if (present(prefix)) then @@ -73,17 +81,32 @@ subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) fname = trim(prefix_) write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam lname = lname + 5 + + if (global_num_) then + iv = desc%get_global_indices(owned=.false.) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' - if (sv%l%is_asb()) & - & call sv%l%print(fname,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' - if (allocated(sv%d)) & - & call psb_geprt(fname,sv%d,head=head) - write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' - if (sv%u%is_asb()) & - & call sv%u%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head,iv=iv) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head,iv=iv) + + else + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' + if (sv%l%is_asb()) & + & call sv%l%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' + if (sv%u%is_asb()) & + & call sv%u%print(fname,head=head) + end if end if end subroutine mld_z_ilu_solver_dmp diff --git a/mlprec/mld_c_base_solver_mod.f90 b/mlprec/mld_c_base_solver_mod.f90 index bc250976..fe0a1b07 100644 --- a/mlprec/mld_c_base_solver_mod.f90 +++ b/mlprec/mld_c_base_solver_mod.f90 @@ -286,17 +286,17 @@ module mld_c_base_solver_mod end interface interface - subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_c_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & mld_c_base_solver_type, psb_ipk_ implicit none class(mld_c_base_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_c_base_solver_dmp end interface diff --git a/mlprec/mld_c_diag_solver.f90 b/mlprec/mld_c_diag_solver.f90 index 5f8c738d..e5212b63 100644 --- a/mlprec/mld_c_diag_solver.f90 +++ b/mlprec/mld_c_diag_solver.f90 @@ -143,17 +143,17 @@ module mld_c_diag_solver end interface interface - subroutine mld_c_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_c_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_c_diag_solver_type, psb_c_vect_type, psb_spk_, & & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, & & psb_ipk_ implicit none class(mld_c_diag_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_c_diag_solver_dmp end interface @@ -336,17 +336,17 @@ module mld_c_l1_diag_solver end interface interface - subroutine mld_c_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_c_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_c_l1_diag_solver_type, psb_c_vect_type, psb_spk_, & & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, & & psb_ipk_ implicit none class(mld_c_l1_diag_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_c_l1_diag_solver_dmp end interface diff --git a/mlprec/mld_c_gs_solver.f90 b/mlprec/mld_c_gs_solver.f90 index 4940b1e2..8bb92e83 100644 --- a/mlprec/mld_c_gs_solver.f90 +++ b/mlprec/mld_c_gs_solver.f90 @@ -221,17 +221,17 @@ module mld_c_gs_solver end interface interface - subroutine mld_c_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_c_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_c_gs_solver_type, psb_c_vect_type, psb_spk_, & & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, & & psb_ipk_ implicit none class(mld_c_gs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_c_gs_solver_dmp end interface diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index e8ab8f9c..184c9ad5 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -170,17 +170,17 @@ module mld_c_ilu_solver end interface interface - subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_c_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, & & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, & & psb_ipk_ implicit none class(mld_c_ilu_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_c_ilu_solver_dmp end interface diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index 9a56ce6b..1db63184 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -286,17 +286,17 @@ module mld_d_base_solver_mod end interface interface - subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_d_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_solver_type, psb_ipk_ implicit none class(mld_d_base_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_d_base_solver_dmp end interface diff --git a/mlprec/mld_d_diag_solver.f90 b/mlprec/mld_d_diag_solver.f90 index 0235e259..f73ef0ce 100644 --- a/mlprec/mld_d_diag_solver.f90 +++ b/mlprec/mld_d_diag_solver.f90 @@ -143,17 +143,17 @@ module mld_d_diag_solver end interface interface - subroutine mld_d_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_d_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_d_diag_solver_type, psb_d_vect_type, psb_dpk_, & & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, & & psb_ipk_ implicit none class(mld_d_diag_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_d_diag_solver_dmp end interface @@ -336,17 +336,17 @@ module mld_d_l1_diag_solver end interface interface - subroutine mld_d_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_d_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_d_l1_diag_solver_type, psb_d_vect_type, psb_dpk_, & & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, & & psb_ipk_ implicit none class(mld_d_l1_diag_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_d_l1_diag_solver_dmp end interface diff --git a/mlprec/mld_d_gs_solver.f90 b/mlprec/mld_d_gs_solver.f90 index 213eab55..ed89ce0f 100644 --- a/mlprec/mld_d_gs_solver.f90 +++ b/mlprec/mld_d_gs_solver.f90 @@ -221,17 +221,17 @@ module mld_d_gs_solver end interface interface - subroutine mld_d_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_d_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_d_gs_solver_type, psb_d_vect_type, psb_dpk_, & & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, & & psb_ipk_ implicit none class(mld_d_gs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_d_gs_solver_dmp end interface diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index b2ff7a0b..026e676f 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -170,17 +170,17 @@ module mld_d_ilu_solver end interface interface - subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_d_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, & & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, & & psb_ipk_ implicit none class(mld_d_ilu_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_d_ilu_solver_dmp end interface diff --git a/mlprec/mld_s_base_solver_mod.f90 b/mlprec/mld_s_base_solver_mod.f90 index 3df02c35..d9a2101b 100644 --- a/mlprec/mld_s_base_solver_mod.f90 +++ b/mlprec/mld_s_base_solver_mod.f90 @@ -286,17 +286,17 @@ module mld_s_base_solver_mod end interface interface - subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_s_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & mld_s_base_solver_type, psb_ipk_ implicit none class(mld_s_base_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_s_base_solver_dmp end interface diff --git a/mlprec/mld_s_diag_solver.f90 b/mlprec/mld_s_diag_solver.f90 index 76c1151c..a0f76a33 100644 --- a/mlprec/mld_s_diag_solver.f90 +++ b/mlprec/mld_s_diag_solver.f90 @@ -143,17 +143,17 @@ module mld_s_diag_solver end interface interface - subroutine mld_s_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_s_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_s_diag_solver_type, psb_s_vect_type, psb_spk_, & & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, & & psb_ipk_ implicit none class(mld_s_diag_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_s_diag_solver_dmp end interface @@ -336,17 +336,17 @@ module mld_s_l1_diag_solver end interface interface - subroutine mld_s_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_s_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_s_l1_diag_solver_type, psb_s_vect_type, psb_spk_, & & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, & & psb_ipk_ implicit none class(mld_s_l1_diag_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_s_l1_diag_solver_dmp end interface diff --git a/mlprec/mld_s_gs_solver.f90 b/mlprec/mld_s_gs_solver.f90 index 9059ff58..e34766a4 100644 --- a/mlprec/mld_s_gs_solver.f90 +++ b/mlprec/mld_s_gs_solver.f90 @@ -221,17 +221,17 @@ module mld_s_gs_solver end interface interface - subroutine mld_s_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_s_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_s_gs_solver_type, psb_s_vect_type, psb_spk_, & & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, & & psb_ipk_ implicit none class(mld_s_gs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_s_gs_solver_dmp end interface diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index a9f3e3ad..b785ce04 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -170,17 +170,17 @@ module mld_s_ilu_solver end interface interface - subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_s_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, & & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, & & psb_ipk_ implicit none class(mld_s_ilu_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_s_ilu_solver_dmp end interface diff --git a/mlprec/mld_z_base_solver_mod.f90 b/mlprec/mld_z_base_solver_mod.f90 index 3988d97e..3b3d47de 100644 --- a/mlprec/mld_z_base_solver_mod.f90 +++ b/mlprec/mld_z_base_solver_mod.f90 @@ -286,17 +286,17 @@ module mld_z_base_solver_mod end interface interface - subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_z_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & mld_z_base_solver_type, psb_ipk_ implicit none class(mld_z_base_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_z_base_solver_dmp end interface diff --git a/mlprec/mld_z_diag_solver.f90 b/mlprec/mld_z_diag_solver.f90 index b403a8e2..2a62ce11 100644 --- a/mlprec/mld_z_diag_solver.f90 +++ b/mlprec/mld_z_diag_solver.f90 @@ -143,17 +143,17 @@ module mld_z_diag_solver end interface interface - subroutine mld_z_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_z_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_z_diag_solver_type, psb_z_vect_type, psb_dpk_, & & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, & & psb_ipk_ implicit none class(mld_z_diag_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_z_diag_solver_dmp end interface @@ -336,17 +336,17 @@ module mld_z_l1_diag_solver end interface interface - subroutine mld_z_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_z_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_z_l1_diag_solver_type, psb_z_vect_type, psb_dpk_, & & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, & & psb_ipk_ implicit none class(mld_z_l1_diag_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_z_l1_diag_solver_dmp end interface diff --git a/mlprec/mld_z_gs_solver.f90 b/mlprec/mld_z_gs_solver.f90 index b3d3f21c..710867e7 100644 --- a/mlprec/mld_z_gs_solver.f90 +++ b/mlprec/mld_z_gs_solver.f90 @@ -221,17 +221,17 @@ module mld_z_gs_solver end interface interface - subroutine mld_z_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_z_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_z_gs_solver_type, psb_z_vect_type, psb_dpk_, & & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, & & psb_ipk_ implicit none class(mld_z_gs_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_z_gs_solver_dmp end interface diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index b3585a2b..0b98de2b 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -170,17 +170,17 @@ module mld_z_ilu_solver end interface interface - subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) + subroutine mld_z_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, & & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, & & psb_ipk_ implicit none class(mld_z_ilu_solver_type), intent(in) :: sv - integer(psb_ipk_), intent(in) :: ictxt + 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) :: solver + logical, optional, intent(in) :: solver, global_num end subroutine mld_z_ilu_solver_dmp end interface