Define DESC%check_addr for debugging

base/modules/desc/psb_desc_mod.F90

@@ -245,6 +245,7 @@ module psb_desc_mod
     procedure, pass(desc) :: free            => psb_cdfree
     procedure, pass(desc) :: destroy         => psb_cd_destroy
     procedure, pass(desc) :: nullify         => nullify_desc
+    procedure, pass(desc) :: check_addr      => psb_cd_check_addr
 
     procedure, pass(desc) :: get_fmt         => cd_get_fmt
     procedure, pass(desc) :: fnd_owner       => cd_fnd_owner
@@ -1162,6 +1163,60 @@ contains
 
   end subroutine psb_cd_clone
 
+  subroutine psb_cd_check_addr(desc, info)
+
+    use psb_error_mod
+    use psb_penv_mod
+    use psb_realloc_mod
+    implicit none
+    !....parameters...
+
+    class(psb_desc_type), intent(inout), target :: desc
+    integer(psb_ipk_), intent(out)              :: info
+    !locals
+    type(psb_ctxt_type) :: ctxt
+    integer(psb_ipk_)   :: np, me, err_act
+    integer(psb_ipk_)   :: debug_level, debug_unit
+    character(len=20)   :: name
+
+    debug_unit  = psb_get_debug_unit()
+    debug_level = psb_get_debug_level()
+
+    if (psb_get_errstatus() /= 0) return 
+    info = psb_success_
+    call psb_erractionsave(err_act)
+    name = 'psb_cdcpy'
+
+    if (desc%is_asb()) then
+      write(0,*) 'DESC%CHECK_ADDR:  v_halo, v_ext_idx, v_ovrlap_idx,v_ovr_mst'
+      if (info == psb_success_) &
+           & call desc%v_halo_index%check_addr()
+      if (info == psb_success_) &
+           & call desc%v_ext_index%check_addr()
+      if (info == psb_success_) &
+           & call desc%v_ovrlap_index%check_addr()
+      if (info == psb_success_) &
+           & call desc%v_ovr_mst_idx%check_addr()
+      write(0,*) 'DESC%CHECK_ADDR:  done'
+    end if
+    
+    if (info /= psb_success_) then
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+    if (debug_level >= psb_debug_ext_) &
+         & write(debug_unit,*) me,' ',trim(name),': Done'
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+    return
+
+  end subroutine psb_cd_check_addr
+
   
   Subroutine psb_cd_get_recv_idx(tmp,desc,data,info)
     use psb_error_mod

base/modules/serial/psb_i_base_vect_mod.F90

@@ -168,8 +168,7 @@ module psb_i_base_vect_mod
     procedure, pass(y) :: sctb_buf => i_base_sctb_buf
     generic, public    :: sct      => sctb, sctb_x, sctb_buf
 
-
-
+    procedure, pass(x) :: check_addr  => i_base_check_addr
 
 
   end type psb_i_base_vect_type
@@ -1178,6 +1177,13 @@ contains
   end subroutine i_base_set_vect
 
 
+  subroutine i_base_check_addr(x)
+    class(psb_i_base_vect_type), intent(inout) :: x
+
+    write(0,*) 'Check addr: base version, do nothing'
+
+  end subroutine i_base_check_addr
+
 
   !
   ! Gather: Y = beta * Y + alpha * X(IDX(:))

base/modules/serial/psb_i_vect_mod.F90

@@ -105,6 +105,7 @@ module psb_i_vect_mod
     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
@@ -474,6 +475,13 @@ contains
 
   end subroutine i_vect_set_vect
 
+  subroutine i_vect_check_addr(x)
+    class(psb_i_vect_type), intent(inout) :: x
+
+    integer(psb_ipk_) :: info
+    if (allocated(x%v)) call x%v%check_addr()
+
+  end subroutine i_vect_check_addr
 
   function constructor(x) result(this)
     integer(psb_ipk_)   :: x(:)

cbind/base/psb_base_tools_cbind_mod.F90

@@ -414,6 +414,23 @@ contains
   end function psb_c_cd_is_asb
 
 
+  function psb_c_cd_check_addr(cdh) &
+       & bind(c,name='psb_c_cd_check_addr') result(res)
+    implicit none
+
+    integer(psb_c_ipk_) :: res
+    type(psb_c_object_type) :: cdh
+    type(psb_desc_type), pointer :: descp
+    integer               :: info
+
+    res = 0
+
+    if (c_associated(cdh%item)) then
+      call c_f_pointer(cdh%item,descp)
+      call descp%check_addr(info)
+      res = info
+    end if
+  end function psb_c_cd_check_addr
 
   function psb_c_cd_get_local_rows(cdh) bind(c,name='psb_c_cd_get_local_rows') result(res)
     implicit none

cbind/base/psb_c_base.h

