various changes, including test matrix generators

base/modules/serial/psb_c_base_vect_mod.F90

@@ -157,6 +157,7 @@ module psb_c_base_vect_mod
     procedure, pass(x) :: set_vect => c_base_set_vect
     generic, public    :: set      => set_vect, set_scal
     procedure, pass(x) :: get_entry=> c_base_get_entry
+    procedure, pass(x) :: set_entry=> c_base_set_entry
     !
     ! Gather/scatter. These are needed for MPI interfacing.
     ! May have to be reworked.
@@ -1275,15 +1276,33 @@ contains
   !
   function c_base_get_entry(x, index) result(res)
     implicit none
-    class(psb_c_base_vect_type), intent(in) :: x
+    class(psb_c_base_vect_type), intent(inout) :: x
     integer(psb_ipk_), intent(in)             :: index
     complex(psb_spk_)                           :: res
 
     res = 0
-    if (allocated(x%v)) res = x%v(index)
+    if (allocated(x%v)) then
+      if (x%is_dev()) call x%sync()
+      res = x%v(index)
+    end if
 
   end function c_base_get_entry
 
+  subroutine c_base_set_entry(x, index, val)
+    implicit none
+    class(psb_c_base_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)             :: index
+    complex(psb_spk_)                           :: val
+
+
+    if (allocated(x%v)) then
+      if (x%is_dev()) call x%sync()
+      x%v(index) =val
+      call x%set_host()
+    end if
+
+  end subroutine c_base_set_entry
+
   !
   ! Overwrite with absolute value
   !

base/modules/serial/psb_c_vect_mod.F90

@@ -108,6 +108,7 @@ module psb_c_vect_mod
     procedure, pass(x) :: check_addr => c_vect_check_addr
 
     procedure, pass(x) :: get_entry => c_vect_get_entry
+    procedure, pass(x) :: set_entry => c_vect_set_entry
 
     procedure, pass(x) :: dot_v    => c_vect_dot_v
     procedure, pass(x) :: dot_a    => c_vect_dot_a
@@ -855,13 +856,21 @@ contains
 
   function c_vect_get_entry(x,index) result(res)
     implicit none
-    class(psb_c_vect_type), intent(in) :: x
+    class(psb_c_vect_type), intent(inout) :: x
     integer(psb_ipk_), intent(in)        :: index
     complex(psb_spk_) :: res
-    res = 0
+    res = czero
     if (allocated(x%v)) res = x%v%get_entry(index)
   end function c_vect_get_entry
 
+  subroutine c_vect_set_entry(x,index,val)
+    implicit none
+    class(psb_c_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)        :: index
+    complex(psb_spk_) :: val
+    if (allocated(x%v)) call x%v%set_entry(index,val)
+  end subroutine c_vect_set_entry
+
   function c_vect_dot_v(n,x,y) result(res)
     implicit none
     class(psb_c_vect_type), intent(inout) :: x, y

base/modules/serial/psb_d_base_vect_mod.F90

@@ -157,6 +157,7 @@ module psb_d_base_vect_mod
     procedure, pass(x) :: set_vect => d_base_set_vect
     generic, public    :: set      => set_vect, set_scal
     procedure, pass(x) :: get_entry=> d_base_get_entry
+    procedure, pass(x) :: set_entry=> d_base_set_entry
     !
     ! Gather/scatter. These are needed for MPI interfacing.
     ! May have to be reworked.
@@ -1282,15 +1283,33 @@ contains
   !
   function d_base_get_entry(x, index) result(res)
     implicit none
-    class(psb_d_base_vect_type), intent(in) :: x
+    class(psb_d_base_vect_type), intent(inout) :: x
     integer(psb_ipk_), intent(in)             :: index
     real(psb_dpk_)                           :: res
 
     res = 0
-    if (allocated(x%v)) res = x%v(index)
+    if (allocated(x%v)) then
+      if (x%is_dev()) call x%sync()
+      res = x%v(index)
+    end if
 
   end function d_base_get_entry
 
+  subroutine d_base_set_entry(x, index, val)
+    implicit none
+    class(psb_d_base_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)             :: index
+    real(psb_dpk_)                           :: val
+
+
+    if (allocated(x%v)) then
+      if (x%is_dev()) call x%sync()
+      x%v(index) =val
+      call x%set_host()
+    end if
+
+  end subroutine d_base_set_entry
+
   !
   ! Overwrite with absolute value
   !
