fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
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.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent c0bbff11bd
commit 0d79ec597f
38 changed files with 2403 additions and 259 deletions
Show Stats Download Patch File Download Diff File

217
base/modules/psb_base_mat_mod.f90
Unescape Escape View File

@ -65,43 +65,65 @@ module psb_base_mat_mod
use psi_serial_mod use psi_serial_mod
! !
! type psb_base_sparse_mat: the basic data about your matrix !> \namespace psb_base_mod \class psb_base_sparse_mat
! This class is extended twice, to provide the various !! The basic data about your matrix.
! data variations S/D/C/Z and to implement the actual !! This class is extended twice, to provide the various
! storage formats. The grandchild classes are then !! data variations S/D/C/Z and to implement the actual
! encapsulated to implement the STATE design pattern. !! storage formats. The grandchild classes are then
! We have an ambiguity in that the inner class has a !! encapsulated to implement the STATE design pattern.
! "state" variable; we hope the context will make it clear. !! We have an ambiguity in that the inner class has a
! !! "state" variable; we hope the context will make it clear.
! M: number of rows !!
! N: number of columns !!
! STATE: null: pristine !! The methods associated to this class can be grouped into three sets:
! build: it's being filled with entries !! - Fully implemented methods: some methods such as get_nrows or
! assembled: ready to use in computations !! set_nrows can be fully implemented at this level.
! update: accepts coefficients but only !! - Partially implemented methods: Some methods have an
! in already existing entries !! implementation that is split between this level and the leaf
! The transitions among the states are detailed in !! level. For example, the matrix transposition can be partially
! psb_T_mat_mod !! 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
! TRIANGLE: is it triangular? !! (for actually transposing the row and column indices).
! UPPER: If it is triangular, is it upper (otherwise lower)? !! - Other methods: There are a number of methods that are defined
! UNITD: If it is triangular, is the diagonal assumed to !! (i.e their interface is defined) but not implemented at this
! be unitary and not stored explicitly? !! level. This methods will be overwritten at the leaf level with
! SORTED: are the entries guaranteed to be sorted? !! an actual implementation. If it is not the case, the method
! !! defined at this level will raise an error. These methods are
! DUPLICATE: How duplicate entries are to be handled when !! defined in the serial/impl/psb_base_mat_impl.f90 file
! 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 type :: psb_base_sparse_mat
integer(psb_ipk_), private :: m, n !> Row size
integer(psb_ipk_), private :: state, duplicate integer(psb_ipk_), private :: m
logical, private :: triangle, upper, unitd, sorted !> 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 contains
! == = ================================= ! == = =================================
@ -178,10 +200,10 @@ module psb_base_mat_mod
end type psb_base_sparse_mat end type psb_base_sparse_mat
! !> Function: psb_base_get_nz_row
! GET_NZ_ROW: !! Interface for the get_nz_row method. Equivalent to:
! !! count(A(idx,:)/=0)
! count(A(idx,:)/=0) !! \param idx The line we are interested in.
! !
interface interface
function psb_base_get_nz_row(idx,a) result(res) function psb_base_get_nz_row(idx,a) result(res)
@ -193,9 +215,9 @@ module psb_base_mat_mod
end interface end interface
! !
! GET_NZEROS: !> Function: psb_base_get_nzeros
! !! Interface for the get_nzeros method. Equivalent to:
! count(A(:,:)/=0) !! count(A(:,:)/=0)
! !
interface interface
function psb_base_get_nzeros(a) result(res) function psb_base_get_nzeros(a) result(res)
@ -205,11 +227,11 @@ module psb_base_mat_mod
end function psb_base_get_nzeros end function psb_base_get_nzeros
end interface end interface
! !> Function get_size
! GET_SIZE: how many items can A hold with !! how many items can A hold with
! its current space allocation? !! its current space allocation?
! (as opposed to how many are !! (as opposed to how many are
! currently occupied) !! currently occupied)
! !
interface interface
function psb_base_get_size(a) result(res) function psb_base_get_size(a) result(res)
@ -220,8 +242,8 @@ module psb_base_mat_mod
end interface end interface
! !
! REINIT: transition state from ASB to UPDATE !> Function reinit: transition state from ASB to UPDATE
! by default zero the coefficient values. !! \param clear [true] explicitly zero out coefficients.
! !
interface interface
subroutine psb_base_reinit(a,clear) subroutine psb_base_reinit(a,clear)
@ -233,12 +255,13 @@ module psb_base_mat_mod
! !
! PRINT: print on file in Matrix Market format. !> Function
! Optional arguments: !! print on file in Matrix Market format.
! head: header descriptive string. !! \param iout the output unit
! iv: renumbering to be applied to both rows and columns !! \param iv(:) [none] renumber both row and column indices
! ivr, ivc: renumbering to be applied independently to !! \param head [none] a descriptive header for the matrix data
! rows and columns !! \param ivr(:) [none] renumbering for the rows
!! \param ivc(:) [none] renumbering for the cols
! !
interface interface
subroutine psb_base_sparse_print(iout,a,iv,head,ivr,ivc) subroutine psb_base_sparse_print(iout,a,iv,head,ivr,ivc)
@ -253,20 +276,29 @@ module psb_base_mat_mod
! !
! GETPTN: Get the pattern. !> Function getptn:
! Return a list of NZ pairs !! \brief Get the pattern.
! (IA(i),JA(i)) !!
! each identifying the position of a nonzero in A !!
! between row indices IMIN:IMAX. !! Return a list of NZ pairs
! IA,JA are reallocated as necessary. !! (IA(i),JA(i))
! Optional arguments: !! each identifying the position of a nonzero in A
! iren: return (IREN(IA(:)),IREN(JA(:)) !! between row indices IMIN:IMAX;
! RSCALE: map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1] !! IA,JA are reallocated as necessary.
! CSCALE: map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1] !! \param imin the minimum row index we are interested in
! !! \param imax the minimum row index we are interested in
! iren cannot be specified with rscale/cscale. !! \param nz the number of output coefficients
! !! \param ia(:) the output row indices
! APPEND: append to IA,JA; first new entry will be in NZIN+1 !! \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 interface
@ -286,10 +318,18 @@ module psb_base_mat_mod
end interface end interface
! !
! GETNEIGH: Get the neighbours of index IDX, i.e. !> Function get_neigh:
! get the nonzero indices in its row. !! \brief Get the neighbours.
! Optional: LEV: recurse at LEV levels, !!
! i.e. LEV=2 add neighours of neighbours of IDX, etc. !!
!! 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 interface
subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev) subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev)
@ -304,9 +344,13 @@ module psb_base_mat_mod
end interface end interface
! !
! ALLOCATE_MNNZ: allocate/initialize empty for !
! an MxN matrix capable of holding NZ nonzeros. !> Function allocate_mnnz
! Note: NZ is usually an estimate !! \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 interface
subroutine psb_base_allocate_mnnz(m,n,a,nz) 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 interface
subroutine psb_base_reallocate_nz(nz,a) subroutine psb_base_reallocate_nz(nz,a)
@ -330,7 +378,8 @@ module psb_base_mat_mod
end interface end interface
! !
! FREE: name says all !> Function free
!! \brief destructor
! !
interface interface
subroutine psb_base_free(a) subroutine psb_base_free(a)
@ -340,8 +389,10 @@ module psb_base_mat_mod
end interface end interface
! !
! TRIM: reallocate internal memory to the barest minimum !> Function trim
! necessary to hold the current nonzeros. !! \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 interface
subroutine psb_base_trim(a) 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) function psb_base_sizeof(a) result(res)
implicit none implicit none
@ -365,7 +417,8 @@ contains
end function psb_base_sizeof 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) function psb_base_get_fmt() result(res)
implicit none implicit none

