Fix vect_clone and define check_addr

base/modules/serial/psb_c_base_vect_mod.F90

@@ -171,6 +171,9 @@ module psb_c_base_vect_mod
     procedure, pass(y) :: sctb_buf => c_base_sctb_buf
     generic, public    :: sct      => sctb, sctb_x, sctb_buf
 
+    procedure, pass(x) :: check_addr  => c_base_check_addr
+
+
 
     !
     ! Dot product and AXPBY
@@ -1244,6 +1247,13 @@ contains
 
   end subroutine c_base_set_vect
 
+  subroutine c_base_check_addr(x)
+    class(psb_c_base_vect_type), intent(inout) :: x
+
+    write(0,*) 'Check addr: base version, do nothing'
+
+  end subroutine c_base_check_addr
+
 
   !
   ! Get entry.

base/modules/serial/psb_c_vect_mod.F90

@@ -105,6 +105,7 @@ module psb_c_vect_mod
     procedure, pass(x) :: set_host => c_vect_set_host
     procedure, pass(x) :: set_dev  => c_vect_set_dev
     procedure, pass(x) :: set_sync => c_vect_set_sync
+    procedure, pass(x) :: check_addr => c_vect_check_addr
 
     procedure, pass(x) :: get_entry => c_vect_get_entry
 
@@ -408,7 +409,13 @@ contains
     info = psb_success_
     call y%free(info)
     if ((info==0).and.allocated(x%v)) then
-      allocate(y%v,source=x%v, stat=info)
+      !
+      ! Using sourced allocation here creates
+      ! problems with handling of memory allocated
+      ! elsewhere (e.g. accelerators), hence delegation
+      ! to %bld method
+      ! 
+      call y%bld(x%get_vect(),mold=x%v)
     end if
   end subroutine c_vect_clone
 
@@ -529,6 +536,13 @@ contains
 
   end subroutine c_vect_set_vect
 
+  subroutine c_vect_check_addr(x)
+    class(psb_c_vect_type), intent(inout) :: x
+
+    integer(psb_ipk_) :: info
+    if (allocated(x%v)) call x%v%check_addr()
+
+  end subroutine c_vect_check_addr
 
   function constructor(x) result(this)
     complex(psb_spk_)   :: x(:)

base/modules/serial/psb_d_base_vect_mod.F90

@@ -171,6 +171,9 @@ module psb_d_base_vect_mod
     procedure, pass(y) :: sctb_buf => d_base_sctb_buf
     generic, public    :: sct      => sctb, sctb_x, sctb_buf
 
+    procedure, pass(x) :: check_addr  => d_base_check_addr
+
+
 
     !
     ! Dot product and AXPBY
@@ -1251,6 +1254,13 @@ contains
 
   end subroutine d_base_set_vect
 
+  subroutine d_base_check_addr(x)
+    class(psb_d_base_vect_type), intent(inout) :: x
+
+    write(0,*) 'Check addr: base version, do nothing'
+
+  end subroutine d_base_check_addr
+
 
   !
   ! Get entry.

base/modules/serial/psb_d_vect_mod.F90

@@ -105,6 +105,7 @@ module psb_d_vect_mod
     procedure, pass(x) :: set_host => d_vect_set_host
     procedure, pass(x) :: set_dev  => d_vect_set_dev
     procedure, pass(x) :: set_sync => d_vect_set_sync
+    procedure, pass(x) :: check_addr => d_vect_check_addr
 
     procedure, pass(x) :: get_entry => d_vect_get_entry
 
@@ -415,7 +416,13 @@ contains
     info = psb_success_
     call y%free(info)
     if ((info==0).and.allocated(x%v)) then
-      allocate(y%v,source=x%v, stat=info)
+      !
+      ! Using sourced allocation here creates
+      ! problems with handling of memory allocated
+      ! elsewhere (e.g. accelerators), hence delegation
+      ! to %bld method
+      ! 
+      call y%bld(x%get_vect(),mold=x%v)
     end if
   end subroutine d_vect_clone
 
@@ -536,6 +543,13 @@ contains
 
   end subroutine d_vect_set_vect
 
