mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-20 21:02:35 +00:00
Remove temporary implementation of L1
This commit is contained in:
Salvatore Filippone
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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_
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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_
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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_
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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_
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user