6
base/modules/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -594,11 +594,12 @@ module psb_c_base_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a class(psb_c_base_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:) complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_c_base_scal end subroutine psb_c_base_scal
end interface end interface
@ -1011,11 +1012,12 @@ module psb_c_base_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_coo_sparse_mat), intent(inout) :: a class(psb_c_coo_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:) complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_c_coo_scal end subroutine psb_c_coo_scal
end interface end interface

3
base/modules/psb_c_csc_mat_mod.f90
Unescape Escape View File

@ -404,11 +404,12 @@ module psb_c_csc_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_c_csc_sparse_mat, psb_spk_
class(psb_c_csc_sparse_mat), intent(inout) :: a class(psb_c_csc_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:) complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_c_csc_scal end subroutine psb_c_csc_scal
end interface end interface

3
base/modules/psb_c_csr_mat_mod.f90
Unescape Escape View File

@ -404,11 +404,12 @@ module psb_c_csr_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_c_csr_sparse_mat, psb_spk_
class(psb_c_csr_sparse_mat), intent(inout) :: a class(psb_c_csr_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:) complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_c_csr_scal end subroutine psb_c_csr_scal
end interface end interface

3
base/modules/psb_c_mat_mod.f90
Unescape Escape View File

@ -766,11 +766,12 @@ module psb_c_mat_mod
end interface end interface
interface psb_scal 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_ import :: psb_ipk_, psb_cspmat_type, psb_spk_
class(psb_cspmat_type), intent(inout) :: a class(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:) complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_c_scal end subroutine psb_c_scal
subroutine psb_c_scals(d,a,info) subroutine psb_c_scals(d,a,info)
import :: psb_ipk_, psb_cspmat_type, psb_spk_ import :: psb_ipk_, psb_cspmat_type, psb_spk_

