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

New has_xt_tri method.

Browse Source
new-parstruct
Salvatore Filippone 6 years ago
parent 839b82ff94
commit 5fd73b347e
17 changed files with 916 additions and 0 deletions
Show Stats Download Patch File Download Diff File

12
base/modules/serial/psb_base_mat_mod.f90
Unescape Escape View File

@ -143,6 +143,7 @@ module psb_base_mat_mod
procedure, pass(a) :: get_dupl => psb_base_get_dupl procedure, pass(a) :: get_dupl => psb_base_get_dupl
procedure, nopass :: get_fmt => psb_base_get_fmt procedure, nopass :: get_fmt => psb_base_get_fmt
procedure, nopass :: has_update => psb_base_has_update procedure, nopass :: has_update => psb_base_has_update
procedure, nopass :: has_xt_tri => psb_base_has_xt_tri
procedure, pass(a) :: is_null => psb_base_is_null procedure, pass(a) :: is_null => psb_base_is_null
procedure, pass(a) :: is_bld => psb_base_is_bld procedure, pass(a) :: is_bld => psb_base_is_bld
procedure, pass(a) :: is_upd => psb_base_is_upd procedure, pass(a) :: is_upd => psb_base_is_upd
@ -718,6 +719,17 @@ contains
res = a%repeatable_updates res = a%repeatable_updates
end function psb_base_is_repeatable_updates end function psb_base_is_repeatable_updates
!
! has_xt_tri: does the current type support
! extended triangle operations?
!
function psb_base_has_xt_tri() result(res)
implicit none
logical :: res
res = .false.
end function psb_base_has_xt_tri
! !
! TRANSP: note sorted=.false. ! TRANSP: note sorted=.false.