@@ -2190,7 +2209,7 @@ contains
     end do
 #else
     !
-    ! From M&R: if the array is of size zero, MINVAL
+    ! From M&R&C: if the array is of size zero, MINVAL
     !           returns the largest positive value
     !
     res =  minval(x%v(1:n))

base/modules/serial/psb_d_vect_mod.F90

@@ -108,6 +108,7 @@ module psb_d_vect_mod
     procedure, pass(x) :: check_addr => d_vect_check_addr
 
     procedure, pass(x) :: get_entry => d_vect_get_entry
+    procedure, pass(x) :: set_entry => d_vect_set_entry
 
     procedure, pass(x) :: dot_v    => d_vect_dot_v
     procedure, pass(x) :: dot_a    => d_vect_dot_a
@@ -862,13 +863,21 @@ contains
 
   function d_vect_get_entry(x,index) result(res)
     implicit none
-    class(psb_d_vect_type), intent(in) :: x
+    class(psb_d_vect_type), intent(inout) :: x
     integer(psb_ipk_), intent(in)        :: index
     real(psb_dpk_) :: res
-    res = 0
+    res = dzero
     if (allocated(x%v)) res = x%v%get_entry(index)
   end function d_vect_get_entry
 
+  subroutine d_vect_set_entry(x,index,val)
+    implicit none
+    class(psb_d_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)        :: index
+    real(psb_dpk_) :: val
+    if (allocated(x%v)) call x%v%set_entry(index,val)
+  end subroutine d_vect_set_entry
+
   function d_vect_dot_v(n,x,y) result(res)
     implicit none
     class(psb_d_vect_type), intent(inout) :: x, y
@@ -1430,7 +1439,7 @@ contains
     if (allocated(x%v)) then
       res = x%v%minreal(n)
     else
-      res = dzero
+      res = HUGE(done)
     end if
 
   end function d_vect_min

base/modules/serial/psb_s_base_vect_mod.F90

@@ -157,6 +157,7 @@ module psb_s_base_vect_mod
     procedure, pass(x) :: set_vect => s_base_set_vect
     generic, public    :: set      => set_vect, set_scal
     procedure, pass(x) :: get_entry=> s_base_get_entry
+    procedure, pass(x) :: set_entry=> s_base_set_entry
     !
     ! Gather/scatter. These are needed for MPI interfacing.
     ! May have to be reworked.
@@ -1282,15 +1283,33 @@ contains
   !
   function s_base_get_entry(x, index) result(res)
     implicit none
-    class(psb_s_base_vect_type), intent(in) :: x
+    class(psb_s_base_vect_type), intent(inout) :: x
     integer(psb_ipk_), intent(in)             :: index
     real(psb_spk_)                           :: res
 
     res = 0
-    if (allocated(x%v)) res = x%v(index)
+    if (allocated(x%v)) then
+      if (x%is_dev()) call x%sync()
+      res = x%v(index)
+    end if
 
   end function s_base_get_entry
 
+  subroutine s_base_set_entry(x, index, val)
+    implicit none
+    class(psb_s_base_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)             :: index
+    real(psb_spk_)                           :: val
+
+
+    if (allocated(x%v)) then
+      if (x%is_dev()) call x%sync()
+      x%v(index) =val
+      call x%set_host()
+    end if
+
+  end subroutine s_base_set_entry
+
   !
   ! Overwrite with absolute value
   !
@@ -2190,7 +2209,7 @@ contains
     end do
 #else
     !
-    ! From M&R: if the array is of size zero, MINVAL
+    ! From M&R&C: if the array is of size zero, MINVAL
     !           returns the largest positive value
     !
     res =  minval(x%v(1:n))

base/modules/serial/psb_s_vect_mod.F90

@@ -108,6 +108,7 @@ module psb_s_vect_mod
     procedure, pass(x) :: check_addr => s_vect_check_addr
 
     procedure, pass(x) :: get_entry => s_vect_get_entry
+    procedure, pass(x) :: set_entry => s_vect_set_entry
 
     procedure, pass(x) :: dot_v    => s_vect_dot_v
     procedure, pass(x) :: dot_a    => s_vect_dot_a
@@ -862,13 +863,21 @@ contains
 
   function s_vect_get_entry(x,index) result(res)
     implicit none
