psblas:

base/modules/psb_c_base_vect_mod.f90
 base/modules/psb_d_base_vect_mod.f90
 base/modules/psb_i_base_vect_mod.f90
 base/modules/psb_s_base_vect_mod.f90
 base/modules/psb_z_base_vect_mod.f90
 base/serial/psi_serial_impl.f90


Multivector gather

base/modules/psb_c_base_vect_mod.f90

@@ -1340,6 +1340,7 @@ module psb_c_base_multivect_mod
   use psb_const_mod
   use psb_error_mod
   use psb_realloc_mod
+  use psb_c_base_vect_mod
 
   !> \namespace  psb_base_mod  \class psb_c_base_vect_type
   !! The psb_c_base_vect_type 
@@ -1440,9 +1441,9 @@ module psb_c_base_multivect_mod
 !!$    ! May have to be reworked. 
 !!$    !
     procedure, pass(x) :: gthab    => c_base_mlv_gthab
-!!$    procedure, pass(x) :: gthzv    => c_base_mlv_gthzv
-!!$    procedure, pass(x) :: gthzv_x  => c_base_mlv_gthzv_x
-!!$    generic, public    :: gth      => gthab, gthzv, gthzv_x
+    procedure, pass(x) :: gthzv    => c_base_mlv_gthzv
+    procedure, pass(x) :: gthzv_x  => c_base_mlv_gthzv_x
+    generic, public    :: gth      => gthab, gthzv, gthzv_x
 !!$    procedure, pass(y) :: sctb     => c_base_mlv_sctb
 !!$    procedure, pass(y) :: sctb_x   => c_base_mlv_sctb_x
 !!$    generic, public    :: sct      => sctb, sctb_x
@@ -2435,46 +2436,53 @@ contains
     call psi_gth(n,nc,idx,alpha,x%v,beta,y)
     
   end subroutine c_base_mlv_gthab
-!!$  !
-!!$  ! shortcut alpha=1 beta=0
-!!$  ! 
-!!$  !> Function  base_mlv_gthzv
-!!$  !! \memberof  psb_c_base_multivect_type
-!!$  !! \brief gather into an array special alpha=1 beta=0
-!!$  !!    Y = X(IDX(:))
-!!$  !! \param n  how many entries to consider
-!!$  !! \param idx(:) indices
-!!$  subroutine c_base_mlv_gthzv_x(i,n,idx,x,y)
-!!$    use psi_serial_mod
-!!$    integer(psb_ipk_) :: i,n
-!!$    class(psb_c_base_multivect_type) :: idx
-!!$    complex(psb_spk_) ::  y(:)
-!!$    class(psb_c_base_multivect_type) :: x
-!!$    
-!!$    call x%gth(n,idx%v(i:),y)
-!!$
-!!$  end subroutine c_base_mlv_gthzv_x
-!!$
-!!$  !
-!!$  ! shortcut alpha=1 beta=0
-!!$  ! 
-!!$  !> Function  base_mlv_gthzv
-!!$  !! \memberof  psb_c_base_multivect_type
-!!$  !! \brief gather into an array special alpha=1 beta=0
-!!$  !!    Y = X(IDX(:))
-!!$  !! \param n  how many entries to consider
-!!$  !! \param idx(:) indices
-!!$  subroutine c_base_mlv_gthzv(n,idx,x,y)
-!!$    use psi_serial_mod
-!!$    integer(psb_ipk_) :: n, idx(:)
-!!$    complex(psb_spk_) ::  y(:)
-!!$    class(psb_c_base_multivect_type) :: x
-!!$    
-!!$    call x%sync()
-!!$    call psi_gth(n,idx,x%v,y)
-!!$
-!!$  end subroutine c_base_mlv_gthzv
-!!$
+  !
+  ! shortcut alpha=1 beta=0
+  ! 
+  !> Function  base_mlv_gthzv
+  !! \memberof  psb_c_base_multivect_type
+  !! \brief gather into an array special alpha=1 beta=0
+  !!    Y = X(IDX(:))
+  !! \param n  how many entries to consider
+  !! \param idx(:) indices
+  subroutine c_base_mlv_gthzv_x(i,n,idx,x,y)
+    use psi_serial_mod
+    integer(psb_ipk_) :: i,n
+    class(psb_i_base_vect_type) :: idx
+    complex(psb_spk_) ::  y(:)
+    class(psb_c_base_multivect_type) :: x
+
+    call x%sync()
+    call x%gth(n,idx%v(i:),y)
+
+  end subroutine c_base_mlv_gthzv_x
+
+  !
+  ! shortcut alpha=1 beta=0
+  ! 
+  !> Function  base_mlv_gthzv
+  !! \memberof  psb_c_base_multivect_type
+  !! \brief gather into an array special alpha=1 beta=0
+  !!    Y = X(IDX(:))
+  !! \param n  how many entries to consider
+  !! \param idx(:) indices
+  subroutine c_base_mlv_gthzv(n,idx,x,y)
+    use psi_serial_mod
+    integer(psb_ipk_) :: n, idx(:)
+    complex(psb_spk_) ::  y(:)
+    class(psb_c_base_multivect_type) :: x
+    integer(psb_ipk_) :: nc
+
+    call x%sync()
+    if (.not.allocated(x%v)) then
+      return
+    end if
+    nc = psb_size(x%v,2)
+    
+    call psi_gth(n,nc,idx,x%v,y)
+
+  end subroutine c_base_mlv_gthzv
+
 !!$  !
 !!$  ! Scatter: 
 !!$  ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)

