Linear combination of multivector columns

base/modules/psblas/psb_c_psblas_mod.F90

@@ -506,6 +506,16 @@ module psb_c_psblas_mod
       integer(psb_ipk_), intent(out)        :: info
       character(len=1), intent(in), optional :: conjgx, conjgy
     end subroutine psb_cmlt_vect2
+    subroutine psb_cmlt_mltvec_va(x,a,v,desc,info)
+      import :: psb_desc_type, psb_ipk_, psb_c_vect_type, &
+        & psb_c_multivect_type, psb_spk_
+      implicit none
+      type(psb_c_multivect_type), intent(inout) :: x
+      complex(psb_spk_), dimension(:), allocatable, intent(inout) :: a
+      type(psb_c_vect_type), intent(inout) :: v
+      type(psb_desc_type), intent(inout) :: desc
+      integer(psb_ipk_), intent(inout) :: info
+    end subroutine
   end interface
 
   interface psb_gediv

base/modules/psblas/psb_d_psblas_mod.F90

@@ -142,7 +142,8 @@ module psb_d_psblas_mod
       integer(psb_ipk_), optional, intent(in) :: n, jx, jy
       integer(psb_ipk_), intent(out)      :: info
     end subroutine psb_daxpby
-    subroutine psb_daxpby_multivect_vect(alpha, x, beta, y, j, desc_a, info)
+    subroutine psb_daxpby_multivect_vect(alpha, x, beta, y,&
+         & j, desc_a, info)
       import :: psb_desc_type, psb_dpk_, psb_ipk_, &
               & psb_d_vect_type, psb_dspmat_type, psb_d_multivect_type
       type(psb_d_vect_type), intent (inout) ::  x
@@ -516,6 +517,16 @@ module psb_d_psblas_mod
       integer(psb_ipk_), intent(out)        :: info
       character(len=1), intent(in), optional :: conjgx, conjgy
     end subroutine psb_dmlt_vect2
+    subroutine psb_dmlt_mltvec_va(x,a,v,desc,info)
+      import :: psb_desc_type, psb_ipk_, psb_d_vect_type, &
+        & psb_d_multivect_type, psb_dpk_
+      implicit none
+      type(psb_d_multivect_type), intent(inout) :: x
+      real(psb_dpk_), dimension(:), allocatable, intent(inout) :: a
+      type(psb_d_vect_type), intent(inout) :: v
+      type(psb_desc_type), intent(inout) :: desc
+      integer(psb_ipk_), intent(inout) :: info
+    end subroutine
   end interface
 
   interface psb_gediv

base/modules/psblas/psb_s_psblas_mod.F90

@@ -517,6 +517,16 @@ module psb_s_psblas_mod
       integer(psb_ipk_), intent(out)        :: info
       character(len=1), intent(in), optional :: conjgx, conjgy
     end subroutine psb_smlt_vect2
+    subroutine psb_smlt_mltvec_va(x,a,v,desc,info)
+      import :: psb_desc_type, psb_ipk_, psb_s_vect_type, &
+        & psb_s_multivect_type, psb_spk_
+      implicit none
+      type(psb_s_multivect_type), intent(inout) :: x
+      real(psb_spk_), dimension(:), allocatable, intent(inout) :: a
+      type(psb_s_vect_type), intent(inout) :: v
+      type(psb_desc_type), intent(inout) :: desc
+      integer(psb_ipk_), intent(inout) :: info
+    end subroutine
   end interface
 
   interface psb_gediv

base/modules/psblas/psb_z_psblas_mod.F90

@@ -506,6 +506,16 @@ module psb_z_psblas_mod
       integer(psb_ipk_), intent(out)        :: info
       character(len=1), intent(in), optional :: conjgx, conjgy
     end subroutine psb_zmlt_vect2
+    subroutine psb_zmlt_mltvec_va(x,a,v,desc,info)
+      import :: psb_desc_type, psb_ipk_, psb_z_vect_type, &
+        & psb_z_multivect_type, psb_dpk_
+      implicit none
+      type(psb_z_multivect_type), intent(inout) :: x
+      complex(psb_dpk_), dimension(:), allocatable, intent(inout) :: a
+      type(psb_z_vect_type), intent(inout) :: v
+      type(psb_desc_type), intent(inout) :: desc
+      integer(psb_ipk_), intent(inout) :: info
+    end subroutine
   end interface
 
   interface psb_gediv