-    class(psb_s_vect_type), intent(in) :: x
+    class(psb_s_vect_type), intent(inout) :: x
     integer(psb_ipk_), intent(in)        :: index
     real(psb_spk_) :: res
-    res = 0
+    res = szero
     if (allocated(x%v)) res = x%v%get_entry(index)
   end function s_vect_get_entry
 
+  subroutine s_vect_set_entry(x,index,val)
+    implicit none
+    class(psb_s_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)        :: index
+    real(psb_spk_) :: val
+    if (allocated(x%v)) call x%v%set_entry(index,val)
+  end subroutine s_vect_set_entry
+
   function s_vect_dot_v(n,x,y) result(res)
     implicit none
     class(psb_s_vect_type), intent(inout) :: x, y
@@ -1430,7 +1439,7 @@ contains
     if (allocated(x%v)) then
       res = x%v%minreal(n)
     else
-      res = szero
+      res = HUGE(sone)
     end if
 
   end function s_vect_min

base/modules/serial/psb_z_base_vect_mod.F90

@@ -157,6 +157,7 @@ module psb_z_base_vect_mod
     procedure, pass(x) :: set_vect => z_base_set_vect
     generic, public    :: set      => set_vect, set_scal
     procedure, pass(x) :: get_entry=> z_base_get_entry
+    procedure, pass(x) :: set_entry=> z_base_set_entry
     !
     ! Gather/scatter. These are needed for MPI interfacing.
     ! May have to be reworked.
@@ -1275,15 +1276,33 @@ contains
   !
   function z_base_get_entry(x, index) result(res)
     implicit none
-    class(psb_z_base_vect_type), intent(in) :: x
+    class(psb_z_base_vect_type), intent(inout) :: x
     integer(psb_ipk_), intent(in)             :: index
     complex(psb_dpk_)                           :: res
 
     res = 0
-    if (allocated(x%v)) res = x%v(index)
+    if (allocated(x%v)) then
+      if (x%is_dev()) call x%sync()
+      res = x%v(index)
+    end if
 
   end function z_base_get_entry
 
+  subroutine z_base_set_entry(x, index, val)
+    implicit none
+    class(psb_z_base_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)             :: index
+    complex(psb_dpk_)                           :: val
+
+
+    if (allocated(x%v)) then
+      if (x%is_dev()) call x%sync()
+      x%v(index) =val
+      call x%set_host()
+    end if
+
+  end subroutine z_base_set_entry
+
   !
   ! Overwrite with absolute value
   !

base/modules/serial/psb_z_vect_mod.F90

@@ -108,6 +108,7 @@ module psb_z_vect_mod
     procedure, pass(x) :: check_addr => z_vect_check_addr
 
     procedure, pass(x) :: get_entry => z_vect_get_entry
+    procedure, pass(x) :: set_entry => z_vect_set_entry
 
     procedure, pass(x) :: dot_v    => z_vect_dot_v
     procedure, pass(x) :: dot_a    => z_vect_dot_a
@@ -855,13 +856,21 @@ contains
 
   function z_vect_get_entry(x,index) result(res)
     implicit none
-    class(psb_z_vect_type), intent(in) :: x
+    class(psb_z_vect_type), intent(inout) :: x
     integer(psb_ipk_), intent(in)        :: index
     complex(psb_dpk_) :: res
-    res = 0
+    res = zzero
     if (allocated(x%v)) res = x%v%get_entry(index)
   end function z_vect_get_entry
 
+  subroutine z_vect_set_entry(x,index,val)
+    implicit none
+    class(psb_z_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)        :: index
+    complex(psb_dpk_) :: val
+    if (allocated(x%v)) call x%v%set_entry(index,val)
+  end subroutine z_vect_set_entry
+
   function z_vect_dot_v(n,x,y) result(res)
     implicit none
     class(psb_z_vect_type), intent(inout) :: x, y

cbind/base/psb_base_cbind_mod.f90

@@ -1,6 +1,10 @@
 module psb_base_cbind_mod
   use psb_objhandle_mod
   use psb_cpenv_mod
+  use psb_s_serial_cbind_mod
+  use psb_d_serial_cbind_mod
+  use psb_c_serial_cbind_mod
+  use psb_z_serial_cbind_mod  
   use psb_base_tools_cbind_mod
   use psb_s_tools_cbind_mod
   use psb_d_tools_cbind_mod

