psblas3:

base/comm/psb_ihalo.f90
 base/comm/psb_iovrl.f90
 base/internals/psi_ovrl_restr.f90
 base/internals/psi_ovrl_save.f90
 base/internals/psi_ovrl_upd.f90
 base/modules/psb_i_tools_mod.f90
 base/modules/psi_i_mod.f90
 base/tools/psb_ialloc.f90
 base/tools/psb_iasb.f90
 base/tools/psb_ifree.f90
 base/tools/psb_iins.f90

Fixes fir i_Vect

base/comm/psb_ihalo.f90

@@ -427,3 +427,153 @@ end subroutine psb_ihalov
 
 
 
+
+subroutine  psb_ihalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
+  use psb_base_mod, psb_protect_name => psb_ihalo_vect
+  use psi_mod
+  implicit none
+
+  type(psb_i_vect_type), intent(inout)    :: x
+  type(psb_desc_type), intent(in)         :: desc_a
+  integer(psb_ipk_), intent(out)                    :: info
+  integer(psb_ipk_), intent(in), optional :: alpha
+  integer(psb_ipk_), target, optional, intent(inout)  :: work(:)
+  integer(psb_ipk_), intent(in), optional           :: mode,data
+  character, intent(in), optional         :: tran
+
+  ! locals
+  integer(psb_ipk_) :: ictxt, np, me,&
+       & err_act, m, n, iix, jjx, ix, ijx, nrow, imode,&
+       & err, liwork,data_
+  integer(psb_ipk_),pointer :: iwork(:)
+  character                 :: tran_
+  character(len=20)         :: name, ch_err
+  logical                   :: aliw
+
+  name='psb_ihalov'
+  if(psb_get_errstatus() /= 0) return 
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt=desc_a%get_context()
+
+  ! check on blacs grid 
+  call psb_info(ictxt, me, np)
+  if (np == -1) 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
+
+  ix = 1
+  ijx = 1
+
+  m = desc_a%get_global_rows()
+  n = desc_a%get_global_cols()
+  nrow = desc_a%get_local_rows()
+
+  if (present(tran)) then     
+    tran_ = psb_toupper(tran)
+  else
+    tran_ = 'N'
+  endif
+  if (present(data)) then     
+    data_ = data
+  else
+    data_ = psb_comm_halo_
+  endif
+  if (present(mode)) then 
+    imode = mode
+  else
+    imode = IOR(psb_swap_send_,psb_swap_recv_)
+  endif
+
+  ! check vector correctness
+  call psb_chkvect(m,ione,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
+  if(info /= psb_success_) then
+    info=psb_err_from_subroutine_
+    ch_err='psb_chkvect'
+    call psb_errpush(info,name,a_err=ch_err)
+  end if
+
+  if (iix /= 1) then
+    info=psb_err_ix_n1_iy_n1_unsupported_
+    call psb_errpush(info,name)
+  end if
+
+  err=info
+  call psb_errcomm(ictxt,err)
+  if(err /= 0) goto 9999
+
+  if(present(alpha)) then
+    if(alpha /= done) then
+      call x%scal(alpha)
+    end if
+  end if
+
+  liwork=nrow
+  if (present(work)) then
+    if(size(work) >= liwork) then
+      iwork => work
+      aliw=.false.
+    else
+      aliw=.true.
+      allocate(iwork(liwork),stat=info)
+      if(info /= psb_success_) then
+        info=psb_err_from_subroutine_
+        ch_err='psb_realloc'
+        call psb_errpush(info,name,a_err=ch_err)
+        goto 9999
+      end if
+    end if
+  else
+    aliw=.true.
+    allocate(iwork(liwork),stat=info)
+    if(info /= psb_success_) then
+      info=psb_err_from_subroutine_
+      ch_err='psb_realloc'
+      call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
+    end if
+  end if
+
+  ! exchange halo elements
+  if(tran_ == 'N') then
+    call psi_swapdata(imode,izero,x%v,&
+         & desc_a,iwork,info,data=data_)
+  else if((tran_ == 'T').or.(tran_ == 'C')) then
+    call psi_swaptran(imode,ione,x%v,&
+         & desc_a,iwork,info)
+  else
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,a_err='invalid tran')
+    goto 9999      
+  end if
+
+  if (info /= psb_success_) then
+    ch_err='PSI_swapdata'
+    call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
+    goto 9999
+  end if
+
+  if (aliw) deallocate(iwork)
+  nullify(iwork)
+
+  call psb_erractionrestore(err_act)
+  return  
+
+9999 continue
+  call psb_erractionrestore(err_act)
+
+  if (err_act == psb_act_abort_) then
+    call psb_error(ictxt)
+    return
+  end if
+  return
+end subroutine psb_ihalo_vect

