diff --git a/base/modules/serial/psb_d_vect_mod.F90 b/base/modules/serial/psb_d_vect_mod.F90 index 408831fc9..fef61b278 100644 --- a/base/modules/serial/psb_d_vect_mod.F90 +++ b/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 diff --git a/base/psblas/psb_cdiv_vect.f90 b/base/psblas/psb_cdiv_vect.f90 index 9a2525a13..e384f5b4c 100644 --- a/base/psblas/psb_cdiv_vect.f90 +++ b/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) diff --git a/base/psblas/psb_ddiv_vect.f90 b/base/psblas/psb_ddiv_vect.f90 index 37fe59e1b..05d689c21 100644 --- a/base/psblas/psb_ddiv_vect.f90 +++ b/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) diff --git a/base/psblas/psb_sdiv_vect.f90 b/base/psblas/psb_sdiv_vect.f90 index 223ce77ff..c6ec1dc42 100644 --- a/base/psblas/psb_sdiv_vect.f90 +++ b/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) diff --git a/base/psblas/psb_zdiv_vect.f90 b/base/psblas/psb_zdiv_vect.f90 index ad4d069d8..1d61fea1e 100644 --- a/base/psblas/psb_zdiv_vect.f90 +++ b/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) diff --git a/cbind/base/psb_c_base.c b/cbind/base/psb_c_base.c index 045a1a7c3..c5d21f5a1 100644 --- a/cbind/base/psb_c_base.c +++ b/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 diff --git a/cbind/base/psb_c_base.h b/cbind/base/psb_c_base.h index ec130a9fc..fc7ce0b25 100644 --- a/cbind/base/psb_c_base.h +++ b/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); diff --git a/cbind/base/psb_d_tools_cbind_mod.F90 b/cbind/base/psb_d_tools_cbind_mod.F90 index 46a1656df..9177b688b 100644 --- a/cbind/base/psb_d_tools_cbind_mod.F90 +++ b/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) diff --git a/cbind/base/psb_objhandle_mod.F90 b/cbind/base/psb_objhandle_mod.F90 index e7cb8aeb3..7712e186f 100644 --- a/cbind/base/psb_objhandle_mod.F90 +++ b/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