6
base/modules/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -594,11 +594,12 @@ module psb_d_base_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a class(psb_d_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:) real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_d_base_scal end subroutine psb_d_base_scal
end interface end interface
@ -1011,11 +1012,12 @@ module psb_d_base_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(inout) :: a class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:) real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_d_coo_scal end subroutine psb_d_coo_scal
end interface end interface

3
base/modules/psb_d_csc_mat_mod.f90
Unescape Escape View File

@ -404,11 +404,12 @@ module psb_d_csc_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(inout) :: a class(psb_d_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:) real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_d_csc_scal end subroutine psb_d_csc_scal
end interface end interface

3
base/modules/psb_d_csr_mat_mod.f90
Unescape Escape View File

@ -404,11 +404,12 @@ module psb_d_csr_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_d_csr_sparse_mat, psb_dpk_
class(psb_d_csr_sparse_mat), intent(inout) :: a class(psb_d_csr_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:) real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_d_csr_scal end subroutine psb_d_csr_scal
end interface end interface

5
base/modules/psb_d_mat_mod.f90
Unescape Escape View File

@ -44,7 +44,7 @@
! the functionalities to have the encapsulated class change its ! the functionalities to have the encapsulated class change its
! type dynamically, and to extract/input an inner object. ! 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. ! through the application life.
! In particular, computational methods can only be invoked when ! In particular, computational methods can only be invoked when
! the matrix is in the ASSEMBLED state, whereas the other states are ! the matrix is in the ASSEMBLED state, whereas the other states are
@ -766,11 +766,12 @@ module psb_d_mat_mod
end interface end interface
interface psb_scal 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_ import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(inout) :: a class(psb_dspmat_type), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:) real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_d_scal end subroutine psb_d_scal
subroutine psb_d_scals(d,a,info) subroutine psb_d_scals(d,a,info)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_ import :: psb_ipk_, psb_dspmat_type, psb_dpk_