base/comm/psb_iovrl.f90

@@ -388,3 +388,133 @@ subroutine  psb_iovrlv(x,desc_a,info,work,update,mode)
   end if
   return
 end subroutine psb_iovrlv
+
+subroutine  psb_iovrl_vect(x,desc_a,info,work,update,mode)
+  use psb_base_mod, psb_protect_name => psb_iovrl_vect
+  use psi_mod
+  implicit none
+
+  type(psb_i_vect_type), intent(inout)   :: x
+  type(psb_desc_type), intent(in)        :: desc_a
+  integer(psb_ipk_), intent(out)                   :: info
+  integer(psb_ipk_), optional, target, intent(inout) :: work(:)
+  integer(psb_ipk_), intent(in), optional          :: update,mode
+
+  ! locals
+  integer(psb_ipk_) :: ictxt, np, me, &
+       & err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, update_,&
+       & mode_, err, liwork,ldx
+  integer(psb_ipk_),pointer :: iwork(:)
+  logical                  :: do_swap
+  character(len=20)        :: name, ch_err
+  logical                  :: aliw
+
+  name='psb_iovrlv'
+  if(psb_get_errstatus() /= 0) return 
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt=desc_a%get_context()
+
+  ! check on blacs grid 
+  call psb_info(ictxt, me, np)
+  if (np == -1) 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
+
+  ix = 1
+  ijx = 1
+
+  m = desc_a%get_global_rows()
+  n = desc_a%get_global_cols()
+  nrow = desc_a%get_local_rows()
+  ncol = desc_a%get_local_cols()
+
+  k = 1
+
+  if (present(update)) then 
+    update_ = update
+  else
+    update_ = psb_avg_
+  endif
+
+  if (present(mode)) then 
+    mode_ = mode
+  else
+    mode_ = IOR(psb_swap_send_,psb_swap_recv_)
+  endif
+  do_swap = (mode_ /= 0)
+
+  ! check vector correctness
+  call psb_chkvect(m,ione,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
+  if(info /= psb_success_) then
+    info=psb_err_from_subroutine_
+    ch_err='psb_chkvect'
+    call psb_errpush(info,name,a_err=ch_err)
+  end if
+
+  if (iix /= 1) then
+    info=psb_err_ix_n1_iy_n1_unsupported_
+    call psb_errpush(info,name)
+  end if
+
+  err=info
+  call psb_errcomm(ictxt,err)
+  if(err /= 0) goto 9999
+
+  ! check for presence/size of a work area
+  liwork=ncol
+  if (present(work)) then
+    if(size(work) >= liwork) then
+      aliw=.false.
+    else
+      aliw=.true.
+    end if
+  else
+    aliw=.true.
+  end if
+  if (aliw) then 
+    allocate(iwork(liwork),stat=info)
+    if(info /= psb_success_) then
+      info=psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999
+    end if
+  else
+    iwork => work    
+  end if
+
+  ! exchange overlap elements
+  if (do_swap) then
+    call psi_swapdata(mode_,ione,x%v,&
+         & desc_a,iwork,info,data=psb_comm_ovr_)
+  end if
+  if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
+  if (info /= psb_success_) then
+    call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner updates')
+    goto 9999
+  end if
+  
+  if (aliw) deallocate(iwork)
+  nullify(iwork)
+
+  call psb_erractionrestore(err_act)
+  return  
+
+9999 continue
+  call psb_erractionrestore(err_act)
+
+  if (err_act == psb_act_abort_) then
+    call psb_error(ictxt)
+    return
+  end if
+  return
+end subroutine psb_iovrl_vect
+

base/internals/psi_ovrl_restr.f90

@@ -531,6 +531,51 @@ end subroutine psi_iovrl_restrr2
 
 
 
+subroutine  psi_iovrl_restr_vect(x,xs,desc_a,info)
+  use psi_mod, psi_protect_name =>   psi_iovrl_restr_vect
+  use psb_i_base_vect_mod
+
+  implicit none
+
+  class(psb_i_base_vect_type)     :: x
+  integer(psb_ipk_)                  :: xs(:)
+  type(psb_desc_type), intent(in) :: desc_a
+  integer(psb_ipk_), intent(out)            :: info
+
+  ! locals
+  integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
+  character(len=20) :: name, ch_err
+
+  name='psi_iovrl_restrr1'
+  if (psb_get_errstatus() /= 0) return 
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  ictxt = desc_a%get_context()
+  call psb_info(ictxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  isz = size(desc_a%ovrlap_elem,1)
+  
+  call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,izero)
+
+  call psb_erractionrestore(err_act)
+  return  
+
+9999 continue
+  call psb_erractionrestore(err_act)
+
+  if (err_act == psb_act_abort_) then
+    call psb_error(ictxt)
+    return
+  end if
+  return
+end subroutine psi_iovrl_restr_vect
+
+
 subroutine  psi_sovrl_restr_vect(x,xs,desc_a,info)
   use psi_mod, psi_protect_name =>   psi_sovrl_restr_vect
   use psb_s_base_vect_mod

base/internals/psi_ovrl_save.f90

@@ -579,6 +579,57 @@ end subroutine psi_iovrl_saver2
 
 
 
+subroutine  psi_iovrl_save_vect(x,xs,desc_a,info)
+  use psi_mod, psi_protect_name =>   psi_iovrl_save_vect
+  use psb_realloc_mod
+  use psb_i_base_vect_mod
+
+  implicit none
+
+  class(psb_i_base_vect_type)     :: x
+  integer(psb_ipk_), allocatable     :: xs(:)
+  type(psb_desc_type), intent(in) :: desc_a
+  integer(psb_ipk_), intent(out)            :: info
+
+  ! locals
+  integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
+  character(len=20) :: name, ch_err
+
+  name='psi_iovrl_saver1'
+  if (psb_get_errstatus() /= 0) return 
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  ictxt = desc_a%get_context()
+  call psb_info(ictxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  isz = size(desc_a%ovrlap_elem,1)
+  call psb_realloc(isz,xs,info) 
+  if (info /= psb_success_) then 
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+  
+  call x%gth(isz,desc_a%ovrlap_elem(:,1),xs)
+
+  call psb_erractionrestore(err_act)
+  return  
+
+9999 continue
+  call psb_erractionrestore(err_act)
+
+  if (err_act == psb_act_abort_) then
+    call psb_error(ictxt)
+    return
+  end if
+  return
+end subroutine psi_iovrl_save_vect
+
 subroutine  psi_sovrl_save_vect(x,xs,desc_a,info)
   use psi_mod, psi_protect_name =>   psi_sovrl_save_vect
   use psb_realloc_mod

base/internals/psi_ovrl_upd.f90

@@ -748,6 +748,90 @@ subroutine  psi_iovrl_updr2(x,desc_a,update,info)
 end subroutine psi_iovrl_updr2
 
 
+subroutine  psi_iovrl_upd_vect(x,desc_a,update,info)
+  use psi_mod, psi_protect_name =>   psi_iovrl_upd_vect
+  use psb_realloc_mod
+  use psb_i_base_vect_mod
+
+  implicit none
+
+  class(psb_i_base_vect_type)     :: x
+  type(psb_desc_type), intent(in) :: desc_a
+  integer(psb_ipk_), intent(in)             :: update
+  integer(psb_ipk_), intent(out)            :: info
+
+  ! locals
+  integer(psb_ipk_), allocatable :: xs(:)
+  integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx
+  integer(psb_ipk_) :: ierr(5)
+  character(len=20) :: name, ch_err
+
+
+  name='psi_iovrl_updr1'
+  if (psb_get_errstatus() /= 0) return 
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  ictxt = desc_a%get_context()
+  call psb_info(ictxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+  nx = size(desc_a%ovrlap_elem,1)
+  call psb_realloc(nx,xs,info)
+  if (info /= psb_success_) then 
+    info = psb_err_alloc_Dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  if (update /= psb_sum_) then 
+    call x%gth(nx,desc_a%ovrlap_elem(:,1),xs)
+    ! switch on update type
+
+    select case (update)
+    case(psb_square_root_)
+      do i=1,nx
+        ndm = desc_a%ovrlap_elem(i,2)
+        xs(i) = xs(i)/sqrt(real(ndm))
+      end do
+    case(psb_avg_)
+      do i=1,nx
+        ndm = desc_a%ovrlap_elem(i,2)
+        xs(i) = xs(i)/real(ndm)
+      end do
+    case(psb_setzero_)
+      do i=1,nx
+        if (me /= desc_a%ovrlap_elem(i,3))&
+             & xs(i) = izero
+      end do
+    case(psb_sum_)
+      ! do nothing
+
+    case default 
+      ! wrong value for choice argument
+      info = psb_err_iarg_invalid_value_
+      ierr(1) = 3; ierr(2)=update;
+      call psb_errpush(info,name,i_err=ierr)
+      goto 9999
+    end select
+    call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,izero)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return  
+
+9999 continue
+  call psb_erractionrestore(err_act)
+
+  if (err_act == psb_act_abort_) then
+    call psb_error(ictxt)
+    return
+  end if
+  return
+end subroutine psi_iovrl_upd_vect
+
 subroutine  psi_sovrl_upd_vect(x,desc_a,update,info)
   use psi_mod, psi_protect_name =>   psi_sovrl_upd_vect
   use psb_realloc_mod

base/modules/psb_i_tools_mod.f90

@@ -30,7 +30,8 @@
 !!$ 
 !!$  
 module psb_i_tools_mod
-  use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_ipk_, psb_success_
+  use psb_descriptor_type, only : psb_desc_type, psb_ipk_, psb_success_
+  use psb_i_vect_mod, only : psb_i_base_vect_type, psb_i_vect_type
   
 
   interface  psb_geall
@@ -48,6 +49,14 @@ module psb_i_tools_mod
       integer(psb_ipk_), intent(out)              :: info
       integer(psb_ipk_), optional, intent(in)     :: n
     end subroutine psb_iallocv
+    subroutine psb_ialloc_vect(x, desc_a,info,n)
+      import :: psb_desc_type,  psb_ipk_, &
+           & psb_i_base_vect_type, psb_i_vect_type
+      type(psb_i_vect_type), intent(out)  :: x
+      type(psb_desc_type), intent(in) :: desc_a
+      integer(psb_ipk_),intent(out)             :: info
+      integer(psb_ipk_), optional, intent(in)   :: n
+    end subroutine psb_ialloc_vect
   end interface
 
 
@@ -64,6 +73,15 @@ module psb_i_tools_mod
       integer(psb_ipk_), allocatable, intent(inout)   ::  x(:)
       integer(psb_ipk_), intent(out)        ::  info
     end subroutine psb_iasbv
+    subroutine psb_iasb_vect(x, desc_a, info,mold, scratch)
+      import :: psb_desc_type,  psb_ipk_, &
+           & psb_i_base_vect_type, psb_i_vect_type
+      type(psb_desc_type), intent(in)      ::  desc_a
+      type(psb_i_vect_type), intent(inout) :: x
+      integer(psb_ipk_), intent(out)                 ::  info
+      class(psb_i_base_vect_type), intent(in), optional :: mold
+      logical, intent(in), optional        :: scratch
+    end subroutine psb_iasb_vect
   end interface
 
 
@@ -80,10 +98,17 @@ module psb_i_tools_mod
       type(psb_desc_type), intent(in)     :: desc_a
       integer(psb_ipk_), intent(out)                :: info
     end subroutine psb_ifreev
+    subroutine psb_ifree_vect(x, desc_a, info)
+      import :: psb_desc_type,  psb_ipk_, &
+           & psb_i_base_vect_type, psb_i_vect_type
+      type(psb_desc_type), intent(in)  ::  desc_a
+      type(psb_i_vect_type), intent(inout) :: x
+      integer(psb_ipk_), intent(out)             ::  info
+    end subroutine psb_ifree_vect
   end interface
 
   interface psb_geins
-    subroutine psb_iinsi(m,irw,val, x,desc_a,info,dupl)
+    subroutine psb_iinsi(m,irw,val, x,desc_a,info,dupl,local)
       import :: psb_ipk_, psb_desc_type
       integer(psb_ipk_), intent(in)              ::  m
       type(psb_desc_type), intent(in)  ::  desc_a
@@ -92,8 +117,9 @@ module psb_i_tools_mod
       integer(psb_ipk_), intent(in)              ::  val(:,:)
       integer(psb_ipk_), intent(out)             ::  info
       integer(psb_ipk_), optional, intent(in)    ::  dupl
+      logical, intent(in), optional        :: local
     end subroutine psb_iinsi
-    subroutine psb_iinsvi(m, irw,val, x,desc_a,info,dupl)
+    subroutine psb_iinsvi(m, irw,val, x,desc_a,info,dupl,local)
       import :: psb_ipk_, psb_desc_type
       integer(psb_ipk_), intent(in)             ::  m
       type(psb_desc_type), intent(in) ::  desc_a
@@ -102,7 +128,20 @@ module psb_i_tools_mod
       integer(psb_ipk_), intent(in)             ::  val(:)
       integer(psb_ipk_), intent(out)            ::  info
       integer(psb_ipk_), optional, intent(in)   ::  dupl
+      logical, intent(in), optional        :: local
     end subroutine psb_iinsvi
+    subroutine psb_iins_vect(m,irw,val,x,desc_a,info,dupl,local)
+      import :: psb_desc_type,  psb_ipk_, &
+           & psb_i_base_vect_type, psb_i_vect_type
+      integer(psb_ipk_), intent(in)              :: m
+      type(psb_desc_type), intent(in)  :: desc_a
+      type(psb_i_vect_type), intent(inout) :: x
+      integer(psb_ipk_), intent(in)              :: irw(:)
+      integer(psb_ipk_), intent(in)    :: val(:)
+      integer(psb_ipk_), intent(out)             :: info
+      integer(psb_ipk_), optional, intent(in)    :: dupl
+      logical, intent(in), optional        :: local
+    end subroutine psb_iins_vect
   end interface
 
 

base/modules/psi_i_mod.f90

@@ -413,6 +413,13 @@ module psi_i_mod
       integer(psb_ipk_), intent(in)                :: update
       integer(psb_ipk_), intent(out)               :: info
     end subroutine psi_iovrl_updr2
+    subroutine  psi_iovrl_upd_vect(x,desc_a,update,info)
+      import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
+      class(psb_i_base_vect_type)       :: x
+      type(psb_desc_type), intent(in)   :: desc_a
+      integer(psb_ipk_), intent(in)               :: update
+      integer(psb_ipk_), intent(out)              :: info
+    end subroutine psi_iovrl_upd_vect
   end interface
 
   interface psi_ovrl_save
@@ -430,6 +437,13 @@ module psi_i_mod
       type(psb_desc_type), intent(in)  :: desc_a
       integer(psb_ipk_), intent(out)             :: info
     end subroutine psi_iovrl_saver2
+    subroutine  psi_iovrl_save_vect(x,xs,desc_a,info)
+      import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
+      class(psb_i_base_vect_type)     :: x
+      integer(psb_ipk_), allocatable     :: xs(:)
+      type(psb_desc_type), intent(in) :: desc_a
+      integer(psb_ipk_), intent(out)            :: info
+    end subroutine psi_iovrl_save_vect
   end interface
 
   interface psi_ovrl_restore
@@ -447,6 +461,13 @@ module psi_i_mod
       type(psb_desc_type), intent(in)  :: desc_a
       integer(psb_ipk_), intent(out)             :: info
     end subroutine psi_iovrl_restrr2
+    subroutine  psi_iovrl_restr_vect(x,xs,desc_a,info)
+      import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
+      class(psb_i_base_vect_type)     :: x
+      integer(psb_ipk_)                  :: xs(:)
+      type(psb_desc_type), intent(in) :: desc_a
+      integer(psb_ipk_), intent(out)            :: info
+    end subroutine psi_iovrl_restr_vect
   end interface
 
 end module psi_i_mod

base/tools/psb_ialloc.f90

@@ -250,3 +250,81 @@ subroutine psb_iallocv(x, desc_a, info,n)
 
 end subroutine psb_iallocv
 
+
+subroutine psb_ialloc_vect(x, desc_a,info,n)
+  use psb_base_mod, psb_protect_name => psb_ialloc_vect
+  use psi_mod
+  implicit none
+
+  !....parameters...
+  type(psb_i_vect_type), intent(out)  :: x
+  type(psb_desc_type), intent(in) :: desc_a
+  integer(psb_ipk_),intent(out)             :: info
+  integer(psb_ipk_), optional, intent(in)   :: n
+
+  !locals
+  integer(psb_ipk_) :: np,me,nr,i,err_act
+  integer(psb_ipk_) :: ictxt, int_err(5)
+  integer(psb_ipk_) :: debug_level, debug_unit
+  character(len=20)   :: name
+
+  info=psb_success_
+  if (psb_errstatus_fatal()) return 
+  name='psb_geall'
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+
+  ictxt=desc_a%get_context()
+
+  call psb_info(ictxt, me, np)
+  !     ....verify blacs grid correctness..
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  !... check m and n parameters....
+  if (.not.desc_a%is_ok()) then
+    info = psb_err_invalid_cd_state_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  ! As this is a rank-1 array, optional parameter N is actually ignored.
+
+  !....allocate x .....
+  if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then
+    nr = max(1,desc_a%get_local_cols())
+  else if (psb_is_bld_desc(desc_a)) then
+    nr = max(1,desc_a%get_local_rows())
+  else
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,int_err,a_err='Invalid desc_a')
+    goto 9999
+  endif
+
+  allocate(psb_i_base_vect_type :: x%v, stat=info) 
+  if (info == 0) call x%all(nr,info)
+  if (psb_errstatus_fatal()) then 
+    info=psb_err_alloc_request_
+    int_err(1)=nr
+    call psb_errpush(info,name,int_err,a_err='integer(psb_ipk_)')
+    goto 9999
+  endif
+  call x%zero()
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error(ictxt)
+    return
+  end if
+  return
+
+end subroutine psb_ialloc_vect
+

base/tools/psb_iasb.f90

@@ -251,3 +251,82 @@ subroutine psb_iasbv(x, desc_a, info)
   
 end subroutine psb_iasbv
 
+
+subroutine psb_iasb_vect(x, desc_a, info, mold, scratch)
+  use psb_base_mod, psb_protect_name => psb_iasb_vect
+  implicit none
+
+  type(psb_desc_type), intent(in)      ::  desc_a
+  type(psb_i_vect_type), intent(inout) ::  x
+  integer(psb_ipk_), intent(out)                 ::  info
+  class(psb_i_base_vect_type), intent(in), optional :: mold
+  logical, intent(in), optional        :: scratch
+
+  ! local variables
+  integer(psb_ipk_) :: ictxt,np,me
+  integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act
+  logical :: scratch_
+  integer(psb_ipk_) :: debug_level, debug_unit
+  character(len=20)    :: name,ch_err
+
+  info = psb_success_
+  if (psb_errstatus_fatal()) return 
+
+  int_err(1) = 0
+  name = 'psb_igeasb_v'
+
+  ictxt       = desc_a%get_context()
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+
+  scratch_ = .false.
+  if (present(scratch)) scratch_ = scratch
+  call psb_info(ictxt, me, np)
+
+  !     ....verify blacs grid correctness..
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  else   if (.not.desc_a%is_ok()) then
+    info = psb_err_invalid_cd_state_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  nrow = desc_a%get_local_rows()
+  ncol = desc_a%get_local_cols()
+  if (debug_level >= psb_debug_ext_) &
+       & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
+
+  if (scratch_) then 
+    call x%free(info)
+    call x%bld(ncol,mold=mold)
+  else
+    call x%asb(ncol,info)
+    ! ..update halo elements..
+    call psb_halo(x,desc_a,info)
+    if(info /= psb_success_) then
+      info=psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='psb_halo')
+      goto 9999
+    end if
+    if (present(mold)) then 
+      call x%cnv(mold)
+    end if
+  end if
+  if (debug_level >= psb_debug_ext_) &
+       & write(debug_unit,*) me,' ',trim(name),': end'
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error(ictxt)
+    return
+  end if
+  return
+
+end subroutine psb_iasb_vect