cbind/base/psb_c_cbase.h

@@ -64,8 +64,10 @@ psb_i_t    psb_c_cspasb_opt(psb_c_cspmat *mh, psb_c_descriptor *cdh,
  			const char *afmt, psb_i_t upd, psb_i_t dupl); 
 psb_i_t    psb_c_csprn(psb_c_cspmat *mh, psb_c_descriptor *cdh, _Bool clear);
 psb_i_t    psb_c_cmat_name_print(psb_c_cspmat *mh, char *name);
-psb_i_t		 psb_c_cvect_set_scal(psb_c_cvector *xh, psb_c_t val);
-psb_i_t		 psb_c_cvect_set_vect(psb_c_cvector *xh, psb_c_t *val, psb_i_t n);
+psb_i_t	   psb_c_cvect_set_scal(psb_c_cvector *xh, psb_c_t val);
+psb_i_t	   psb_c_cvect_set_vect(psb_c_cvector *xh, psb_c_t *val, psb_i_t n);
+psb_c_t    psb_c_cvect_get_entry(psb_c_cvector *xh, psb_i_t index);
+psb_i_t    psb_c_cvect_set_entry(psb_c_cvector *xh, psb_i_t index, psb_c_t val);
 
 /* psblas computational routines */
 psb_c_t psb_c_cgedot(psb_c_cvector *xh, psb_c_cvector *yh, psb_c_descriptor *cdh);

cbind/base/psb_c_dbase.h

@@ -65,8 +65,10 @@ psb_i_t    psb_c_dspasb_opt(psb_c_dspmat *mh, psb_c_descriptor *cdh,
  			const char *afmt, psb_i_t upd, psb_i_t dupl); 
 psb_i_t    psb_c_dsprn(psb_c_dspmat *mh, psb_c_descriptor *cdh, _Bool clear);
 psb_i_t    psb_c_dmat_name_print(psb_c_dspmat *mh, char *name);
-psb_i_t		 psb_c_dvect_set_scal(psb_c_dvector *xh, psb_d_t val);
-psb_i_t		 psb_c_dvect_set_vect(psb_c_dvector *xh, psb_d_t *val, psb_i_t n);
+psb_i_t    psb_c_dvect_set_scal(psb_c_dvector *xh, psb_d_t val);
+psb_i_t	   psb_c_dvect_set_vect(psb_c_dvector *xh, psb_d_t *val, psb_i_t n);
+psb_d_t    psb_c_dvect_get_entry(psb_c_dvector *xh, psb_i_t index);
+psb_i_t    psb_c_dvect_set_entry(psb_c_dvector *xh, psb_i_t index, psb_d_t val);
 
 /* psblas computational routines */
 psb_d_t psb_c_dgedot(psb_c_dvector *xh, psb_c_dvector *yh, psb_c_descriptor *cdh);

cbind/base/psb_c_psblas_cbind_mod.f90

@@ -429,14 +429,13 @@ contains
   function psb_c_cgecmp(xh,ch,zh,cdh) bind(c) result(res)
     implicit none
     integer(psb_c_ipk_)    :: res
-
+    real(c_float_complex), value :: ch
     type(psb_c_cvector)  :: xh,zh
     type(psb_c_descriptor) :: cdh
 
     type(psb_desc_type), pointer :: descp
     type(psb_c_vect_type), pointer :: xp,zp
     integer(psb_c_ipk_)          :: info
-    real(c_float_complex), value :: ch
 
     res = -1
 

cbind/base/psb_c_sbase.h

@@ -65,8 +65,11 @@ psb_i_t		 psb_c_scopy_mat(psb_c_sspmat *ah,psb_c_sspmat *bh,psb_c_descriptor *cd
  			const char *afmt, psb_i_t upd, psb_i_t dupl); 
 psb_i_t    psb_c_ssprn(psb_c_sspmat *mh, psb_c_descriptor *cdh, _Bool clear);
 psb_i_t    psb_c_smat_name_print(psb_c_sspmat *mh, char *name);