base/modules/psb_d_base_vect_mod.f90

@@ -1340,6 +1340,7 @@ module psb_d_base_multivect_mod
   use psb_const_mod
   use psb_error_mod
   use psb_realloc_mod
+  use psb_d_base_vect_mod
 
   !> \namespace  psb_base_mod  \class psb_d_base_vect_type
   !! The psb_d_base_vect_type 
@@ -1440,9 +1441,9 @@ module psb_d_base_multivect_mod
 !!$    ! May have to be reworked. 
 !!$    !
     procedure, pass(x) :: gthab    => d_base_mlv_gthab
-!!$    procedure, pass(x) :: gthzv    => d_base_mlv_gthzv
-!!$    procedure, pass(x) :: gthzv_x  => d_base_mlv_gthzv_x
-!!$    generic, public    :: gth      => gthab, gthzv, gthzv_x
+    procedure, pass(x) :: gthzv    => d_base_mlv_gthzv
+    procedure, pass(x) :: gthzv_x  => d_base_mlv_gthzv_x
+    generic, public    :: gth      => gthab, gthzv, gthzv_x
 !!$    procedure, pass(y) :: sctb     => d_base_mlv_sctb
 !!$    procedure, pass(y) :: sctb_x   => d_base_mlv_sctb_x
 !!$    generic, public    :: sct      => sctb, sctb_x
@@ -2435,46 +2436,53 @@ contains
     call psi_gth(n,nc,idx,alpha,x%v,beta,y)
     
   end subroutine d_base_mlv_gthab