base/tools/psb_ifree.f90

@@ -198,3 +198,63 @@ subroutine psb_ifreev(x, desc_a,info)
   return
 
 end subroutine psb_ifreev
+
+
+subroutine psb_ifree_vect(x, desc_a, info)
+  use psb_base_mod, psb_protect_name => psb_ifree_vect
+  implicit none
+  !....parameters...
+  type(psb_i_vect_type), intent(inout) :: x
+  type(psb_desc_type), intent(in)  :: desc_a
+  integer(psb_ipk_), intent(out)             :: info 
+  !...locals....
+  integer(psb_ipk_) :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+
+  info=psb_success_
+  if (psb_errstatus_fatal()) return 
+  call psb_erractionsave(err_act)
+  name='psb_ifreev'
+
+  if (.not.desc_a%is_ok()) then
+    info = psb_err_invalid_cd_state_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+  ictxt = desc_a%get_context()
+
+  call psb_info(ictxt, me, np)
+  if (np == -1) 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
+
+
+  call x%free(info)
+
+  if (info /= psb_no_err_) then
+    info=psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+  endif
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+     call psb_error(ictxt)
+     return
+  end if
+  return
+
+end subroutine psb_ifree_vect
+

base/tools/psb_iins.f90

@@ -366,3 +366,126 @@ subroutine psb_iinsi(m, irw, val, x, desc_a, info, dupl)
   return
 
 end subroutine psb_iinsi
