First round of changes for vector builds

base/modules/psb_const_mod.F90

@@ -203,14 +203,16 @@ module psb_const_mod
   !
 
   !
-  ! State of matrices.
+  ! State of matrices/vectors.
   !
   integer(psb_ipk_), parameter :: psb_invalid_ = -1
   integer(psb_ipk_), parameter :: psb_spmat_null_=0, psb_spmat_bld_=1
   integer(psb_ipk_), parameter :: psb_spmat_asb_=2, psb_spmat_upd_=4
-
   integer(psb_ipk_), parameter :: psb_matbld_noremote_=0, psb_matbld_remote_=1
 
+  integer(psb_ipk_), parameter :: psb_vect_null_=0, psb_vect_bld_=1
+  integer(psb_ipk_), parameter :: psb_vect_asb_=2, psb_vect_upd_=4
+
   
   integer(psb_ipk_), parameter :: psb_ireg_flgs_=10, psb_ip2_=0
   integer(psb_ipk_), parameter :: psb_iflag_=2, psb_ichk_=3
@@ -223,9 +225,10 @@ module psb_const_mod
   ! Duplicate coefficients handling
   ! These are usually set while calling spcnv as one of its
   ! optional arugments.
-  integer(psb_ipk_), parameter :: psb_dupl_add_   = 0
-  integer(psb_ipk_), parameter :: psb_dupl_ovwrt_ = 1
-  integer(psb_ipk_), parameter :: psb_dupl_err_   = 2
+  integer(psb_ipk_), parameter :: psb_dupl_null_  = 0
+  integer(psb_ipk_), parameter :: psb_dupl_add_   = 1
+  integer(psb_ipk_), parameter :: psb_dupl_ovwrt_ = 2
+  integer(psb_ipk_), parameter :: psb_dupl_err_   = 3
   integer(psb_ipk_), parameter :: psb_dupl_def_   = psb_dupl_add_
   ! Matrix update mode
   integer(psb_ipk_), parameter :: psb_upd_srch_   = 98764

base/modules/serial/psb_base_mat_mod.F90

@@ -128,7 +128,7 @@ module psb_base_mat_mod
     !!            in already existing entries.
     !!    The transitions among the states are detailed in
     !!            psb_T_mat_mod.
-    integer(psb_ipk_), private     :: state
+    integer(psb_ipk_), private     :: bldstate
     !> How to treat duplicate elements when
     !!            transitioning from the BUILD to the ASSEMBLED state.
     !!            While many formats would allow for duplicate
@@ -137,7 +137,7 @@ module psb_base_mat_mod
     !!            BUILD state; in our overall design, only COO matrices
     !!            can ever be in the BUILD state, hence all other formats
     !!            cannot have duplicate entries.
-    integer(psb_ipk_), private     :: duplicate
+    integer(psb_ipk_), private     :: duplicate = psb_dupl_null_
     !> Is the matrix  symmetric? (must also be square)
     logical, private     :: symmetric
     !> Is the matrix triangular? (must also be square)
@@ -503,7 +503,7 @@ module psb_base_mat_mod
     !!            in already existing entries.
     !!    The transitions among the states are detailed in
     !!            psb_T_mat_mod.
-    integer(psb_ipk_), private     :: state
+    integer(psb_ipk_), private     :: bldstate
     !> How to treat duplicate elements when
     !!            transitioning from the BUILD to the ASSEMBLED state.
     !!            While many formats would allow for duplicate
@@ -909,7 +909,7 @@ contains
     implicit none
     class(psb_base_sparse_mat), intent(in) :: a
     integer(psb_ipk_) :: res
-    res = a%state
+    res = a%bldstate
   end function psb_base_get_state
 
   function psb_base_get_nrows(a) result(res)
@@ -945,7 +945,7 @@ contains
     implicit none
     class(psb_base_sparse_mat), intent(inout) :: a
     integer(psb_ipk_), intent(in) :: n
-    a%state = n
+    a%bldstate = n
   end subroutine psb_base_set_state
 
 
@@ -960,28 +960,28 @@ contains
     implicit none
     class(psb_base_sparse_mat), intent(inout) :: a
 
-    a%state = psb_spmat_null_
+    a%bldstate = psb_spmat_null_
   end subroutine psb_base_set_null
 
   subroutine  psb_base_set_bld(a)
     implicit none
     class(psb_base_sparse_mat), intent(inout) :: a
 
-    a%state = psb_spmat_bld_
+    a%bldstate = psb_spmat_bld_
   end subroutine psb_base_set_bld
 
   subroutine  psb_base_set_upd(a)
     implicit none
     class(psb_base_sparse_mat), intent(inout) :: a
 
-    a%state = psb_spmat_upd_
+    a%bldstate = psb_spmat_upd_
   end subroutine psb_base_set_upd
 
   subroutine  psb_base_set_asb(a)
     implicit none
     class(psb_base_sparse_mat), intent(inout) :: a
 
-    a%state = psb_spmat_asb_
+    a%bldstate = psb_spmat_asb_
   end subroutine psb_base_set_asb
 
   subroutine psb_base_set_sorted(a,val)
@@ -1107,28 +1107,28 @@ contains
     implicit none
     class(psb_base_sparse_mat), intent(in) :: a
     logical :: res
-    res = (a%state == psb_spmat_null_)
+    res = (a%bldstate == psb_spmat_null_)
   end function psb_base_is_null
 
   function psb_base_is_bld(a) result(res)
     implicit none
     class(psb_base_sparse_mat), intent(in) :: a
     logical :: res
-    res = (a%state == psb_spmat_bld_)
+    res = (a%bldstate == psb_spmat_bld_)
   end function psb_base_is_bld
 
   function psb_base_is_upd(a) result(res)
     implicit none
     class(psb_base_sparse_mat), intent(in) :: a
     logical :: res
-    res = (a%state == psb_spmat_upd_)
+    res = (a%bldstate == psb_spmat_upd_)
   end function psb_base_is_upd
 
   function psb_base_is_asb(a) result(res)
     implicit none
     class(psb_base_sparse_mat), intent(in) :: a
     logical :: res
-    res = (a%state == psb_spmat_asb_)
+    res = (a%bldstate == psb_spmat_asb_)
   end function psb_base_is_asb
 
   function psb_base_is_sorted(a) result(res)
@@ -1185,7 +1185,7 @@ contains
 
     b%m         = a%n
     b%n         = a%m
-    b%state     = a%state
+    b%bldstate  = a%bldstate
     b%duplicate = a%duplicate
     b%triangle  = a%triangle
     b%symmetric = a%symmetric