+  subroutine d_vect_check_addr(x)
+    class(psb_d_vect_type), intent(inout) :: x
+
+    integer(psb_ipk_) :: info
+    if (allocated(x%v)) call x%v%check_addr()
+
+  end subroutine d_vect_check_addr
 
   function constructor(x) result(this)
     real(psb_dpk_)   :: x(:)

base/modules/serial/psb_i_base_vect_mod.F90

@@ -171,6 +171,10 @@ module psb_i_base_vect_mod
     procedure, pass(x) :: check_addr  => i_base_check_addr
 
 
+
+
+
+
   end type psb_i_base_vect_type
 
   public  :: psb_i_base_vect
@@ -1176,7 +1180,6 @@ contains
 
   end subroutine i_base_set_vect
 
-
   subroutine i_base_check_addr(x)
     class(psb_i_base_vect_type), intent(inout) :: x
 
@@ -1185,6 +1188,7 @@ contains
   end subroutine i_base_check_addr
 
 
+
   !
   ! Gather: Y = beta * Y + alpha * X(IDX(:))
   !

base/modules/serial/psb_i_vect_mod.F90

@@ -104,10 +104,10 @@ module psb_i_vect_mod
     procedure, pass(x) :: set_host => i_vect_set_host
     procedure, pass(x) :: set_dev  => i_vect_set_dev
     procedure, pass(x) :: set_sync => i_vect_set_sync
-
     procedure, pass(x) :: check_addr => i_vect_check_addr
 
 
+
   end type psb_i_vect_type
 
   public  :: psb_i_vect
@@ -354,7 +354,13 @@ contains
     info = psb_success_
     call y%free(info)
     if ((info==0).and.allocated(x%v)) then
-      allocate(y%v,source=x%v, stat=info)
+      !
+      ! Using sourced allocation here creates
+      ! problems with handling of memory allocated
+      ! elsewhere (e.g. accelerators), hence delegation
+      ! to %bld method
+      ! 
+      call y%bld(x%get_vect(),mold=x%v)
     end if
   end subroutine i_vect_clone
 

base/modules/serial/psb_l_base_vect_mod.F90

@@ -169,6 +169,9 @@ module psb_l_base_vect_mod
     procedure, pass(y) :: sctb_buf => l_base_sctb_buf
     generic, public    :: sct      => sctb, sctb_x, sctb_buf
 
+    procedure, pass(x) :: check_addr  => l_base_check_addr
+
+
 
 
 
@@ -1178,6 +1181,13 @@ contains
 
   end subroutine l_base_set_vect
 
+  subroutine l_base_check_addr(x)
+    class(psb_l_base_vect_type), intent(inout) :: x
+
+    write(0,*) 'Check addr: base version, do nothing'
+
+  end subroutine l_base_check_addr
+
 
 
   !

base/modules/serial/psb_l_vect_mod.F90

@@ -105,6 +105,7 @@ module psb_l_vect_mod
     procedure, pass(x) :: set_host => l_vect_set_host
     procedure, pass(x) :: set_dev  => l_vect_set_dev
     procedure, pass(x) :: set_sync => l_vect_set_sync
+    procedure, pass(x) :: check_addr => l_vect_check_addr
 
 
 
@@ -354,7 +355,13 @@ contains
     info = psb_success_
     call y%free(info)
     if ((info==0).and.allocated(x%v)) then
-      allocate(y%v,source=x%v, stat=info)
+      !
+      ! Using sourced allocation here creates
+      ! problems with handling of memory allocated
+      ! elsewhere (e.g. accelerators), hence delegation
+      ! to %bld method
+      ! 
+      call y%bld(x%get_vect(),mold=x%v)
     end if
   end subroutine l_vect_clone
 
@@ -475,6 +482,13 @@ contains
 
   end subroutine l_vect_set_vect
 
+  subroutine l_vect_check_addr(x)
+    class(psb_l_vect_type), intent(inout) :: x
+
+    integer(psb_ipk_) :: info
+    if (allocated(x%v)) call x%v%check_addr()
+
+  end subroutine l_vect_check_addr
 
   function constructor(x) result(this)
     integer(psb_lpk_)   :: x(:)

base/modules/serial/psb_s_base_vect_mod.F90

@@ -171,6 +171,9 @@ module psb_s_base_vect_mod
     procedure, pass(y) :: sctb_buf => s_base_sctb_buf
     generic, public    :: sct      => sctb, sctb_x, sctb_buf
 
