Added interface (and C interface) to is_upd() for sparse matrices

base/modules/psblas/psb_c_psblas_mod.F90

@@ -599,4 +599,15 @@ module psb_c_psblas_mod
     end function
   end interface
 
+  interface psb_is_matupd
+    function psb_c_is_matupd(a,desc_a,info) result(res)
+      import :: psb_desc_type, psb_cspmat_type, &
+        & psb_spk_, psb_ipk_
+      logical                               :: res
+      type(psb_cspmat_type), intent(in)   :: a
+      type(psb_desc_type), intent (in)      :: desc_a
+      integer(psb_ipk_), intent(out)        :: info
+    end function
+  end interface
+
 end module psb_c_psblas_mod

base/modules/psblas/psb_d_psblas_mod.F90

@@ -634,4 +634,15 @@ module psb_d_psblas_mod
     end function
   end interface
 
+  interface psb_is_matupd
+    function psb_d_is_matupd(a,desc_a,info) result(res)
+      import :: psb_desc_type, psb_dspmat_type, &
+        & psb_dpk_, psb_ipk_
+      logical                               :: res
+      type(psb_dspmat_type), intent(in)   :: a
+      type(psb_desc_type), intent (in)      :: desc_a
+      integer(psb_ipk_), intent(out)        :: info
+    end function
+  end interface
+
 end module psb_d_psblas_mod

base/modules/psblas/psb_s_psblas_mod.F90

@@ -634,4 +634,15 @@ module psb_s_psblas_mod
     end function
   end interface
 
+  interface psb_is_matupd
+    function psb_s_is_matupd(a,desc_a,info) result(res)
+      import :: psb_desc_type, psb_sspmat_type, &
+        & psb_spk_, psb_ipk_
+      logical                               :: res
+      type(psb_sspmat_type), intent(in)   :: a
+      type(psb_desc_type), intent (in)      :: desc_a
+      integer(psb_ipk_), intent(out)        :: info
+    end function
+  end interface
+
 end module psb_s_psblas_mod

base/modules/psblas/psb_z_psblas_mod.F90

@@ -599,4 +599,15 @@ module psb_z_psblas_mod
     end function
   end interface
 
+  interface psb_is_matupd
+    function psb_z_is_matupd(a,desc_a,info) result(res)
+      import :: psb_desc_type, psb_zspmat_type, &
+        & psb_dpk_, psb_ipk_
+      logical                               :: res
+      type(psb_zspmat_type), intent(in)   :: a
+      type(psb_desc_type), intent (in)      :: desc_a
+      integer(psb_ipk_), intent(out)        :: info
+    end function
+  end interface
+
 end module psb_z_psblas_mod

base/psblas/psb_cgetmatinfo.f90

@@ -52,7 +52,7 @@ function  psb_cget_nnz(a,desc_a,info) result(res)
   integer(psb_lpk_) :: m,n,ia,ja,localnnz
   character(len=20) :: name, ch_err
   !
-  name='psb_cspmv'
+  name='psb_cget_nnz'
   info=psb_success_
   call psb_erractionsave(err_act)
   if  (psb_errstatus_fatal()) then
@@ -90,3 +90,57 @@ function  psb_cget_nnz(a,desc_a,info) result(res)
 
   return
 end function