@@ -1205,7 +1205,7 @@ contains
 
     b%m         = a%n
     b%n         = a%m
-    b%state     = a%state
+    b%bldstate  = a%bldstate
     b%duplicate = a%duplicate
     b%triangle  = a%triangle
     b%symmetric = a%symmetric
@@ -1225,7 +1225,7 @@ contains
     itmp        = a%m
     a%m         = a%n
     a%n         = itmp
-    a%state     = a%state
+    a%bldstate  = a%bldstate
     a%duplicate = a%duplicate
     a%triangle  = a%triangle
     a%unitd     = a%unitd
@@ -1402,7 +1402,7 @@ contains
     implicit none
     class(psb_lbase_sparse_mat), intent(in) :: a
     integer(psb_ipk_) :: res
-    res = a%state
+    res = a%bldstate
   end function psb_lbase_get_state
 
   function psb_lbase_get_nrows(a) result(res)
@@ -1479,7 +1479,7 @@ contains
     implicit none
     class(psb_lbase_sparse_mat), intent(inout) :: a
     integer(psb_lpk_), intent(in) :: n
-    a%state = n
+    a%bldstate = n
   end subroutine psb_lbase_set_state
 
 
@@ -1494,28 +1494,28 @@ contains
     implicit none
     class(psb_lbase_sparse_mat), intent(inout) :: a
 
-    a%state = psb_spmat_null_
+    a%bldstate = psb_spmat_null_
   end subroutine psb_lbase_set_null
 
   subroutine  psb_lbase_set_bld(a)
     implicit none
     class(psb_lbase_sparse_mat), intent(inout) :: a
 
-    a%state = psb_spmat_bld_
+    a%bldstate = psb_spmat_bld_
   end subroutine psb_lbase_set_bld
 
   subroutine  psb_lbase_set_upd(a)
     implicit none
     class(psb_lbase_sparse_mat), intent(inout) :: a
 
-    a%state = psb_spmat_upd_
+    a%bldstate = psb_spmat_upd_
   end subroutine psb_lbase_set_upd
 
   subroutine  psb_lbase_set_asb(a)
     implicit none
     class(psb_lbase_sparse_mat), intent(inout) :: a
 
-    a%state = psb_spmat_asb_
+    a%bldstate = psb_spmat_asb_
   end subroutine psb_lbase_set_asb
 
   subroutine psb_lbase_set_sorted(a,val)
@@ -1652,28 +1652,28 @@ contains
     implicit none
     class(psb_lbase_sparse_mat), intent(in) :: a
     logical :: res
-    res = (a%state == psb_spmat_null_)
+    res = (a%bldstate == psb_spmat_null_)
   end function psb_lbase_is_null
 
   function psb_lbase_is_bld(a) result(res)
     implicit none
     class(psb_lbase_sparse_mat), intent(in) :: a
     logical :: res
-    res = (a%state == psb_spmat_bld_)
+    res = (a%bldstate == psb_spmat_bld_)
   end function psb_lbase_is_bld
 
   function psb_lbase_is_upd(a) result(res)
     implicit none
     class(psb_lbase_sparse_mat), intent(in) :: a
     logical :: res
-    res = (a%state == psb_spmat_upd_)
+    res = (a%bldstate == psb_spmat_upd_)
   end function psb_lbase_is_upd
 
   function psb_lbase_is_asb(a) result(res)
     implicit none
     class(psb_lbase_sparse_mat), intent(in) :: a
     logical :: res
-    res = (a%state == psb_spmat_asb_)
+    res = (a%bldstate == psb_spmat_asb_)
   end function psb_lbase_is_asb
 
   function psb_lbase_is_sorted(a) result(res)
@@ -1719,7 +1719,7 @@ contains
 
     b%m         = a%n
     b%n         = a%m
-    b%state     = a%state
+    b%bldstate     = a%bldstate
     b%duplicate = a%duplicate
     b%triangle  = a%triangle
     b%unitd     = a%unitd
@@ -1738,7 +1738,7 @@ contains
 
     b%m         = a%n
     b%n         = a%m
-    b%state     = a%state
+    b%bldstate     = a%bldstate
     b%duplicate = a%duplicate
     b%triangle  = a%triangle
     b%unitd     = a%unitd
@@ -1757,7 +1757,7 @@ contains
     itmp        = a%m
     a%m         = a%n
     a%n         = itmp
-    a%state     = a%state
+    a%bldstate     = a%bldstate
     a%duplicate = a%duplicate
     a%triangle  = a%triangle
     a%unitd     = a%unitd
@@ -1891,7 +1891,7 @@ contains
 
     lb%m                  = ib%m
     lb%n                  = ib%n
-    lb%state              = ib%state
+    lb%bldstate           = ib%bldstate
     lb%duplicate          = ib%duplicate
     lb%triangle           = ib%triangle
     lb%unitd              = ib%unitd
@@ -1907,7 +1907,7 @@ contains
 
     ib%m                  = lb%m
     ib%n                  = lb%n
-    ib%state              = lb%state
+    ib%bldstate           = lb%bldstate
     ib%duplicate          = lb%duplicate
     ib%triangle           = lb%triangle
     ib%unitd              = lb%unitd

base/modules/serial/psb_d_base_vect_mod.F90

@@ -65,6 +65,18 @@ module psb_d_base_vect_mod
     real(psb_dpk_), allocatable :: v(:)
     real(psb_dpk_), allocatable :: combuf(:)
     integer(psb_mpk_), allocatable :: comid(:,:)
+    !> vector bldstate:
+    !!    null:   pristine;
+    !!    build:  it's being filled with entries;
+    !!    assembled: ready to use in computations;
+    !!    update: accepts coefficients but only
+    !!            in already existing entries.
+    !!    The transitions among the states are detailed in
+    !!            psb_T_vect_mod.
+    integer(psb_ipk_), private :: bldstate
+    integer(psb_ipk_), private :: dupl = psb_dupl_null_
+    integer(psb_ipk_), private :: ncfs
+    integer(psb_ipk_), allocatable :: iv(:)
   contains
     !
     !  Constructors/allocators
@@ -77,17 +89,30 @@ module psb_d_base_vect_mod
     procedure, pass(x) :: mold     => d_base_mold
     !
     ! Insert/set. Assembly and free.
-    ! Assembly does almost nothing here, but is important
-    ! in derived classes.
     !