-psb_i_t		 psb_c_svect_set_scal(psb_c_svector *xh, psb_s_t val);
-psb_i_t		 psb_c_svect_set_vect(psb_c_svector *xh, psb_s_t *val, psb_i_t n);
+psb_i_t	   psb_c_svect_set_scal(psb_c_svector *xh, psb_s_t val);
+psb_i_t	   psb_c_svect_set_vect(psb_c_svector *xh, psb_s_t *val, psb_i_t n);
+psb_s_t    psb_c_svect_get_entry(psb_c_svector *xh, psb_i_t index);
+psb_i_t    psb_c_svect_set_entry(psb_c_svector *xh, psb_i_t index, psb_s_t val);
+
 
 /* psblas computational routines */
 psb_s_t psb_c_sgedot(psb_c_svector *xh, psb_c_svector *yh, psb_c_descriptor *cdh);

cbind/base/psb_c_serial_cbind_mod.F90

@@ -200,6 +200,51 @@ contains
 
   end function psb_c_cvect_set_vect
 
+  function psb_c_cvect_set_entry(x,index,val) bind(c) result(info)
+    use psb_base_mod
+    implicit none
+
+    type(psb_c_cvector) :: x
+    type(psb_c_vect_type), pointer :: xp
+    integer(psb_c_ipk_) :: info
+    integer(psb_c_ipk_), value :: index
+    complex(c_float_complex), value :: val
+    integer(psb_c_ipk_) :: ixb
+
+    info = -1;
+
+    if (c_associated(x%item)) then
+      call c_f_pointer(x%item,xp)
+    else
+      return
+    end if
+
+    ixb = psb_c_get_index_base()
+    call xp%set_entry((index+(1-ixb)),val)
+    info = 0
+
+  end function psb_c_cvect_set_entry
+  
+  
+  function psb_c_cvect_get_entry(x,index) bind(c) result(res)
+    use psb_base_mod
+    implicit none
+
+    type(psb_c_cvector) :: x
+    type(psb_c_vect_type), pointer :: xp
+    integer(psb_c_ipk_), value :: index
+    complex(c_float_complex) :: res
+    integer(psb_c_ipk_) :: ixb
+    
+    if (c_associated(x%item)) then
+      call c_f_pointer(x%item,xp)
+    else
+      return
+    end if
+
+    ixb = psb_c_get_index_base()
+    res = xp%get_entry((index+(1-ixb)))
+  end function psb_c_cvect_get_entry
 
   function psb_c_cvect_clone(xh,yh) bind(c) result(info)
     implicit none

cbind/base/psb_c_tools_cbind_mod.F90

@@ -281,13 +281,19 @@ contains
     end if
 
     ixb = psb_c_get_index_base()
-    if (ixb == 1) then
-      call psb_geins(nz,irw(1:nz),val(1:nz),&
-           & xp,descp,info)
-    else
+    select case(ixb)
+    case (0)  
+      !write(0,*) 'C_GEINS:  IDX_BASE',ixb,' :',irw(1:nz)+(1-ixb),val(1:nz)
       call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
            & xp,descp,info)
-    end if
+    case(1)
+      !write(0,*) 'C_GEINS:  IDX_BASE',ixb,' :',irw(1:nz),val(1:nz)
+      call psb_geins(nz,irw(1:nz),val(1:nz),&
+           & xp,descp,info)
+    case default
+      write(0,*) 'C_GEINS: Unkonwn inndex base ',ixb
+      info =-2
+    end select
 
     res = min(0,info)
 

cbind/base/psb_c_zbase.h

@@ -66,8 +66,10 @@ psb_i_t    psb_c_zspasb_opt(psb_c_zspmat *mh, psb_c_descriptor *cdh,
  			const char *afmt, psb_i_t upd, psb_i_t dupl); 
 psb_i_t    psb_c_zsprn(psb_c_zspmat *mh, psb_c_descriptor *cdh, _Bool clear);
 psb_i_t    psb_c_zmat_name_print(psb_c_zspmat *mh, char *name);
-psb_i_t		 psb_c_zvect_set_scal(psb_c_zvector *xh, psb_z_t val);
-psb_i_t		 psb_c_zvect_set_vect(psb_c_zvector *xh, psb_z_t *val, psb_i_t n);
+psb_i_t	   psb_c_zvect_set_scal(psb_c_zvector *xh, psb_z_t val);
+psb_i_t	   psb_c_zvect_set_vect(psb_c_zvector *xh, psb_z_t *val, psb_i_t n);
+psb_z_t    psb_c_zvect_get_entry(psb_c_zvector *xh, psb_i_t index);
+psb_i_t    psb_c_zvect_set_entry(psb_c_zvector *xh, psb_i_t index, psb_z_t val);
 
 /* psblas computational routines */
 psb_z_t psb_c_zgedot(psb_c_zvector *xh, psb_c_zvector *yh, psb_c_descriptor *cdh);