base/modules/serial/psb_c_base_vect_mod.F90

@@ -2085,8 +2085,9 @@ module psb_c_base_multivect_mod
     procedure, pass(z) :: mlt_v_2  => c_base_mlv_mlt_v_2
 !!$    procedure, pass(z) :: mlt_va   => c_base_mlv_mlt_va
 !!$    procedure, pass(z) :: mlt_av   => c_base_mlv_mlt_av
+    procedure, pass(y) :: mltav    => c_base_mltav
     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, mltav !, mlt_av, mlt_va
     !
     ! Scaling and norms
     !
@@ -3014,6 +3015,25 @@ contains
 !!$  end subroutine c_base_mlv_mlt_va
 !!$
 !!$
+  !> Function  base_mltav
+  !! \memberof  psb_c_base_multivect_type
+  !! \brief Linear combination of the columns of the multivector
+  !! \param y The multivector
+  !! \param a The coefficients of the linear combination
+  !! \param v The resulting vector
+  !!
+  subroutine c_base_mltav(y,a,v,info)
+    use psi_serial_mod
+    use psb_c_base_vect_mod
+    implicit none
+    class(psb_c_base_multivect_type), intent(inout)  :: y
+    complex(psb_spk_), intent(in), dimension(:) :: a
+    type(psb_c_base_vect_type), intent(inout) :: v
+    integer(psb_ipk_), intent(out) :: info
+
+    v%v = matmul(y%v,a)
+
+  end subroutine c_base_mltav
   !
   ! Simple scaling
   !

base/modules/serial/psb_c_vect_mod.F90

@@ -1318,6 +1318,8 @@ module psb_c_multivect_mod
 !!$    procedure, pass(x) :: asum     => c_vect_asum
        procedure, pass(y) :: axpby_vv => c_vect_axpby_vv
        generic, public :: axpby => axpby_vv
+       procedure, pass(y) :: mlt_av   => c_vect_mltav
+       generic, public :: mlt => mlt_av
   end type psb_c_multivect_type
 
   public  :: psb_c_multivect, psb_c_multivect_type,&
@@ -1954,5 +1956,22 @@ contains
 !!$    end if
 !!$
 !!$  end function c_vect_asum
+  subroutine c_vect_mltav(y,a,v,info)
+    use psb_c_vect_mod
+    implicit none
+    class(psb_c_multivect_type), intent(inout) :: y
+    complex(psb_spk_), dimension(:), allocatable :: a
+    type(psb_c_vect_type), intent(inout) :: v
+    integer(psb_ipk_), intent(out) :: info
+
+    info = 0
+
+    if (allocated(y%v).and.allocated(a)) then
+      call y%v%mlt(a,v%v,info)
+    else
+      info = -1
+    end if
+
+  end subroutine c_vect_mltav
 
 end module psb_c_multivect_mod

base/modules/serial/psb_d_base_vect_mod.F90

@@ -2264,8 +2264,9 @@ module psb_d_base_multivect_mod
     procedure, pass(z) :: mlt_v_2  => d_base_mlv_mlt_v_2
 !!$    procedure, pass(z) :: mlt_va   => d_base_mlv_mlt_va
 !!$    procedure, pass(z) :: mlt_av   => d_base_mlv_mlt_av
+    procedure, pass(y) :: mltav    => d_base_mltav
     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, mltav !, mlt_av, mlt_va
     !
     ! Scaling and norms
     !
@@ -3193,6 +3194,25 @@ contains
 !!$  end subroutine d_base_mlv_mlt_va
 !!$
 !!$
+  !> Function  base_mltav
+  !! \memberof  psb_d_base_multivect_type
+  !! \brief Linear combination of the columns of the multivector
+  !! \param y The multivector
+  !! \param a The coefficients of the linear combination
+  !! \param v The resulting vector
+  !!
+  subroutine d_base_mltav(y,a,v,info)
+    use psi_serial_mod
+    use psb_d_base_vect_mod
+    implicit none
+    class(psb_d_base_multivect_type), intent(inout)  :: y
+    real(psb_dpk_), intent(in), dimension(:) :: a
+    type(psb_d_base_vect_type), intent(inout) :: v
+    integer(psb_ipk_), intent(out) :: info
+
+    v%v = matmul(y%v,a)
+
+  end subroutine d_base_mltav
   !
   ! Simple scaling
   !