-    procedure, pass(x) :: ins_a    => d_base_ins_a
-    procedure, pass(x) :: ins_v    => d_base_ins_v
-    generic, public    :: ins      => ins_a, ins_v
-    procedure, pass(x) :: zero     => d_base_zero
-    procedure, pass(x) :: asb_m    => d_base_asb_m
-    procedure, pass(x) :: asb_e    => d_base_asb_e
-    generic, public    :: asb      => asb_m, asb_e
-    procedure, pass(x) :: free     => d_base_free
+    procedure, pass(x) :: ins_a     => d_base_ins_a
+    procedure, pass(x) :: ins_v     => d_base_ins_v
+    generic, public    :: ins       => ins_a, ins_v
+    procedure, pass(x) :: zero      => d_base_zero
+    procedure, pass(x) :: asb_m     => d_base_asb_m
+    procedure, pass(x) :: asb_e     => d_base_asb_e
+    generic, public    :: asb       => asb_m, asb_e
+    procedure, pass(x) :: free      => d_base_free
+    procedure, pass(x) :: reinit      => d_base_reinit
+    procedure, pass(x) :: set_ncfs => d_base_set_ncfs 
+    procedure, pass(x) :: get_ncfs => d_base_get_ncfs
+    procedure, pass(x) :: set_dupl => d_base_set_dupl 
+    procedure, pass(x) :: get_dupl => d_base_get_dupl
+    procedure, pass(x) :: set_state => d_base_set_state
+    procedure, pass(x) :: set_null  => d_base_set_null
+    procedure, pass(x) :: set_bld   => d_base_set_bld
+    procedure, pass(x) :: set_upd   => d_base_set_upd
+    procedure, pass(x) :: set_asb   => d_base_set_asb
+    procedure, pass(x) :: get_state => d_base_get_state
+    procedure, pass(x) :: is_null   => d_base_is_null
+    procedure, pass(x) :: is_bld    => d_base_is_bld
+    procedure, pass(x) :: is_upd    => d_base_is_upd
+    procedure, pass(x) :: is_asb    => d_base_is_asb
     !
     ! Sync: centerpiece of handling of external storage.
     ! Any derived class having extra storage upon sync
@@ -228,6 +253,7 @@ module psb_d_base_vect_mod
     module procedure constructor, size_const
   end interface psb_d_base_vect
 
+  logical, parameter :: try_newins=.true.
 contains
 
   !
@@ -347,9 +373,28 @@ contains
     integer(psb_ipk_), intent(out)              :: info
 
     call psb_realloc(n,x%v,info)
+#ifdef TRY_NEWINS
+    call psb_realloc(n,x%iv,info)
+    call x%set_ncfs(0)
+#endif
 
   end subroutine d_base_all
 
+  subroutine d_base_reinit(x, info)
+    use psi_serial_mod
+    use psb_realloc_mod
+    implicit none
+    class(psb_d_base_vect_type), intent(out)    :: x
+    integer(psb_ipk_), intent(out)              :: info
+
+    if (allocated(x%v)) then 
+      call x%sync()
+      x%v(:) = dzero
+      call x%set_host()
+    end if
+
+  end subroutine d_base_reinit
+
   !> Function  base_mold:
   !! \memberof  psb_d_base_vect_type
   !! \brief     Mold method: return a variable with the same dynamic type
@@ -395,20 +440,77 @@ contains
   !!  \param info  return code
   !!
   !
-  subroutine d_base_ins_a(n,irl,val,dupl,x,info)
+  subroutine d_base_ins_a(n,irl,val,dupl,x,maxr,info)
     use psi_serial_mod
     implicit none
     class(psb_d_base_vect_type), intent(inout)  :: x
-    integer(psb_ipk_), intent(in)               :: n, dupl
+    integer(psb_ipk_), intent(in)               :: n, dupl,maxr
     integer(psb_ipk_), intent(in)               :: irl(:)
     real(psb_dpk_), intent(in)        :: val(:)
     integer(psb_ipk_), intent(out)              :: info
 
-    integer(psb_ipk_) :: i, isz
+    integer(psb_ipk_) :: i, isz, dupl_, ncfs_, k
 
     info = 0
     if (psb_errstatus_fatal()) return
-
+#ifdef TRY_NEWINS
+    if (x%is_bld()) then
+      ncfs_ = x%get_ncfs()
+      isz = ncfs_ + n
+      call psb_ensure_size(isz,x%v,info)
+      call psb_ensure_size(isz,x%iv,info)
+      k   = ncfs_
+      do i = 1, n
+        !loop over all val's rows
+        ! row actual block row
+        if ((1 <= irl(i)).and.(irl(i) <= maxr)) then
+          k  = k + 1 
+          ! this row belongs to me
+          ! copy i-th row of block val in x
+          x%v(k)  = val(i)
+          x%iv(k) = irl(i)
+        end if
+      enddo
+      call x%set_ncfs(k)      
+    else
+      dupl_ = x%get_dupl()
+      if (.not.allocated(x%v)) then
+        info = psb_err_invalid_vect_state_
+      else if (n > min(size(irl),size(val))) then
+        info = psb_err_invalid_input_
+      else
+        isz = size(x%v)
+        select case(dupl_)
+        case(psb_dupl_ovwrt_)
+          do i = 1, n
+            !loop over all val's rows
+            ! row actual block row
+            if ((1 <= irl(i)).and.(irl(i) <= maxr)) then
+              ! this row belongs to me
+              ! copy i-th row of block val in x
+              x%v(irl(i)) = val(i)
+            end if
+          enddo
+          
+        case(psb_dupl_add_)
+          
+          do i = 1, n
+            !loop over all val's rows
+            if ((1 <= irl(i)).and.(irl(i) <= maxr)) then
+              ! this row belongs to me
+              ! copy i-th row of block val in x
+              x%v(irl(i)) = x%v(irl(i)) +  val(i)
+            end if
+          enddo
+          
+        case default
+          info = 321
+          ! !$      call psb_errpush(info,name)
+          ! !$      goto 9999
+        end select
+      end if
+    end if
+#else
     if (.not.allocated(x%v)) then
       info = psb_err_invalid_vect_state_
     else if (n > min(size(irl),size(val))) then
@@ -445,6 +547,7 @@ contains
         ! !$      goto 9999
       end select
     end if
+#endif
     call x%set_host()
     if (info /= 0) then
       call psb_errpush(info,'base_vect_ins')
@@ -453,11 +556,11 @@ contains
 
   end subroutine d_base_ins_a
 
