fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-24 23:01:48 +00:00
Code Issues Packages Projects Releases Wiki Activity

Added implementation of multivector operations for all type/kinds

Browse Source
This commit is contained in:
fdurastante
2025-04-09 10:55:07 +02:00
parent e423e149fa
commit 611301a606
22 changed files with 1470 additions and 189 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/serial/psb_c_base_vect_mod.F90
+109 -1
View File
@@ -2177,13 +2177,15 @@ module psb_c_base_multivect_mod
procedure, pass(y) :: mlt_ar2 => c_base_mlv_mlt_ar2
procedure, pass(z) :: mlt_a_2 => c_base_mlv_mlt_a_2
procedure, pass(z) :: mlt_v_2 => c_base_mlv_mlt_v_2
procedure, pass(x) :: mlt_mv2 => c_base_mlv_mlt_mv2
!!$ procedure, pass(z) :: mlt_va => c_base_mlv_mlt_va
!!$ procedure, pass(z) :: mlt_av => c_base_mlv_mlt_av
generic, public :: mlt => mlt_mv, mlt_mv_v, mlt_ar1, mlt_ar2, &
& mlt_a_2, mlt_v_2 !, mlt_av, mlt_va
& mlt_a_2, mlt_v_2, mlt_mv2 !, mlt_av, mlt_va
!
! Scaling and norms
!
procedure, pass(x) :: trslv => c_base_mlv_trslv
procedure, pass(x) :: scal => c_base_mlv_scal
procedure, pass(x) :: nrm2 => c_base_mlv_nrm2
procedure, pass(x) :: amax => c_base_mlv_amax
@@ -2672,6 +2674,70 @@ contains
res(1:m,1:n) = x%v(1:m,1:n)
end function c_base_mlv_get_vect
!
!> subroutine d_base_mlv_trslv
!! \memberof psb_d_base_multivect_type
!! \brief Computes X = X / A with A an upper triangular matrix
!! \param n Number of entries to be considered
!! \param x The multivector to be used for the division
!! \param uplo 'U' for upper triangular, 'L' for lower triangular
!! \param a The matrix to be used for the division
!! \param alpha (optional) The scaling factor
!! \param trans (optional) 'N' for no transpose, 'T' for transpose
!! \param diag (optional) 'N' for non-unit diagonal, 'U' for unit diagonal
!! \param info return code
!!
subroutine c_base_mlv_trslv(n,x,a,uplo,alpha,trans,diag,info)
implicit none
class(psb_c_base_multivect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: a(:,:)
integer(psb_ipk_), intent(in) :: n
character(len=1), intent(in) :: uplo
complex(psb_spk_), intent(in), optional :: alpha
character(len=1), intent(in), optional :: trans, diag
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: lda, ldb
character(len=1) :: trans_, diag_, side
complex(psb_spk_) :: alpha_
! Default values
if (.not.present(alpha)) then
alpha_ = cone
else
alpha_ = alpha
end if
if (.not.present(trans)) then
trans_ = 'N'
else
trans_ = trans
end if
if (.not.present(diag)) then
diag_ = 'N'
else
diag_ = diag
end if
info = psb_success_
! Check that a is square
if (size(a,1) /= size(a,2)) then
info = psb_err_invalid_input_
return
end if
! Check that a has the same number of columns as x
if (size(a,2) /= x%get_ncols()) then
info = psb_err_invalid_input_
return
end if
if (x%is_dev()) call x%sync()
if (x%is_sync()) then
! Call BLAS function to solve the system
lda = size(a,1)
ldb = x%get_nrows()
side = 'R' ! X*op( A ) = alpha*B.
call dtrsm(side, uplo, trans_, diag_, n, x%get_ncols(), alpha_, a, lda, x%v, ldb)
end if
end subroutine c_base_mlv_trslv
!
! Reset all values
!
@@ -2886,6 +2952,48 @@ contains
end subroutine c_base_mlv_axpby_a
!> Function base_mlv_mlt_mv2
!! \memberof psb_d_base_multivect_type
!! \brief computes A = transpose(X)*Y / conjugatetranspose(X)*Y
!! \param x The class(base_mlv_vect) to be multiplied by
!! \param y The class(base_mlv_vect) to be multiplied by
!! \param a The resulting matrix
!! \param info return code
subroutine c_base_mlv_mlt_mv2(n,x,y,a,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_c_base_multivect_type), intent(inout) :: x
class(psb_c_base_multivect_type), intent(inout) :: y
complex(psb_spk_), intent(inout), allocatable :: a(:,:)
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (x%is_dev()) call x%sync()
if (y%is_dev()) call y%sync()
if (allocated(a)) then
if (size(a,1) /= x%get_ncols()) then
info = psb_err_invalid_input_
return
end if
if (size(a,2) /= y%get_ncols()) then
info = psb_err_invalid_input_
return
end if
else
allocate(a(x%get_ncols(),y%get_ncols()),stat=info)
if (info /= 0) call psb_errpush(psb_err_alloc_dealloc_,'base_mlv_mlt_mv2')
end if
! We do the multiplication by using the BLAS function
! dgemm, which computes the matrix-matrix product
! C = alpha*op( A )*op( B ) + beta*C
! In our case, we want to compute
! C = X'*Y
call dgemm('C', 'N', x%get_ncols(), y%get_ncols(), n, cone, &
& x%v, x%get_nrows(), y%v, y%get_nrows(), czero, a, x%get_ncols())
end subroutine c_base_mlv_mlt_mv2
!
! Multiple variants of two operations:
base/modules/serial/psb_c_vect_mod.F90
+40
View File
@@ -1344,6 +1344,9 @@ module psb_c_multivect_mod
procedure, pass(x) :: dot_a => c_mvect_dot_a
procedure, pass(x) :: dot_a_vect => c_mvect_dot_vect
generic, public :: dot => dot_v, dot_a, dot_a_vect
procedure, pass(x) :: trslv => c_mlv_trslv
procedure, pass(x) :: mlt_mv2 => c_mvect_mlt_mv2
generic, public :: mlt => mlt_mv2
!!$ procedure, pass(y) :: axpby_v => c_mvect_axpby_v
!!$ procedure, pass(y) :: axpby_a => c_mvect_axpby_a
!!$ generic, public :: axpby => axpby_v, axpby_a
@@ -1876,6 +1879,43 @@ contains
end function c_mvect_dot_a
subroutine c_mlv_trslv(n,x,a,uplo,alpha,trans,diag,info)
implicit none
class(psb_c_multivect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: a(:,:)
integer(psb_ipk_), intent(in) :: n
character(len=1), intent(in) :: uplo
complex(psb_spk_), intent(in), optional :: alpha
character(len=1), intent(in), optional :: trans, diag
integer(psb_ipk_), intent(out) :: info
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
return
else
call x%v%trslv(n,a,uplo,alpha=alpha,trans=trans,diag=diag,info=info)
end if
end subroutine c_mlv_trslv
subroutine c_mvect_mlt_mv2(n,x,y,a,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_c_multivect_type), intent(inout) :: x
class(psb_c_multivect_type), intent(inout) :: y
complex(psb_spk_), intent(inout), allocatable :: a(:,:)
integer(psb_ipk_), intent(out) :: info
if (allocated(x%v).and.allocated(y%v)) then
call y%v%mlt(n,x%v,a,info)
else
info = psb_err_invalid_vect_state_
return
end if
end subroutine c_mvect_mlt_mv2
!!$ subroutine c_mvect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
base/modules/serial/psb_d_base_vect_mod.F90
+3 -8
View File
@@ -2917,8 +2917,6 @@ contains
call dtrsm(side, uplo, trans_, diag_, n, x%get_ncols(), alpha_, a, lda, x%v, ldb)
end if
end subroutine d_base_mlv_trslv
!
! Reset all values
!
@@ -3133,10 +3131,9 @@ contains
end subroutine d_base_mlv_axpby_a
!> Function base_mlv_mlt_mv2
!> Function base_mlv_mlt_mv2
!! \memberof psb_d_base_multivect_type
!! \brief computes A = transpose(X)*Y
!! \brief computes A = transpose(X)*Y / conjugatetranspose(X)*Y
!! \param x The class(base_mlv_vect) to be multiplied by
!! \param y The class(base_mlv_vect) to be multiplied by
!! \param a The resulting matrix
@@ -3172,13 +3169,11 @@ contains
! C = alpha*op( A )*op( B ) + beta*C
! In our case, we want to compute
! C = X'*Y
call dgemm('T', 'N', x%get_ncols(), y%get_ncols(), n, done, &
call dgemm('C', 'N', x%get_ncols(), y%get_ncols(), n, done, &
& x%v, x%get_nrows(), y%v, y%get_nrows(), dzero, a, x%get_ncols())
end subroutine d_base_mlv_mlt_mv2
!
! Multiple variants of two operations:
! Simple multiplication Y(:.:) = X(:,:)*Y(:,:)
base/modules/serial/psb_d_vect_mod.F90
+1
View File
@@ -1994,6 +1994,7 @@ contains
end subroutine d_mvect_mlt_mv2
!!$ subroutine d_mvect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
base/modules/serial/psb_s_base_vect_mod.F90
+109 -1
View File
@@ -2356,13 +2356,15 @@ module psb_s_base_multivect_mod
procedure, pass(y) :: mlt_ar2 => s_base_mlv_mlt_ar2
procedure, pass(z) :: mlt_a_2 => s_base_mlv_mlt_a_2
procedure, pass(z) :: mlt_v_2 => s_base_mlv_mlt_v_2
procedure, pass(x) :: mlt_mv2 => s_base_mlv_mlt_mv2
!!$ procedure, pass(z) :: mlt_va => s_base_mlv_mlt_va
!!$ procedure, pass(z) :: mlt_av => s_base_mlv_mlt_av
generic, public :: mlt => mlt_mv, mlt_mv_v, mlt_ar1, mlt_ar2, &
& mlt_a_2, mlt_v_2 !, mlt_av, mlt_va
& mlt_a_2, mlt_v_2, mlt_mv2 !, mlt_av, mlt_va
!
! Scaling and norms
!
procedure, pass(x) :: trslv => s_base_mlv_trslv
procedure, pass(x) :: scal => s_base_mlv_scal
procedure, pass(x) :: nrm2 => s_base_mlv_nrm2
procedure, pass(x) :: amax => s_base_mlv_amax
@@ -2851,6 +2853,70 @@ contains
res(1:m,1:n) = x%v(1:m,1:n)
end function s_base_mlv_get_vect
!
!> subroutine d_base_mlv_trslv
!! \memberof psb_d_base_multivect_type
!! \brief Computes X = X / A with A an upper triangular matrix
!! \param n Number of entries to be considered
!! \param x The multivector to be used for the division
!! \param uplo 'U' for upper triangular, 'L' for lower triangular
!! \param a The matrix to be used for the division
!! \param alpha (optional) The scaling factor
!! \param trans (optional) 'N' for no transpose, 'T' for transpose
!! \param diag (optional) 'N' for non-unit diagonal, 'U' for unit diagonal
!! \param info return code
!!
subroutine s_base_mlv_trslv(n,x,a,uplo,alpha,trans,diag,info)
implicit none
class(psb_s_base_multivect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: a(:,:)
integer(psb_ipk_), intent(in) :: n
character(len=1), intent(in) :: uplo
real(psb_spk_), intent(in), optional :: alpha
character(len=1), intent(in), optional :: trans, diag
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: lda, ldb
character(len=1) :: trans_, diag_, side
real(psb_spk_) :: alpha_
! Default values
if (.not.present(alpha)) then
alpha_ = sone
else
alpha_ = alpha
end if
if (.not.present(trans)) then
trans_ = 'N'
else
trans_ = trans
end if
if (.not.present(diag)) then
diag_ = 'N'
else
diag_ = diag
end if
info = psb_success_
! Check that a is square
if (size(a,1) /= size(a,2)) then
info = psb_err_invalid_input_
return
end if
! Check that a has the same number of columns as x
if (size(a,2) /= x%get_ncols()) then
info = psb_err_invalid_input_
return
end if
if (x%is_dev()) call x%sync()
if (x%is_sync()) then
! Call BLAS function to solve the system
lda = size(a,1)
ldb = x%get_nrows()
side = 'R' ! X*op( A ) = alpha*B.
call dtrsm(side, uplo, trans_, diag_, n, x%get_ncols(), alpha_, a, lda, x%v, ldb)
end if
end subroutine s_base_mlv_trslv
!
! Reset all values
!
@@ -3065,6 +3131,48 @@ contains
end subroutine s_base_mlv_axpby_a
!> Function base_mlv_mlt_mv2
!! \memberof psb_d_base_multivect_type
!! \brief computes A = transpose(X)*Y / conjugatetranspose(X)*Y
!! \param x The class(base_mlv_vect) to be multiplied by
!! \param y The class(base_mlv_vect) to be multiplied by
!! \param a The resulting matrix
!! \param info return code
subroutine s_base_mlv_mlt_mv2(n,x,y,a,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_s_base_multivect_type), intent(inout) :: x
class(psb_s_base_multivect_type), intent(inout) :: y
real(psb_spk_), intent(inout), allocatable :: a(:,:)
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (x%is_dev()) call x%sync()
if (y%is_dev()) call y%sync()
if (allocated(a)) then
if (size(a,1) /= x%get_ncols()) then
info = psb_err_invalid_input_
return
end if
if (size(a,2) /= y%get_ncols()) then
info = psb_err_invalid_input_
return
end if
else
allocate(a(x%get_ncols(),y%get_ncols()),stat=info)
if (info /= 0) call psb_errpush(psb_err_alloc_dealloc_,'base_mlv_mlt_mv2')
end if
! We do the multiplication by using the BLAS function
! dgemm, which computes the matrix-matrix product
! C = alpha*op( A )*op( B ) + beta*C
! In our case, we want to compute
! C = X'*Y
call dgemm('C', 'N', x%get_ncols(), y%get_ncols(), n, sone, &
& x%v, x%get_nrows(), y%v, y%get_nrows(), szero, a, x%get_ncols())
end subroutine s_base_mlv_mlt_mv2
!
! Multiple variants of two operations:
base/modules/serial/psb_s_vect_mod.F90
+40
View File
@@ -1423,6 +1423,9 @@ module psb_s_multivect_mod
procedure, pass(x) :: dot_a => s_mvect_dot_a
procedure, pass(x) :: dot_a_vect => s_mvect_dot_vect
generic, public :: dot => dot_v, dot_a, dot_a_vect
procedure, pass(x) :: trslv => s_mlv_trslv
procedure, pass(x) :: mlt_mv2 => s_mvect_mlt_mv2
generic, public :: mlt => mlt_mv2
!!$ procedure, pass(y) :: axpby_v => s_mvect_axpby_v
!!$ procedure, pass(y) :: axpby_a => s_mvect_axpby_a
!!$ generic, public :: axpby => axpby_v, axpby_a
@@ -1955,6 +1958,43 @@ contains
end function s_mvect_dot_a
subroutine s_mlv_trslv(n,x,a,uplo,alpha,trans,diag,info)
implicit none
class(psb_s_multivect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: a(:,:)
integer(psb_ipk_), intent(in) :: n
character(len=1), intent(in) :: uplo
real(psb_spk_), intent(in), optional :: alpha
character(len=1), intent(in), optional :: trans, diag
integer(psb_ipk_), intent(out) :: info
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
return
else
call x%v%trslv(n,a,uplo,alpha=alpha,trans=trans,diag=diag,info=info)
end if
end subroutine s_mlv_trslv
subroutine s_mvect_mlt_mv2(n,x,y,a,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_s_multivect_type), intent(inout) :: x
class(psb_s_multivect_type), intent(inout) :: y
real(psb_spk_), intent(inout), allocatable :: a(:,:)
integer(psb_ipk_), intent(out) :: info
if (allocated(x%v).and.allocated(y%v)) then
call y%v%mlt(n,x%v,a,info)
else
info = psb_err_invalid_vect_state_
return
end if
end subroutine s_mvect_mlt_mv2
!!$ subroutine s_mvect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
base/modules/serial/psb_z_base_vect_mod.F90
+109 -1
View File
@@ -2177,13 +2177,15 @@ module psb_z_base_multivect_mod
procedure, pass(y) :: mlt_ar2 => z_base_mlv_mlt_ar2
procedure, pass(z) :: mlt_a_2 => z_base_mlv_mlt_a_2
procedure, pass(z) :: mlt_v_2 => z_base_mlv_mlt_v_2
procedure, pass(x) :: mlt_mv2 => z_base_mlv_mlt_mv2
!!$ procedure, pass(z) :: mlt_va => z_base_mlv_mlt_va
!!$ procedure, pass(z) :: mlt_av => z_base_mlv_mlt_av
generic, public :: mlt => mlt_mv, mlt_mv_v, mlt_ar1, mlt_ar2, &
& mlt_a_2, mlt_v_2 !, mlt_av, mlt_va
& mlt_a_2, mlt_v_2, mlt_mv2 !, mlt_av, mlt_va
!
! Scaling and norms
!
procedure, pass(x) :: trslv => z_base_mlv_trslv
procedure, pass(x) :: scal => z_base_mlv_scal
procedure, pass(x) :: nrm2 => z_base_mlv_nrm2
procedure, pass(x) :: amax => z_base_mlv_amax
@@ -2672,6 +2674,70 @@ contains
res(1:m,1:n) = x%v(1:m,1:n)
end function z_base_mlv_get_vect
!
!> subroutine d_base_mlv_trslv
!! \memberof psb_d_base_multivect_type
!! \brief Computes X = X / A with A an upper triangular matrix
!! \param n Number of entries to be considered
!! \param x The multivector to be used for the division
!! \param uplo 'U' for upper triangular, 'L' for lower triangular
!! \param a The matrix to be used for the division
!! \param alpha (optional) The scaling factor
!! \param trans (optional) 'N' for no transpose, 'T' for transpose
!! \param diag (optional) 'N' for non-unit diagonal, 'U' for unit diagonal
!! \param info return code
!!
subroutine z_base_mlv_trslv(n,x,a,uplo,alpha,trans,diag,info)
implicit none
class(psb_z_base_multivect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: a(:,:)
integer(psb_ipk_), intent(in) :: n
character(len=1), intent(in) :: uplo
complex(psb_dpk_), intent(in), optional :: alpha
character(len=1), intent(in), optional :: trans, diag
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: lda, ldb
character(len=1) :: trans_, diag_, side
complex(psb_dpk_) :: alpha_
! Default values
if (.not.present(alpha)) then
alpha_ = zone
else
alpha_ = alpha
end if
if (.not.present(trans)) then
trans_ = 'N'
else
trans_ = trans
end if
if (.not.present(diag)) then
diag_ = 'N'
else
diag_ = diag
end if
info = psb_success_
! Check that a is square
if (size(a,1) /= size(a,2)) then
info = psb_err_invalid_input_
return
end if
! Check that a has the same number of columns as x
if (size(a,2) /= x%get_ncols()) then
info = psb_err_invalid_input_
return
end if
if (x%is_dev()) call x%sync()
if (x%is_sync()) then
! Call BLAS function to solve the system
lda = size(a,1)
ldb = x%get_nrows()
side = 'R' ! X*op( A ) = alpha*B.
call dtrsm(side, uplo, trans_, diag_, n, x%get_ncols(), alpha_, a, lda, x%v, ldb)
end if
end subroutine z_base_mlv_trslv
!
! Reset all values
!
@@ -2886,6 +2952,48 @@ contains
end subroutine z_base_mlv_axpby_a
!> Function base_mlv_mlt_mv2
!! \memberof psb_d_base_multivect_type
!! \brief computes A = transpose(X)*Y / conjugatetranspose(X)*Y
!! \param x The class(base_mlv_vect) to be multiplied by
!! \param y The class(base_mlv_vect) to be multiplied by
!! \param a The resulting matrix
!! \param info return code
subroutine z_base_mlv_mlt_mv2(n,x,y,a,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_z_base_multivect_type), intent(inout) :: x
class(psb_z_base_multivect_type), intent(inout) :: y
complex(psb_dpk_), intent(inout), allocatable :: a(:,:)
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (x%is_dev()) call x%sync()
if (y%is_dev()) call y%sync()
if (allocated(a)) then
if (size(a,1) /= x%get_ncols()) then
info = psb_err_invalid_input_
return
end if
if (size(a,2) /= y%get_ncols()) then
info = psb_err_invalid_input_
return
end if
else
allocate(a(x%get_ncols(),y%get_ncols()),stat=info)
if (info /= 0) call psb_errpush(psb_err_alloc_dealloc_,'base_mlv_mlt_mv2')
end if
! We do the multiplication by using the BLAS function
! dgemm, which computes the matrix-matrix product
! C = alpha*op( A )*op( B ) + beta*C
! In our case, we want to compute
! C = X'*Y
call dgemm('C', 'N', x%get_ncols(), y%get_ncols(), n, zone, &
& x%v, x%get_nrows(), y%v, y%get_nrows(), zzero, a, x%get_ncols())
end subroutine z_base_mlv_mlt_mv2
!
! Multiple variants of two operations:
base/modules/serial/psb_z_vect_mod.F90
+40
View File
@@ -1344,6 +1344,9 @@ module psb_z_multivect_mod
procedure, pass(x) :: dot_a => z_mvect_dot_a
procedure, pass(x) :: dot_a_vect => z_mvect_dot_vect
generic, public :: dot => dot_v, dot_a, dot_a_vect
procedure, pass(x) :: trslv => z_mlv_trslv
procedure, pass(x) :: mlt_mv2 => z_mvect_mlt_mv2
generic, public :: mlt => mlt_mv2
!!$ procedure, pass(y) :: axpby_v => z_mvect_axpby_v
!!$ procedure, pass(y) :: axpby_a => z_mvect_axpby_a
!!$ generic, public :: axpby => axpby_v, axpby_a
@@ -1876,6 +1879,43 @@ contains
end function z_mvect_dot_a
subroutine z_mlv_trslv(n,x,a,uplo,alpha,trans,diag,info)
implicit none
class(psb_z_multivect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: a(:,:)
integer(psb_ipk_), intent(in) :: n
character(len=1), intent(in) :: uplo
complex(psb_dpk_), intent(in), optional :: alpha
character(len=1), intent(in), optional :: trans, diag
integer(psb_ipk_), intent(out) :: info
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
return
else
call x%v%trslv(n,a,uplo,alpha=alpha,trans=trans,diag=diag,info=info)
end if
end subroutine z_mlv_trslv
subroutine z_mvect_mlt_mv2(n,x,y,a,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_z_multivect_type), intent(inout) :: x
class(psb_z_multivect_type), intent(inout) :: y
complex(psb_dpk_), intent(inout), allocatable :: a(:,:)
integer(psb_ipk_), intent(out) :: info
if (allocated(x%v).and.allocated(y%v)) then
call y%v%mlt(n,x%v,a,info)
else
info = psb_err_invalid_vect_state_
return
end if
end subroutine z_mvect_mlt_mv2
!!$ subroutine z_mvect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none