psblas3:

base/modules/psb_c_base_vect_mod.f90
 base/modules/psb_c_vect_mod.F90
 base/modules/psb_d_base_vect_mod.f90
 base/modules/psb_d_vect_mod.F90
 base/modules/psb_s_base_vect_mod.f90
 base/modules/psb_s_vect_mod.F90
 base/modules/psb_z_base_vect_mod.f90
 base/modules/psb_z_vect_mod.F90
 base/modules/psi_c_mod.f90
 base/modules/psi_d_mod.f90
 base/modules/psi_s_mod.f90
 base/psblas/psb_cspmm.f90
 base/psblas/psb_dspmm.f90
 base/psblas/psb_sspmm.f90
 base/psblas/psb_zspmm.f90

New optional first/last in V%set(); use them to fix distributed
transpose product.

base/modules/psb_c_base_vect_mod.f90

@@ -47,7 +47,7 @@ module psb_c_base_vect_mod
   use psb_const_mod
   use psb_error_mod
   use psb_i_base_vect_mod
-
+  use psb_realloc_mod
 
   !> \namespace  psb_base_mod  \class psb_c_base_vect_type
   !! The psb_c_base_vect_type 
@@ -650,13 +650,20 @@ contains
   !! \brief  Set all entries
   !! \param val   The value to set
   !!
-  subroutine c_base_set_scal(x,val)
+  subroutine c_base_set_scal(x,val,first,last)
     class(psb_c_base_vect_type), intent(inout)  :: x
     complex(psb_spk_), intent(in) :: val
+    integer(psb_ipk_), optional :: first, last
         
-    integer(psb_ipk_) :: info
+    integer(psb_ipk_) :: info, first_, last_
 
-    x%v = val
+    first_=1
+    last_=size(x%v)
+    if (present(first)) first_ = max(1,first)
+    if (present(last))  last_  = min(last,last_)
+    
+    if (x%is_dev()) call x%sync()
+    x%v(first_:last_) = val
     call x%set_host()
 
   end subroutine c_base_set_scal
@@ -699,15 +706,20 @@ contains
   !! \brief  Set all entries
   !! \param val(:)  The vector to be copied in 
   !!
-  subroutine c_base_set_vect(x,val)
+  subroutine c_base_set_vect(x,val,first,last)
     class(psb_c_base_vect_type), intent(inout)  :: x
     complex(psb_spk_), intent(in) :: val(:)
-    integer(psb_ipk_) :: nr
-    integer(psb_ipk_) :: info
+    integer(psb_ipk_), optional :: first, last
+        
+    integer(psb_ipk_) :: info, first_, last_, nr
+
+    first_=1
+    last_=min(psb_size(x%v),size(val))
+    if (present(first)) first_ = max(1,first)
+    if (present(last))  last_  = min(last,last_)
 
     if (allocated(x%v)) then 
-      nr = min(size(x%v),size(val))
-      x%v(1:nr) = val(1:nr)
+      x%v(first_:last_) = val(1:last_-first_+1)
     else
       x%v = val
     end if

base/modules/psb_c_vect_mod.F90

@@ -231,21 +231,23 @@ contains
     end if
   end function c_vect_get_vect
 
-  subroutine c_vect_set_scal(x,val)
+  subroutine c_vect_set_scal(x,val,first,last)
     class(psb_c_vect_type), intent(inout)  :: x
     complex(psb_spk_), intent(in) :: val
+    integer(psb_ipk_), optional :: first, last
         
     integer(psb_ipk_) :: info
-    if (allocated(x%v)) call x%v%set(val)
+    if (allocated(x%v)) call x%v%set(val,first,last)
     
   end subroutine c_vect_set_scal
 
-  subroutine c_vect_set_vect(x,val)
+  subroutine c_vect_set_vect(x,val,first,last)
     class(psb_c_vect_type), intent(inout) :: x
     complex(psb_spk_), intent(in)         :: val(:)
+    integer(psb_ipk_), optional :: first, last
         
     integer(psb_ipk_) :: info