-  subroutine d_base_ins_v(n,irl,val,dupl,x,info)
+  subroutine d_base_ins_v(n,irl,val,dupl,x,maxr,info)
     use psi_serial_mod
     implicit none
     class(psb_d_base_vect_type), intent(inout)  :: x
-    integer(psb_ipk_), intent(in)               :: n, dupl
+    integer(psb_ipk_), intent(in)               :: n, dupl,maxr
     class(psb_i_base_vect_type), intent(inout)  :: irl
     class(psb_d_base_vect_type), intent(inout)  :: val
     integer(psb_ipk_), intent(out)              :: info
@@ -470,7 +573,7 @@ contains
     if (irl%is_dev()) call irl%sync()
     if (val%is_dev()) call val%sync()
     if (x%is_dev())   call x%sync()
-    call x%ins(n,irl%v,val%v,dupl,info)
+    call x%ins(n,irl%v,val%v,dupl,maxr,info)
 
     if (info /= 0) then
       call psb_errpush(info,'base_vect_ins')
@@ -521,12 +624,52 @@ contains
     integer(psb_mpk_), intent(in)              :: n
     class(psb_d_base_vect_type), intent(inout) :: x
     integer(psb_ipk_), intent(out)             :: info
-
+    integer(psb_ipk_) :: i,ncfs,xvsz
+    real(psb_dpk_), allocatable ::  vv(:)
     info = 0
-    if (x%get_nrows() < n) &
-         & call psb_realloc(n,x%v,info)
-    if (info /= 0) &
-         & call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
+    
+    if (try_newins) then 
+      if (x%is_bld()) then
+        ncfs = x%get_ncfs()
+        xvsz = psb_size(x%v)
+        call psb_realloc(n,vv,info)
+        vv(:) = dzero
+        select case(x%get_dupl())
+        case(psb_dupl_add_)
+          do i=1,ncfs
+            vv(x%iv(i)) = vv(x%iv(i)) + x%v(i)
+          end do
+        case(psb_dupl_ovwrt_)
+          do i=1,ncfs
+            vv(x%iv(i)) = x%v(i)
+          end do
+        case(psb_dupl_err_)
+          do i=1,ncfs
+            if (vv(x%iv(i)).ne.dzero) then
+              call psb_errpush(psb_err_duplicate_coo,'vect-asb')
+              return
+            else
+              vv(x%iv(i)) = x%v(i)
+            end if
+          end do
+        case default
+          write(psb_err_unit,*) 'Error in vect_asb: unsafe dupl',x%get_dupl()
+          info =-7
+        end select
+        call psb_move_alloc(vv,x%v,info)
+        if (allocated(x%iv)) deallocate(x%iv,stat=info)
+      else
+        if (x%get_nrows() < n) &
+             & call psb_realloc(n,x%v,info)
+        if (info /= 0) &
+             & call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
+      end if
+    else
+      if (x%get_nrows() < n) &
+           & call psb_realloc(n,x%v,info)
+      if (info /= 0) &
+           & call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
+    end if 
     call x%sync()
   end subroutine d_base_asb_m
 
@@ -551,13 +694,54 @@ contains
     integer(psb_epk_), intent(in)              :: n
     class(psb_d_base_vect_type), intent(inout) :: x
     integer(psb_ipk_), intent(out)             :: info
-
+    integer(psb_ipk_) :: i, j
+    real(psb_dpk_), allocatable ::  vv(:)
     info = 0
-    if (x%get_nrows() < n) &
-         & call psb_realloc(n,x%v,info)
-    if (info /= 0) &
-         & call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
+
+    if (try_newins) then
+      if (info /= 0) &
+           & call psb_errpush(psb_err_alloc_dealloc_,'vect_asb unhandled')    
+      if (x%is_bld()) then
+        call psb_realloc(n,vv,info)
+        vv(:) = dzero
+        select case(x%get_dupl())
+        case(psb_dupl_add_)
+          do i=1,x%get_ncfs()
+            vv(x%iv(i)) = vv(x%iv(i)) + x%v(i)
+          end do
+        case(psb_dupl_ovwrt_)
+          do i=1,x%get_ncfs()
+            vv(x%iv(i)) = x%v(i)
+          end do
+        case(psb_dupl_err_)
+          do i=1,x%get_ncfs()
+            if (vv(x%iv(i)).ne.dzero) then
+              call psb_errpush(psb_err_duplicate_coo,'vect_asb')
+              return
+            else
+              vv(x%iv(i)) = x%v(i)
+            end if
+          end do
+        case default
+          write(psb_err_unit,*) 'Error in vect_asb: unsafe dupl',x%get_dupl()
+          info =-7
+        end select
+        call psb_move_alloc(vv,x%v,info)
+        if (allocated(x%iv)) deallocate(x%iv,stat=info)
+      else
+        if (x%get_nrows() < n) &
+             & call psb_realloc(n,x%v,info)
+        if (info /= 0) &
+             & call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
+      end if
+    else
+      if (x%get_nrows() < n) &
+           & call psb_realloc(n,x%v,info)
+      if (info /= 0) &
+           & call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
+    end if
     call x%sync()
+
   end subroutine d_base_asb_e
 
   !
@@ -645,7 +829,104 @@ contains
          &  deallocate(x%comid,stat=info)
   end subroutine d_base_free_comid
 
+  function d_base_get_ncfs(x) result(res)
+    implicit none
+    class(psb_d_base_vect_type), intent(in) :: x
+    integer(psb_ipk_) :: res
+    res = x%ncfs
+  end function d_base_get_ncfs
 