-!!$  !
-!!$  ! shortcut alpha=1 beta=0
-!!$  ! 
-!!$  !> Function  base_mlv_gthzv
-!!$  !! \memberof  psb_d_base_multivect_type
-!!$  !! \brief gather into an array special alpha=1 beta=0
-!!$  !!    Y = X(IDX(:))
-!!$  !! \param n  how many entries to consider
-!!$  !! \param idx(:) indices
-!!$  subroutine d_base_mlv_gthzv_x(i,n,idx,x,y)
-!!$    use psi_serial_mod
-!!$    integer(psb_ipk_) :: i,n
-!!$    class(psb_d_base_multivect_type) :: idx
-!!$    real(psb_dpk_) ::  y(:)
-!!$    class(psb_d_base_multivect_type) :: x
-!!$    
-!!$    call x%gth(n,idx%v(i:),y)
-!!$
-!!$  end subroutine d_base_mlv_gthzv_x
-!!$
-!!$  !
-!!$  ! shortcut alpha=1 beta=0
-!!$  ! 
-!!$  !> Function  base_mlv_gthzv
-!!$  !! \memberof  psb_d_base_multivect_type
-!!$  !! \brief gather into an array special alpha=1 beta=0
-!!$  !!    Y = X(IDX(:))
-!!$  !! \param n  how many entries to consider
-!!$  !! \param idx(:) indices
-!!$  subroutine d_base_mlv_gthzv(n,idx,x,y)
-!!$    use psi_serial_mod
-!!$    integer(psb_ipk_) :: n, idx(:)
-!!$    real(psb_dpk_) ::  y(:)
-!!$    class(psb_d_base_multivect_type) :: x
-!!$    
-!!$    call x%sync()
-!!$    call psi_gth(n,idx,x%v,y)
-!!$
-!!$  end subroutine d_base_mlv_gthzv
-!!$
+  !
+  ! shortcut alpha=1 beta=0
+  ! 
+  !> Function  base_mlv_gthzv
+  !! \memberof  psb_d_base_multivect_type
+  !! \brief gather into an array special alpha=1 beta=0
+  !!    Y = X(IDX(:))
+  !! \param n  how many entries to consider
+  !! \param idx(:) indices
+  subroutine d_base_mlv_gthzv_x(i,n,idx,x,y)
+    use psi_serial_mod
+    integer(psb_ipk_) :: i,n
+    class(psb_i_base_vect_type) :: idx
+    real(psb_dpk_) ::  y(:)
+    class(psb_d_base_multivect_type) :: x
+
+    call x%sync()
+    call x%gth(n,idx%v(i:),y)
+
+  end subroutine d_base_mlv_gthzv_x
+
+  !
+  ! shortcut alpha=1 beta=0
+  ! 
+  !> Function  base_mlv_gthzv
+  !! \memberof  psb_d_base_multivect_type
+  !! \brief gather into an array special alpha=1 beta=0
+  !!    Y = X(IDX(:))
+  !! \param n  how many entries to consider
+  !! \param idx(:) indices
+  subroutine d_base_mlv_gthzv(n,idx,x,y)
+    use psi_serial_mod
+    integer(psb_ipk_) :: n, idx(:)
+    real(psb_dpk_) ::  y(:)
+    class(psb_d_base_multivect_type) :: x
+    integer(psb_ipk_) :: nc
+
+    call x%sync()
+    if (.not.allocated(x%v)) then
+      return
+    end if
+    nc = psb_size(x%v,2)
+    
+    call psi_gth(n,nc,idx,x%v,y)
+
+  end subroutine d_base_mlv_gthzv
+
 !!$  !
 !!$  ! Scatter: 
 !!$  ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)

base/modules/psb_i_base_vect_mod.f90

@@ -880,6 +880,7 @@ module psb_i_base_multivect_mod
   use psb_const_mod
   use psb_error_mod
   use psb_realloc_mod
+  use psb_i_base_vect_mod
 
   !> \namespace  psb_base_mod  \class psb_i_base_vect_type
   !! The psb_i_base_vect_type 

base/modules/psb_s_base_vect_mod.f90

@@ -1340,6 +1340,7 @@ module psb_s_base_multivect_mod
   use psb_const_mod
   use psb_error_mod
   use psb_realloc_mod
+  use psb_s_base_vect_mod
 
   !> \namespace  psb_base_mod  \class psb_s_base_vect_type
   !! The psb_s_base_vect_type 
@@ -1440,9 +1441,9 @@ module psb_s_base_multivect_mod
 !!$    ! May have to be reworked. 
 !!$    !
     procedure, pass(x) :: gthab    => s_base_mlv_gthab
-!!$    procedure, pass(x) :: gthzv    => s_base_mlv_gthzv
-!!$    procedure, pass(x) :: gthzv_x  => s_base_mlv_gthzv_x
-!!$    generic, public    :: gth      => gthab, gthzv, gthzv_x
+    procedure, pass(x) :: gthzv    => s_base_mlv_gthzv
+    procedure, pass(x) :: gthzv_x  => s_base_mlv_gthzv_x
+    generic, public    :: gth      => gthab, gthzv, gthzv_x
 !!$    procedure, pass(y) :: sctb     => s_base_mlv_sctb
 !!$    procedure, pass(y) :: sctb_x   => s_base_mlv_sctb_x
 !!$    generic, public    :: sct      => sctb, sctb_x
@@ -2435,46 +2436,53 @@ contains
     call psi_gth(n,nc,idx,alpha,x%v,beta,y)
     
   end subroutine s_base_mlv_gthab