cbind/base/psb_d_psblas_cbind_mod.f90

@@ -429,14 +429,13 @@ contains
   function psb_c_dgecmp(xh,ch,zh,cdh) bind(c) result(res)
     implicit none
     integer(psb_c_ipk_)    :: res
-
+    real(c_double), value :: ch
     type(psb_c_dvector)  :: xh,zh
     type(psb_c_descriptor) :: cdh
 
     type(psb_desc_type), pointer :: descp
     type(psb_d_vect_type), pointer :: xp,zp
     integer(psb_c_ipk_)          :: info
-    real(c_double), value :: ch
 
     res = -1
 

cbind/base/psb_d_serial_cbind_mod.F90

@@ -200,6 +200,51 @@ contains
 
   end function psb_c_dvect_set_vect
 
+  function psb_c_dvect_set_entry(x,index,val) bind(c) result(info)
+    use psb_base_mod
+    implicit none
+
+    type(psb_c_dvector) :: x
+    type(psb_d_vect_type), pointer :: xp
+    integer(psb_c_ipk_) :: info
+    integer(psb_c_ipk_), value :: index
+    real(c_double), value :: val
+    integer(psb_c_ipk_) :: ixb
+
+    info = -1;
+
+    if (c_associated(x%item)) then
+      call c_f_pointer(x%item,xp)
+    else
+      return
+    end if
+
+    ixb = psb_c_get_index_base()
+    call xp%set_entry((index+(1-ixb)),val)
+    info = 0
+
+  end function psb_c_dvect_set_entry
+  
+  
+  function psb_c_dvect_get_entry(x,index) bind(c) result(res)
+    use psb_base_mod
+    implicit none
+
+    type(psb_c_dvector) :: x
+    type(psb_d_vect_type), pointer :: xp
+    integer(psb_c_ipk_), value :: index
+    real(c_double) :: res
+    integer(psb_c_ipk_) :: ixb
+    
+    if (c_associated(x%item)) then
+      call c_f_pointer(x%item,xp)
+    else
+      return
+    end if
+
+    ixb = psb_c_get_index_base()
+    res = xp%get_entry((index+(1-ixb)))
+  end function psb_c_dvect_get_entry
 
   function psb_c_dvect_clone(xh,yh) bind(c) result(info)
     implicit none

cbind/base/psb_d_tools_cbind_mod.F90

@@ -281,13 +281,19 @@ contains
     end if
 
     ixb = psb_c_get_index_base()
-    if (ixb == 1) then
-      call psb_geins(nz,irw(1:nz),val(1:nz),&
-           & xp,descp,info)
-    else
+    select case(ixb)
+    case (0)  
+      !write(0,*) 'C_GEINS:  IDX_BASE',ixb,' :',irw(1:nz)+(1-ixb),val(1:nz)
       call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
            & xp,descp,info)
-    end if
+    case(1)
+      !write(0,*) 'C_GEINS:  IDX_BASE',ixb,' :',irw(1:nz),val(1:nz)
+      call psb_geins(nz,irw(1:nz),val(1:nz),&
+           & xp,descp,info)
+    case default
+      write(0,*) 'C_GEINS: Unkonwn inndex base ',ixb
+      info =-2
+    end select
 
     res = min(0,info)
 

cbind/base/psb_s_psblas_cbind_mod.f90

@@ -429,14 +429,13 @@ contains
   function psb_c_sgecmp(xh,ch,zh,cdh) bind(c) result(res)
     implicit none
     integer(psb_c_ipk_)    :: res
-
+    real(c_float), value :: ch
     type(psb_c_svector)  :: xh,zh
     type(psb_c_descriptor) :: cdh
 
     type(psb_desc_type), pointer :: descp
     type(psb_s_vect_type), pointer :: xp,zp
     integer(psb_c_ipk_)          :: info
-    real(c_float), value :: ch
 
     res = -1
 

cbind/base/psb_s_serial_cbind_mod.F90

@@ -200,6 +200,51 @@ contains
 
   end function psb_c_svect_set_vect
 