+  function d_base_get_dupl(x) result(res)
+    implicit none
+    class(psb_d_base_vect_type), intent(in) :: x
+    integer(psb_ipk_) :: res
+    res = x%dupl
+  end function d_base_get_dupl
+
+  function d_base_get_state(x) result(res)
+    implicit none
+    class(psb_d_base_vect_type), intent(in) :: x
+    integer(psb_ipk_) :: res
+    res = x%bldstate 
+  end function d_base_get_state
+
+  function d_base_is_null(x) result(res)
+    implicit none
+    class(psb_d_base_vect_type), intent(in) :: x
+    logical :: res
+    res = (x%bldstate == psb_vect_null_)
+  end function d_base_is_null
+
+  function d_base_is_bld(x) result(res)
+    implicit none
+    class(psb_d_base_vect_type), intent(in) :: x
+    logical :: res
+    res = (x%bldstate == psb_vect_bld_)
+  end function d_base_is_bld
+
+  function d_base_is_upd(x) result(res)
+    implicit none
+    class(psb_d_base_vect_type), intent(in) :: x
+    logical :: res
+    res = (x%bldstate == psb_vect_upd_)
+  end function d_base_is_upd
+
+  function d_base_is_asb(x) result(res)
+    implicit none
+    class(psb_d_base_vect_type), intent(in) :: x
+    logical :: res
+    res = (x%bldstate == psb_vect_asb_)
+  end function d_base_is_asb
+
+  subroutine  d_base_set_ncfs(n,x)
+    implicit none
+    class(psb_d_base_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in) :: n
+    x%ncfs = n
+  end subroutine d_base_set_ncfs
+
+  subroutine  d_base_set_dupl(n,x)
+    implicit none
+    class(psb_d_base_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in) :: n
+    x%dupl = n
+  end subroutine d_base_set_dupl
+
+  subroutine  d_base_set_state(n,x)
+    implicit none
+    class(psb_d_base_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in) :: n
+    x%bldstate = n
+  end subroutine d_base_set_state
+
+  subroutine  d_base_set_null(x)
+    implicit none
+    class(psb_d_base_vect_type), intent(inout) :: x
+
+    x%bldstate = psb_vect_null_
+  end subroutine d_base_set_null
+
+  subroutine  d_base_set_bld(x)
+    implicit none
+    class(psb_d_base_vect_type), intent(inout) :: x
+
+    x%bldstate = psb_vect_bld_
+  end subroutine d_base_set_bld
+
+  subroutine  d_base_set_upd(x)
+    implicit none
+    class(psb_d_base_vect_type), intent(inout) :: x
+
+    x%bldstate = psb_vect_upd_
+  end subroutine d_base_set_upd
+
+  subroutine  d_base_set_asb(x)
+    implicit none
+    class(psb_d_base_vect_type), intent(inout) :: x
+
+    x%bldstate = psb_vect_asb_
+  end subroutine d_base_set_asb
+  
   !
   ! The base version of SYNC & friends does nothing, it's just
   ! a placeholder.

base/modules/serial/psb_d_vect_mod.F90

@@ -45,9 +45,8 @@ module psb_d_vect_mod
 
   type psb_d_vect_type
     class(psb_d_base_vect_type), allocatable :: v
-    integer(psb_ipk_) :: nrmv = 0
-    integer(psb_ipk_) :: remote_build=psb_matbld_noremote_
-    integer(psb_ipk_) :: dupl = psb_dupl_add_
+    integer(psb_ipk_) :: nrmv         = 0
+    integer(psb_ipk_) :: remote_build = psb_matbld_noremote_
     real(psb_dpk_), allocatable :: rmtv(:)
     integer(psb_lpk_), allocatable :: rmidx(:)
   contains
@@ -56,14 +55,26 @@ module psb_d_vect_mod
     procedure, pass(x) :: get_fmt  => d_vect_get_fmt
     procedure, pass(x) :: is_remote_build => d_vect_is_remote_build
     procedure, pass(x) :: set_remote_build => d_vect_set_remote_build
-    procedure, pass(x) :: get_dupl => d_vect_get_dupl
-    procedure, pass(x) :: set_dupl => d_vect_set_dupl 
     procedure, pass(x) :: get_nrmv => d_vect_get_nrmv
     procedure, pass(x) :: set_nrmv => d_vect_set_nrmv
     procedure, pass(x) :: all      => d_vect_all
     procedure, pass(x) :: reall    => d_vect_reall
     procedure, pass(x) :: zero     => d_vect_zero
     procedure, pass(x) :: asb      => d_vect_asb
+    procedure, pass(x) :: set_dupl => d_vect_set_dupl 
+    procedure, pass(x) :: get_dupl => d_vect_get_dupl
+    procedure, pass(x) :: set_state => d_vect_set_state
+    procedure, pass(x) :: set_null  => d_vect_set_null
+    procedure, pass(x) :: set_bld   => d_vect_set_bld
+    procedure, pass(x) :: set_upd   => d_vect_set_upd
+    procedure, pass(x) :: set_asb   => d_vect_set_asb
+    procedure, pass(x) :: get_state => d_vect_get_state
+    procedure, pass(x) :: is_null   => d_vect_is_null
+    procedure, pass(x) :: is_bld    => d_vect_is_bld
+    procedure, pass(x) :: is_upd    => d_vect_is_upd
+    procedure, pass(x) :: is_asb    => d_vect_is_asb
+    procedure, pass(x) :: reinit    => d_vect_reinit
+    
     procedure, pass(x) :: gthab    => d_vect_gthab
     procedure, pass(x) :: gthzv    => d_vect_gthzv
     generic, public    :: gth      => gthab, gthzv
@@ -194,7 +205,11 @@ contains
     implicit none
     class(psb_d_vect_type), intent(in) :: x
     integer(psb_ipk_) :: res
-    res = x%dupl
+    if (allocated(x%v)) then 
+      res = x%v%get_state()
+    else
+      res = psb_vect_null_
+    end if
   end function d_vect_get_dupl
 
   subroutine d_vect_set_dupl(x,val)
@@ -202,13 +217,93 @@ contains
     class(psb_d_vect_type), intent(inout) :: x
     integer(psb_ipk_), intent(in), optional :: val
 
-    if (present(val)) then
-      x%dupl = val
-    else
-      x%dupl = psb_dupl_def_
+    if (allocated(x%v)) then 
+      if (present(val)) then
+        call x%v%set_dupl(val)
+      else
+        call x%v%set_dupl(psb_dupl_def_)
+      end if
     end if
   end subroutine d_vect_set_dupl
 