+    procedure, pass(x) :: check_addr  => s_base_check_addr
+
+
 
     !
     ! Dot product and AXPBY
@@ -1251,6 +1254,13 @@ contains
 
   end subroutine s_base_set_vect
 
+  subroutine s_base_check_addr(x)
+    class(psb_s_base_vect_type), intent(inout) :: x
+
+    write(0,*) 'Check addr: base version, do nothing'
+
+  end subroutine s_base_check_addr
+
 
   !
   ! Get entry.

base/modules/serial/psb_s_vect_mod.F90

@@ -105,6 +105,7 @@ module psb_s_vect_mod
     procedure, pass(x) :: set_host => s_vect_set_host
     procedure, pass(x) :: set_dev  => s_vect_set_dev
     procedure, pass(x) :: set_sync => s_vect_set_sync
+    procedure, pass(x) :: check_addr => s_vect_check_addr
 
     procedure, pass(x) :: get_entry => s_vect_get_entry
 
@@ -415,7 +416,13 @@ contains
     info = psb_success_
     call y%free(info)
     if ((info==0).and.allocated(x%v)) then
-      allocate(y%v,source=x%v, stat=info)
+      !
+      ! Using sourced allocation here creates
+      ! problems with handling of memory allocated
+      ! elsewhere (e.g. accelerators), hence delegation
+      ! to %bld method
+      ! 
+      call y%bld(x%get_vect(),mold=x%v)
     end if
   end subroutine s_vect_clone
 
@@ -536,6 +543,13 @@ contains
 
   end subroutine s_vect_set_vect
 
+  subroutine s_vect_check_addr(x)
+    class(psb_s_vect_type), intent(inout) :: x
+
+    integer(psb_ipk_) :: info
+    if (allocated(x%v)) call x%v%check_addr()
+
+  end subroutine s_vect_check_addr
 
   function constructor(x) result(this)
     real(psb_spk_)   :: x(:)

base/modules/serial/psb_z_base_vect_mod.F90

@@ -171,6 +171,9 @@ module psb_z_base_vect_mod
     procedure, pass(y) :: sctb_buf => z_base_sctb_buf
     generic, public    :: sct      => sctb, sctb_x, sctb_buf
 
+    procedure, pass(x) :: check_addr  => z_base_check_addr
+
+
 
     !
     ! Dot product and AXPBY
@@ -1244,6 +1247,13 @@ contains
 
   end subroutine z_base_set_vect
 
+  subroutine z_base_check_addr(x)
+    class(psb_z_base_vect_type), intent(inout) :: x
+
+    write(0,*) 'Check addr: base version, do nothing'
+
+  end subroutine z_base_check_addr
+
 
   !
   ! Get entry.

base/modules/serial/psb_z_vect_mod.F90

@@ -105,6 +105,7 @@ module psb_z_vect_mod
     procedure, pass(x) :: set_host => z_vect_set_host
     procedure, pass(x) :: set_dev  => z_vect_set_dev
     procedure, pass(x) :: set_sync => z_vect_set_sync
+    procedure, pass(x) :: check_addr => z_vect_check_addr
 
     procedure, pass(x) :: get_entry => z_vect_get_entry
 
@@ -408,7 +409,13 @@ contains
     info = psb_success_
     call y%free(info)
     if ((info==0).and.allocated(x%v)) then
-      allocate(y%v,source=x%v, stat=info)
+      !
+      ! Using sourced allocation here creates
+      ! problems with handling of memory allocated
+      ! elsewhere (e.g. accelerators), hence delegation
+      ! to %bld method
+      ! 
+      call y%bld(x%get_vect(),mold=x%v)
     end if
   end subroutine z_vect_clone
 
@@ -529,6 +536,13 @@ contains
 
   end subroutine z_vect_set_vect
 
+  subroutine z_vect_check_addr(x)
+    class(psb_z_vect_type), intent(inout) :: x
+
+    integer(psb_ipk_) :: info
+    if (allocated(x%v)) call x%v%check_addr()
+
+  end subroutine z_vect_check_addr
 
   function constructor(x) result(this)
     complex(psb_dpk_)   :: x(:)