@@ -92,7 +92,8 @@ extern "C" {
   psb_i_t    psb_c_cdins_lidx(psb_i_t nz, const psb_l_t *ja, const psb_i_t *lidx, psb_c_descriptor *cd);
   bool       psb_c_is_owned(psb_l_t gindex, psb_c_descriptor *cd);
   bool       psb_c_cd_is_asb(psb_c_descriptor *cd);
-
+  psb_i_t    psb_c_cd_check_addr(psb_c_descriptor *cd);
+  
 
   psb_i_t    psb_c_cd_get_local_rows(psb_c_descriptor *cd);
   psb_i_t    psb_c_cd_get_local_cols(psb_c_descriptor *cd);

cbind/psb_c_base.h

@@ -92,7 +92,8 @@ extern "C" {
   psb_i_t    psb_c_cdins_lidx(psb_i_t nz, const psb_l_t *ja, const psb_i_t *lidx, psb_c_descriptor *cd);
   bool       psb_c_is_owned(psb_l_t gindex, psb_c_descriptor *cd);
   bool       psb_c_cd_is_asb(psb_c_descriptor *cd);
-
+  psb_i_t    psb_c_cd_check_addr(psb_c_descriptor *cd);
+  
 
   psb_i_t    psb_c_cd_get_local_rows(psb_c_descriptor *cd);
   psb_i_t    psb_c_cd_get_local_cols(psb_c_descriptor *cd);

cuda/ivectordev.c

@@ -42,6 +42,14 @@ int registerMappedInt(void  *buff, void **d_p, int n, int dummy)
   return registerMappedMemory(buff,d_p,((size_t) n)*sizeof(int));
 }
 
+int checkMultiVecDeviceInt(void* deviceMultiVec)
+{
+  struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceMultiVec;
+  fprintf(stderr,"checkMultiVecDeviceInt Size: %d  Pointer %p\n",
+	  devVec->size_,devVec->v_);
+  return(0);
+}
+
 int writeMultiVecDeviceInt(void* deviceVec, int* hostVec)
 { int i;
   struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec;

cuda/ivectordev.h

@@ -38,6 +38,7 @@
 #include "vector.h"
 
 int registerMappedInt(void *, void **, int, int);
+int checkMultiVecDeviceInt(void* deviceMultiVec);
 int writeMultiVecDeviceInt(void* deviceMultiVec, int* hostMultiVec);
 int writeMultiVecDeviceIntR2(void* deviceMultiVec, int* hostMultiVec, int ld);
 int readMultiVecDeviceInt(void* deviceMultiVec, int* hostMultiVec);

cuda/psb_i_cuda_vect_mod.F90

@@ -84,6 +84,7 @@ module psb_i_cuda_vect_mod
     procedure, pass(x) :: free_buffer  => i_cuda_free_buffer
     procedure, pass(x) :: maybe_free_buffer  => i_cuda_maybe_free_buffer
 
+    procedure, pass(x) :: check_addr  => i_cuda_check_addr
     final              :: i_cuda_vect_finalize
   end type psb_i_vect_cuda
 
@@ -201,6 +202,18 @@ contains
 
   end subroutine i_cuda_free_buffer
 
+  subroutine i_cuda_check_addr(x)
+    class(psb_i_vect_cuda), intent(inout) :: x
+    integer(psb_ipk_) info;
+    select type(ii=> x) 
+    class is (psb_i_vect_cuda) 
+      info = checkMultiVecDeviceInt(x%deviceVect)      
+    class default
+      write(0,*) 'Check addr: cuda  version, why am I here? '
+    end select
+  end subroutine i_cuda_check_addr
+
+
   subroutine i_cuda_gthzv_x(i,n,idx,x,y)
     use psb_cuda_env_mod
     use psi_serial_mod
@@ -798,12 +811,12 @@ contains
     integer(psb_ipk_), intent(out)        :: info
     
     info = 0  
-    if (allocated(x%v)) deallocate(x%v, stat=info)
     if (c_associated(x%deviceVect)) then
 !!$      write(0,*)'d_cuda_free Calling freeMultiVecDevice'
       call freeMultiVecDevice(x%deviceVect)
       x%deviceVect=c_null_ptr
     end if
+    if (allocated(x%v)) deallocate(x%v, stat=info)
     call x%free_buffer(info)
     call x%set_sync()
   end subroutine i_cuda_free

cuda/psb_i_vectordev_mod.F90

@@ -122,6 +122,15 @@ module psb_i_vectordev_mod
       integer(c_int)       :: hidx(m,*)
       integer(c_int),value :: m,n
     end function writeMultiInt
+  end interface writeInt
+  
+  interface 
+    function checkMultiVecDeviceInt(deviceVec) &
+         & result(res) bind(c,name='checkMultiVecDeviceInt')
+      use iso_c_binding
+      integer(c_int)             :: res
+      type(c_ptr), value         :: deviceVec
+    end function checkMultiVecDeviceInt
   end interface
   
   interface readInt