+  function d_vect_get_state(x) result(res)
+    implicit none
+    class(psb_d_vect_type), intent(in) :: x
+    integer(psb_ipk_) :: res
+    if (allocated(x%v)) then 
+      res = x%v%get_state()
+    else
+      res = psb_vect_null_
+    end if
+  end function d_vect_get_state
+
+  function d_vect_is_null(x) result(res)
+    implicit none
+    class(psb_d_vect_type), intent(in) :: x
+    logical :: res
+    res = (x%get_state() == psb_vect_null_)
+  end function d_vect_is_null
+
+  function d_vect_is_bld(x) result(res)
+    implicit none
+    class(psb_d_vect_type), intent(in) :: x
+    logical :: res
+    res = (x%get_state() == psb_vect_bld_)
+  end function d_vect_is_bld
+
+  function d_vect_is_upd(x) result(res)
+    implicit none
+    class(psb_d_vect_type), intent(in) :: x
+    logical :: res
+    res = (x%get_state() == psb_vect_upd_)
+  end function d_vect_is_upd
+
+  function d_vect_is_asb(x) result(res)
+    implicit none
+    class(psb_d_vect_type), intent(in) :: x
+    logical :: res
+    res = (x%get_state() == psb_vect_asb_)
+  end function d_vect_is_asb
+
+  subroutine  d_vect_set_state(n,x)
+    implicit none
+    class(psb_d_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in) :: n
+    if (allocated(x%v)) then 
+      call x%v%set_state(n)
+    end if
+  end subroutine d_vect_set_state
+
+
+  subroutine  d_vect_set_null(x)
+    implicit none
+    class(psb_d_vect_type), intent(inout) :: x
+
+    call x%set_state(psb_vect_null_)
+  end subroutine d_vect_set_null
+
+  subroutine  d_vect_set_bld(x)
+    implicit none
+    class(psb_d_vect_type), intent(inout) :: x
+
+    call x%set_state(psb_vect_bld_)
+  end subroutine d_vect_set_bld
+
+  subroutine  d_vect_set_upd(x)
+    implicit none
+    class(psb_d_vect_type), intent(inout) :: x
+
+    call x%set_state(psb_vect_upd_)
+  end subroutine d_vect_set_upd
+
+  subroutine  d_vect_set_asb(x)
+    implicit none
+    class(psb_d_vect_type), intent(inout) :: x
+
+    call x%set_state(psb_vect_asb_)
+  end subroutine d_vect_set_asb
+
+  
   function d_vect_get_nrmv(x) result(res)
     implicit none
     class(psb_d_vect_type), intent(in) :: x
@@ -457,8 +552,20 @@ contains
     else
       info = psb_err_alloc_dealloc_
     end if
+    call x%set_bld()
   end subroutine d_vect_all
 
+  subroutine d_vect_reinit(x, info)
+
+    implicit none
+    class(psb_d_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(out)      :: info
+
+    if (allocated(x%v)) call x%v%reinit(info)
+    call x%set_upd()
+
+  end subroutine d_vect_reinit
+
   subroutine d_vect_reall(n, x, info)
 
     implicit none
@@ -547,11 +654,11 @@ contains
 
   end subroutine d_vect_free
 
-  subroutine d_vect_ins_a(n,irl,val,x,info)
+  subroutine d_vect_ins_a(n,irl,val,x,maxr,info)
     use psi_serial_mod
     implicit none
     class(psb_d_vect_type), intent(inout)  :: x
-    integer(psb_ipk_), intent(in)               :: n
+    integer(psb_ipk_), intent(in)               :: n,maxr
     integer(psb_ipk_), intent(in)               :: irl(:)
     real(psb_dpk_), intent(in)        :: val(:)
     integer(psb_ipk_), intent(out)              :: info
@@ -564,15 +671,15 @@ contains
       return
     end if
     dupl = x%get_dupl()
-    call  x%v%ins(n,irl,val,dupl,info)
+    call  x%v%ins(n,irl,val,dupl,maxr,info)
 
   end subroutine d_vect_ins_a
 
-  subroutine d_vect_ins_v(n,irl,val,x,info)
+  subroutine d_vect_ins_v(n,irl,val,x,maxr,info)
     use psi_serial_mod
     implicit none
     class(psb_d_vect_type), intent(inout)  :: x
-    integer(psb_ipk_), intent(in)               :: n
+    integer(psb_ipk_), intent(in)               :: n,maxr
     class(psb_i_vect_type), intent(inout)       :: irl
     class(psb_d_vect_type), intent(inout)       :: val
     integer(psb_ipk_), intent(out)              :: info
@@ -585,7 +692,7 @@ contains
       return
     end if
     dupl = x%get_dupl()
-    call  x%v%ins(n,irl%v,val%v,dupl,info)
+    call  x%v%ins(n,irl%v,val%v,dupl,maxr,info)
 
   end subroutine d_vect_ins_v
 

base/modules/tools/psb_d_tools_mod.F90

@@ -70,7 +70,7 @@ Module psb_d_tools_mod
 
 
   interface psb_geasb
-    subroutine psb_dasb_vect(x, desc_a, info,mold, scratch)
+    subroutine psb_dasb_vect(x, desc_a, info,mold, scratch,dupl)
       import
       implicit none
       type(psb_desc_type), intent(in)      ::  desc_a
@@ -78,6 +78,7 @@ Module psb_d_tools_mod
       integer(psb_ipk_), intent(out)                 ::  info
       class(psb_d_base_vect_type), intent(in), optional :: mold
       logical, intent(in), optional        :: scratch
+      integer(psb_ipk_), optional, intent(in) :: dupl
     end subroutine psb_dasb_vect
     subroutine psb_dasb_vect_r2(x, desc_a, info,mold, scratch)
       import
@@ -250,16 +251,17 @@ Module psb_d_tools_mod
   end interface
 
   interface psb_spasb
-    subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold, bld_and)
+    subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold, dupl, bld_and)
       import
       implicit none
       type(psb_dspmat_type), intent (inout)   :: a
       type(psb_desc_type), intent(inout)        :: desc_a
       integer(psb_ipk_), intent(out)                    :: info
-      integer(psb_ipk_),optional, intent(in)            :: upd
+      integer(psb_ipk_), optional, intent(in)           :: upd
       character(len=*), optional, intent(in)  :: afmt
       class(psb_d_base_sparse_mat), intent(in), optional :: mold
       logical, intent(in), optional :: bld_and
+      integer(psb_ipk_), optional, intent(in) :: dupl
     end subroutine psb_dspasb
   end interface
 

base/tools/psb_dallc.f90

@@ -111,10 +111,11 @@ subroutine psb_dalloc_vect(x, desc_a,info, dupl, bldmode)
   end if
   if (present(dupl)) then
     dupl_ = dupl 
-  else
-    dupl_ = psb_dupl_def_
+!!$  else
+!!$    dupl_ = psb_dupl_def_
   end if
-  call x%set_dupl(dupl_)
+!!$  call x%set_dupl(dupl_)
+  call x%set_bld()
   call x%set_remote_build(bldmode_)
   call x%set_nrmv(izero)
   if (x%is_remote_build()) then

base/tools/psb_dasb.f90

@@ -51,7 +51,7 @@
 !    scratch - logical, optional       If true, allocate without checking/zeroing contents.
 !                                      default: .false.
 !    
-subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
+subroutine psb_dasb_vect(x, desc_a, info, mold, scratch,dupl)
   use psb_base_mod, psb_protect_name => psb_dasb_vect
   implicit none
 