6
base/modules/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -594,11 +594,12 @@ module psb_s_base_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a class(psb_s_base_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_s_base_scal end subroutine psb_s_base_scal
end interface end interface
@ -1011,11 +1012,12 @@ module psb_s_base_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_coo_sparse_mat), intent(inout) :: a class(psb_s_coo_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_s_coo_scal end subroutine psb_s_coo_scal
end interface end interface

3
base/modules/psb_s_csc_mat_mod.f90
Unescape Escape View File

@ -404,11 +404,12 @@ module psb_s_csc_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_s_csc_sparse_mat, psb_spk_
class(psb_s_csc_sparse_mat), intent(inout) :: a class(psb_s_csc_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_s_csc_scal end subroutine psb_s_csc_scal
end interface end interface

3
base/modules/psb_s_csr_mat_mod.f90
Unescape Escape View File

@ -404,11 +404,12 @@ module psb_s_csr_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_s_csr_sparse_mat, psb_spk_
class(psb_s_csr_sparse_mat), intent(inout) :: a class(psb_s_csr_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_s_csr_scal end subroutine psb_s_csr_scal
end interface end interface

3
base/modules/psb_s_mat_mod.f90
Unescape Escape View File

@ -766,11 +766,12 @@ module psb_s_mat_mod
end interface end interface
interface psb_scal 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_ import :: psb_ipk_, psb_sspmat_type, psb_spk_
class(psb_sspmat_type), intent(inout) :: a class(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_s_scal end subroutine psb_s_scal
subroutine psb_s_scals(d,a,info) subroutine psb_s_scals(d,a,info)
import :: psb_ipk_, psb_sspmat_type, psb_spk_ import :: psb_ipk_, psb_sspmat_type, psb_spk_

6
base/modules/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -594,11 +594,12 @@ module psb_z_base_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a class(psb_z_base_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:) complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_z_base_scal end subroutine psb_z_base_scal
end interface end interface
@ -1011,11 +1012,12 @@ module psb_z_base_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_coo_sparse_mat), intent(inout) :: a class(psb_z_coo_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:) complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_z_coo_scal end subroutine psb_z_coo_scal
end interface end interface

3
base/modules/psb_z_csc_mat_mod.f90
Unescape Escape View File

@ -404,11 +404,12 @@ module psb_z_csc_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_z_csc_sparse_mat, psb_dpk_
class(psb_z_csc_sparse_mat), intent(inout) :: a class(psb_z_csc_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:) complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_z_csc_scal end subroutine psb_z_csc_scal
end interface end interface

3
base/modules/psb_z_csr_mat_mod.f90
Unescape Escape View File

@ -404,11 +404,12 @@ module psb_z_csr_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_z_csr_sparse_mat, psb_dpk_
class(psb_z_csr_sparse_mat), intent(inout) :: a class(psb_z_csr_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:) complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_z_csr_scal end subroutine psb_z_csr_scal
end interface end interface

3
base/modules/psb_z_mat_mod.f90
Unescape Escape View File

@ -766,11 +766,12 @@ module psb_z_mat_mod
end interface end interface
interface psb_scal 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_ import :: psb_ipk_, psb_zspmat_type, psb_dpk_
class(psb_zspmat_type), intent(inout) :: a class(psb_zspmat_type), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:) complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_z_scal end subroutine psb_z_scal
subroutine psb_z_scals(d,a,info) subroutine psb_z_scals(d,a,info)
import :: psb_ipk_, psb_zspmat_type, psb_dpk_ import :: psb_ipk_, psb_zspmat_type, psb_dpk_

3
base/serial/impl/psb_c_base_mat_impl.f90
Unescape Escape View File

@ -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_c_base_mat_mod, psb_protect_name => psb_c_base_scal
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_c_base_sparse_mat), intent(inout) :: a class(psb_c_base_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:) complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)

49
base/serial/impl/psb_c_coo_impl.f90
Unescape Escape View File

@ -49,35 +49,61 @@ subroutine psb_c_coo_get_diag(a,d,info)
end subroutine psb_c_coo_get_diag 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_c_base_mat_mod, psb_protect_name => psb_c_coo_scal
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
use psb_string_mod
implicit none implicit none
class(psb_c_coo_sparse_mat), intent(inout) :: a class(psb_c_coo_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:) complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
m = a%get_nrows() side_ = 'L'
if (size(d) < m) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1,a%get_nzeros() left = (side_ == 'L')
j = a%ia(i)
a%val(i) = a%val(i) * d(j) if (left) then
enddo 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) call psb_erractionrestore(err_act)
return return
@ -1215,7 +1241,6 @@ subroutine psb_c_coo_csmv(alpha,a,x,beta,y,info,trans)
trans_ = 'N' trans_ = 'N'
end if end if
tra = (psb_toupper(trans_) == 'T') tra = (psb_toupper(trans_) == 'T')
ctra = (psb_toupper(trans_) == 'C') ctra = (psb_toupper(trans_) == 'C')