-!!$  !
-!!$  ! shortcut alpha=1 beta=0
-!!$  ! 
-!!$  !> Function  base_mlv_gthzv
-!!$  !! \memberof  psb_s_base_multivect_type
-!!$  !! \brief gather into an array special alpha=1 beta=0
-!!$  !!    Y = X(IDX(:))
-!!$  !! \param n  how many entries to consider
-!!$  !! \param idx(:) indices
-!!$  subroutine s_base_mlv_gthzv_x(i,n,idx,x,y)
-!!$    use psi_serial_mod
-!!$    integer(psb_ipk_) :: i,n
-!!$    class(psb_s_base_multivect_type) :: idx
-!!$    real(psb_spk_) ::  y(:)
-!!$    class(psb_s_base_multivect_type) :: x
-!!$    
-!!$    call x%gth(n,idx%v(i:),y)
-!!$
-!!$  end subroutine s_base_mlv_gthzv_x
-!!$
-!!$  !
-!!$  ! shortcut alpha=1 beta=0
-!!$  ! 
-!!$  !> Function  base_mlv_gthzv
-!!$  !! \memberof  psb_s_base_multivect_type
-!!$  !! \brief gather into an array special alpha=1 beta=0
-!!$  !!    Y = X(IDX(:))
-!!$  !! \param n  how many entries to consider
-!!$  !! \param idx(:) indices
-!!$  subroutine s_base_mlv_gthzv(n,idx,x,y)
-!!$    use psi_serial_mod
-!!$    integer(psb_ipk_) :: n, idx(:)
-!!$    real(psb_spk_) ::  y(:)
-!!$    class(psb_s_base_multivect_type) :: x
-!!$    
-!!$    call x%sync()
-!!$    call psi_gth(n,idx,x%v,y)
-!!$
-!!$  end subroutine s_base_mlv_gthzv
-!!$
+  !
+  ! shortcut alpha=1 beta=0
+  ! 
+  !> Function  base_mlv_gthzv
+  !! \memberof  psb_s_base_multivect_type
+  !! \brief gather into an array special alpha=1 beta=0
+  !!    Y = X(IDX(:))
+  !! \param n  how many entries to consider
+  !! \param idx(:) indices
+  subroutine s_base_mlv_gthzv_x(i,n,idx,x,y)
+    use psi_serial_mod
+    integer(psb_ipk_) :: i,n
+    class(psb_i_base_vect_type) :: idx
+    real(psb_spk_) ::  y(:)
+    class(psb_s_base_multivect_type) :: x
+
+    call x%sync()
+    call x%gth(n,idx%v(i:),y)
+
+  end subroutine s_base_mlv_gthzv_x
+
+  !
+  ! shortcut alpha=1 beta=0
+  ! 
+  !> Function  base_mlv_gthzv
+  !! \memberof  psb_s_base_multivect_type
+  !! \brief gather into an array special alpha=1 beta=0
+  !!    Y = X(IDX(:))
+  !! \param n  how many entries to consider
+  !! \param idx(:) indices
+  subroutine s_base_mlv_gthzv(n,idx,x,y)
+    use psi_serial_mod
+    integer(psb_ipk_) :: n, idx(:)
+    real(psb_spk_) ::  y(:)
+    class(psb_s_base_multivect_type) :: x
+    integer(psb_ipk_) :: nc
+
+    call x%sync()
+    if (.not.allocated(x%v)) then
+      return
+    end if
+    nc = psb_size(x%v,2)
+    
+    call psi_gth(n,nc,idx,x%v,y)
+
+  end subroutine s_base_mlv_gthzv
+
 !!$  !
 !!$  ! Scatter: 
 !!$  ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)

base/modules/psb_z_base_vect_mod.f90

@@ -1340,6 +1340,7 @@ module psb_z_base_multivect_mod
   use psb_const_mod
   use psb_error_mod
   use psb_realloc_mod
+  use psb_z_base_vect_mod
 
   !> \namespace  psb_base_mod  \class psb_z_base_vect_type
   !! The psb_z_base_vect_type 
@@ -1440,9 +1441,9 @@ module psb_z_base_multivect_mod
 !!$    ! May have to be reworked. 
 !!$    !
     procedure, pass(x) :: gthab    => z_base_mlv_gthab
