mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-20 12:52:14 +00:00
psblas3:
base/modules/psb_base_mat_mod.f90 base/modules/psb_c_base_mat_mod.f90 base/modules/psb_c_csc_mat_mod.f90 base/modules/psb_c_csr_mat_mod.f90 base/modules/psb_c_mat_mod.f90 base/modules/psb_d_base_mat_mod.f90 base/modules/psb_d_csc_mat_mod.f90 base/modules/psb_d_csr_mat_mod.f90 base/modules/psb_d_mat_mod.f90 base/modules/psb_s_base_mat_mod.f90 base/modules/psb_s_csc_mat_mod.f90 base/modules/psb_s_csr_mat_mod.f90 base/modules/psb_s_mat_mod.f90 base/modules/psb_z_base_mat_mod.f90 base/modules/psb_z_csc_mat_mod.f90 base/modules/psb_z_csr_mat_mod.f90 base/modules/psb_z_mat_mod.f90 base/serial/impl/psb_c_base_mat_impl.f90 base/serial/impl/psb_c_coo_impl.f90 base/serial/impl/psb_c_csc_impl.f90 base/serial/impl/psb_c_csr_impl.f90 base/serial/impl/psb_c_mat_impl.F90 base/serial/impl/psb_d_base_mat_impl.f90 base/serial/impl/psb_d_coo_impl.f90 base/serial/impl/psb_d_csc_impl.f90 base/serial/impl/psb_d_csr_impl.f90 base/serial/impl/psb_d_mat_impl.F90 base/serial/impl/psb_s_base_mat_impl.f90 base/serial/impl/psb_s_coo_impl.f90 base/serial/impl/psb_s_csc_impl.f90 base/serial/impl/psb_s_csr_impl.f90 base/serial/impl/psb_s_mat_impl.F90 base/serial/impl/psb_z_base_mat_impl.f90 base/serial/impl/psb_z_coo_impl.f90 base/serial/impl/psb_z_csc_impl.f90 base/serial/impl/psb_z_csr_impl.f90 base/serial/impl/psb_z_mat_impl.F90 doxypsb Added scale on right method. Added doxypsb.
This commit is contained in:
Salvatore Filippone
@@ -1093,13 +1093,14 @@ end subroutine psb_c_base_scals
|
||||
|
||||
|
||||
|
||||
subroutine psb_c_base_scal(d,a,info)
|
||||
subroutine psb_c_base_scal(d,a,info,side)
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_scal
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
|
||||
@@ -49,35 +49,61 @@ subroutine psb_c_coo_get_diag(a,d,info)
|
||||
end subroutine psb_c_coo_get_diag
|
||||
|
||||
|
||||
subroutine psb_c_coo_scal(d,a,info)
|
||||
subroutine psb_c_coo_scal(d,a,info,side)
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_scal
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ia(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ia(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
else
|
||||
m = a%get_ncols()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ja(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -1215,7 +1241,6 @@ subroutine psb_c_coo_csmv(alpha,a,x,beta,y,info,trans)
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
|
||||
|
||||
@@ -1384,37 +1384,61 @@ subroutine psb_c_csc_get_diag(a,d,info)
|
||||
end subroutine psb_c_csc_get_diag
|
||||
|
||||
|
||||
subroutine psb_c_csc_scal(d,a,info)
|
||||
subroutine psb_c_csc_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_scal
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_c_csc_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, n
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1, n
|
||||
do j = a%icp(i), a%icp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(a%ia(j))
|
||||
end do
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d(a%ia(i))
|
||||
enddo
|
||||
else
|
||||
n = a%get_nrows()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do j=1, n
|
||||
do i = a%icp(j), a%icp(j+1) -1
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
end do
|
||||
enddo
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
@@ -1589,36 +1589,64 @@ subroutine psb_c_csr_get_diag(a,d,info)
|
||||
end subroutine psb_c_csr_get_diag
|
||||
|
||||
|
||||
subroutine psb_c_csr_scal(d,a,info)
|
||||
subroutine psb_c_csr_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_scal
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_c_csr_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
do j = a%irp(i), a%irp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(i)
|
||||
end do
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
do j = a%irp(i), a%irp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(i)
|
||||
end do
|
||||
enddo
|
||||
else
|
||||
m = a%get_ncols()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ja(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
end if
|
||||
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2323,7 +2323,7 @@ subroutine psb_c_get_diag(a,d,info)
|
||||
end subroutine psb_c_get_diag
|
||||
|
||||
|
||||
subroutine psb_c_scal(d,a,info)
|
||||
subroutine psb_c_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_c_mat_mod, psb_protect_name => psb_c_scal
|
||||
@@ -2331,6 +2331,7 @@ subroutine psb_c_scal(d,a,info)
|
||||
class(psb_cspmat_type), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='scal'
|
||||
@@ -2344,7 +2345,7 @@ subroutine psb_c_scal(d,a,info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%scal(d,info)
|
||||
call a%a%scal(d,info,side=side)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -1093,13 +1093,14 @@ end subroutine psb_d_base_scals
|
||||
|
||||
|
||||
|
||||
subroutine psb_d_base_scal(d,a,info)
|
||||
subroutine psb_d_base_scal(d,a,info,side)
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_scal
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_d_base_sparse_mat), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
|
||||
@@ -49,35 +49,61 @@ subroutine psb_d_coo_get_diag(a,d,info)
|
||||
end subroutine psb_d_coo_get_diag
|
||||
|
||||
|
||||
subroutine psb_d_coo_scal(d,a,info)
|
||||
subroutine psb_d_coo_scal(d,a,info,side)
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_scal
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_d_coo_sparse_mat), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ia(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ia(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
else
|
||||
m = a%get_ncols()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ja(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -1215,7 +1241,6 @@ subroutine psb_d_coo_csmv(alpha,a,x,beta,y,info,trans)
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
|
||||
|
||||
@@ -1384,37 +1384,61 @@ subroutine psb_d_csc_get_diag(a,d,info)
|
||||
end subroutine psb_d_csc_get_diag
|
||||
|
||||
|
||||
subroutine psb_d_csc_scal(d,a,info)
|
||||
subroutine psb_d_csc_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_scal
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_d_csc_sparse_mat), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, n
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1, n
|
||||
do j = a%icp(i), a%icp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(a%ia(j))
|
||||
end do
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d(a%ia(i))
|
||||
enddo
|
||||
else
|
||||
n = a%get_nrows()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do j=1, n
|
||||
do i = a%icp(j), a%icp(j+1) -1
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
end do
|
||||
enddo
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
@@ -1589,36 +1589,64 @@ subroutine psb_d_csr_get_diag(a,d,info)
|
||||
end subroutine psb_d_csr_get_diag
|
||||
|
||||
|
||||
subroutine psb_d_csr_scal(d,a,info)
|
||||
subroutine psb_d_csr_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_scal
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_d_csr_sparse_mat), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
do j = a%irp(i), a%irp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(i)
|
||||
end do
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
do j = a%irp(i), a%irp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(i)
|
||||
end do
|
||||
enddo
|
||||
else
|
||||
m = a%get_ncols()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ja(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
end if
|
||||
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2323,7 +2323,7 @@ subroutine psb_d_get_diag(a,d,info)
|
||||
end subroutine psb_d_get_diag
|
||||
|
||||
|
||||
subroutine psb_d_scal(d,a,info)
|
||||
subroutine psb_d_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_d_mat_mod, psb_protect_name => psb_d_scal
|
||||
@@ -2331,6 +2331,7 @@ subroutine psb_d_scal(d,a,info)
|
||||
class(psb_dspmat_type), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='scal'
|
||||
@@ -2344,7 +2345,7 @@ subroutine psb_d_scal(d,a,info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%scal(d,info)
|
||||
call a%a%scal(d,info,side=side)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -1093,13 +1093,14 @@ end subroutine psb_s_base_scals
|
||||
|
||||
|
||||
|
||||
subroutine psb_s_base_scal(d,a,info)
|
||||
subroutine psb_s_base_scal(d,a,info,side)
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_scal
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_s_base_sparse_mat), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
|
||||
@@ -49,35 +49,61 @@ subroutine psb_s_coo_get_diag(a,d,info)
|
||||
end subroutine psb_s_coo_get_diag
|
||||
|
||||
|
||||
subroutine psb_s_coo_scal(d,a,info)
|
||||
subroutine psb_s_coo_scal(d,a,info,side)
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_scal
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_s_coo_sparse_mat), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ia(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ia(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
else
|
||||
m = a%get_ncols()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ja(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -1215,7 +1241,6 @@ subroutine psb_s_coo_csmv(alpha,a,x,beta,y,info,trans)
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
|
||||
|
||||
@@ -1384,37 +1384,61 @@ subroutine psb_s_csc_get_diag(a,d,info)
|
||||
end subroutine psb_s_csc_get_diag
|
||||
|
||||
|
||||
subroutine psb_s_csc_scal(d,a,info)
|
||||
subroutine psb_s_csc_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_scal
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_s_csc_sparse_mat), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, n
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1, n
|
||||
do j = a%icp(i), a%icp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(a%ia(j))
|
||||
end do
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d(a%ia(i))
|
||||
enddo
|
||||
else
|
||||
n = a%get_nrows()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do j=1, n
|
||||
do i = a%icp(j), a%icp(j+1) -1
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
end do
|
||||
enddo
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
@@ -1589,36 +1589,64 @@ subroutine psb_s_csr_get_diag(a,d,info)
|
||||
end subroutine psb_s_csr_get_diag
|
||||
|
||||
|
||||
subroutine psb_s_csr_scal(d,a,info)
|
||||
subroutine psb_s_csr_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_scal
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_s_csr_sparse_mat), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
do j = a%irp(i), a%irp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(i)
|
||||
end do
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
do j = a%irp(i), a%irp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(i)
|
||||
end do
|
||||
enddo
|
||||
else
|
||||
m = a%get_ncols()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ja(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
end if
|
||||
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2323,7 +2323,7 @@ subroutine psb_s_get_diag(a,d,info)
|
||||
end subroutine psb_s_get_diag
|
||||
|
||||
|
||||
subroutine psb_s_scal(d,a,info)
|
||||
subroutine psb_s_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_s_mat_mod, psb_protect_name => psb_s_scal
|
||||
@@ -2331,6 +2331,7 @@ subroutine psb_s_scal(d,a,info)
|
||||
class(psb_sspmat_type), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='scal'
|
||||
@@ -2344,7 +2345,7 @@ subroutine psb_s_scal(d,a,info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%scal(d,info)
|
||||
call a%a%scal(d,info,side=side)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -1093,13 +1093,14 @@ end subroutine psb_z_base_scals
|
||||
|
||||
|
||||
|
||||
subroutine psb_z_base_scal(d,a,info)
|
||||
subroutine psb_z_base_scal(d,a,info,side)
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_scal
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_z_base_sparse_mat), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
|
||||
@@ -49,35 +49,61 @@ subroutine psb_z_coo_get_diag(a,d,info)
|
||||
end subroutine psb_z_coo_get_diag
|
||||
|
||||
|
||||
subroutine psb_z_coo_scal(d,a,info)
|
||||
subroutine psb_z_coo_scal(d,a,info,side)
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_scal
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_z_coo_sparse_mat), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ia(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ia(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
else
|
||||
m = a%get_ncols()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ja(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -1215,7 +1241,6 @@ subroutine psb_z_coo_csmv(alpha,a,x,beta,y,info,trans)
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
|
||||
|
||||
@@ -1384,37 +1384,61 @@ subroutine psb_z_csc_get_diag(a,d,info)
|
||||
end subroutine psb_z_csc_get_diag
|
||||
|
||||
|
||||
subroutine psb_z_csc_scal(d,a,info)
|
||||
subroutine psb_z_csc_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_scal
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_z_csc_sparse_mat), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, n
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1, n
|
||||
do j = a%icp(i), a%icp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(a%ia(j))
|
||||
end do
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, a%get_nzeros()
|
||||
a%val(i) = a%val(i) * d(a%ia(i))
|
||||
enddo
|
||||
else
|
||||
n = a%get_nrows()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do j=1, n
|
||||
do i = a%icp(j), a%icp(j+1) -1
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
end do
|
||||
enddo
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
@@ -1589,36 +1589,64 @@ subroutine psb_z_csr_get_diag(a,d,info)
|
||||
end subroutine psb_z_csr_get_diag
|
||||
|
||||
|
||||
subroutine psb_z_csr_scal(d,a,info)
|
||||
subroutine psb_z_csr_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_scal
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
class(psb_z_csr_sparse_mat), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act,mnm, i, j, m
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
do j = a%irp(i), a%irp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(i)
|
||||
end do
|
||||
enddo
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
do j = a%irp(i), a%irp(i+1) -1
|
||||
a%val(j) = a%val(j) * d(i)
|
||||
end do
|
||||
enddo
|
||||
else
|
||||
m = a%get_ncols()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,a%get_nzeros()
|
||||
j = a%ja(i)
|
||||
a%val(i) = a%val(i) * d(j)
|
||||
enddo
|
||||
end if
|
||||
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2323,7 +2323,7 @@ subroutine psb_z_get_diag(a,d,info)
|
||||
end subroutine psb_z_get_diag
|
||||
|
||||
|
||||
subroutine psb_z_scal(d,a,info)
|
||||
subroutine psb_z_scal(d,a,info,side)
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_z_mat_mod, psb_protect_name => psb_z_scal
|
||||
@@ -2331,6 +2331,7 @@ subroutine psb_z_scal(d,a,info)
|
||||
class(psb_zspmat_type), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='scal'
|
||||
@@ -2344,7 +2345,7 @@ subroutine psb_z_scal(d,a,info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%scal(d,info)
|
||||
call a%a%scal(d,info,side=side)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
Reference in New Issue
Block a user