base/modules/serial/psb_d_vect_mod.F90

@@ -1397,6 +1397,8 @@ module psb_d_multivect_mod
 !!$    procedure, pass(x) :: asum     => d_vect_asum
        procedure, pass(y) :: axpby_vv => d_vect_axpby_vv
        generic, public :: axpby => axpby_vv
+       procedure, pass(y) :: mlt_av   => d_vect_mltav
+       generic, public :: mlt => mlt_av
   end type psb_d_multivect_type
 
   public  :: psb_d_multivect, psb_d_multivect_type,&
@@ -2033,5 +2035,22 @@ contains
 !!$    end if
 !!$
 !!$  end function d_vect_asum
+  subroutine d_vect_mltav(y,a,v,info)
+    use psb_d_vect_mod
+    implicit none
+    class(psb_d_multivect_type), intent(inout) :: y
+    real(psb_dpk_), dimension(:), allocatable :: a
+    type(psb_d_vect_type), intent(inout) :: v
+    integer(psb_ipk_), intent(out) :: info
+
+    info = 0
+
+    if (allocated(y%v).and.allocated(a)) then
+      call y%v%mlt(a,v%v,info)
+    else
+      info = -1
+    end if
+
+  end subroutine d_vect_mltav
 
 end module psb_d_multivect_mod

base/modules/serial/psb_s_base_vect_mod.F90

@@ -2264,8 +2264,9 @@ module psb_s_base_multivect_mod
     procedure, pass(z) :: mlt_v_2  => s_base_mlv_mlt_v_2
 !!$    procedure, pass(z) :: mlt_va   => s_base_mlv_mlt_va
 !!$    procedure, pass(z) :: mlt_av   => s_base_mlv_mlt_av
+    procedure, pass(y) :: mltav    => s_base_mltav
     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, mltav !, mlt_av, mlt_va
     !
     ! Scaling and norms
     !
@@ -3193,6 +3194,25 @@ contains
 !!$  end subroutine s_base_mlv_mlt_va
 !!$
 !!$
+  !> Function  base_mltav
+  !! \memberof  psb_s_base_multivect_type
+  !! \brief Linear combination of the columns of the multivector
+  !! \param y The multivector
+  !! \param a The coefficients of the linear combination
+  !! \param v The resulting vector
+  !!
+  subroutine s_base_mltav(y,a,v,info)
+    use psi_serial_mod
+    use psb_s_base_vect_mod
+    implicit none
+    class(psb_s_base_multivect_type), intent(inout)  :: y
+    real(psb_spk_), intent(in), dimension(:) :: a
+    type(psb_s_base_vect_type), intent(inout) :: v
+    integer(psb_ipk_), intent(out) :: info
+
+    v%v = matmul(y%v,a)
+
+  end subroutine s_base_mltav
   !
   ! Simple scaling
   !

base/modules/serial/psb_s_vect_mod.F90

@@ -1397,6 +1397,8 @@ module psb_s_multivect_mod
 !!$    procedure, pass(x) :: asum     => s_vect_asum
        procedure, pass(y) :: axpby_vv => s_vect_axpby_vv
        generic, public :: axpby => axpby_vv
+       procedure, pass(y) :: mlt_av   => s_vect_mltav
+       generic, public :: mlt => mlt_av
   end type psb_s_multivect_type
 
   public  :: psb_s_multivect, psb_s_multivect_type,&
@@ -2033,5 +2035,22 @@ contains
 !!$    end if
 !!$
 !!$  end function s_vect_asum
+  subroutine s_vect_mltav(y,a,v,info)
+    use psb_s_vect_mod
+    implicit none
+    class(psb_s_multivect_type), intent(inout) :: y
+    real(psb_spk_), dimension(:), allocatable :: a
+    type(psb_s_vect_type), intent(inout) :: v
+    integer(psb_ipk_), intent(out) :: info
+
+    info = 0
+
+    if (allocated(y%v).and.allocated(a)) then
+      call y%v%mlt(a,v%v,info)
+    else
+      info = -1
+    end if
+
+  end subroutine s_vect_mltav
 
 end module psb_s_multivect_mod