+  function psb_c_svect_set_entry(x,index,val) bind(c) result(info)
+    use psb_base_mod
+    implicit none
+
+    type(psb_c_svector) :: x
+    type(psb_s_vect_type), pointer :: xp
+    integer(psb_c_ipk_) :: info
+    integer(psb_c_ipk_), value :: index
+    real(c_float), value :: val
+    integer(psb_c_ipk_) :: ixb
+
+    info = -1;
+
+    if (c_associated(x%item)) then
+      call c_f_pointer(x%item,xp)
+    else
+      return
+    end if
+
+    ixb = psb_c_get_index_base()
+    call xp%set_entry((index+(1-ixb)),val)
+    info = 0
+
+  end function psb_c_svect_set_entry
+  
+  
+  function psb_c_svect_get_entry(x,index) bind(c) result(res)
+    use psb_base_mod
+    implicit none
+
+    type(psb_c_svector) :: x
+    type(psb_s_vect_type), pointer :: xp
+    integer(psb_c_ipk_), value :: index
+    real(c_float) :: res
+    integer(psb_c_ipk_) :: ixb
+    
+    if (c_associated(x%item)) then
+      call c_f_pointer(x%item,xp)
+    else
+      return
+    end if
+
+    ixb = psb_c_get_index_base()
+    res = xp%get_entry((index+(1-ixb)))
+  end function psb_c_svect_get_entry
 
   function psb_c_svect_clone(xh,yh) bind(c) result(info)
     implicit none

cbind/base/psb_s_tools_cbind_mod.F90

@@ -281,13 +281,19 @@ contains
     end if
 
     ixb = psb_c_get_index_base()
-    if (ixb == 1) then
-      call psb_geins(nz,irw(1:nz),val(1:nz),&
-           & xp,descp,info)
-    else
+    select case(ixb)
+    case (0)  
+      !write(0,*) 'C_GEINS:  IDX_BASE',ixb,' :',irw(1:nz)+(1-ixb),val(1:nz)
       call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
            & xp,descp,info)
-    end if
+    case(1)
+      !write(0,*) 'C_GEINS:  IDX_BASE',ixb,' :',irw(1:nz),val(1:nz)
+      call psb_geins(nz,irw(1:nz),val(1:nz),&
+           & xp,descp,info)
+    case default
+      write(0,*) 'C_GEINS: Unkonwn inndex base ',ixb
+      info =-2
+    end select
 
     res = min(0,info)
 

cbind/base/psb_z_psblas_cbind_mod.f90

@@ -429,14 +429,13 @@ contains
   function psb_c_zgecmp(xh,ch,zh,cdh) bind(c) result(res)
     implicit none
     integer(psb_c_ipk_)    :: res
-
+    real(c_double_complex), value :: ch
     type(psb_c_zvector)  :: xh,zh
     type(psb_c_descriptor) :: cdh
 
     type(psb_desc_type), pointer :: descp
     type(psb_z_vect_type), pointer :: xp,zp
     integer(psb_c_ipk_)          :: info
-    real(c_double_complex), value :: ch
 
     res = -1
 

cbind/base/psb_z_serial_cbind_mod.F90

@@ -200,6 +200,51 @@ contains
 
   end function psb_c_zvect_set_vect
 
+  function psb_c_zvect_set_entry(x,index,val) bind(c) result(info)
+    use psb_base_mod
+    implicit none
+
+    type(psb_c_zvector) :: x
+    type(psb_z_vect_type), pointer :: xp
+    integer(psb_c_ipk_) :: info
+    integer(psb_c_ipk_), value :: index
+    complex(c_double_complex), value :: val
+    integer(psb_c_ipk_) :: ixb
+
+    info = -1;
+
+    if (c_associated(x%item)) then
+      call c_f_pointer(x%item,xp)
+    else
+      return
+    end if
+
+    ixb = psb_c_get_index_base()
+    call xp%set_entry((index+(1-ixb)),val)
+    info = 0
+
+  end function psb_c_zvect_set_entry
+  
+  
+  function psb_c_zvect_get_entry(x,index) bind(c) result(res)
+    use psb_base_mod
+    implicit none
+
+    type(psb_c_zvector) :: x
+    type(psb_z_vect_type), pointer :: xp
+    integer(psb_c_ipk_), value :: index
+    complex(c_double_complex) :: res
+    integer(psb_c_ipk_) :: ixb
+    
+    if (c_associated(x%item)) then
+      call c_f_pointer(x%item,xp)
+    else
+      return
+    end if
+
+    ixb = psb_c_get_index_base()
+    res = xp%get_entry((index+(1-ixb)))
+  end function psb_c_zvect_get_entry
 
   function psb_c_zvect_clone(xh,yh) bind(c) result(info)
     implicit none