-    if (allocated(x%v)) call x%v%set(val)
+    if (allocated(x%v)) call x%v%set(val,first,last)
     
   end subroutine c_vect_set_vect
 

base/modules/psb_d_base_vect_mod.f90

@@ -47,7 +47,7 @@ module psb_d_base_vect_mod
   use psb_const_mod
   use psb_error_mod
   use psb_i_base_vect_mod
-
+  use psb_realloc_mod
 
   !> \namespace  psb_base_mod  \class psb_d_base_vect_type
   !! The psb_d_base_vect_type 
@@ -650,13 +650,20 @@ contains
   !! \brief  Set all entries
   !! \param val   The value to set
   !!
-  subroutine d_base_set_scal(x,val)
+  subroutine d_base_set_scal(x,val,first,last)
     class(psb_d_base_vect_type), intent(inout)  :: x
     real(psb_dpk_), intent(in) :: val
+    integer(psb_ipk_), optional :: first, last
         
-    integer(psb_ipk_) :: info
+    integer(psb_ipk_) :: info, first_, last_
 
-    x%v = val
+    first_=1
+    last_=size(x%v)
+    if (present(first)) first_ = max(1,first)
+    if (present(last))  last_  = min(last,last_)
+    
+    if (x%is_dev()) call x%sync()
+    x%v(first_:last_) = val
     call x%set_host()
 
   end subroutine d_base_set_scal
@@ -699,15 +706,20 @@ contains
   !! \brief  Set all entries
   !! \param val(:)  The vector to be copied in 
   !!
-  subroutine d_base_set_vect(x,val)
+  subroutine d_base_set_vect(x,val,first,last)
     class(psb_d_base_vect_type), intent(inout)  :: x
     real(psb_dpk_), intent(in) :: val(:)
-    integer(psb_ipk_) :: nr
-    integer(psb_ipk_) :: info
+    integer(psb_ipk_), optional :: first, last
+        
+    integer(psb_ipk_) :: info, first_, last_, nr
+
+    first_=1
+    last_=min(psb_size(x%v),size(val))
+    if (present(first)) first_ = max(1,first)
+    if (present(last))  last_  = min(last,last_)
 
     if (allocated(x%v)) then 
-      nr = min(size(x%v),size(val))
-      x%v(1:nr) = val(1:nr)
+      x%v(first_:last_) = val(1:last_-first_+1)
     else
       x%v = val
     end if

base/modules/psb_d_vect_mod.F90

@@ -231,21 +231,23 @@ contains
     end if
   end function d_vect_get_vect
 
-  subroutine d_vect_set_scal(x,val)
+  subroutine d_vect_set_scal(x,val,first,last)
     class(psb_d_vect_type), intent(inout)  :: x
     real(psb_dpk_), intent(in) :: val
+    integer(psb_ipk_), optional :: first, last
         
     integer(psb_ipk_) :: info
-    if (allocated(x%v)) call x%v%set(val)
+    if (allocated(x%v)) call x%v%set(val,first,last)
     
   end subroutine d_vect_set_scal
 
-  subroutine d_vect_set_vect(x,val)
+  subroutine d_vect_set_vect(x,val,first,last)
     class(psb_d_vect_type), intent(inout) :: x
     real(psb_dpk_), intent(in)         :: val(:)
+    integer(psb_ipk_), optional :: first, last
         
     integer(psb_ipk_) :: info
-    if (allocated(x%v)) call x%v%set(val)
+    if (allocated(x%v)) call x%v%set(val,first,last)
     
   end subroutine d_vect_set_vect
 

base/modules/psb_s_base_vect_mod.f90

@@ -47,7 +47,7 @@ module psb_s_base_vect_mod
   use psb_const_mod
   use psb_error_mod
   use psb_i_base_vect_mod
-
+  use psb_realloc_mod
 
   !> \namespace  psb_base_mod  \class psb_s_base_vect_type
   !! The psb_s_base_vect_type 
@@ -650,13 +650,20 @@ contains
   !! \brief  Set all entries
   !! \param val   The value to set
   !!
-  subroutine s_base_set_scal(x,val)
+  subroutine s_base_set_scal(x,val,first,last)
     class(psb_s_base_vect_type), intent(inout)  :: x
     real(psb_spk_), intent(in) :: val