base/modules/serial/psb_z_base_vect_mod.F90

@@ -2085,8 +2085,9 @@ module psb_z_base_multivect_mod
     procedure, pass(z) :: mlt_v_2  => z_base_mlv_mlt_v_2
 !!$    procedure, pass(z) :: mlt_va   => z_base_mlv_mlt_va
 !!$    procedure, pass(z) :: mlt_av   => z_base_mlv_mlt_av
+    procedure, pass(y) :: mltav    => z_base_mltav
     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, mltav !, mlt_av, mlt_va
     !
     ! Scaling and norms
     !
@@ -3014,6 +3015,25 @@ contains
 !!$  end subroutine z_base_mlv_mlt_va
 !!$
 !!$
+  !> Function  base_mltav
+  !! \memberof  psb_z_base_multivect_type
+  !! \brief Linear combination of the columns of the multivector
+  !! \param y The multivector
+  !! \param a The coefficients of the linear combination
+  !! \param v The resulting vector
+  !!
+  subroutine z_base_mltav(y,a,v,info)
+    use psi_serial_mod
+    use psb_z_base_vect_mod
+    implicit none
+    class(psb_z_base_multivect_type), intent(inout)  :: y
+    complex(psb_dpk_), intent(in), dimension(:) :: a
+    type(psb_z_base_vect_type), intent(inout) :: v
+    integer(psb_ipk_), intent(out) :: info
+
+    v%v = matmul(y%v,a)
+
+  end subroutine z_base_mltav
   !
   ! Simple scaling
   !

base/modules/serial/psb_z_vect_mod.F90

@@ -1318,6 +1318,8 @@ module psb_z_multivect_mod
 !!$    procedure, pass(x) :: asum     => z_vect_asum
        procedure, pass(y) :: axpby_vv => z_vect_axpby_vv
        generic, public :: axpby => axpby_vv
+       procedure, pass(y) :: mlt_av   => z_vect_mltav
+       generic, public :: mlt => mlt_av
   end type psb_z_multivect_type
 
   public  :: psb_z_multivect, psb_z_multivect_type,&
@@ -1954,5 +1956,22 @@ contains
 !!$    end if
 !!$
 !!$  end function z_vect_asum
+  subroutine z_vect_mltav(y,a,v,info)
+    use psb_z_vect_mod
+    implicit none
+    class(psb_z_multivect_type), intent(inout) :: y
+    complex(psb_dpk_), dimension(:), allocatable :: a
+    type(psb_z_vect_type), intent(inout) :: v
+    integer(psb_ipk_), intent(out) :: info
+
+    info = 0
+
+    if (allocated(y%v).and.allocated(a)) then
+      call y%v%mlt(a,v%v,info)
+    else
+      info = -1
+    end if
+
+  end subroutine z_vect_mltav
 
 end module psb_z_multivect_mod

base/psblas/psb_cmlt_vect.f90

@@ -198,3 +198,60 @@ subroutine psb_cmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy)
   return
 
 end subroutine psb_cmlt_vect2
+
+subroutine psb_cmlt_mltvec_va(x,a,v,desc,info)
+  use psb_base_mod, psb_protect_name => psb_cmlt_mltvec_va
+  implicit none
+  type(psb_c_multivect_type), intent(inout) :: x
+  complex(psb_spk_), dimension(:), allocatable, intent(inout) :: a
+  type(psb_c_vect_type), intent(inout) :: v
+  type(psb_desc_type), intent(inout) :: desc
+  integer(psb_ipk_), intent(inout) :: info
+
+  ! locals
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: np, me,&
+       & err_act, iix, jjx, iiy, jjy, iiz, jjz
+  integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
+  character(len=20)        :: name, ch_err
+
+  name='psb_c_mlt_mltvec_va'
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  call psb_info(ctxt, me, np)
+  if (np == -ione) then
+    info = psb_err_context_error_
+    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(v%v)) then
+    info = psb_err_invalid_vect_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+  if (.not.allocated(a)) then
+    info = psb_err_invalid_vect_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  if(desc%get_local_rows() > 0) then
+    call x%mlt(a,v,info)
+  end if
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_cmlt_mltvec_va