-!!$    procedure, pass(x) :: gthzv    => z_base_mlv_gthzv
-!!$    procedure, pass(x) :: gthzv_x  => z_base_mlv_gthzv_x
-!!$    generic, public    :: gth      => gthab, gthzv, gthzv_x
+    procedure, pass(x) :: gthzv    => z_base_mlv_gthzv
+    procedure, pass(x) :: gthzv_x  => z_base_mlv_gthzv_x
+    generic, public    :: gth      => gthab, gthzv, gthzv_x
 !!$    procedure, pass(y) :: sctb     => z_base_mlv_sctb
 !!$    procedure, pass(y) :: sctb_x   => z_base_mlv_sctb_x
 !!$    generic, public    :: sct      => sctb, sctb_x
@@ -2435,46 +2436,53 @@ contains
     call psi_gth(n,nc,idx,alpha,x%v,beta,y)
     
   end subroutine z_base_mlv_gthab
-!!$  !
-!!$  ! shortcut alpha=1 beta=0
-!!$  ! 
-!!$  !> Function  base_mlv_gthzv
-!!$  !! \memberof  psb_z_base_multivect_type
-!!$  !! \brief gather into an array special alpha=1 beta=0
-!!$  !!    Y = X(IDX(:))
-!!$  !! \param n  how many entries to consider
-!!$  !! \param idx(:) indices
-!!$  subroutine z_base_mlv_gthzv_x(i,n,idx,x,y)
-!!$    use psi_serial_mod
-!!$    integer(psb_ipk_) :: i,n
-!!$    class(psb_z_base_multivect_type) :: idx
-!!$    complex(psb_dpk_) ::  y(:)
-!!$    class(psb_z_base_multivect_type) :: x
-!!$    
-!!$    call x%gth(n,idx%v(i:),y)
-!!$
-!!$  end subroutine z_base_mlv_gthzv_x
-!!$
-!!$  !
-!!$  ! shortcut alpha=1 beta=0
-!!$  ! 
-!!$  !> Function  base_mlv_gthzv
-!!$  !! \memberof  psb_z_base_multivect_type
-!!$  !! \brief gather into an array special alpha=1 beta=0
-!!$  !!    Y = X(IDX(:))
-!!$  !! \param n  how many entries to consider
-!!$  !! \param idx(:) indices
-!!$  subroutine z_base_mlv_gthzv(n,idx,x,y)
-!!$    use psi_serial_mod
-!!$    integer(psb_ipk_) :: n, idx(:)
-!!$    complex(psb_dpk_) ::  y(:)
-!!$    class(psb_z_base_multivect_type) :: x
-!!$    
-!!$    call x%sync()
-!!$    call psi_gth(n,idx,x%v,y)
-!!$
-!!$  end subroutine z_base_mlv_gthzv
-!!$
+  !
+  ! shortcut alpha=1 beta=0
+  ! 
+  !> Function  base_mlv_gthzv
+  !! \memberof  psb_z_base_multivect_type
+  !! \brief gather into an array special alpha=1 beta=0
+  !!    Y = X(IDX(:))
+  !! \param n  how many entries to consider
+  !! \param idx(:) indices
+  subroutine z_base_mlv_gthzv_x(i,n,idx,x,y)
+    use psi_serial_mod
+    integer(psb_ipk_) :: i,n
+    class(psb_i_base_vect_type) :: idx
+    complex(psb_dpk_) ::  y(:)
+    class(psb_z_base_multivect_type) :: x
+
+    call x%sync()
+    call x%gth(n,idx%v(i:),y)
+
+  end subroutine z_base_mlv_gthzv_x
+
+  !
+  ! shortcut alpha=1 beta=0
+  ! 
+  !> Function  base_mlv_gthzv
+  !! \memberof  psb_z_base_multivect_type
+  !! \brief gather into an array special alpha=1 beta=0
+  !!    Y = X(IDX(:))
+  !! \param n  how many entries to consider
+  !! \param idx(:) indices
+  subroutine z_base_mlv_gthzv(n,idx,x,y)
+    use psi_serial_mod
+    integer(psb_ipk_) :: n, idx(:)
+    complex(psb_dpk_) ::  y(:)
+    class(psb_z_base_multivect_type) :: x
+    integer(psb_ipk_) :: nc
+
+    call x%sync()
+    if (.not.allocated(x%v)) then
+      return
+    end if
+    nc = psb_size(x%v,2)
+    
+    call psi_gth(n,nc,idx,x%v,y)
+
+  end subroutine z_base_mlv_gthzv
+
 !!$  !
 !!$  ! Scatter: 
 !!$  ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)