+    integer(psb_ipk_), optional :: first, last
         
-    integer(psb_ipk_) :: info
+    integer(psb_ipk_) :: info, first_, last_
 
-    x%v = val
+    first_=1
+    last_=size(x%v)
+    if (present(first)) first_ = max(1,first)
+    if (present(last))  last_  = min(last,last_)
+    
+    if (x%is_dev()) call x%sync()
+    x%v(first_:last_) = val
     call x%set_host()
 
   end subroutine s_base_set_scal
@@ -699,15 +706,20 @@ contains
   !! \brief  Set all entries
   !! \param val(:)  The vector to be copied in 
   !!
-  subroutine s_base_set_vect(x,val)
+  subroutine s_base_set_vect(x,val,first,last)
     class(psb_s_base_vect_type), intent(inout)  :: x
     real(psb_spk_), intent(in) :: val(:)
-    integer(psb_ipk_) :: nr
-    integer(psb_ipk_) :: info
+    integer(psb_ipk_), optional :: first, last
+        
+    integer(psb_ipk_) :: info, first_, last_, nr
+
+    first_=1
+    last_=min(psb_size(x%v),size(val))
+    if (present(first)) first_ = max(1,first)
+    if (present(last))  last_  = min(last,last_)
 
     if (allocated(x%v)) then 
-      nr = min(size(x%v),size(val))
-      x%v(1:nr) = val(1:nr)
+      x%v(first_:last_) = val(1:last_-first_+1)
     else
       x%v = val
     end if

base/modules/psb_s_vect_mod.F90

@@ -231,21 +231,23 @@ contains
     end if
   end function s_vect_get_vect
 
-  subroutine s_vect_set_scal(x,val)
+  subroutine s_vect_set_scal(x,val,first,last)
     class(psb_s_vect_type), intent(inout)  :: x
     real(psb_spk_), intent(in) :: val
+    integer(psb_ipk_), optional :: first, last
         
     integer(psb_ipk_) :: info
-    if (allocated(x%v)) call x%v%set(val)
+    if (allocated(x%v)) call x%v%set(val,first,last)
     
   end subroutine s_vect_set_scal
 
-  subroutine s_vect_set_vect(x,val)
+  subroutine s_vect_set_vect(x,val,first,last)
     class(psb_s_vect_type), intent(inout) :: x
     real(psb_spk_), intent(in)         :: val(:)
+    integer(psb_ipk_), optional :: first, last
         
     integer(psb_ipk_) :: info
-    if (allocated(x%v)) call x%v%set(val)
+    if (allocated(x%v)) call x%v%set(val,first,last)
     
   end subroutine s_vect_set_vect
 

base/modules/psb_z_base_vect_mod.f90

@@ -47,7 +47,7 @@ module psb_z_base_vect_mod
   use psb_const_mod
   use psb_error_mod
   use psb_i_base_vect_mod
-
+  use psb_realloc_mod
 
   !> \namespace  psb_base_mod  \class psb_z_base_vect_type
   !! The psb_z_base_vect_type 
@@ -650,13 +650,20 @@ contains
   !! \brief  Set all entries
   !! \param val   The value to set
   !!
-  subroutine z_base_set_scal(x,val)
+  subroutine z_base_set_scal(x,val,first,last)
     class(psb_z_base_vect_type), intent(inout)  :: x
     complex(psb_dpk_), intent(in) :: val
+    integer(psb_ipk_), optional :: first, last
         
-    integer(psb_ipk_) :: info
+    integer(psb_ipk_) :: info, first_, last_
 
-    x%v = val
+    first_=1
+    last_=size(x%v)
+    if (present(first)) first_ = max(1,first)
+    if (present(last))  last_  = min(last,last_)
+    
+    if (x%is_dev()) call x%sync()
+    x%v(first_:last_) = val
     call x%set_host()
 
   end subroutine z_base_set_scal
@@ -699,15 +706,20 @@ contains
   !! \brief  Set all entries
   !! \param val(:)  The vector to be copied in 
   !!