base/psblas/psb_dmlt_vect.f90

@@ -198,3 +198,60 @@ subroutine psb_dmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy)
   return
 
 end subroutine psb_dmlt_vect2
+
+subroutine psb_dmlt_mltvec_va(x,a,v,desc,info)
+  use psb_base_mod, psb_protect_name => psb_dmlt_mltvec_va
+  implicit none
+  type(psb_d_multivect_type), intent(inout) :: x
+  real(psb_dpk_), dimension(:), allocatable, intent(inout) :: a
+  type(psb_d_vect_type), intent(inout) :: v
+  type(psb_desc_type), intent(inout) :: desc
+  integer(psb_ipk_), intent(inout) :: info
+
+  ! locals
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: np, me,&
+       & err_act, iix, jjx, iiy, jjy, iiz, jjz
+  integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
+  character(len=20)        :: name, ch_err
+
+  name='psb_d_mlt_mltvec_va'
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  call psb_info(ctxt, me, np)
+  if (np == -ione) then
+    info = psb_err_context_error_
+    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(v%v)) then
+    info = psb_err_invalid_vect_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+  if (.not.allocated(a)) then
+    info = psb_err_invalid_vect_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  if(desc%get_local_rows() > 0) then
+    call x%mlt(a,v,info)
+  end if
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_dmlt_mltvec_va

base/psblas/psb_smlt_vect.f90

@@ -198,3 +198,60 @@ subroutine psb_smlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy)
   return
 
 end subroutine psb_smlt_vect2
+
+subroutine psb_smlt_mltvec_va(x,a,v,desc,info)
+  use psb_base_mod, psb_protect_name => psb_smlt_mltvec_va
+  implicit none
+  type(psb_s_multivect_type), intent(inout) :: x
+  real(psb_spk_), dimension(:), allocatable, intent(inout) :: a
+  type(psb_s_vect_type), intent(inout) :: v
+  type(psb_desc_type), intent(inout) :: desc
+  integer(psb_ipk_), intent(inout) :: info
+
+  ! locals
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: np, me,&
+       & err_act, iix, jjx, iiy, jjy, iiz, jjz
+  integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
+  character(len=20)        :: name, ch_err
+
+  name='psb_s_mlt_mltvec_va'
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  call psb_info(ctxt, me, np)
+  if (np == -ione) then
+    info = psb_err_context_error_
+    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(v%v)) then
+    info = psb_err_invalid_vect_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+  if (.not.allocated(a)) then
+    info = psb_err_invalid_vect_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  if(desc%get_local_rows() > 0) then
+    call x%mlt(a,v,info)
+  end if
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_smlt_mltvec_va

base/psblas/psb_zmlt_vect.f90

@@ -198,3 +198,60 @@ subroutine psb_zmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy)
   return
 
 end subroutine psb_zmlt_vect2
+
+subroutine psb_zmlt_mltvec_va(x,a,v,desc,info)
+  use psb_base_mod, psb_protect_name => psb_zmlt_mltvec_va
+  implicit none
+  type(psb_z_multivect_type), intent(inout) :: x
+  complex(psb_dpk_), dimension(:), allocatable, intent(inout) :: a
+  type(psb_z_vect_type), intent(inout) :: v
+  type(psb_desc_type), intent(inout) :: desc
+  integer(psb_ipk_), intent(inout) :: info
+
+  ! locals
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: np, me,&
+       & err_act, iix, jjx, iiy, jjy, iiz, jjz
+  integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
+  character(len=20)        :: name, ch_err
+
+  name='psb_z_mlt_mltvec_va'
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  call psb_info(ctxt, me, np)
+  if (np == -ione) then
+    info = psb_err_context_error_
+    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(v%v)) then
+    info = psb_err_invalid_vect_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+  if (.not.allocated(a)) then
+    info = psb_err_invalid_vect_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  if(desc%get_local_rows() > 0) then
+    call x%mlt(a,v,info)
+  end if
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_zmlt_mltvec_va