cbind/base/psb_z_tools_cbind_mod.F90

@@ -281,13 +281,19 @@ contains
     end if
 
     ixb = psb_c_get_index_base()
-    if (ixb == 1) then
-      call psb_geins(nz,irw(1:nz),val(1:nz),&
-           & xp,descp,info)
-    else
+    select case(ixb)
+    case (0)  
+      !write(0,*) 'C_GEINS:  IDX_BASE',ixb,' :',irw(1:nz)+(1-ixb),val(1:nz)
       call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
            & xp,descp,info)
-    end if
+    case(1)
+      !write(0,*) 'C_GEINS:  IDX_BASE',ixb,' :',irw(1:nz),val(1:nz)
+      call psb_geins(nz,irw(1:nz),val(1:nz),&
+           & xp,descp,info)
+    case default
+      write(0,*) 'C_GEINS: Unkonwn inndex base ',ixb
+      info =-2
+    end select
 
     res = min(0,info)
 

test/pdegen/psb_d_pde2d.F90

@@ -230,7 +230,7 @@ contains
       f_ => d_null_func_2d
     end if
 
-    deltah   = done/(idim+1)
+    deltah   = done/(idim+2)
     sqdeltah = deltah*deltah
     deltah2  = (2*done)* deltah
 
@@ -467,8 +467,8 @@ contains
           ! compute gridpoint coordinates
           call idx2ijk(ix,iy,glob_row,idim,idim)
           ! x, y coordinates
-          x = (ix-1)*deltah
-          y = (iy-1)*deltah
+          x = (ix)*deltah
+          y = (iy)*deltah
           
           zt(k) = f_(x,y)
           ! internal point: build discretization

test/pdegen/psb_d_pde3d.F90

@@ -246,7 +246,7 @@ contains
       f_ => d_null_func_3d
     end if
 
-    deltah   = done/(idim+1)
+    deltah   = done/(idim+2)
     sqdeltah = deltah*deltah
     deltah2  = (2*done)* deltah
 
@@ -496,9 +496,9 @@ contains
           ! compute gridpoint coordinates
           call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim)
           ! x, y, z coordinates
-          x = (ix-1)*deltah
-          y = (iy-1)*deltah
-          z = (iz-1)*deltah
+          x = (ix)*deltah
+          y = (iy)*deltah
+          z = (iz)*deltah
           zt(k) = f_(x,y,z)
           ! internal point: build discretization
           !

test/pdegen/psb_s_pde2d.F90

@@ -230,7 +230,7 @@ contains
       f_ => s_null_func_2d
     end if
 
-    deltah   = sone/(idim+1)
+    deltah   = sone/(idim+2)
     sqdeltah = deltah*deltah
     deltah2  = (2*sone)* deltah
 
@@ -467,8 +467,8 @@ contains
           ! compute gridpoint coordinates
           call idx2ijk(ix,iy,glob_row,idim,idim)
           ! x, y coordinates
-          x = (ix-1)*deltah
-          y = (iy-1)*deltah
+          x = (ix)*deltah
+          y = (iy)*deltah
           
           zt(k) = f_(x,y)
           ! internal point: build discretization

test/pdegen/psb_s_pde3d.F90

@@ -246,7 +246,7 @@ contains
       f_ => s_null_func_3d
     end if
 
-    deltah   = sone/(idim+1)
+    deltah   = sone/(idim+2)
     sqdeltah = deltah*deltah
     deltah2  = (2*sone)* deltah
 
@@ -496,9 +496,9 @@ contains
           ! compute gridpoint coordinates
           call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim)
           ! x, y, z coordinates
-          x = (ix-1)*deltah
-          y = (iy-1)*deltah
-          z = (iz-1)*deltah
+          x = (ix)*deltah
+          y = (iy)*deltah
+          z = (iz)*deltah
           zt(k) = f_(x,y,z)
           ! internal point: build discretization
           !