Intermediate step for debugging

base/modules/serial/psb_d_vect_mod.F90

@@ -418,6 +418,8 @@ contains
     class(psb_d_vect_type), intent(in) :: x
     integer(psb_ipk_) :: res
     res = 0
+    write(0,*) allocated(x%v)
+    if (allocated(x%v)) write(0,*) allocated(x%v%v)
     if (allocated(x%v)) res = x%v%get_nrows()
   end function d_vect_get_nrows
 

base/psblas/psb_cdiv_vect.f90

@@ -93,7 +93,7 @@ subroutine psb_cdiv_vect(x,y,desc_a,info)
   end if
 
   if(desc_a%get_local_rows() > 0) then
-    call x%div(y,info)
+    call y%div(x,info)
   end if
 
   call psb_erractionrestore(err_act)

base/psblas/psb_ddiv_vect.f90

@@ -93,7 +93,7 @@ subroutine psb_ddiv_vect(x,y,desc_a,info)
   end if
 
   if(desc_a%get_local_rows() > 0) then
-    call x%div(y,info)
+    call y%div(x,info)
   end if
 
   call psb_erractionrestore(err_act)

base/psblas/psb_sdiv_vect.f90

@@ -93,7 +93,7 @@ subroutine psb_sdiv_vect(x,y,desc_a,info)
   end if
 
   if(desc_a%get_local_rows() > 0) then
-    call x%div(y,info)
+    call y%div(x,info)
   end if
 
   call psb_erractionrestore(err_act)

base/psblas/psb_zdiv_vect.f90

@@ -93,7 +93,7 @@ subroutine psb_zdiv_vect(x,y,desc_a,info)
   end if
 
   if(desc_a%get_local_rows() > 0) then
-    call x%div(y,info)
+    call y%div(x,info)
   end if
 
   call psb_erractionrestore(err_act)

cbind/base/psb_c_base.c

@@ -58,4 +58,7 @@ char *psb_c_pop_errmsg()
   return(tmp);
 }
 
+void    psb_c_print_pointer(void *p){
+  fprintf(stderr,"psb_c_print_pointer  %p\n",p);
+}
 // Convertire il comunicatore fortran in comunicatore c

cbind/base/psb_c_base.h

@@ -30,6 +30,10 @@ extern "C" {
     psb_i_t *ctxt;
   } psb_c_ctxt;
 
+  typedef struct PSB_C_OBJTYPE   {
+    void *item;
+  } psb_c_objtype;
+
 
 
   void  psb_c_check_error(psb_c_ctxt cctxt);
@@ -42,6 +46,7 @@ extern "C" {
   void psb_c_seterraction_print();
   void psb_c_seterraction_abort();
 
+  void    psb_c_print_pointer(void *p);
   /* Environment routines */
   void    psb_c_init(psb_c_ctxt *cctxt);
   void    psb_c_init_from_fint(psb_c_ctxt *cctxt, psb_i_t f_comm);

cbind/base/psb_d_tools_cbind_mod.F90

@@ -21,19 +21,32 @@ contains
     integer(psb_c_ipk_)               :: info
 
     res = -1
-
+    nullify(xp)
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
       return
     end if
+!!$    write(0,*) 'On entry  to C_DGEALL xh->item'
+    call psb_c_print_pointer(xh%item)
     if (c_associated(xh%item)) then
+      write(0,*) 'C associated on c_dgeall'
+      call psb_c_print_pointer(xh%item)
       return
     end if
-    allocate(xp)
+    allocate(xp,stat=info)
+    write(0,*) 'From DGEALL/ALLOCATE:',info
+    call psb_c_print_pointer(c_loc(xp))
     call psb_geall(xp,descp,info)
+    xp%v%v(1) = 1.d0
+    write(0,*) 'c_dgeall out from geall xp ',xp%get_nrows()
     xh%item = c_loc(xp)
     res = min(0,info)
+!!$    write(0,*) 'Check from C_DGEALL 1:',info
+    write(0,*) 'On end of  C_DGEALL xh->item'
+    call psb_c_print_pointer(xh%item)
+!!$    if (info==0)  write(0,*) 'Check from C_DGEALL 2:',xp%get_nrows(),descp%get_local_cols()
+    
 
     return
   end function psb_c_dgeall
@@ -57,6 +70,8 @@ contains
       return
     end if
     if (c_associated(xh%item)) then
+      write(0,*) 'C associated on c_dgeall_remote'
+      call psb_c_print_pointer(xh%item)
       return
     end if
     allocate(xp)

cbind/base/psb_objhandle_mod.F90

@@ -42,4 +42,15 @@ module psb_objhandle_mod
     type(c_ptr) :: item = c_null_ptr
   end type psb_c_zspmat
 
+  interface
+    subroutine psb_c_print_pointer(p) bind(c,name='psb_c_print_pointer')
+      use iso_c_binding
+      type(c_ptr), value :: p
+    end subroutine psb_c_print_pointer
+  end interface
+contains
+  function psb_c_get_new_object() result(res)
+    type(psb_c_object_type) :: res
+    res%item = c_null_ptr
+  end function psb_c_get_new_object
 end module psb_objhandle_mod