-  subroutine z_base_set_vect(x,val)
+  subroutine z_base_set_vect(x,val,first,last)
     class(psb_z_base_vect_type), intent(inout)  :: x
     complex(psb_dpk_), intent(in) :: val(:)
-    integer(psb_ipk_) :: nr
-    integer(psb_ipk_) :: info
+    integer(psb_ipk_), optional :: first, last
+        
+    integer(psb_ipk_) :: info, first_, last_, nr
+
+    first_=1
+    last_=min(psb_size(x%v),size(val))
+    if (present(first)) first_ = max(1,first)
+    if (present(last))  last_  = min(last,last_)
 
     if (allocated(x%v)) then 
-      nr = min(size(x%v),size(val))
-      x%v(1:nr) = val(1:nr)
+      x%v(first_:last_) = val(1:last_-first_+1)
     else
       x%v = val
     end if

base/modules/psb_z_vect_mod.F90

@@ -231,21 +231,23 @@ contains
     end if
   end function z_vect_get_vect
 
-  subroutine z_vect_set_scal(x,val)
+  subroutine z_vect_set_scal(x,val,first,last)
     class(psb_z_vect_type), intent(inout)  :: x
     complex(psb_dpk_), intent(in) :: val
+    integer(psb_ipk_), optional :: first, last
         
     integer(psb_ipk_) :: info
-    if (allocated(x%v)) call x%v%set(val)
+    if (allocated(x%v)) call x%v%set(val,first,last)
     
   end subroutine z_vect_set_scal
 
-  subroutine z_vect_set_vect(x,val)
+  subroutine z_vect_set_vect(x,val,first,last)
     class(psb_z_vect_type), intent(inout) :: x
     complex(psb_dpk_), intent(in)         :: val(:)
+    integer(psb_ipk_), optional :: first, last
         
     integer(psb_ipk_) :: info
-    if (allocated(x%v)) call x%v%set(val)
+    if (allocated(x%v)) call x%v%set(val,first,last)
     
   end subroutine z_vect_set_vect
 

base/modules/psi_c_mod.f90

@@ -30,7 +30,7 @@
 !!$ 
 !!$  
 module psi_c_mod
-  use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_, psb_i_base_vect_type
+  use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_, psb_i_base_vect_type
   use psb_c_vect_mod, only : psb_c_base_vect_type 
 
   interface psi_swapdata

base/psblas/psb_cspmm.f90

@@ -813,9 +813,7 @@ subroutine  psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,&
     call psi_ovrl_save(x%v,xvsave,desc_a,info)
     if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info)
 
-!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
-!!$    yp(nrow+1:ncol) = czero
-
+    if (beta /= czero) call y%set(czero,nrow+1,ncol)
     !  local Matrix-vector product
     if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
 

base/psblas/psb_dspmm.f90

@@ -813,13 +813,7 @@ subroutine  psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,&
     call psi_ovrl_save(x%v,xvsave,desc_a,info)
     if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info)
 
-!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
-!!$    yp(nrow+1:ncol) = dzero
-    ! FIXME
-    info = psb_err_transpose_not_n_unsupported_
-    call psb_errpush(info,name)
-    goto 9999
-
+    if (beta /= dzero) call y%set(dzero,nrow+1,ncol)
     !  local Matrix-vector product
     if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
 

base/psblas/psb_sspmm.f90

@@ -813,9 +813,7 @@ subroutine  psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,&
     call psi_ovrl_save(x%v,xvsave,desc_a,info)
     if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info)
 
-!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
-!!$    yp(nrow+1:ncol) = szero
-
+    if (beta /= szero) call y%set(szero,nrow+1,ncol)
     !  local Matrix-vector product
     if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
 

base/psblas/psb_zspmm.f90

@@ -813,9 +813,7 @@ subroutine  psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,&
     call psi_ovrl_save(x%v,xvsave,desc_a,info)
     if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info)
 
-!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
-!!$    yp(nrow+1:ncol) = zzero
-
+    if (beta /= zzero) call y%set(zzero,nrow+1,ncol)
     !  local Matrix-vector product
     if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)