+
+
+
+subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local)
+  use psb_base_mod, psb_protect_name => psb_iins_vect
+  use psi_mod
+  implicit none
+
+  ! m rows number of submatrix belonging to val to be inserted
+  ! ix  x global-row corresponding to position at which val submatrix
+  !     must be inserted
+
+  !....parameters...
+  integer(psb_ipk_), intent(in)                  :: m
+  integer(psb_ipk_), intent(in)                  :: irw(:)
+  integer(psb_ipk_), intent(in)        :: val(:)
+  type(psb_i_vect_type), intent(inout) :: x
+  type(psb_desc_type), intent(in)      :: desc_a
+  integer(psb_ipk_), intent(out)                 :: info
+  integer(psb_ipk_), optional, intent(in)        :: dupl
+  logical, intent(in), optional        :: local
+
+  !locals.....
+  integer(psb_ipk_) :: ictxt,i,&
+       & loc_rows,loc_cols,mglob,err_act, int_err(5)
+  integer(psb_ipk_) :: np, me, dupl_
+  integer(psb_ipk_), allocatable   :: irl(:)
+  logical :: local_
+  character(len=20)      :: name
+
+  if (psb_errstatus_fatal()) return 
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  name = 'psb_iinsvi'
+
+  if (.not.desc_a%is_ok()) then
+    info = psb_err_invalid_cd_state_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  ictxt = desc_a%get_context()
+
+  call psb_info(ictxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  !... check parameters....
+  if (m < 0) then
+    info = psb_err_iarg_neg_
+    int_err(1) = 1
+    int_err(2) = m
+    call psb_errpush(info,name,int_err)
+    goto 9999
+  else if (x%get_nrows() < desc_a%get_local_rows()) then
+    info = 310
+    int_err(1) = 5
+    int_err(2) = 4
+    call psb_errpush(info,name,int_err)
+    goto 9999
+  endif
+
+  if (m == 0) return  
+  loc_rows = desc_a%get_local_rows()
+  loc_cols = desc_a%get_local_cols()
+  mglob    = desc_a%get_global_rows()
+
+  if (.not.allocated(x%v)) then 
+    info = psb_err_invalid_vect_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+
+
+  allocate(irl(m),stat=info) 
+  if (info /= psb_success_) then 
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+    
+  if (present(dupl)) then 
+    dupl_ = dupl
+  else
+    dupl_ = psb_dupl_ovwrt_
+  endif
+  if (present(local)) then 
+    local_ = local
+  else
+    local_ = .false.
+  endif
+
+  if (local_) then 
+    irl(1:m) = irw(1:m)
+  else
+    call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
+  end if
+  call x%ins(m,irl,val,dupl_,info) 
+  if (info /= 0) then 
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+  deallocate(irl)
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+
+  if (err_act == psb_act_ret_) then
+    return
+  else
+    call psb_error(ictxt)
+  end if
+  return
+
+end subroutine psb_iins_vect
+