61
base/modules/serial/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -95,6 +95,9 @@ module psb_c_base_mat_mod
procedure, pass(a) :: csmv => psb_c_base_csmv procedure, pass(a) :: csmv => psb_c_base_csmv
procedure, pass(a) :: csmm => psb_c_base_csmm procedure, pass(a) :: csmm => psb_c_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: trvect_mv => psb_c_base_trvect_mv
procedure, pass(a) :: trmv => psb_c_base_trmv
generic, public :: trmm => trmv, trvect_mv
procedure, pass(a) :: in_vect_sv => psb_c_base_inner_vect_sv procedure, pass(a) :: in_vect_sv => psb_c_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_c_base_inner_cssv procedure, pass(a) :: inner_cssv => psb_c_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_c_base_inner_cssm procedure, pass(a) :: inner_cssm => psb_c_base_inner_cssm
@ -871,6 +874,64 @@ module psb_c_base_mat_mod
end subroutine psb_c_base_vect_mv end subroutine psb_c_base_vect_mv
end interface end interface
!> Function trmv:
!! \memberof psb_c_base_sparse_mat
!! \brief Product of a subtriangle by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(UPLO(A))*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param uplo [L] Whether to use LOW(A) (L), or UP(A) (U)
!! \param diag [D] Diagonal: use D(A) (D), zeros (Z), or unit (U)
!!
!
interface
subroutine psb_c_base_trmv(alpha,a,x,beta,y,info,uplo,diag)
import :: psb_ipk_, psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_c_base_trmv
end interface
!> Function trvect_mv:
!! \memberof psb_c_base_sparse_mat
!! \brief Product of a subtriangle by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(UPLO(A))*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param uplo [L] Whether to use LOW(A) (L), or UP(A) (U)
!! \param diag [D] Diagonal: use D(A) (D), zeros (Z), or unit (U)
!!
!
interface
subroutine psb_c_base_trvect_mv(alpha,a,x,beta,y,info,uplo,diag)
import :: psb_ipk_, psb_c_base_sparse_mat, psb_spk_, psb_c_base_vect_type
class(psb_c_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
class(psb_c_base_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_c_base_trvect_mv
end interface
! !
!> Function cssm: !> Function cssm:
!! \memberof psb_c_base_sparse_mat !! \memberof psb_c_base_sparse_mat

41
base/modules/serial/psb_c_mat_mod.f90
Unescape Escape View File

@ -116,6 +116,8 @@ module psb_c_mat_mod
procedure, pass(a) :: set_triangle => psb_c_set_triangle procedure, pass(a) :: set_triangle => psb_c_set_triangle
procedure, pass(a) :: set_unit => psb_c_set_unit procedure, pass(a) :: set_unit => psb_c_set_unit
procedure, pass(a) :: set_repeatable_updates => psb_c_set_repeatable_updates procedure, pass(a) :: set_repeatable_updates => psb_c_set_repeatable_updates
procedure, pass(a) :: has_xt_tri => psb_c_has_xt_tri
! Memory/data management ! Memory/data management
procedure, pass(a) :: csall => psb_c_csall procedure, pass(a) :: csall => psb_c_csall
@ -197,6 +199,9 @@ module psb_c_mat_mod
procedure, pass(a) :: csmv => psb_c_csmv procedure, pass(a) :: csmv => psb_c_csmv
procedure, pass(a) :: csmm => psb_c_csmm procedure, pass(a) :: csmm => psb_c_csmm
generic, public :: spmm => csmm, csmv, csmv_v generic, public :: spmm => csmm, csmv, csmv_v
procedure, pass(a) :: trmv_v => psb_c_trmv_vect
procedure, pass(a) :: trmv => psb_c_trmv
generic, public :: trmm => trmv, trmv_v
procedure, pass(a) :: scals => psb_c_scals procedure, pass(a) :: scals => psb_c_scals
procedure, pass(a) :: scalv => psb_c_scal procedure, pass(a) :: scalv => psb_c_scal
generic, public :: scal => scals, scalv generic, public :: scal => scals, scalv
@ -759,6 +764,30 @@ module psb_c_mat_mod
end subroutine psb_c_csmv_vect end subroutine psb_c_csmv_vect
end interface end interface
interface psb_trmm
subroutine psb_c_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_c_vect_mod, only : psb_c_vect_type
import :: psb_ipk_, psb_cspmat_type, psb_spk_
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_c_trmv
subroutine psb_c_trmv_vect(alpha,a,x,beta,y,info,uplo,diag)
use psb_c_vect_mod, only : psb_c_vect_type
import :: psb_ipk_, psb_cspmat_type, psb_spk_
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_c_trmv_vect
end interface
interface psb_cssm interface psb_cssm
subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_ipk_, psb_cspmat_type, psb_spk_ import :: psb_ipk_, psb_cspmat_type, psb_spk_
@ -1243,6 +1272,18 @@ contains
end subroutine psb_c_set_repeatable_updates end subroutine psb_c_set_repeatable_updates
function psb_c_has_xt_tri(a) result(res)
implicit none
class(psb_cspmat_type), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%has_xt_tri()
else
res = .false.
end if
end function psb_c_has_xt_tri
function psb_c_get_nzeros(a) result(res) function psb_c_get_nzeros(a) result(res)
implicit none implicit none

61
base/modules/serial/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -95,6 +95,9 @@ module psb_d_base_mat_mod
procedure, pass(a) :: csmv => psb_d_base_csmv procedure, pass(a) :: csmv => psb_d_base_csmv
procedure, pass(a) :: csmm => psb_d_base_csmm procedure, pass(a) :: csmm => psb_d_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: trvect_mv => psb_d_base_trvect_mv
procedure, pass(a) :: trmv => psb_d_base_trmv
generic, public :: trmm => trmv, trvect_mv
procedure, pass(a) :: in_vect_sv => psb_d_base_inner_vect_sv procedure, pass(a) :: in_vect_sv => psb_d_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_d_base_inner_cssv procedure, pass(a) :: inner_cssv => psb_d_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_d_base_inner_cssm procedure, pass(a) :: inner_cssm => psb_d_base_inner_cssm
@ -871,6 +874,64 @@ module psb_d_base_mat_mod
end subroutine psb_d_base_vect_mv end subroutine psb_d_base_vect_mv
end interface end interface
!> Function trmv:
!! \memberof psb_d_base_sparse_mat
!! \brief Product of a subtriangle by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(UPLO(A))*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param uplo [L] Whether to use LOW(A) (L), or UP(A) (U)
!! \param diag [D] Diagonal: use D(A) (D), zeros (Z), or unit (U)
!!
!
interface
subroutine psb_d_base_trmv(alpha,a,x,beta,y,info,uplo,diag)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_d_base_trmv
end interface
!> Function trvect_mv:
!! \memberof psb_d_base_sparse_mat
!! \brief Product of a subtriangle by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(UPLO(A))*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param uplo [L] Whether to use LOW(A) (L), or UP(A) (U)
!! \param diag [D] Diagonal: use D(A) (D), zeros (Z), or unit (U)
!!
!
interface
subroutine psb_d_base_trvect_mv(alpha,a,x,beta,y,info,uplo,diag)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_, psb_d_base_vect_type
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
class(psb_d_base_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_d_base_trvect_mv
end interface
! !
!> Function cssm: !> Function cssm:
!! \memberof psb_d_base_sparse_mat !! \memberof psb_d_base_sparse_mat

41
base/modules/serial/psb_d_mat_mod.f90
Unescape Escape View File

@ -116,6 +116,8 @@ module psb_d_mat_mod
procedure, pass(a) :: set_triangle => psb_d_set_triangle procedure, pass(a) :: set_triangle => psb_d_set_triangle
procedure, pass(a) :: set_unit => psb_d_set_unit procedure, pass(a) :: set_unit => psb_d_set_unit
procedure, pass(a) :: set_repeatable_updates => psb_d_set_repeatable_updates procedure, pass(a) :: set_repeatable_updates => psb_d_set_repeatable_updates
procedure, pass(a) :: has_xt_tri => psb_d_has_xt_tri
! Memory/data management ! Memory/data management
procedure, pass(a) :: csall => psb_d_csall procedure, pass(a) :: csall => psb_d_csall
@ -197,6 +199,9 @@ module psb_d_mat_mod
procedure, pass(a) :: csmv => psb_d_csmv procedure, pass(a) :: csmv => psb_d_csmv
procedure, pass(a) :: csmm => psb_d_csmm procedure, pass(a) :: csmm => psb_d_csmm
generic, public :: spmm => csmm, csmv, csmv_v generic, public :: spmm => csmm, csmv, csmv_v
procedure, pass(a) :: trmv_v => psb_d_trmv_vect
procedure, pass(a) :: trmv => psb_d_trmv
generic, public :: trmm => trmv, trmv_v
procedure, pass(a) :: scals => psb_d_scals procedure, pass(a) :: scals => psb_d_scals
procedure, pass(a) :: scalv => psb_d_scal procedure, pass(a) :: scalv => psb_d_scal
generic, public :: scal => scals, scalv generic, public :: scal => scals, scalv
@ -759,6 +764,30 @@ module psb_d_mat_mod
end subroutine psb_d_csmv_vect end subroutine psb_d_csmv_vect
end interface end interface
interface psb_trmm
subroutine psb_d_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_d_vect_mod, only : psb_d_vect_type
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_d_trmv
subroutine psb_d_trmv_vect(alpha,a,x,beta,y,info,uplo,diag)
use psb_d_vect_mod, only : psb_d_vect_type
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_d_trmv_vect
end interface
interface psb_cssm interface psb_cssm
subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_ import :: psb_ipk_, psb_dspmat_type, psb_dpk_
@ -1243,6 +1272,18 @@ contains
end subroutine psb_d_set_repeatable_updates end subroutine psb_d_set_repeatable_updates
function psb_d_has_xt_tri(a) result(res)
implicit none
class(psb_dspmat_type), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%has_xt_tri()
else
res = .false.
end if
end function psb_d_has_xt_tri
function psb_d_get_nzeros(a) result(res) function psb_d_get_nzeros(a) result(res)
implicit none implicit none

61
base/modules/serial/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -95,6 +95,9 @@ module psb_s_base_mat_mod
procedure, pass(a) :: csmv => psb_s_base_csmv procedure, pass(a) :: csmv => psb_s_base_csmv
procedure, pass(a) :: csmm => psb_s_base_csmm procedure, pass(a) :: csmm => psb_s_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: trvect_mv => psb_s_base_trvect_mv
procedure, pass(a) :: trmv => psb_s_base_trmv
generic, public :: trmm => trmv, trvect_mv
procedure, pass(a) :: in_vect_sv => psb_s_base_inner_vect_sv procedure, pass(a) :: in_vect_sv => psb_s_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_s_base_inner_cssv procedure, pass(a) :: inner_cssv => psb_s_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_s_base_inner_cssm procedure, pass(a) :: inner_cssm => psb_s_base_inner_cssm
@ -871,6 +874,64 @@ module psb_s_base_mat_mod
end subroutine psb_s_base_vect_mv end subroutine psb_s_base_vect_mv
end interface end interface
!> Function trmv:
!! \memberof psb_s_base_sparse_mat
!! \brief Product of a subtriangle by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(UPLO(A))*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param uplo [L] Whether to use LOW(A) (L), or UP(A) (U)
!! \param diag [D] Diagonal: use D(A) (D), zeros (Z), or unit (U)
!!
!
interface
subroutine psb_s_base_trmv(alpha,a,x,beta,y,info,uplo,diag)
import :: psb_ipk_, psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_s_base_trmv
end interface
!> Function trvect_mv:
!! \memberof psb_s_base_sparse_mat
!! \brief Product of a subtriangle by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(UPLO(A))*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param uplo [L] Whether to use LOW(A) (L), or UP(A) (U)
!! \param diag [D] Diagonal: use D(A) (D), zeros (Z), or unit (U)
!!
!
interface
subroutine psb_s_base_trvect_mv(alpha,a,x,beta,y,info,uplo,diag)
import :: psb_ipk_, psb_s_base_sparse_mat, psb_spk_, psb_s_base_vect_type
class(psb_s_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta
class(psb_s_base_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_s_base_trvect_mv
end interface
! !
!> Function cssm: !> Function cssm:
!! \memberof psb_s_base_sparse_mat !! \memberof psb_s_base_sparse_mat

41
base/modules/serial/psb_s_mat_mod.f90
Unescape Escape View File

@ -116,6 +116,8 @@ module psb_s_mat_mod
procedure, pass(a) :: set_triangle => psb_s_set_triangle procedure, pass(a) :: set_triangle => psb_s_set_triangle
procedure, pass(a) :: set_unit => psb_s_set_unit procedure, pass(a) :: set_unit => psb_s_set_unit
procedure, pass(a) :: set_repeatable_updates => psb_s_set_repeatable_updates procedure, pass(a) :: set_repeatable_updates => psb_s_set_repeatable_updates
procedure, pass(a) :: has_xt_tri => psb_s_has_xt_tri
! Memory/data management ! Memory/data management
procedure, pass(a) :: csall => psb_s_csall procedure, pass(a) :: csall => psb_s_csall
@ -197,6 +199,9 @@ module psb_s_mat_mod
procedure, pass(a) :: csmv => psb_s_csmv procedure, pass(a) :: csmv => psb_s_csmv
procedure, pass(a) :: csmm => psb_s_csmm procedure, pass(a) :: csmm => psb_s_csmm
generic, public :: spmm => csmm, csmv, csmv_v generic, public :: spmm => csmm, csmv, csmv_v
procedure, pass(a) :: trmv_v => psb_s_trmv_vect
procedure, pass(a) :: trmv => psb_s_trmv
generic, public :: trmm => trmv, trmv_v
procedure, pass(a) :: scals => psb_s_scals procedure, pass(a) :: scals => psb_s_scals
procedure, pass(a) :: scalv => psb_s_scal procedure, pass(a) :: scalv => psb_s_scal
generic, public :: scal => scals, scalv generic, public :: scal => scals, scalv
@ -759,6 +764,30 @@ module psb_s_mat_mod
end subroutine psb_s_csmv_vect end subroutine psb_s_csmv_vect
end interface end interface
interface psb_trmm
subroutine psb_s_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_s_vect_mod, only : psb_s_vect_type
import :: psb_ipk_, psb_sspmat_type, psb_spk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_s_trmv
subroutine psb_s_trmv_vect(alpha,a,x,beta,y,info,uplo,diag)
use psb_s_vect_mod, only : psb_s_vect_type
import :: psb_ipk_, psb_sspmat_type, psb_spk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_s_trmv_vect
end interface
interface psb_cssm interface psb_cssm
subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_ipk_, psb_sspmat_type, psb_spk_ import :: psb_ipk_, psb_sspmat_type, psb_spk_
@ -1243,6 +1272,18 @@ contains
end subroutine psb_s_set_repeatable_updates end subroutine psb_s_set_repeatable_updates
function psb_s_has_xt_tri(a) result(res)
implicit none
class(psb_sspmat_type), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%has_xt_tri()
else
res = .false.
end if
end function psb_s_has_xt_tri
function psb_s_get_nzeros(a) result(res) function psb_s_get_nzeros(a) result(res)
implicit none implicit none

61
base/modules/serial/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -95,6 +95,9 @@ module psb_z_base_mat_mod
procedure, pass(a) :: csmv => psb_z_base_csmv procedure, pass(a) :: csmv => psb_z_base_csmv
procedure, pass(a) :: csmm => psb_z_base_csmm procedure, pass(a) :: csmm => psb_z_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: trvect_mv => psb_z_base_trvect_mv
procedure, pass(a) :: trmv => psb_z_base_trmv
generic, public :: trmm => trmv, trvect_mv
procedure, pass(a) :: in_vect_sv => psb_z_base_inner_vect_sv procedure, pass(a) :: in_vect_sv => psb_z_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_z_base_inner_cssv procedure, pass(a) :: inner_cssv => psb_z_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_z_base_inner_cssm procedure, pass(a) :: inner_cssm => psb_z_base_inner_cssm
@ -871,6 +874,64 @@ module psb_z_base_mat_mod
end subroutine psb_z_base_vect_mv end subroutine psb_z_base_vect_mv
end interface end interface
!> Function trmv:
!! \memberof psb_z_base_sparse_mat
!! \brief Product of a subtriangle by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(UPLO(A))*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param uplo [L] Whether to use LOW(A) (L), or UP(A) (U)
!! \param diag [D] Diagonal: use D(A) (D), zeros (Z), or unit (U)
!!
!
interface
subroutine psb_z_base_trmv(alpha,a,x,beta,y,info,uplo,diag)
import :: psb_ipk_, psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
complex(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_z_base_trmv
end interface
!> Function trvect_mv:
!! \memberof psb_z_base_sparse_mat
!! \brief Product of a subtriangle by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(UPLO(A))*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param uplo [L] Whether to use LOW(A) (L), or UP(A) (U)
!! \param diag [D] Diagonal: use D(A) (D), zeros (Z), or unit (U)
!!
!
interface
subroutine psb_z_base_trvect_mv(alpha,a,x,beta,y,info,uplo,diag)
import :: psb_ipk_, psb_z_base_sparse_mat, psb_dpk_, psb_z_base_vect_type
class(psb_z_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta
class(psb_z_base_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_z_base_trvect_mv
end interface
! !
!> Function cssm: !> Function cssm:
!! \memberof psb_z_base_sparse_mat !! \memberof psb_z_base_sparse_mat

41
base/modules/serial/psb_z_mat_mod.f90
Unescape Escape View File

@ -116,6 +116,8 @@ module psb_z_mat_mod
procedure, pass(a) :: set_triangle => psb_z_set_triangle procedure, pass(a) :: set_triangle => psb_z_set_triangle
procedure, pass(a) :: set_unit => psb_z_set_unit procedure, pass(a) :: set_unit => psb_z_set_unit
procedure, pass(a) :: set_repeatable_updates => psb_z_set_repeatable_updates procedure, pass(a) :: set_repeatable_updates => psb_z_set_repeatable_updates
procedure, pass(a) :: has_xt_tri => psb_z_has_xt_tri
! Memory/data management ! Memory/data management
procedure, pass(a) :: csall => psb_z_csall procedure, pass(a) :: csall => psb_z_csall
@ -197,6 +199,9 @@ module psb_z_mat_mod
procedure, pass(a) :: csmv => psb_z_csmv procedure, pass(a) :: csmv => psb_z_csmv
procedure, pass(a) :: csmm => psb_z_csmm procedure, pass(a) :: csmm => psb_z_csmm
generic, public :: spmm => csmm, csmv, csmv_v generic, public :: spmm => csmm, csmv, csmv_v
procedure, pass(a) :: trmv_v => psb_z_trmv_vect
procedure, pass(a) :: trmv => psb_z_trmv
generic, public :: trmm => trmv, trmv_v
procedure, pass(a) :: scals => psb_z_scals procedure, pass(a) :: scals => psb_z_scals
procedure, pass(a) :: scalv => psb_z_scal procedure, pass(a) :: scalv => psb_z_scal
generic, public :: scal => scals, scalv generic, public :: scal => scals, scalv
@ -759,6 +764,30 @@ module psb_z_mat_mod
end subroutine psb_z_csmv_vect end subroutine psb_z_csmv_vect
end interface end interface
interface psb_trmm
subroutine psb_z_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_z_vect_mod, only : psb_z_vect_type
import :: psb_ipk_, psb_zspmat_type, psb_dpk_
class(psb_zspmat_type), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
complex(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_z_trmv
subroutine psb_z_trmv_vect(alpha,a,x,beta,y,info,uplo,diag)
use psb_z_vect_mod, only : psb_z_vect_type
import :: psb_ipk_, psb_zspmat_type, psb_dpk_
class(psb_zspmat_type), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta
class(psb_z_vect_type), intent(inout) :: x
class(psb_z_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
end subroutine psb_z_trmv_vect
end interface
interface psb_cssm interface psb_cssm
subroutine psb_z_cssm(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_z_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_ipk_, psb_zspmat_type, psb_dpk_ import :: psb_ipk_, psb_zspmat_type, psb_dpk_
@ -1243,6 +1272,18 @@ contains
end subroutine psb_z_set_repeatable_updates end subroutine psb_z_set_repeatable_updates
function psb_z_has_xt_tri(a) result(res)
implicit none
class(psb_zspmat_type), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%has_xt_tri()
else
res = .false.
end if
end function psb_z_has_xt_tri
function psb_z_get_nzeros(a) result(res) function psb_z_get_nzeros(a) result(res)
implicit none implicit none

47
base/serial/impl/psb_c_base_mat_impl.F90
Unescape Escape View File

@ -1227,6 +1227,33 @@ subroutine psb_c_base_csmv(alpha,a,x,beta,y,info,trans)
end subroutine psb_c_base_csmv end subroutine psb_c_base_csmv
subroutine psb_c_base_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_trmv
use psb_error_mod
implicit none
class(psb_c_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_base_trmv'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_c_base_trmv
subroutine psb_c_base_inner_cssm(alpha,a,x,beta,y,info,trans) subroutine psb_c_base_inner_cssm(alpha,a,x,beta,y,info,trans)
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_inner_cssm use psb_c_base_mat_mod, psb_protect_name => psb_c_base_inner_cssm
use psb_error_mod use psb_error_mod
@ -1885,6 +1912,26 @@ subroutine psb_c_base_vect_mv(alpha,a,x,beta,y,info,trans)
call y%set_host() call y%set_host()
end subroutine psb_c_base_vect_mv end subroutine psb_c_base_vect_mv
subroutine psb_c_base_trvect_mv(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_trvect_mv
implicit none
class(psb_c_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
class(psb_c_base_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
! For the time being we just throw everything back
! onto the normal routines.
call x%sync()
call y%sync()
call a%trmm(alpha,x%v,beta,y%v,info,uplo,diag)
call y%set_host()
end subroutine psb_c_base_trvect_mv
subroutine psb_c_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_c_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_vect_cssv use psb_c_base_mat_mod, psb_protect_name => psb_c_base_vect_cssv
use psb_c_base_vect_mod use psb_c_base_vect_mod

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

@ -1971,6 +1971,83 @@ subroutine psb_c_csmv_vect(alpha,a,x,beta,y,info,trans)
end subroutine psb_c_csmv_vect end subroutine psb_c_csmv_vect
subroutine psb_c_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_c_mat_mod, psb_protect_name => psb_c_trmv
implicit none
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo,diag
integer(psb_ipk_) :: err_act
character(len=20) :: name='psb_trmv'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%trmm(alpha,x,beta,y,info,uplo,diag)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_trmv
subroutine psb_c_trmv_vect(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_c_vect_mod
use psb_c_mat_mod, psb_protect_name => psb_c_trmv_vect
implicit none
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
type(psb_c_vect_type), intent(inout) :: x
type(psb_c_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo,diag
integer(psb_ipk_) :: err_act
character(len=20) :: name='psb_trmv'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%trmm(alpha,x%v,beta,y%v,info,uplo,diag)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_trmv_vect
subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d)
use psb_error_mod use psb_error_mod

47
base/serial/impl/psb_d_base_mat_impl.F90
Unescape Escape View File

@ -1227,6 +1227,33 @@ subroutine psb_d_base_csmv(alpha,a,x,beta,y,info,trans)
end subroutine psb_d_base_csmv end subroutine psb_d_base_csmv
subroutine psb_d_base_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_trmv
use psb_error_mod
implicit none
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_base_trmv'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_d_base_trmv
subroutine psb_d_base_inner_cssm(alpha,a,x,beta,y,info,trans) subroutine psb_d_base_inner_cssm(alpha,a,x,beta,y,info,trans)
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_inner_cssm use psb_d_base_mat_mod, psb_protect_name => psb_d_base_inner_cssm
use psb_error_mod use psb_error_mod
@ -1885,6 +1912,26 @@ subroutine psb_d_base_vect_mv(alpha,a,x,beta,y,info,trans)
call y%set_host() call y%set_host()
end subroutine psb_d_base_vect_mv end subroutine psb_d_base_vect_mv
subroutine psb_d_base_trvect_mv(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_trvect_mv
implicit none
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
class(psb_d_base_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
! For the time being we just throw everything back
! onto the normal routines.
call x%sync()
call y%sync()
call a%trmm(alpha,x%v,beta,y%v,info,uplo,diag)
call y%set_host()
end subroutine psb_d_base_trvect_mv
subroutine psb_d_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_d_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_vect_cssv use psb_d_base_mat_mod, psb_protect_name => psb_d_base_vect_cssv
use psb_d_base_vect_mod use psb_d_base_vect_mod

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

@ -1971,6 +1971,83 @@ subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans)
end subroutine psb_d_csmv_vect end subroutine psb_d_csmv_vect
subroutine psb_d_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_d_mat_mod, psb_protect_name => psb_d_trmv
implicit none
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo,diag
integer(psb_ipk_) :: err_act
character(len=20) :: name='psb_trmv'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%trmm(alpha,x,beta,y,info,uplo,diag)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_trmv
subroutine psb_d_trmv_vect(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_d_vect_mod
use psb_d_mat_mod, psb_protect_name => psb_d_trmv_vect
implicit none
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
type(psb_d_vect_type), intent(inout) :: x
type(psb_d_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo,diag
integer(psb_ipk_) :: err_act
character(len=20) :: name='psb_trmv'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%trmm(alpha,x%v,beta,y%v,info,uplo,diag)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_trmv_vect
subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d)
use psb_error_mod use psb_error_mod

47
base/serial/impl/psb_s_base_mat_impl.F90
Unescape Escape View File

@ -1227,6 +1227,33 @@ subroutine psb_s_base_csmv(alpha,a,x,beta,y,info,trans)
end subroutine psb_s_base_csmv end subroutine psb_s_base_csmv
subroutine psb_s_base_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_trmv
use psb_error_mod
implicit none
class(psb_s_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_base_trmv'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_s_base_trmv
subroutine psb_s_base_inner_cssm(alpha,a,x,beta,y,info,trans) subroutine psb_s_base_inner_cssm(alpha,a,x,beta,y,info,trans)
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_inner_cssm use psb_s_base_mat_mod, psb_protect_name => psb_s_base_inner_cssm
use psb_error_mod use psb_error_mod
@ -1885,6 +1912,26 @@ subroutine psb_s_base_vect_mv(alpha,a,x,beta,y,info,trans)
call y%set_host() call y%set_host()
end subroutine psb_s_base_vect_mv end subroutine psb_s_base_vect_mv
subroutine psb_s_base_trvect_mv(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_trvect_mv
implicit none
class(psb_s_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta
class(psb_s_base_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
! For the time being we just throw everything back
! onto the normal routines.
call x%sync()
call y%sync()
call a%trmm(alpha,x%v,beta,y%v,info,uplo,diag)
call y%set_host()
end subroutine psb_s_base_trvect_mv
subroutine psb_s_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_s_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_vect_cssv use psb_s_base_mat_mod, psb_protect_name => psb_s_base_vect_cssv
use psb_s_base_vect_mod use psb_s_base_vect_mod

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

@ -1971,6 +1971,83 @@ subroutine psb_s_csmv_vect(alpha,a,x,beta,y,info,trans)
end subroutine psb_s_csmv_vect end subroutine psb_s_csmv_vect
subroutine psb_s_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_s_mat_mod, psb_protect_name => psb_s_trmv
implicit none
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo,diag
integer(psb_ipk_) :: err_act
character(len=20) :: name='psb_trmv'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%trmm(alpha,x,beta,y,info,uplo,diag)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_trmv
subroutine psb_s_trmv_vect(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_s_vect_mod
use psb_s_mat_mod, psb_protect_name => psb_s_trmv_vect
implicit none
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta
type(psb_s_vect_type), intent(inout) :: x
type(psb_s_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo,diag
integer(psb_ipk_) :: err_act
character(len=20) :: name='psb_trmv'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%trmm(alpha,x%v,beta,y%v,info,uplo,diag)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_trmv_vect
subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d)
use psb_error_mod use psb_error_mod

47
base/serial/impl/psb_z_base_mat_impl.F90
Unescape Escape View File

@ -1227,6 +1227,33 @@ subroutine psb_z_base_csmv(alpha,a,x,beta,y,info,trans)
end subroutine psb_z_base_csmv end subroutine psb_z_base_csmv
subroutine psb_z_base_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_trmv
use psb_error_mod
implicit none
class(psb_z_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
complex(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_base_trmv'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_z_base_trmv
subroutine psb_z_base_inner_cssm(alpha,a,x,beta,y,info,trans) subroutine psb_z_base_inner_cssm(alpha,a,x,beta,y,info,trans)
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_inner_cssm use psb_z_base_mat_mod, psb_protect_name => psb_z_base_inner_cssm
use psb_error_mod use psb_error_mod
@ -1885,6 +1912,26 @@ subroutine psb_z_base_vect_mv(alpha,a,x,beta,y,info,trans)
call y%set_host() call y%set_host()
end subroutine psb_z_base_vect_mv end subroutine psb_z_base_vect_mv
subroutine psb_z_base_trvect_mv(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_trvect_mv
implicit none
class(psb_z_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta
class(psb_z_base_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo, diag
! For the time being we just throw everything back
! onto the normal routines.
call x%sync()
call y%sync()
call a%trmm(alpha,x%v,beta,y%v,info,uplo,diag)
call y%set_host()
end subroutine psb_z_base_trvect_mv
subroutine psb_z_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_z_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_vect_cssv use psb_z_base_mat_mod, psb_protect_name => psb_z_base_vect_cssv
use psb_z_base_vect_mod use psb_z_base_vect_mod

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

@ -1971,6 +1971,83 @@ subroutine psb_z_csmv_vect(alpha,a,x,beta,y,info,trans)
end subroutine psb_z_csmv_vect end subroutine psb_z_csmv_vect
subroutine psb_z_trmv(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_z_mat_mod, psb_protect_name => psb_z_trmv
implicit none
class(psb_zspmat_type), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
complex(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo,diag
integer(psb_ipk_) :: err_act
character(len=20) :: name='psb_trmv'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%trmm(alpha,x,beta,y,info,uplo,diag)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_trmv
subroutine psb_z_trmv_vect(alpha,a,x,beta,y,info,uplo,diag)
use psb_error_mod
use psb_z_vect_mod
use psb_z_mat_mod, psb_protect_name => psb_z_trmv_vect
implicit none
class(psb_zspmat_type), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta
type(psb_z_vect_type), intent(inout) :: x
type(psb_z_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: uplo,diag
integer(psb_ipk_) :: err_act
character(len=20) :: name='psb_trmv'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%trmm(alpha,x%v,beta,y%v,info,uplo,diag)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_trmv_vect
subroutine psb_z_cssm(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_z_cssm(alpha,a,x,beta,y,info,trans,scale,d)
use psb_error_mod use psb_error_mod

Write Preview
Loading…
Cancel
Save