48
base/serial/impl/psb_c_csc_impl.f90
Unescape Escape View File

@ -1384,37 +1384,61 @@ subroutine psb_c_csc_get_diag(a,d,info)
end subroutine psb_c_csc_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_scal use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_scal
use psb_string_mod
implicit none implicit none
class(psb_c_csc_sparse_mat), intent(inout) :: a class(psb_c_csc_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:) complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, n integer(psb_ipk_) :: err_act,mnm, i, j, n
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
n = a%get_ncols() side_ = 'L'
if (size(d) < n) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1, n left = (side_ == 'L')
do j = a%icp(i), a%icp(i+1) -1
a%val(j) = a%val(j) * d(a%ia(j)) if (left) then
end do n = a%get_ncols()
enddo 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) call psb_erractionrestore(err_act)
return return

52
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

@ -1589,36 +1589,64 @@ subroutine psb_c_csr_get_diag(a,d,info)
end subroutine psb_c_csr_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_scal use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_scal
use psb_string_mod
implicit none implicit none
class(psb_c_csr_sparse_mat), intent(inout) :: a class(psb_c_csr_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:) complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
m = a%get_nrows() side_ = 'L'
if (size(d) < m) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1, m left = (side_ == 'L')
do j = a%irp(i), a%irp(i+1) -1
a%val(j) = a%val(j) * d(i) if (left) then
end do m = a%get_nrows()
enddo 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) call psb_erractionrestore(err_act)
return return

5
base/serial/impl/psb_c_mat_impl.F90
Unescape Escape View File

@ -2323,7 +2323,7 @@ subroutine psb_c_get_diag(a,d,info)
end subroutine psb_c_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_c_mat_mod, psb_protect_name => psb_c_scal 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 class(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:) complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='scal' character(len=20) :: name='scal'
@ -2344,7 +2345,7 @@ subroutine psb_c_scal(d,a,info)
goto 9999 goto 9999
endif endif
call a%a%scal(d,info) call a%a%scal(d,info,side=side)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

3
base/serial/impl/psb_d_base_mat_impl.f90
Unescape Escape View File

@ -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_d_base_mat_mod, psb_protect_name => psb_d_base_scal
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a class(psb_d_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:) real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)

49
base/serial/impl/psb_d_coo_impl.f90
Unescape Escape View File

@ -49,35 +49,61 @@ subroutine psb_d_coo_get_diag(a,d,info)
end subroutine psb_d_coo_get_diag 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_d_base_mat_mod, psb_protect_name => psb_d_coo_scal
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
use psb_string_mod
implicit none implicit none
class(psb_d_coo_sparse_mat), intent(inout) :: a class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:) real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
m = a%get_nrows() side_ = 'L'
if (size(d) < m) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1,a%get_nzeros() left = (side_ == 'L')
j = a%ia(i)
a%val(i) = a%val(i) * d(j) if (left) then
enddo 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) call psb_erractionrestore(err_act)
return return
@ -1215,7 +1241,6 @@ subroutine psb_d_coo_csmv(alpha,a,x,beta,y,info,trans)
trans_ = 'N' trans_ = 'N'
end if end if
tra = (psb_toupper(trans_) == 'T') tra = (psb_toupper(trans_) == 'T')
ctra = (psb_toupper(trans_) == 'C') ctra = (psb_toupper(trans_) == 'C')

48
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

@ -1384,37 +1384,61 @@ subroutine psb_d_csc_get_diag(a,d,info)
end subroutine psb_d_csc_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_scal use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_scal
use psb_string_mod
implicit none implicit none
class(psb_d_csc_sparse_mat), intent(inout) :: a class(psb_d_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:) real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, n integer(psb_ipk_) :: err_act,mnm, i, j, n
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
n = a%get_ncols() side_ = 'L'
if (size(d) < n) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1, n left = (side_ == 'L')
do j = a%icp(i), a%icp(i+1) -1
a%val(j) = a%val(j) * d(a%ia(j)) if (left) then
end do n = a%get_ncols()
enddo 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) call psb_erractionrestore(err_act)
return return

52
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