@@ -60,6 +60,7 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
   integer(psb_ipk_), intent(out)                 ::  info
   class(psb_d_base_vect_type), intent(in), optional :: mold
   logical, intent(in), optional        :: scratch
+  integer(psb_ipk_), optional, intent(in) :: dupl
 
   ! local variables
   type(psb_ctxt_type) :: ctxt
@@ -68,6 +69,7 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
   logical :: scratch_
   integer(psb_ipk_) :: debug_level, debug_unit
   character(len=20)    :: name,ch_err
+  !logical, parameter :: try_newins = .true.
 
   info = psb_success_
   name = 'psb_dgeasb_v'
@@ -83,7 +85,6 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
   scratch_ = .false.
   if (present(scratch)) scratch_ = scratch
   call psb_info(ctxt, me, np)
-  dupl_ = x%get_dupl()
   !     ....verify blacs grid correctness..
   if (np == -1) then
     info = psb_err_context_error_
@@ -94,46 +95,93 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
     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
-    
-    if (x%is_remote_build()) then
-      block
-        integer(psb_lpk_), allocatable :: lvx(:)
-        real(psb_dpk_), allocatable  :: vx(:)
-        integer(psb_ipk_), allocatable :: ivx(:) 
-        integer(psb_ipk_) :: nrmv, nx, i
-
-        nrmv = x%get_nrmv()        
-        call psb_remote_vect(nrmv,x%rmtv,x%rmidx,desc_a,vx,lvx,info)
-        nx  = size(vx)
-        call psb_realloc(nx,ivx,info)
-        call desc_a%g2l(lvx,ivx,info,owned=.true.)
-        call x%ins(nx,ivx,vx,info)
-      end block
+  if (try_newins) then
+!!$    if (present(dupl)) then
+!!$      call x%set_dupl(dupl)
+!!$    end if
+    dupl_ = x%get_dupl()
+
+    if (scratch_) then 
+      call x%free(info)
+      call x%bld(ncol,mold=mold)
+    else
+      if (x%is_bld().and.present(dupl)) then
+      call x%set_dupl(dupl)
+        dupl_ = dupl
+      end if
+      if (x%is_remote_build()) then
+        block
+          integer(psb_lpk_), allocatable :: lvx(:)
+          real(psb_dpk_), allocatable  :: vx(:)
+          integer(psb_ipk_), allocatable :: ivx(:) 
+          integer(psb_ipk_) :: nrmv, nx, i
+
+          nrmv = x%get_nrmv()        
+          call psb_remote_vect(nrmv,x%rmtv,x%rmidx,desc_a,vx,lvx,info)
+          nx  = size(vx)
+          call psb_realloc(nx,ivx,info)
+          call desc_a%g2l(lvx,ivx,info,owned=.true.)
+          call x%ins(nx,ivx,vx,nrow,info)
+        end block
+      end if
+
+      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
+      call x%cnv(mold)
     end if
+    if (debug_level >= psb_debug_ext_) &
+         & write(debug_unit,*) me,' ',trim(name),': end'
+  else
+    dupl_ = x%get_dupl()
 
-    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
+    if (scratch_) then 
+      call x%free(info)
+      call x%bld(ncol,mold=mold)
+    else
+      if (x%is_bld().and.present(dupl)) then
+!!$      call x%set_dupl(dupl)
+        dupl_ = dupl
+      end if
+      if (x%is_remote_build()) then
+        block
+          integer(psb_lpk_), allocatable :: lvx(:)
+          real(psb_dpk_), allocatable  :: vx(:)
+          integer(psb_ipk_), allocatable :: ivx(:) 
+          integer(psb_ipk_) :: nrmv, nx, i
+
+          nrmv = x%get_nrmv()        
+          call psb_remote_vect(nrmv,x%rmtv,x%rmidx,desc_a,vx,lvx,info)
+          nx  = size(vx)
+          call psb_realloc(nx,ivx,info)
+          call desc_a%g2l(lvx,ivx,info,owned=.true.)
+          call x%ins(nx,ivx,vx,nrow,info)
+        end block
+      end if
+
+      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
+      call x%cnv(mold)
     end if
-    call x%cnv(mold)
+    if (debug_level >= psb_debug_ext_) &
+         & write(debug_unit,*) me,' ',trim(name),': end'
   end if
-  if (debug_level >= psb_debug_ext_) &
-       & write(debug_unit,*) me,' ',trim(name),': end'
-
   call psb_erractionrestore(err_act)
   return
 

base/tools/psb_dins.f90

@@ -127,7 +127,7 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, local)
   else
     call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
   end if
-  call x%ins(m,irl,val,info) 
+  call x%ins(m,irl,val,loc_rows,info) 
   if (info /= 0) then 
     call psb_errpush(info,name)
     goto 9999
@@ -261,7 +261,7 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, local)
     call desc_a%indxmap%g2l(irw%v%v(1:m),irl(1:m),info,owned=.true.)
   end if
 
-  call x%ins(m,irl,lval,info) 
+  call x%ins(m,irl,lval,loc_rows,info) 
   if (info /= 0) then 
     call psb_errpush(info,name)
     goto 9999
@@ -368,7 +368,7 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, local)
   do i=1,n
 
     if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_
-    if (info == 0) call x(i)%ins(m,irl,val(:,i),info) 
+    if (info == 0) call x(i)%ins(m,irl,val(:,i),loc_rows,info) 
     if (info /= 0) exit
   end do
   if (info /= 0) then 

base/tools/psb_dspasb.f90

@@ -44,7 +44,7 @@
 !                                            psb_upd_perm_    Permutation(more memory)
 ! 
 !
-subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold, bld_and)
+subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold, dupl, bld_and)
   use psb_base_mod, psb_protect_name => psb_dspasb
   use psb_sort_mod
   use psi_mod
@@ -59,6 +59,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold, bld_and)
   character(len=*), optional, intent(in)   :: afmt
   class(psb_d_base_sparse_mat), intent(in), optional :: mold
   logical, intent(in), optional :: bld_and
+  integer(psb_ipk_), optional, intent(in) :: dupl
   !....Locals....
   type(psb_ctxt_type) :: ctxt
   integer(psb_ipk_) :: np,me, err_act
@@ -103,7 +104,12 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold, bld_and)
   !check on errors encountered in psdspins
 
   if (a%is_bld()) then
-    dupl_ = a%get_dupl()
+    if (present(dupl)) then 
+      dupl_ = dupl
+    else
+      dupl_ = a%get_dupl()
+    end if
+   
     !
     ! First case: we come from a fresh build. 
     ! 
