mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-16 10:52:08 +00:00
Added missign @LX@ implementation of new sparse matrix sum routines
This commit is contained in:
Cirdans-Home
@@ -3532,6 +3532,29 @@ subroutine psb_lc_base_scals(d,a,info)
|
||||
|
||||
end subroutine psb_lc_base_scals
|
||||
|
||||
subroutine psb_lc_base_scalplusidentity(d,a,info)
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_scalplusidentity
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_lc_base_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='lc_scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name,a_err=a%get_fmt())
|
||||
|
||||
call psb_error_handler(err_act)
|
||||
|
||||
end subroutine psb_lc_base_scalplusidentity
|
||||
|
||||
subroutine psb_lc_base_scal(d,a,info,side)
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_scal
|
||||
use psb_error_mod
|
||||
@@ -3743,6 +3766,59 @@ subroutine psb_lc_base_aclsum(d,a)
|
||||
|
||||
end subroutine psb_lc_base_aclsum
|
||||
|
||||
subroutine psb_lc_base_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_spaxpby
|
||||
|
||||
complex(psb_spk_), intent(in) :: alpha
|
||||
class(psb_lc_base_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: beta
|
||||
class(psb_lc_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Auxiliary
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxpby'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_lc_coo_sparse_mat) :: acoo
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if((a%get_ncols() /= b%get_ncols()).or.(a%get_nrows() /= b%get_nrows())) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call a%mv_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acoo%spaxpby(alpha,beta,b,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='spaxby')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acoo%mv_to_fmt(a,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_fmt')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine psb_lc_base_spaxpby
|
||||
|
||||
subroutine psb_lc_base_get_diag(a,d,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
|
||||
@@ -4583,6 +4583,104 @@ subroutine psb_lc_coo_aclsum(d,a)
|
||||
|
||||
end subroutine psb_lc_coo_aclsum
|
||||
|
||||
subroutine psb_lc_coo_scalplusidentity(d,a,info)
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_scalplusidentity
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
implicit none
|
||||
class(psb_lc_coo_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
do i=1,a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d
|
||||
j=a%ia(i)
|
||||
if ((j == a%ja(i)) .and.(j <= mnm ) .and.(j>0)) then
|
||||
a%val(i) = a%val(i) + cone
|
||||
endif
|
||||
enddo
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lc_coo_scalplusidentity
|
||||
|
||||
subroutine psb_lc_coo_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_spaxpby
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
implicit none
|
||||
|
||||
class(psb_lc_coo_sparse_mat), intent(inout) :: a
|
||||
class(psb_lc_base_sparse_mat), intent(inout) :: b
|
||||
complex(psb_spk_), intent(in) :: alpha
|
||||
complex(psb_spk_), intent(in) :: beta
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!Local
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='lc_coo_spaxpby'
|
||||
type(psb_lc_coo_sparse_mat) :: tcoo,bcoo
|
||||
integer(psb_lpk_) :: nza, nzb, M, N
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
! Copy (whatever) b format to coo
|
||||
call b%cp_to_coo(bcoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='cp_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
! Get information on the matrix
|
||||
M = a%get_nrows()
|
||||
N = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
nzb = b%get_nzeros()
|
||||
! Allocate (temporary) space for the solution
|
||||
call tcoo%allocate(M,N,(nza+nzb))
|
||||
! Compute the sum
|
||||
tcoo%ia(1:nza) = a%ia(1:nza)
|
||||
tcoo%ja(1:nza) = a%ja(1:nza)
|
||||
tcoo%val(1:nza) = alpha*a%val(1:nza)
|
||||
tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
|
||||
tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb)
|
||||
tcoo%val(nza+1:nza+nzb) = beta*bcoo%val(1:nzb)
|
||||
! Fix the indexes
|
||||
call tcoo%fix(info)
|
||||
! Move to correct output format
|
||||
call tcoo%mv_to_coo(a,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine psb_lc_coo_spaxpby
|
||||
|
||||
subroutine psb_lc_coo_reallocate_nz(nz,a)
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_reallocate_nz
|
||||
use psb_error_mod
|
||||
|
||||
@@ -3107,6 +3107,48 @@ subroutine psb_lc_csc_scals(d,a,info)
|
||||
|
||||
end subroutine psb_lc_csc_scals
|
||||
|
||||
subroutine psb_lc_csc_scalplusidentity(d,a,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_scalplusidentity
|
||||
implicit none
|
||||
class(psb_lc_csc_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_lpk_) :: mnm, i, j, k, m
|
||||
integer(psb_ipk_) :: err_act, ierr(5)
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
do i=1,a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d
|
||||
do k=a%icp(i),a%icp(i+1)-1
|
||||
j=a%ia(k)
|
||||
if ((j == i) .and.(j <= mnm )) then
|
||||
a%val(k) = a%val(k) + cone
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lc_csc_scalplusidentity
|
||||
|
||||
function psb_lc_csc_maxval(a) result(res)
|
||||
use psb_error_mod
|
||||
|
||||
@@ -2486,6 +2486,41 @@ subroutine psb_c_scalplusidentity(d,a,info)
|
||||
|
||||
end subroutine psb_c_scalplusidentity
|
||||
|
||||
subroutine psb_c_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_c_mat_mod, psb_protect_name => psb_c_spaxpby
|
||||
implicit none
|
||||
complex(psb_spk_), intent(in) :: alpha
|
||||
class(psb_cspmat_type), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: beta
|
||||
class(psb_cspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxby'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%spaxpby(alpha,beta,b%a,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_c_spaxpby
|
||||
|
||||
subroutine psb_c_mv_from_lb(a,b)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
@@ -4617,6 +4652,74 @@ subroutine psb_lc_scals(d,a,info)
|
||||
|
||||
end subroutine psb_lc_scals
|
||||
|
||||
subroutine psb_lc_scalplusidentity(d,a,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_c_mat_mod, psb_protect_name => psb_lc_scalplusidentity
|
||||
implicit none
|
||||
class(psb_lcspmat_type), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%scalpid(d,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lc_scalplusidentity
|
||||
|
||||
subroutine psb_lc_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_c_mat_mod, psb_protect_name => psb_lc_spaxpby
|
||||
implicit none
|
||||
complex(psb_spk_), intent(in) :: alpha
|
||||
class(psb_lcspmat_type), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: beta
|
||||
class(psb_lcspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxby'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%spaxpby(alpha,beta,b%a,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lc_spaxpby
|
||||
|
||||
function psb_lc_maxval(a) result(res)
|
||||
use psb_c_mat_mod, psb_protect_name => psb_lc_maxval
|
||||
use psb_error_mod
|
||||
|
||||
@@ -3532,6 +3532,29 @@ subroutine psb_ld_base_scals(d,a,info)
|
||||
|
||||
end subroutine psb_ld_base_scals
|
||||
|
||||
subroutine psb_ld_base_scalplusidentity(d,a,info)
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_scalplusidentity
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_ld_base_sparse_mat), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='ld_scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name,a_err=a%get_fmt())
|
||||
|
||||
call psb_error_handler(err_act)
|
||||
|
||||
end subroutine psb_ld_base_scalplusidentity
|
||||
|
||||
subroutine psb_ld_base_scal(d,a,info,side)
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_scal
|
||||
use psb_error_mod
|
||||
@@ -3743,6 +3766,59 @@ subroutine psb_ld_base_aclsum(d,a)
|
||||
|
||||
end subroutine psb_ld_base_aclsum
|
||||
|
||||
subroutine psb_ld_base_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_spaxpby
|
||||
|
||||
real(psb_dpk_), intent(in) :: alpha
|
||||
class(psb_ld_base_sparse_mat), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: beta
|
||||
class(psb_ld_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Auxiliary
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxpby'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_ld_coo_sparse_mat) :: acoo
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if((a%get_ncols() /= b%get_ncols()).or.(a%get_nrows() /= b%get_nrows())) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call a%mv_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acoo%spaxpby(alpha,beta,b,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='spaxby')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acoo%mv_to_fmt(a,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_fmt')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine psb_ld_base_spaxpby
|
||||
|
||||
subroutine psb_ld_base_get_diag(a,d,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
|
||||
@@ -4583,6 +4583,104 @@ subroutine psb_ld_coo_aclsum(d,a)
|
||||
|
||||
end subroutine psb_ld_coo_aclsum
|
||||
|
||||
subroutine psb_ld_coo_scalplusidentity(d,a,info)
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_scalplusidentity
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
implicit none
|
||||
class(psb_ld_coo_sparse_mat), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
do i=1,a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d
|
||||
j=a%ia(i)
|
||||
if ((j == a%ja(i)) .and.(j <= mnm ) .and.(j>0)) then
|
||||
a%val(i) = a%val(i) + done
|
||||
endif
|
||||
enddo
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ld_coo_scalplusidentity
|
||||
|
||||
subroutine psb_ld_coo_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_spaxpby
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
implicit none
|
||||
|
||||
class(psb_ld_coo_sparse_mat), intent(inout) :: a
|
||||
class(psb_ld_base_sparse_mat), intent(inout) :: b
|
||||
real(psb_dpk_), intent(in) :: alpha
|
||||
real(psb_dpk_), intent(in) :: beta
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!Local
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='ld_coo_spaxpby'
|
||||
type(psb_ld_coo_sparse_mat) :: tcoo,bcoo
|
||||
integer(psb_lpk_) :: nza, nzb, M, N
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
! Copy (whatever) b format to coo
|
||||
call b%cp_to_coo(bcoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='cp_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
! Get information on the matrix
|
||||
M = a%get_nrows()
|
||||
N = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
nzb = b%get_nzeros()
|
||||
! Allocate (temporary) space for the solution
|
||||
call tcoo%allocate(M,N,(nza+nzb))
|
||||
! Compute the sum
|
||||
tcoo%ia(1:nza) = a%ia(1:nza)
|
||||
tcoo%ja(1:nza) = a%ja(1:nza)
|
||||
tcoo%val(1:nza) = alpha*a%val(1:nza)
|
||||
tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
|
||||
tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb)
|
||||
tcoo%val(nza+1:nza+nzb) = beta*bcoo%val(1:nzb)
|
||||
! Fix the indexes
|
||||
call tcoo%fix(info)
|
||||
! Move to correct output format
|
||||
call tcoo%mv_to_coo(a,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine psb_ld_coo_spaxpby
|
||||
|
||||
subroutine psb_ld_coo_reallocate_nz(nz,a)
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_reallocate_nz
|
||||
use psb_error_mod
|
||||
|
||||
@@ -3107,6 +3107,48 @@ subroutine psb_ld_csc_scals(d,a,info)
|
||||
|
||||
end subroutine psb_ld_csc_scals
|
||||
|
||||
subroutine psb_ld_csc_scalplusidentity(d,a,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_scalplusidentity
|
||||
implicit none
|
||||
class(psb_ld_csc_sparse_mat), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_lpk_) :: mnm, i, j, k, m
|
||||
integer(psb_ipk_) :: err_act, ierr(5)
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
do i=1,a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d
|
||||
do k=a%icp(i),a%icp(i+1)-1
|
||||
j=a%ia(k)
|
||||
if ((j == i) .and.(j <= mnm )) then
|
||||
a%val(k) = a%val(k) + done
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ld_csc_scalplusidentity
|
||||
|
||||
function psb_ld_csc_maxval(a) result(res)
|
||||
use psb_error_mod
|
||||
|
||||
@@ -2486,6 +2486,41 @@ subroutine psb_d_scalplusidentity(d,a,info)
|
||||
|
||||
end subroutine psb_d_scalplusidentity
|
||||
|
||||
subroutine psb_d_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_d_mat_mod, psb_protect_name => psb_d_spaxpby
|
||||
implicit none
|
||||
real(psb_dpk_), intent(in) :: alpha
|
||||
class(psb_dspmat_type), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: beta
|
||||
class(psb_dspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxby'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%spaxpby(alpha,beta,b%a,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_d_spaxpby
|
||||
|
||||
subroutine psb_d_mv_from_lb(a,b)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
@@ -4617,6 +4652,74 @@ subroutine psb_ld_scals(d,a,info)
|
||||
|
||||
end subroutine psb_ld_scals
|
||||
|
||||
subroutine psb_ld_scalplusidentity(d,a,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_d_mat_mod, psb_protect_name => psb_ld_scalplusidentity
|
||||
implicit none
|
||||
class(psb_ldspmat_type), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%scalpid(d,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ld_scalplusidentity
|
||||
|
||||
subroutine psb_ld_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_d_mat_mod, psb_protect_name => psb_ld_spaxpby
|
||||
implicit none
|
||||
real(psb_dpk_), intent(in) :: alpha
|
||||
class(psb_ldspmat_type), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: beta
|
||||
class(psb_ldspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxby'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%spaxpby(alpha,beta,b%a,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ld_spaxpby
|
||||
|
||||
function psb_ld_maxval(a) result(res)
|
||||
use psb_d_mat_mod, psb_protect_name => psb_ld_maxval
|
||||
use psb_error_mod
|
||||
|
||||
@@ -3532,6 +3532,29 @@ subroutine psb_ls_base_scals(d,a,info)
|
||||
|
||||
end subroutine psb_ls_base_scals
|
||||
|
||||
subroutine psb_ls_base_scalplusidentity(d,a,info)
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_scalplusidentity
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_ls_base_sparse_mat), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='ls_scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name,a_err=a%get_fmt())
|
||||
|
||||
call psb_error_handler(err_act)
|
||||
|
||||
end subroutine psb_ls_base_scalplusidentity
|
||||
|
||||
subroutine psb_ls_base_scal(d,a,info,side)
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_scal
|
||||
use psb_error_mod
|
||||
@@ -3743,6 +3766,59 @@ subroutine psb_ls_base_aclsum(d,a)
|
||||
|
||||
end subroutine psb_ls_base_aclsum
|
||||
|
||||
subroutine psb_ls_base_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_spaxpby
|
||||
|
||||
real(psb_spk_), intent(in) :: alpha
|
||||
class(psb_ls_base_sparse_mat), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: beta
|
||||
class(psb_ls_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Auxiliary
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxpby'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_ls_coo_sparse_mat) :: acoo
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if((a%get_ncols() /= b%get_ncols()).or.(a%get_nrows() /= b%get_nrows())) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call a%mv_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acoo%spaxpby(alpha,beta,b,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='spaxby')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acoo%mv_to_fmt(a,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_fmt')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine psb_ls_base_spaxpby
|
||||
|
||||
subroutine psb_ls_base_get_diag(a,d,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
|
||||
@@ -4583,6 +4583,104 @@ subroutine psb_ls_coo_aclsum(d,a)
|
||||
|
||||
end subroutine psb_ls_coo_aclsum
|
||||
|
||||
subroutine psb_ls_coo_scalplusidentity(d,a,info)
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_scalplusidentity
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
implicit none
|
||||
class(psb_ls_coo_sparse_mat), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
do i=1,a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d
|
||||
j=a%ia(i)
|
||||
if ((j == a%ja(i)) .and.(j <= mnm ) .and.(j>0)) then
|
||||
a%val(i) = a%val(i) + sone
|
||||
endif
|
||||
enddo
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ls_coo_scalplusidentity
|
||||
|
||||
subroutine psb_ls_coo_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_spaxpby
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
implicit none
|
||||
|
||||
class(psb_ls_coo_sparse_mat), intent(inout) :: a
|
||||
class(psb_ls_base_sparse_mat), intent(inout) :: b
|
||||
real(psb_spk_), intent(in) :: alpha
|
||||
real(psb_spk_), intent(in) :: beta
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!Local
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='ls_coo_spaxpby'
|
||||
type(psb_ls_coo_sparse_mat) :: tcoo,bcoo
|
||||
integer(psb_lpk_) :: nza, nzb, M, N
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
! Copy (whatever) b format to coo
|
||||
call b%cp_to_coo(bcoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='cp_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
! Get information on the matrix
|
||||
M = a%get_nrows()
|
||||
N = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
nzb = b%get_nzeros()
|
||||
! Allocate (temporary) space for the solution
|
||||
call tcoo%allocate(M,N,(nza+nzb))
|
||||
! Compute the sum
|
||||
tcoo%ia(1:nza) = a%ia(1:nza)
|
||||
tcoo%ja(1:nza) = a%ja(1:nza)
|
||||
tcoo%val(1:nza) = alpha*a%val(1:nza)
|
||||
tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
|
||||
tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb)
|
||||
tcoo%val(nza+1:nza+nzb) = beta*bcoo%val(1:nzb)
|
||||
! Fix the indexes
|
||||
call tcoo%fix(info)
|
||||
! Move to correct output format
|
||||
call tcoo%mv_to_coo(a,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine psb_ls_coo_spaxpby
|
||||
|
||||
subroutine psb_ls_coo_reallocate_nz(nz,a)
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_reallocate_nz
|
||||
use psb_error_mod
|
||||
|
||||
@@ -3107,6 +3107,48 @@ subroutine psb_ls_csc_scals(d,a,info)
|
||||
|
||||
end subroutine psb_ls_csc_scals
|
||||
|
||||
subroutine psb_ls_csc_scalplusidentity(d,a,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_scalplusidentity
|
||||
implicit none
|
||||
class(psb_ls_csc_sparse_mat), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_lpk_) :: mnm, i, j, k, m
|
||||
integer(psb_ipk_) :: err_act, ierr(5)
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
do i=1,a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d
|
||||
do k=a%icp(i),a%icp(i+1)-1
|
||||
j=a%ia(k)
|
||||
if ((j == i) .and.(j <= mnm )) then
|
||||
a%val(k) = a%val(k) + sone
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ls_csc_scalplusidentity
|
||||
|
||||
function psb_ls_csc_maxval(a) result(res)
|
||||
use psb_error_mod
|
||||
|
||||
@@ -2486,6 +2486,41 @@ subroutine psb_s_scalplusidentity(d,a,info)
|
||||
|
||||
end subroutine psb_s_scalplusidentity
|
||||
|
||||
subroutine psb_s_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_s_mat_mod, psb_protect_name => psb_s_spaxpby
|
||||
implicit none
|
||||
real(psb_spk_), intent(in) :: alpha
|
||||
class(psb_sspmat_type), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: beta
|
||||
class(psb_sspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxby'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%spaxpby(alpha,beta,b%a,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_s_spaxpby
|
||||
|
||||
subroutine psb_s_mv_from_lb(a,b)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
@@ -4617,6 +4652,74 @@ subroutine psb_ls_scals(d,a,info)
|
||||
|
||||
end subroutine psb_ls_scals
|
||||
|
||||
subroutine psb_ls_scalplusidentity(d,a,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_s_mat_mod, psb_protect_name => psb_ls_scalplusidentity
|
||||
implicit none
|
||||
class(psb_lsspmat_type), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%scalpid(d,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ls_scalplusidentity
|
||||
|
||||
subroutine psb_ls_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_s_mat_mod, psb_protect_name => psb_ls_spaxpby
|
||||
implicit none
|
||||
real(psb_spk_), intent(in) :: alpha
|
||||
class(psb_lsspmat_type), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: beta
|
||||
class(psb_lsspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxby'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%spaxpby(alpha,beta,b%a,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ls_spaxpby
|
||||
|
||||
function psb_ls_maxval(a) result(res)
|
||||
use psb_s_mat_mod, psb_protect_name => psb_ls_maxval
|
||||
use psb_error_mod
|
||||
|
||||
@@ -3532,6 +3532,29 @@ subroutine psb_lz_base_scals(d,a,info)
|
||||
|
||||
end subroutine psb_lz_base_scals
|
||||
|
||||
subroutine psb_lz_base_scalplusidentity(d,a,info)
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_scalplusidentity
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_lz_base_sparse_mat), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='lz_scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name,a_err=a%get_fmt())
|
||||
|
||||
call psb_error_handler(err_act)
|
||||
|
||||
end subroutine psb_lz_base_scalplusidentity
|
||||
|
||||
subroutine psb_lz_base_scal(d,a,info,side)
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_scal
|
||||
use psb_error_mod
|
||||
@@ -3743,6 +3766,59 @@ subroutine psb_lz_base_aclsum(d,a)
|
||||
|
||||
end subroutine psb_lz_base_aclsum
|
||||
|
||||
subroutine psb_lz_base_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_spaxpby
|
||||
|
||||
complex(psb_dpk_), intent(in) :: alpha
|
||||
class(psb_lz_base_sparse_mat), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: beta
|
||||
class(psb_lz_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Auxiliary
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxpby'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_lz_coo_sparse_mat) :: acoo
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if((a%get_ncols() /= b%get_ncols()).or.(a%get_nrows() /= b%get_nrows())) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call a%mv_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acoo%spaxpby(alpha,beta,b,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='spaxby')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acoo%mv_to_fmt(a,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_fmt')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine psb_lz_base_spaxpby
|
||||
|
||||
subroutine psb_lz_base_get_diag(a,d,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
|
||||
@@ -4583,6 +4583,104 @@ subroutine psb_lz_coo_aclsum(d,a)
|
||||
|
||||
end subroutine psb_lz_coo_aclsum
|
||||
|
||||
subroutine psb_lz_coo_scalplusidentity(d,a,info)
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_scalplusidentity
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
implicit none
|
||||
class(psb_lz_coo_sparse_mat), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
do i=1,a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d
|
||||
j=a%ia(i)
|
||||
if ((j == a%ja(i)) .and.(j <= mnm ) .and.(j>0)) then
|
||||
a%val(i) = a%val(i) + zone
|
||||
endif
|
||||
enddo
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lz_coo_scalplusidentity
|
||||
|
||||
subroutine psb_lz_coo_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_spaxpby
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
implicit none
|
||||
|
||||
class(psb_lz_coo_sparse_mat), intent(inout) :: a
|
||||
class(psb_lz_base_sparse_mat), intent(inout) :: b
|
||||
complex(psb_dpk_), intent(in) :: alpha
|
||||
complex(psb_dpk_), intent(in) :: beta
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!Local
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='lz_coo_spaxpby'
|
||||
type(psb_lz_coo_sparse_mat) :: tcoo,bcoo
|
||||
integer(psb_lpk_) :: nza, nzb, M, N
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
! Copy (whatever) b format to coo
|
||||
call b%cp_to_coo(bcoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='cp_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
! Get information on the matrix
|
||||
M = a%get_nrows()
|
||||
N = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
nzb = b%get_nzeros()
|
||||
! Allocate (temporary) space for the solution
|
||||
call tcoo%allocate(M,N,(nza+nzb))
|
||||
! Compute the sum
|
||||
tcoo%ia(1:nza) = a%ia(1:nza)
|
||||
tcoo%ja(1:nza) = a%ja(1:nza)
|
||||
tcoo%val(1:nza) = alpha*a%val(1:nza)
|
||||
tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
|
||||
tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb)
|
||||
tcoo%val(nza+1:nza+nzb) = beta*bcoo%val(1:nzb)
|
||||
! Fix the indexes
|
||||
call tcoo%fix(info)
|
||||
! Move to correct output format
|
||||
call tcoo%mv_to_coo(a,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name, a_err='mv_to_coo')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine psb_lz_coo_spaxpby
|
||||
|
||||
subroutine psb_lz_coo_reallocate_nz(nz,a)
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_reallocate_nz
|
||||
use psb_error_mod
|
||||
|
||||
@@ -3107,6 +3107,48 @@ subroutine psb_lz_csc_scals(d,a,info)
|
||||
|
||||
end subroutine psb_lz_csc_scals
|
||||
|
||||
subroutine psb_lz_csc_scalplusidentity(d,a,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_scalplusidentity
|
||||
implicit none
|
||||
class(psb_lz_csc_sparse_mat), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_lpk_) :: mnm, i, j, k, m
|
||||
integer(psb_ipk_) :: err_act, ierr(5)
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
do i=1,a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d
|
||||
do k=a%icp(i),a%icp(i+1)-1
|
||||
j=a%ia(k)
|
||||
if ((j == i) .and.(j <= mnm )) then
|
||||
a%val(k) = a%val(k) + zone
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lz_csc_scalplusidentity
|
||||
|
||||
function psb_lz_csc_maxval(a) result(res)
|
||||
use psb_error_mod
|
||||
|
||||
@@ -2486,6 +2486,41 @@ subroutine psb_z_scalplusidentity(d,a,info)
|
||||
|
||||
end subroutine psb_z_scalplusidentity
|
||||
|
||||
subroutine psb_z_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_z_mat_mod, psb_protect_name => psb_z_spaxpby
|
||||
implicit none
|
||||
complex(psb_dpk_), intent(in) :: alpha
|
||||
class(psb_zspmat_type), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: beta
|
||||
class(psb_zspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxby'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%spaxpby(alpha,beta,b%a,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_z_spaxpby
|
||||
|
||||
subroutine psb_z_mv_from_lb(a,b)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
@@ -4617,6 +4652,74 @@ subroutine psb_lz_scals(d,a,info)
|
||||
|
||||
end subroutine psb_lz_scals
|
||||
|
||||
subroutine psb_lz_scalplusidentity(d,a,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_z_mat_mod, psb_protect_name => psb_lz_scalplusidentity
|
||||
implicit none
|
||||
class(psb_lzspmat_type), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='scalplusidentity'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%scalpid(d,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lz_scalplusidentity
|
||||
|
||||
subroutine psb_lz_spaxpby(alpha,a,beta,b,info)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_z_mat_mod, psb_protect_name => psb_lz_spaxpby
|
||||
implicit none
|
||||
complex(psb_dpk_), intent(in) :: alpha
|
||||
class(psb_lzspmat_type), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: beta
|
||||
class(psb_lzspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='spaxby'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%spaxpby(alpha,beta,b%a,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lz_spaxpby
|
||||
|
||||
function psb_lz_maxval(a) result(res)
|
||||
use psb_z_mat_mod, psb_protect_name => psb_lz_maxval
|
||||
use psb_error_mod
|
||||
|
||||
Reference in New Issue
Block a user