From 6259514cd1a961848edb6cb5b2996ec63d3020c1 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 28 May 2020 10:48:01 +0200 Subject: [PATCH] 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