@ -1589,36 +1589,64 @@ subroutine psb_d_csr_get_diag(a,d,info)
end subroutine psb_d_csr_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_scal use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_scal
use psb_string_mod
implicit none implicit none
class(psb_d_csr_sparse_mat), intent(inout) :: a class(psb_d_csr_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:) real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
m = a%get_nrows() side_ = 'L'
if (size(d) < m) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1, m left = (side_ == 'L')
do j = a%irp(i), a%irp(i+1) -1
a%val(j) = a%val(j) * d(i) if (left) then
end do m = a%get_nrows()
enddo 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) call psb_erractionrestore(err_act)
return return

5
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -2323,7 +2323,7 @@ subroutine psb_d_get_diag(a,d,info)
end subroutine psb_d_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_d_mat_mod, psb_protect_name => psb_d_scal 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 class(psb_dspmat_type), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:) real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='scal' character(len=20) :: name='scal'
@ -2344,7 +2345,7 @@ subroutine psb_d_scal(d,a,info)
goto 9999 goto 9999
endif endif
call a%a%scal(d,info) call a%a%scal(d,info,side=side)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

3
base/serial/impl/psb_s_base_mat_impl.f90
Unescape Escape View File

@ -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_s_base_mat_mod, psb_protect_name => psb_s_base_scal
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_s_base_sparse_mat), intent(inout) :: a class(psb_s_base_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)

49
base/serial/impl/psb_s_coo_impl.f90
Unescape Escape View File

@ -49,35 +49,61 @@ subroutine psb_s_coo_get_diag(a,d,info)
end subroutine psb_s_coo_get_diag 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_s_base_mat_mod, psb_protect_name => psb_s_coo_scal
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
use psb_string_mod
implicit none implicit none
class(psb_s_coo_sparse_mat), intent(inout) :: a class(psb_s_coo_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
m = a%get_nrows() side_ = 'L'
if (size(d) < m) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1,a%get_nzeros() left = (side_ == 'L')
j = a%ia(i)
a%val(i) = a%val(i) * d(j) if (left) then
enddo 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) call psb_erractionrestore(err_act)
return return
@ -1215,7 +1241,6 @@ subroutine psb_s_coo_csmv(alpha,a,x,beta,y,info,trans)
trans_ = 'N' trans_ = 'N'
end if end if
tra = (psb_toupper(trans_) == 'T') tra = (psb_toupper(trans_) == 'T')
ctra = (psb_toupper(trans_) == 'C') ctra = (psb_toupper(trans_) == 'C')

48
base/serial/impl/psb_s_csc_impl.f90
Unescape Escape View File

@ -1384,37 +1384,61 @@ subroutine psb_s_csc_get_diag(a,d,info)
end subroutine psb_s_csc_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_scal use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_scal
use psb_string_mod
implicit none implicit none
class(psb_s_csc_sparse_mat), intent(inout) :: a class(psb_s_csc_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, n integer(psb_ipk_) :: err_act,mnm, i, j, n
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
n = a%get_ncols() side_ = 'L'
if (size(d) < n) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1, n left = (side_ == 'L')
do j = a%icp(i), a%icp(i+1) -1
a%val(j) = a%val(j) * d(a%ia(j)) if (left) then
end do n = a%get_ncols()
enddo 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) call psb_erractionrestore(err_act)
return return

52
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

@ -1589,36 +1589,64 @@ subroutine psb_s_csr_get_diag(a,d,info)
end subroutine psb_s_csr_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_scal use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_scal
use psb_string_mod
implicit none implicit none
class(psb_s_csr_sparse_mat), intent(inout) :: a class(psb_s_csr_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
m = a%get_nrows() side_ = 'L'
if (size(d) < m) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1, m left = (side_ == 'L')
do j = a%irp(i), a%irp(i+1) -1
a%val(j) = a%val(j) * d(i) if (left) then
end do m = a%get_nrows()
enddo 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) call psb_erractionrestore(err_act)
return return

5
base/serial/impl/psb_s_mat_impl.F90
Unescape Escape View File