+
+function  psb_c_is_matupd(a,desc_a,info) result(res)
+  use psb_base_mod, psb_protect_name => psb_c_is_matupd
+  use psi_mod
+
+  implicit none
+
+  logical                               :: res
+  type(psb_cspmat_type), intent(in)   :: a
+  type(psb_desc_type), intent (in)      :: desc_a
+  integer(psb_ipk_), intent(out)        :: info
+
+  ! locals
+  integer(psb_ipk_) :: ictxt, np, me,&
+       & err_act, iia, jja
+  integer(psb_lpk_) :: m,n,ia,ja,localnnz
+  character(len=20) :: name, ch_err
+  !
+  name='psb_cis_matupd'
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  if  (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_ ;    goto 9999
+  end if
+
+  ictxt=desc_a%get_context()
+  call psb_info(ictxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  m    = desc_a%get_global_rows()
+  n    = desc_a%get_global_cols()
+
+  ! Check for matrix correctness
+  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
+  if(info /= psb_success_) then
+    info=psb_err_from_subroutine_
+    ch_err='psb_chkmat'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end if
+
+  res = a%is_upd()
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ictxt,err_act)
+
+  return
+end function

base/psblas/psb_dgetmatinfo.f90

@@ -52,7 +52,7 @@ function  psb_dget_nnz(a,desc_a,info) result(res)
   integer(psb_lpk_) :: m,n,ia,ja,localnnz
   character(len=20) :: name, ch_err
   !
-  name='psb_dspmv'
+  name='psb_dget_nnz'
   info=psb_success_
   call psb_erractionsave(err_act)
   if  (psb_errstatus_fatal()) then
@@ -90,3 +90,57 @@ function  psb_dget_nnz(a,desc_a,info) result(res)
 
   return
 end function
+
+function  psb_d_is_matupd(a,desc_a,info) result(res)
+  use psb_base_mod, psb_protect_name => psb_d_is_matupd
+  use psi_mod
+
+  implicit none
+
+  logical                               :: res
+  type(psb_dspmat_type), intent(in)   :: a
+  type(psb_desc_type), intent (in)      :: desc_a
+  integer(psb_ipk_), intent(out)        :: info
+
+  ! locals
+  integer(psb_ipk_) :: ictxt, np, me,&
+       & err_act, iia, jja
+  integer(psb_lpk_) :: m,n,ia,ja,localnnz
+  character(len=20) :: name, ch_err
+  !
+  name='psb_dis_matupd'
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  if  (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_ ;    goto 9999
+  end if
+
+  ictxt=desc_a%get_context()
+  call psb_info(ictxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  m    = desc_a%get_global_rows()
+  n    = desc_a%get_global_cols()
+
+  ! Check for matrix correctness
+  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
+  if(info /= psb_success_) then
+    info=psb_err_from_subroutine_
+    ch_err='psb_chkmat'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end if
+
+  res = a%is_upd()
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ictxt,err_act)
+
+  return
+end function

base/psblas/psb_sgetmatinfo.f90

@@ -52,7 +52,7 @@ function  psb_sget_nnz(a,desc_a,info) result(res)
   integer(psb_lpk_) :: m,n,ia,ja,localnnz
   character(len=20) :: name, ch_err
   !
-  name='psb_sspmv'
+  name='psb_sget_nnz'
   info=psb_success_
   call psb_erractionsave(err_act)
   if  (psb_errstatus_fatal()) then
@@ -90,3 +90,57 @@ function  psb_sget_nnz(a,desc_a,info) result(res)
 
   return
 end function
+
+function  psb_s_is_matupd(a,desc_a,info) result(res)
+  use psb_base_mod, psb_protect_name => psb_s_is_matupd
+  use psi_mod
+
+  implicit none
+
+  logical                               :: res
+  type(psb_sspmat_type), intent(in)   :: a
+  type(psb_desc_type), intent (in)      :: desc_a
+  integer(psb_ipk_), intent(out)        :: info
+
+  ! locals
+  integer(psb_ipk_) :: ictxt, np, me,&
+       & err_act, iia, jja
+  integer(psb_lpk_) :: m,n,ia,ja,localnnz
+  character(len=20) :: name, ch_err
+  !
+  name='psb_sis_matupd'
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  if  (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_ ;    goto 9999
+  end if
+
+  ictxt=desc_a%get_context()
+  call psb_info(ictxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  m    = desc_a%get_global_rows()
+  n    = desc_a%get_global_cols()
+
+  ! Check for matrix correctness
+  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
+  if(info /= psb_success_) then
+    info=psb_err_from_subroutine_
+    ch_err='psb_chkmat'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end if
+
+  res = a%is_upd()
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ictxt,err_act)
+
+  return
+end function

base/psblas/psb_zgetmatinfo.f90

@@ -52,7 +52,7 @@ function  psb_zget_nnz(a,desc_a,info) result(res)
   integer(psb_lpk_) :: m,n,ia,ja,localnnz
   character(len=20) :: name, ch_err
   !
-  name='psb_zspmv'
+  name='psb_zget_nnz'
   info=psb_success_
   call psb_erractionsave(err_act)
   if  (psb_errstatus_fatal()) then
@@ -90,3 +90,57 @@ function  psb_zget_nnz(a,desc_a,info) result(res)
 
   return
 end function
+
+function  psb_z_is_matupd(a,desc_a,info) result(res)
+  use psb_base_mod, psb_protect_name => psb_z_is_matupd
+  use psi_mod
+
+  implicit none
+
+  logical                               :: res
+  type(psb_zspmat_type), intent(in)   :: a
+  type(psb_desc_type), intent (in)      :: desc_a
+  integer(psb_ipk_), intent(out)        :: info
+
+  ! locals
+  integer(psb_ipk_) :: ictxt, np, me,&
+       & err_act, iia, jja
+  integer(psb_lpk_) :: m,n,ia,ja,localnnz
+  character(len=20) :: name, ch_err
+  !
+  name='psb_zis_matupd'
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  if  (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_ ;    goto 9999
+  end if
+
+  ictxt=desc_a%get_context()
+  call psb_info(ictxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  m    = desc_a%get_global_rows()
+  n    = desc_a%get_global_cols()
+
+  ! Check for matrix correctness
+  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
+  if(info /= psb_success_) then
+    info=psb_err_from_subroutine_
+    ch_err='psb_chkmat'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end if
+
+  res = a%is_upd()
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ictxt,err_act)
+
+  return
+end function

cbind/base/psb_c_cbase.h

@@ -41,6 +41,7 @@ psb_i_t    psb_c_cspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
 psb_i_t    psb_c_cmat_get_nrows(psb_c_cspmat *mh);
 psb_i_t    psb_c_cmat_get_ncols(psb_c_cspmat *mh);
 psb_l_t    psb_c_cnnz(psb_c_cspmat *mh,psb_c_descriptor *cdh);
+bool    	 psb_c_cis_matupd(psb_c_cspmat *mh,psb_c_descriptor *cdh);
 
 /* 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); */

cbind/base/psb_c_dbase.h

@@ -41,6 +41,7 @@ psb_i_t    psb_c_dspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
 psb_i_t    psb_c_dmat_get_nrows(psb_c_dspmat *mh);
 psb_i_t    psb_c_dmat_get_ncols(psb_c_dspmat *mh);
 psb_l_t    psb_c_dnnz(psb_c_dspmat *mh,psb_c_descriptor *cdh);
+bool    	 psb_c_dis_matupd(psb_c_dspmat *mh,psb_c_descriptor *cdh);
 
 /* 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); */

cbind/base/psb_c_psblas_cbind_mod.f90

@@ -897,5 +897,29 @@ contains
 
   end function psb_c_cnnz
 
+  function psb_c_cis_matupd(ah,cdh) bind(c) result(res)
+    implicit none
+    logical :: res
+
+    type(psb_c_cspmat)   :: ah
+    type(psb_c_descriptor) :: cdh
+
+    type(psb_desc_type), pointer      :: descp
+    type(psb_cspmat_type), pointer  :: ap
+    integer(psb_c_ipk_)               :: info
+
+    if (c_associated(cdh%item)) then
+      call c_f_pointer(cdh%item,descp)
+    else
+      return
+    end if
+    if (c_associated(ah%item)) then
+      call c_f_pointer(ah%item,ap)
+    else
+      return
+    end if
+
+    res = psb_is_matupd(ap,descp,info)
+  end function
 
 end module psb_c_psblas_cbind_mod

cbind/base/psb_c_sbase.h

@@ -41,6 +41,7 @@ psb_i_t    psb_c_sspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
 psb_i_t    psb_c_smat_get_nrows(psb_c_sspmat *mh);
 psb_i_t    psb_c_smat_get_ncols(psb_c_sspmat *mh);
 psb_l_t    psb_c_snnz(psb_c_sspmat *mh,psb_c_descriptor *cdh);
+bool    	 psb_c_sis_matupd(psb_c_sspmat *mh,psb_c_descriptor *cdh);
 
 /* psb_i_t    psb_c_sspasb_opt(psb_c_sspmat *mh, psb_c_descriptor *cdh,  */
 /* 			const char *afmt, psb_i_t upd, psb_i_t dupl); */

cbind/base/psb_c_zbase.h

@@ -41,6 +41,7 @@ psb_i_t    psb_c_zspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
 psb_i_t    psb_c_zmat_get_nrows(psb_c_zspmat *mh);
 psb_i_t    psb_c_zmat_get_ncols(psb_c_zspmat *mh);
 psb_l_t    psb_c_znnz(psb_c_zspmat *mh,psb_c_descriptor *cdh);
+bool    	 psb_c_zis_matupd(psb_c_zspmat *mh,psb_c_descriptor *cdh);
 
 /* 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); */

cbind/base/psb_d_psblas_cbind_mod.f90

@@ -998,5 +998,29 @@ contains
 
   end function psb_c_dnnz
 
+  function psb_c_dis_matupd(ah,cdh) bind(c) result(res)
+    implicit none
+    logical :: res
+
+    type(psb_c_dspmat)   :: ah
+    type(psb_c_descriptor) :: cdh
+
+    type(psb_desc_type), pointer      :: descp
+    type(psb_dspmat_type), pointer  :: ap
+    integer(psb_c_ipk_)               :: info
+
+    if (c_associated(cdh%item)) then
+      call c_f_pointer(cdh%item,descp)
+    else
+      return
+    end if
+    if (c_associated(ah%item)) then
+      call c_f_pointer(ah%item,ap)
+    else
+      return
+    end if
+
+    res = psb_is_matupd(ap,descp,info)
+  end function
 
 end module psb_d_psblas_cbind_mod

cbind/base/psb_s_psblas_cbind_mod.f90

@@ -998,5 +998,29 @@ contains
 
   end function psb_c_snnz
 
+  function psb_c_sis_matupd(ah,cdh) bind(c) result(res)
+    implicit none
+    logical :: res
+
+    type(psb_c_sspmat)   :: ah
+    type(psb_c_descriptor) :: cdh
+
+    type(psb_desc_type), pointer      :: descp
+    type(psb_sspmat_type), pointer  :: ap
+    integer(psb_c_ipk_)               :: info
+
+    if (c_associated(cdh%item)) then
+      call c_f_pointer(cdh%item,descp)
+    else
+      return
+    end if
+    if (c_associated(ah%item)) then
+      call c_f_pointer(ah%item,ap)
+    else
+      return
+    end if
+
+    res = psb_is_matupd(ap,descp,info)
+  end function
 
 end module psb_s_psblas_cbind_mod

cbind/base/psb_z_psblas_cbind_mod.f90

@@ -897,5 +897,29 @@ contains
 
   end function psb_c_znnz
 
+  function psb_c_zis_matupd(ah,cdh) bind(c) result(res)
+    implicit none
+    logical :: res
+
+    type(psb_c_zspmat)   :: ah
+    type(psb_c_descriptor) :: cdh
+
+    type(psb_desc_type), pointer      :: descp
+    type(psb_zspmat_type), pointer  :: ap
+    integer(psb_c_ipk_)               :: info
+
+    if (c_associated(cdh%item)) then
+      call c_f_pointer(cdh%item,descp)
+    else
+      return
+    end if
+    if (c_associated(ah%item)) then
+      call c_f_pointer(ah%item,ap)
+    else
+      return
+    end if
+
+    res = psb_is_matupd(ap,descp,info)
+  end function
 
 end module psb_z_psblas_cbind_mod