@@ -180,7 +186,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold, bld_and)
   if (bld_and_) then
 !!$    allocate(a%ad,mold=a%a)
 !!$    allocate(a%and,mold=a%a)o    
-    call a%split_nd(n_row,n_col,info)
+!!$    call a%split_nd(n_row,n_col,info)
 !!$    block
 !!$      character(len=1024) :: fname
 !!$      type(psb_d_coo_sparse_mat) :: acoo

base/tools/psb_dspins.F90

@@ -138,7 +138,11 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
 
 
   if (desc_a%is_bld()) then 
-
+    if (.not.a%is_bld()) then
+      info = psb_err_invalid_a_and_cd_state_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
     if (local_) then
       info = psb_err_invalid_a_and_cd_state_
       call psb_errpush(info,name)

cuda/psb_d_cuda_vect_mod.F90

@@ -1252,11 +1252,11 @@ contains
     call x%free(info)
   end subroutine d_cuda_vect_finalize
 
-  subroutine d_cuda_ins_v(n,irl,val,dupl,x,info)
+  subroutine d_cuda_ins_v(n,irl,val,dupl,x,maxr,info)
     use psi_serial_mod
     implicit none 
     class(psb_d_vect_cuda), intent(inout)        :: x
-    integer(psb_ipk_), intent(in)               :: n, dupl
+    integer(psb_ipk_), intent(in)               :: n, dupl,maxr
     class(psb_i_base_vect_type), intent(inout)  :: irl
     class(psb_d_base_vect_type), intent(inout)  :: val
     integer(psb_ipk_), intent(out)              :: info
@@ -1285,7 +1285,7 @@ contains
     if (.not.done_cuda) then 
       if (irl%is_dev()) call irl%sync()
       if (val%is_dev()) call val%sync()
-      call x%ins(n,irl%v,val%v,dupl,info)
+      call x%ins(n,irl%v,val%v,dupl,maxr,info)
     end if
 
     if (info /= 0) then 
@@ -1295,11 +1295,11 @@ contains
 
   end subroutine d_cuda_ins_v
   
-  subroutine d_cuda_ins_a(n,irl,val,dupl,x,info)
+  subroutine d_cuda_ins_a(n,irl,val,dupl,x,maxr,info)
     use psi_serial_mod
     implicit none 
     class(psb_d_vect_cuda), intent(inout) :: x
-    integer(psb_ipk_), intent(in)        :: n, dupl
+    integer(psb_ipk_), intent(in)        :: n, dupl,maxr
     integer(psb_ipk_), intent(in)        :: irl(:)
     real(psb_dpk_), intent(in)           :: val(:)
     integer(psb_ipk_), intent(out)       :: info
@@ -1308,7 +1308,7 @@ contains
 
     info = 0
     if (x%is_dev()) call x%sync()
-    call x%psb_d_base_vect_type%ins(n,irl,val,dupl,info)
+    call x%psb_d_base_vect_type%ins(n,irl,val,dupl,maxr,info)
     call x%set_host()
 
   end subroutine d_cuda_ins_a

openacc/psb_d_oacc_vect_mod.F90

@@ -620,11 +620,11 @@ contains
     end subroutine inner_gth
   end subroutine d_oacc_gthzv_x
 
-  subroutine d_oacc_ins_v(n, irl, val, dupl, x, info)
+  subroutine d_oacc_ins_v(n, irl, val, dupl, x,maxr, info)
     use psi_serial_mod
     implicit none
     class(psb_d_vect_oacc), intent(inout) :: x
-    integer(psb_ipk_), intent(in) :: n, dupl
+    integer(psb_ipk_), intent(in) :: n, dupl,maxr
     class(psb_i_base_vect_type), intent(inout) :: irl
     class(psb_d_base_vect_type), intent(inout) :: val
     integer(psb_ipk_), intent(out) :: info
@@ -661,7 +661,7 @@ contains
       type is (psb_d_vect_oacc)
         if (vval%is_dev()) call vval%sync()
       end select
-      call x%ins(n, irl%v, val%v, dupl, info)
+      call x%ins(n, irl%v, val%v, dupl,maxr, info)
     end if
 
     if (info /= 0) then
@@ -671,11 +671,11 @@ contains
 
   end subroutine d_oacc_ins_v
 
-  subroutine d_oacc_ins_a(n, irl, val, dupl, x, info)
+  subroutine d_oacc_ins_a(n, irl, val, dupl, x,maxr, info)
     use psi_serial_mod
     implicit none
     class(psb_d_vect_oacc), intent(inout) :: x
-    integer(psb_ipk_), intent(in) :: n, dupl
+    integer(psb_ipk_), intent(in) :: n, dupl,maxr
     integer(psb_ipk_), intent(in) :: irl(:)
     real(psb_dpk_), intent(in) :: val(:)
     integer(psb_ipk_), intent(out) :: info
@@ -684,7 +684,7 @@ contains
 
     info = 0
     if (x%is_dev()) call x%sync()
-    call x%psb_d_base_vect_type%ins(n, irl, val, dupl, info)
+    call x%psb_d_base_vect_type%ins(n, irl, val, dupl,maxr, info)
     call x%set_host()
 
 

test/pdegen/psb_d_pde3d.F90

@@ -606,9 +606,9 @@ contains
     t1 = psb_wtime()
     if (info == psb_success_) then
       if (present(amold)) then
-        call psb_spasb(a,desc_a,info,mold=amold)
+        call psb_spasb(a,desc_a,info,mold=amold,dupl=psb_dupl_add_)
       else
-        call psb_spasb(a,desc_a,info,afmt=afmt)
+        call psb_spasb(a,desc_a,info,afmt=afmt,dupl=psb_dupl_add_)
       end if
     end if
     call psb_barrier(ctxt)
@@ -618,8 +618,8 @@ contains
       call psb_errpush(info,name,a_err=ch_err)
       goto 9999
     end if
-    if (info == psb_success_) call psb_geasb(xv,desc_a,info,mold=vmold)
-    if (info == psb_success_) call psb_geasb(bv,desc_a,info,mold=vmold)
+    if (info == psb_success_) call psb_geasb(xv,desc_a,info,mold=vmold,dupl=psb_dupl_add_)
+    if (info == psb_success_) call psb_geasb(bv,desc_a,info,mold=vmold,dupl=psb_dupl_add_)
     if(info /= psb_success_) then
       info=psb_err_from_subroutine_
       ch_err='asb rout.'