@ -2323,7 +2323,7 @@ subroutine psb_s_get_diag(a,d,info)
end subroutine psb_s_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_s_mat_mod, psb_protect_name => psb_s_scal 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 class(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='scal' character(len=20) :: name='scal'
@ -2344,7 +2345,7 @@ subroutine psb_s_scal(d,a,info)
goto 9999 goto 9999
endif endif
call a%a%scal(d,info) call a%a%scal(d,info,side=side)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

3
base/serial/impl/psb_z_base_mat_impl.f90
Unescape Escape View File

@ -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_z_base_mat_mod, psb_protect_name => psb_z_base_scal
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_z_base_sparse_mat), intent(inout) :: a class(psb_z_base_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:) complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)

49
base/serial/impl/psb_z_coo_impl.f90
Unescape Escape View File

@ -49,35 +49,61 @@ subroutine psb_z_coo_get_diag(a,d,info)
end subroutine psb_z_coo_get_diag 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_z_base_mat_mod, psb_protect_name => psb_z_coo_scal
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
use psb_string_mod
implicit none implicit none
class(psb_z_coo_sparse_mat), intent(inout) :: a class(psb_z_coo_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:) complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
m = a%get_nrows() side_ = 'L'
if (size(d) < m) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1,a%get_nzeros() left = (side_ == 'L')
j = a%ia(i)
a%val(i) = a%val(i) * d(j) if (left) then
enddo 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) call psb_erractionrestore(err_act)
return return
@ -1215,7 +1241,6 @@ subroutine psb_z_coo_csmv(alpha,a,x,beta,y,info,trans)
trans_ = 'N' trans_ = 'N'
end if end if
tra = (psb_toupper(trans_) == 'T') tra = (psb_toupper(trans_) == 'T')
ctra = (psb_toupper(trans_) == 'C') ctra = (psb_toupper(trans_) == 'C')

48
base/serial/impl/psb_z_csc_impl.f90
Unescape Escape View File

@ -1384,37 +1384,61 @@ subroutine psb_z_csc_get_diag(a,d,info)
end subroutine psb_z_csc_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_scal use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_scal
use psb_string_mod
implicit none implicit none
class(psb_z_csc_sparse_mat), intent(inout) :: a class(psb_z_csc_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:) complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, n integer(psb_ipk_) :: err_act,mnm, i, j, n
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
n = a%get_ncols() side_ = 'L'
if (size(d) < n) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1, n left = (side_ == 'L')
do j = a%icp(i), a%icp(i+1) -1
a%val(j) = a%val(j) * d(a%ia(j)) if (left) then
end do n = a%get_ncols()
enddo 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) call psb_erractionrestore(err_act)
return return

52
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

@ -1589,36 +1589,64 @@ subroutine psb_z_csr_get_diag(a,d,info)
end subroutine psb_z_csr_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_scal use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_scal
use psb_string_mod
implicit none implicit none
class(psb_z_csr_sparse_mat), intent(inout) :: a class(psb_z_csr_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:) complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
character :: side_
logical :: left
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
m = a%get_nrows() side_ = 'L'
if (size(d) < m) then if (present(side)) then
info=psb_err_input_asize_invalid_i_ side_ = psb_toupper(side)
ierr(1) = 2; ierr(2) = size(d);
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if end if
do i=1, m left = (side_ == 'L')
do j = a%irp(i), a%irp(i+1) -1
a%val(j) = a%val(j) * d(i) if (left) then
end do m = a%get_nrows()
enddo 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) call psb_erractionrestore(err_act)
return return

5
base/serial/impl/psb_z_mat_impl.F90
Unescape Escape View File

@ -2323,7 +2323,7 @@ subroutine psb_z_get_diag(a,d,info)
end subroutine psb_z_get_diag 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_error_mod
use psb_const_mod use psb_const_mod
use psb_z_mat_mod, psb_protect_name => psb_z_scal 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 class(psb_zspmat_type), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:) complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='scal' character(len=20) :: name='scal'
@ -2344,7 +2345,7 @@ subroutine psb_z_scal(d,a,info)
goto 9999 goto 9999
endif endif
call a%a%scal(d,info) call a%a%scal(d,info,side=side)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

1755
doxypsb
View File

File diff suppressed because it is too large Load Diff
Write Preview
Loading…
Cancel
Save