mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-07 07:04:57 +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
@@ -65,43 +65,65 @@ module psb_base_mat_mod
|
||||
use psi_serial_mod
|
||||
|
||||
!
|
||||
! type psb_base_sparse_mat: the basic data about your matrix
|
||||
! This class is extended twice, to provide the various
|
||||
! data variations S/D/C/Z and to implement the actual
|
||||
! storage formats. The grandchild classes are then
|
||||
! encapsulated to implement the STATE design pattern.
|
||||
! We have an ambiguity in that the inner class has a
|
||||
! "state" variable; we hope the context will make it clear.
|
||||
!> \namespace psb_base_mod \class psb_base_sparse_mat
|
||||
!! The basic data about your matrix.
|
||||
!! This class is extended twice, to provide the various
|
||||
!! data variations S/D/C/Z and to implement the actual
|
||||
!! storage formats. The grandchild classes are then
|
||||
!! encapsulated to implement the STATE design pattern.
|
||||
!! We have an ambiguity in that the inner class has a
|
||||
!! "state" variable; we hope the context will make it clear.
|
||||
!!
|
||||
!!
|
||||
!! The methods associated to this class can be grouped into three sets:
|
||||
!! - Fully implemented methods: some methods such as get_nrows or
|
||||
!! set_nrows can be fully implemented at this level.
|
||||
!! - Partially implemented methods: Some methods have an
|
||||
!! implementation that is split between this level and the leaf
|
||||
!! level. For example, the matrix transposition can be partially
|
||||
!! done at this level (swapping of the rows and columns dimensions)
|
||||
!! but it has to be completed by a method defined at the leaf level
|
||||
!! (for actually transposing the row and column indices).
|
||||
!! - Other methods: There are a number of methods that are defined
|
||||
!! (i.e their interface is defined) but not implemented at this
|
||||
!! level. This methods will be overwritten at the leaf level with
|
||||
!! an actual implementation. If it is not the case, the method
|
||||
!! defined at this level will raise an error. These methods are
|
||||
!! defined in the serial/impl/psb_base_mat_impl.f90 file
|
||||
!!
|
||||
!
|
||||
! M: number of rows
|
||||
! N: number of columns
|
||||
! STATE: null: pristine
|
||||
! build: it's being filled with entries
|
||||
! assembled: ready to use in computations
|
||||
! update: accepts coefficients but only
|
||||
! in already existing entries
|
||||
! The transitions among the states are detailed in
|
||||
! psb_T_mat_mod
|
||||
!
|
||||
! TRIANGLE: is it triangular?
|
||||
! UPPER: If it is triangular, is it upper (otherwise lower)?
|
||||
! UNITD: If it is triangular, is the diagonal assumed to
|
||||
! be unitary and not stored explicitly?
|
||||
! SORTED: are the entries guaranteed to be sorted?
|
||||
!
|
||||
! DUPLICATE: How duplicate entries are to be handled when
|
||||
! transitioning from the BUILD to the ASSEMBLED state.
|
||||
! While many formats would allow for duplicate
|
||||
! entries, it is much better to constrain the matrices
|
||||
! NOT to have duplicate entries, except while in the
|
||||
! BUILD state; in our overall design, only COO matrices
|
||||
! can ever be in the BUILD state, hence all other formats
|
||||
! cannot have duplicate entries.
|
||||
!
|
||||
|
||||
type :: psb_base_sparse_mat
|
||||
integer(psb_ipk_), private :: m, n
|
||||
integer(psb_ipk_), private :: state, duplicate
|
||||
logical, private :: triangle, upper, unitd, sorted
|
||||
!> Row size
|
||||
integer(psb_ipk_), private :: m
|
||||
!> Col size
|
||||
integer(psb_ipk_), private :: n
|
||||
!> Matrix state:
|
||||
!! null: pristine;
|
||||
!! build: it's being filled with entries;
|
||||
!! assembled: ready to use in computations;
|
||||
!! update: accepts coefficients but only
|
||||
!! in already existing entries.
|
||||
!! The transitions among the states are detailed in
|
||||
!! psb_T_mat_mod.
|
||||
integer(psb_ipk), private :: state
|
||||
!> How to treat duplicate elements when
|
||||
!! transitioning from the BUILD to the ASSEMBLED state.
|
||||
!! While many formats would allow for duplicate
|
||||
!! entries, it is much better to constrain the matrices
|
||||
!! NOT to have duplicate entries, except while in the
|
||||
!! BUILD state; in our overall design, only COO matrices
|
||||
!! can ever be in the BUILD state, hence all other formats
|
||||
!! cannot have duplicate entries.
|
||||
integer(psb_ipk), private :: duplicate
|
||||
!> Is the matrix triangular? (must also be square)
|
||||
logical, private :: triangle
|
||||
!> Is the matrix upper or lower? (only if triangular)
|
||||
logical, private :: upper
|
||||
!> Is the matrix diagonal stored or assumed unitary? (only if triangular)
|
||||
logical, private :: unitd
|
||||
!> Are the coefficients sorted by row and column indices?
|
||||
logical, private :: sorted
|
||||
contains
|
||||
|
||||
! == = =================================
|
||||
@@ -178,10 +200,10 @@ module psb_base_mat_mod
|
||||
|
||||
end type psb_base_sparse_mat
|
||||
|
||||
!
|
||||
! GET_NZ_ROW:
|
||||
!
|
||||
! count(A(idx,:)/=0)
|
||||
!> Function: psb_base_get_nz_row
|
||||
!! Interface for the get_nz_row method. Equivalent to:
|
||||
!! count(A(idx,:)/=0)
|
||||
!! \param idx The line we are interested in.
|
||||
!
|
||||
interface
|
||||
function psb_base_get_nz_row(idx,a) result(res)
|
||||
@@ -193,9 +215,9 @@ module psb_base_mat_mod
|
||||
end interface
|
||||
|
||||
!
|
||||
! GET_NZEROS:
|
||||
!
|
||||
! count(A(:,:)/=0)
|
||||
!> Function: psb_base_get_nzeros
|
||||
!! Interface for the get_nzeros method. Equivalent to:
|
||||
!! count(A(:,:)/=0)
|
||||
!
|
||||
interface
|
||||
function psb_base_get_nzeros(a) result(res)
|
||||
@@ -205,11 +227,11 @@ module psb_base_mat_mod
|
||||
end function psb_base_get_nzeros
|
||||
end interface
|
||||
|
||||
!
|
||||
! GET_SIZE: how many items can A hold with
|
||||
! its current space allocation?
|
||||
! (as opposed to how many are
|
||||
! currently occupied)
|
||||
!> Function get_size
|
||||
!! how many items can A hold with
|
||||
!! its current space allocation?
|
||||
!! (as opposed to how many are
|
||||
!! currently occupied)
|
||||
!
|
||||
interface
|
||||
function psb_base_get_size(a) result(res)
|
||||
@@ -220,8 +242,8 @@ module psb_base_mat_mod
|
||||
end interface
|
||||
|
||||
!
|
||||
! REINIT: transition state from ASB to UPDATE
|
||||
! by default zero the coefficient values.
|
||||
!> Function reinit: transition state from ASB to UPDATE
|
||||
!! \param clear [true] explicitly zero out coefficients.
|
||||
!
|
||||
interface
|
||||
subroutine psb_base_reinit(a,clear)
|
||||
@@ -233,12 +255,13 @@ module psb_base_mat_mod
|
||||
|
||||
|
||||
!
|
||||
! PRINT: print on file in Matrix Market format.
|
||||
! Optional arguments:
|
||||
! head: header descriptive string.
|
||||
! iv: renumbering to be applied to both rows and columns
|
||||
! ivr, ivc: renumbering to be applied independently to
|
||||
! rows and columns
|
||||
!> Function
|
||||
!! print on file in Matrix Market format.
|
||||
!! \param iout the output unit
|
||||
!! \param iv(:) [none] renumber both row and column indices
|
||||
!! \param head [none] a descriptive header for the matrix data
|
||||
!! \param ivr(:) [none] renumbering for the rows
|
||||
!! \param ivc(:) [none] renumbering for the cols
|
||||
!
|
||||
interface
|
||||
subroutine psb_base_sparse_print(iout,a,iv,head,ivr,ivc)
|
||||
@@ -253,20 +276,29 @@ module psb_base_mat_mod
|
||||
|
||||
|
||||
!
|
||||
! GETPTN: Get the pattern.
|
||||
! Return a list of NZ pairs
|
||||
! (IA(i),JA(i))
|
||||
! each identifying the position of a nonzero in A
|
||||
! between row indices IMIN:IMAX.
|
||||
! IA,JA are reallocated as necessary.
|
||||
! Optional arguments:
|
||||
! iren: return (IREN(IA(:)),IREN(JA(:))
|
||||
! RSCALE: map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1]
|
||||
! CSCALE: map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1]
|
||||
!
|
||||
! iren cannot be specified with rscale/cscale.
|
||||
!
|
||||
! APPEND: append to IA,JA; first new entry will be in NZIN+1
|
||||
!> Function getptn:
|
||||
!! \brief Get the pattern.
|
||||
!!
|
||||
!!
|
||||
!! Return a list of NZ pairs
|
||||
!! (IA(i),JA(i))
|
||||
!! each identifying the position of a nonzero in A
|
||||
!! between row indices IMIN:IMAX;
|
||||
!! IA,JA are reallocated as necessary.
|
||||
!! \param imin the minimum row index we are interested in
|
||||
!! \param imax the minimum row index we are interested in
|
||||
!! \param nz the number of output coefficients
|
||||
!! \param ia(:) the output row indices
|
||||
!! \param ja(:) the output col indices
|
||||
!! \param info return code
|
||||
!! \param jmin [1] minimum col index
|
||||
!! \param jmax [a\%get_ncols()] maximum col index
|
||||
!! \param iren(:) [none] an array to return renumbered indices (iren(ia(:)),iren(ja(:))
|
||||
!! \param rscale [false] map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1]
|
||||
!! \param cscale [false] map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1]
|
||||
!! ( iren cannot be specified with rscale/cscale)
|
||||
!! \param append [false] append to ia,ja
|
||||
!! \param nzin [none] if append, then first new entry should go in entry nzin+1
|
||||
!
|
||||
|
||||
interface
|
||||
@@ -286,10 +318,18 @@ module psb_base_mat_mod
|
||||
end interface
|
||||
|
||||
!
|
||||
! GETNEIGH: Get the neighbours of index IDX, i.e.
|
||||
! get the nonzero indices in its row.
|
||||
! Optional: LEV: recurse at LEV levels,
|
||||
! i.e. LEV=2 add neighours of neighbours of IDX, etc.
|
||||
!> Function get_neigh:
|
||||
!! \brief Get the neighbours.
|
||||
!!
|
||||
!!
|
||||
!! Return a list of N indices of neighbours of index idx,
|
||||
!! i.e. the indices of the nonzeros in row idx of matrix A
|
||||
!! \param idx the index we are interested in
|
||||
!! \param neigh(:) the list of indices, reallocated as necessary
|
||||
!! \param n the number of indices returned
|
||||
!! \param info return code
|
||||
!! \param lev [1] find neighbours recursively for LEV levels,
|
||||
!! i.e. when lev=2 find neighours of neighbours, etc.
|
||||
!
|
||||
interface
|
||||
subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev)
|
||||
@@ -304,9 +344,13 @@ module psb_base_mat_mod
|
||||
end interface
|
||||
|
||||
!
|
||||
! ALLOCATE_MNNZ: allocate/initialize empty for
|
||||
! an MxN matrix capable of holding NZ nonzeros.
|
||||
! Note: NZ is usually an estimate
|
||||
!
|
||||
!> Function allocate_mnnz
|
||||
!! \brief Three-parameters version of allocate
|
||||
!!
|
||||
!! \param m number of rows
|
||||
!! \param n number of cols
|
||||
!! \param nz [estimated internally] number of nonzeros to allocate for
|
||||
!
|
||||
interface
|
||||
subroutine psb_base_allocate_mnnz(m,n,a,nz)
|
||||
@@ -319,7 +363,11 @@ module psb_base_mat_mod
|
||||
|
||||
|
||||
!
|
||||
! REALLOCATE_NZ: make room for NZ in an existing matrix
|
||||
!
|
||||
!> Function reallocate_nz
|
||||
!! \brief One--parameters version of (re)allocate
|
||||
!!
|
||||
!! \param nz number of nonzeros to allocate for
|
||||
!
|
||||
interface
|
||||
subroutine psb_base_reallocate_nz(nz,a)
|
||||
@@ -330,7 +378,8 @@ module psb_base_mat_mod
|
||||
end interface
|
||||
|
||||
!
|
||||
! FREE: name says all
|
||||
!> Function free
|
||||
!! \brief destructor
|
||||
!
|
||||
interface
|
||||
subroutine psb_base_free(a)
|
||||
@@ -340,8 +389,10 @@ module psb_base_mat_mod
|
||||
end interface
|
||||
|
||||
!
|
||||
! TRIM: reallocate internal memory to the barest minimum
|
||||
! necessary to hold the current nonzeros.
|
||||
!> Function trim
|
||||
!! \brief Memory trim
|
||||
!! Make sure the memory allocation of the sparse matrix is as tight as
|
||||
!! possible given the actual number of nonzeros it contains.
|
||||
!
|
||||
interface
|
||||
subroutine psb_base_trim(a)
|
||||
@@ -355,7 +406,8 @@ contains
|
||||
|
||||
|
||||
!
|
||||
! SIZEOF: size in bytes
|
||||
!> Function free
|
||||
!! \brief Memory occupation in byes
|
||||
!
|
||||
function psb_base_sizeof(a) result(res)
|
||||
implicit none
|
||||
@@ -365,7 +417,8 @@ contains
|
||||
end function psb_base_sizeof
|
||||
|
||||
!
|
||||
! GET_FMT: descriptive name (e.g. COO CSR etc.)
|
||||
!> Function get_fmt
|
||||
!! \brief return a short descriptive name (e.g. COO CSR etc.)
|
||||
!
|
||||
function psb_base_get_fmt() result(res)
|
||||
implicit none
|
||||
|
||||
@@ -594,11 +594,12 @@ module psb_c_base_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_c_base_scal(d,a,info)
|
||||
subroutine psb_c_base_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_c_base_sparse_mat, psb_spk_
|
||||
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
|
||||
end subroutine psb_c_base_scal
|
||||
end interface
|
||||
|
||||
@@ -1011,11 +1012,12 @@ module psb_c_base_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_c_coo_scal(d,a,info)
|
||||
subroutine psb_c_coo_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_c_coo_sparse_mat, psb_spk_
|
||||
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
|
||||
end subroutine psb_c_coo_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -404,11 +404,12 @@ module psb_c_csc_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_c_csc_scal(d,a,info)
|
||||
subroutine psb_c_csc_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_c_csc_sparse_mat, psb_spk_
|
||||
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
|
||||
end subroutine psb_c_csc_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -404,11 +404,12 @@ module psb_c_csr_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_c_csr_scal(d,a,info)
|
||||
subroutine psb_c_csr_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_c_csr_sparse_mat, psb_spk_
|
||||
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
|
||||
end subroutine psb_c_csr_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -766,11 +766,12 @@ module psb_c_mat_mod
|
||||
end interface
|
||||
|
||||
interface psb_scal
|
||||
subroutine psb_c_scal(d,a,info)
|
||||
subroutine psb_c_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_cspmat_type, psb_spk_
|
||||
class(psb_cspmat_type), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
end subroutine psb_c_scal
|
||||
subroutine psb_c_scals(d,a,info)
|
||||
import :: psb_ipk_, psb_cspmat_type, psb_spk_
|
||||
|
||||
@@ -594,11 +594,12 @@ module psb_d_base_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_d_base_scal(d,a,info)
|
||||
subroutine psb_d_base_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
|
||||
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
|
||||
end subroutine psb_d_base_scal
|
||||
end interface
|
||||
|
||||
@@ -1011,11 +1012,12 @@ module psb_d_base_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_d_coo_scal(d,a,info)
|
||||
subroutine psb_d_coo_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
|
||||
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
|
||||
end subroutine psb_d_coo_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -404,11 +404,12 @@ module psb_d_csc_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_d_csc_scal(d,a,info)
|
||||
subroutine psb_d_csc_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
|
||||
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
|
||||
end subroutine psb_d_csc_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -404,11 +404,12 @@ module psb_d_csr_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_d_csr_scal(d,a,info)
|
||||
subroutine psb_d_csr_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_d_csr_sparse_mat, psb_dpk_
|
||||
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
|
||||
end subroutine psb_d_csr_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -44,7 +44,7 @@
|
||||
! the functionalities to have the encapsulated class change its
|
||||
! type dynamically, and to extract/input an inner object.
|
||||
!
|
||||
! A sparse matrix has a state corresponding to its progression
|
||||
! A sparse matric has a state corresponding to its progression
|
||||
! through the application life.
|
||||
! In particular, computational methods can only be invoked when
|
||||
! the matrix is in the ASSEMBLED state, whereas the other states are
|
||||
@@ -766,11 +766,12 @@ module psb_d_mat_mod
|
||||
end interface
|
||||
|
||||
interface psb_scal
|
||||
subroutine psb_d_scal(d,a,info)
|
||||
subroutine psb_d_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
|
||||
class(psb_dspmat_type), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
end subroutine psb_d_scal
|
||||
subroutine psb_d_scals(d,a,info)
|
||||
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
|
||||
|
||||
@@ -594,11 +594,12 @@ module psb_s_base_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_s_base_scal(d,a,info)
|
||||
subroutine psb_s_base_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_s_base_sparse_mat, psb_spk_
|
||||
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
|
||||
end subroutine psb_s_base_scal
|
||||
end interface
|
||||
|
||||
@@ -1011,11 +1012,12 @@ module psb_s_base_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_s_coo_scal(d,a,info)
|
||||
subroutine psb_s_coo_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_s_coo_sparse_mat, psb_spk_
|
||||
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
|
||||
end subroutine psb_s_coo_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -404,11 +404,12 @@ module psb_s_csc_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_s_csc_scal(d,a,info)
|
||||
subroutine psb_s_csc_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_s_csc_sparse_mat, psb_spk_
|
||||
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
|
||||
end subroutine psb_s_csc_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -404,11 +404,12 @@ module psb_s_csr_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_s_csr_scal(d,a,info)
|
||||
subroutine psb_s_csr_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_s_csr_sparse_mat, psb_spk_
|
||||
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
|
||||
end subroutine psb_s_csr_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -766,11 +766,12 @@ module psb_s_mat_mod
|
||||
end interface
|
||||
|
||||
interface psb_scal
|
||||
subroutine psb_s_scal(d,a,info)
|
||||
subroutine psb_s_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_sspmat_type, psb_spk_
|
||||
class(psb_sspmat_type), intent(inout) :: a
|
||||
real(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
end subroutine psb_s_scal
|
||||
subroutine psb_s_scals(d,a,info)
|
||||
import :: psb_ipk_, psb_sspmat_type, psb_spk_
|
||||
|
||||
@@ -594,11 +594,12 @@ module psb_z_base_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_z_base_scal(d,a,info)
|
||||
subroutine psb_z_base_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_z_base_sparse_mat, psb_dpk_
|
||||
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
|
||||
end subroutine psb_z_base_scal
|
||||
end interface
|
||||
|
||||
@@ -1011,11 +1012,12 @@ module psb_z_base_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_z_coo_scal(d,a,info)
|
||||
subroutine psb_z_coo_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_z_coo_sparse_mat, psb_dpk_
|
||||
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
|
||||
end subroutine psb_z_coo_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -404,11 +404,12 @@ module psb_z_csc_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_z_csc_scal(d,a,info)
|
||||
subroutine psb_z_csc_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_z_csc_sparse_mat, psb_dpk_
|
||||
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
|
||||
end subroutine psb_z_csc_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -404,11 +404,12 @@ module psb_z_csr_mat_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_z_csr_scal(d,a,info)
|
||||
subroutine psb_z_csr_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_z_csr_sparse_mat, psb_dpk_
|
||||
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
|
||||
end subroutine psb_z_csr_scal
|
||||
end interface
|
||||
|
||||
|
||||
@@ -766,11 +766,12 @@ module psb_z_mat_mod
|
||||
end interface
|
||||
|
||||
interface psb_scal
|
||||
subroutine psb_z_scal(d,a,info)
|
||||
subroutine psb_z_scal(d,a,info,side)
|
||||
import :: psb_ipk_, psb_zspmat_type, psb_dpk_
|
||||
class(psb_zspmat_type), intent(inout) :: a
|
||||
complex(psb_dpk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
end subroutine psb_z_scal
|
||||
subroutine psb_z_scals(d,a,info)
|
||||
import :: psb_ipk_, psb_zspmat_type, psb_dpk_
|
||||
|
||||
@@ -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