fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-17 11:22:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'maint-3.9.0' into merge-maint-par

Browse Source
This commit is contained in:
Salvatore Filippone
2026-05-03 09:11:29 +02:00
parent 19ce4a0942 35ff98d1ab
commit 7ff4d251fd
50 changed files with 28370 additions and 15515 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CMakeLists.txt
+2 -2
View File
@@ -428,7 +428,7 @@ if(METIS_FOUND)
include(CheckTypeSize)
message(STATUS "METIS PATH ${METIS_INCLUDES} and metis libraries ${METIS_LIBRARIES}")
# Make sure this path is correct
# set(METISINCFILE "metis.h") # Adjust this to your actual path
set(CMAKE_METIS_INCFILE "metis.h") # Adjust this to your actual path
# Specify the configuration file
# set(HEADER_TEMPLATE "${CMAKE_CURRENT_SOURCE_DIR}/util/psb_metis_int.h.in")
@@ -509,7 +509,7 @@ if(METIS_FOUND)
# 1. Tell CMake where to find metis.h for the check
set(CMAKE_EXTRA_INCLUDE_FILES "${METIS_INCLUDES}/metis.h")
set(CMAKE_EXTRA_INCLUDE_FILES "${METIS_INCLUDES}/${CMAKE_METIS_INCFILE}")
# 2. Check the size of Metis's own type: real_t
# This replaces checking 'float' and 'double' separately
ReleaseNews
+4
View File
@@ -1,4 +1,8 @@
WHAT'S NEW
Version 3.9.0-1
1. Fix licensing issues
2. Fix build and packaging
Version 3.9
1. PSBLAS3-EXT has been folded into the main library
2. Renamed GPU into CUDA.
base/CMakeLists.txt
+7
View File
@@ -281,6 +281,12 @@ set(PSB_base_source_files
serial/psb_dnumbmm.f90
serial/psb_damax_s.f90
serial/psb_zgeprt.f90
serial/impl/psb_i_base_vect_impl.F90
serial/impl/psb_l_base_vect_impl.F90
serial/impl/psb_c_base_vect_impl.F90
serial/impl/psb_z_base_vect_impl.F90
serial/impl/psb_s_base_vect_impl.F90
serial/impl/psb_d_base_vect_impl.F90
serial/impl/psb_c_coo_impl.F90
serial/impl/psb_d_coo_impl.F90
serial/impl/psb_d_csc_impl.F90
@@ -460,6 +466,7 @@ set(PSB_base_source_files
modules/comm/psb_d_comm_mod.f90
modules/comm/psi_e_comm_a_mod.f90
modules/comm/psb_c_comm_a_mod.f90
modules/comm/psi_i2_comm_a_mod.f90
modules/comm/psb_linmap_mod.f90
modules/comm/psb_z_comm_a_mod.f90
modules/comm/psi_c_comm_a_mod.f90
base/modules/psi_i2_mod.F90
+1 -1
View File
@@ -31,7 +31,7 @@
!
module psi_i2_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_, &
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_, &
& psb_lpk_, psb_i2pk_
use psi_m_comm_a_mod
use psi_e_comm_a_mod
base/modules/psi_i_mod.F90
+1 -1
View File
@@ -31,7 +31,7 @@
!
module psi_i_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_, &
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_, &
& psb_lpk_, psb_i2pk_
use psi_m_comm_a_mod
use psi_e_comm_a_mod
base/modules/psi_l_mod.F90
+1 -1
View File
@@ -31,7 +31,7 @@
!
module psi_l_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_, &
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_, &
& psb_lpk_, psb_i2pk_
use psi_m_comm_a_mod
use psi_e_comm_a_mod
base/modules/serial/psb_c_base_vect_mod.F90
+1149 -2568
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_c_vect_mod.F90
+12 -2
View File
@@ -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,22 @@ 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
+1191 -2694
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_d_vect_mod.F90
+13 -3
View File
@@ -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,22 @@ 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 +1440,7 @@ contains
if (allocated(x%v)) then
res = x%v%minreal(n)
else
res = dzero
res = HUGE(dzero)
end if
end function d_vect_min
base/modules/serial/psb_i2_base_vect_mod.F90
+736 -1598
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_i_base_vect_mod.F90
+736 -1598
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_l_base_vect_mod.F90
+736 -1598
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_s_base_vect_mod.F90
+1191 -2694
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_s_vect_mod.F90
+13 -3
View File
@@ -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,22 @@ 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 +1440,7 @@ contains
if (allocated(x%v)) then
res = x%v%minreal(n)
else
res = szero
res = HUGE(szero)
end if
end function s_vect_min
base/modules/serial/psb_z_base_vect_mod.F90
+1149 -2568
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_z_vect_mod.F90
+12 -2
View File
@@ -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,22 @@ 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
base/modules/tools/psb_c_tools_mod.F90
+11
View File
@@ -454,6 +454,17 @@ Module psb_c_tools_mod
end function
end interface
interface psb_setelem
subroutine psb_c_setelem(index,val,x,desc_a,info)
import
type(psb_c_vect_type), intent(inout) :: x
integer(psb_lpk_), intent(in) :: index
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) ::val
end subroutine psb_c_setelem
end interface
interface psb_remap
subroutine psb_c_remap(np_remap, desc_in, a_in, &
& ipd, isrc, nrsrc, naggr, desc_out, a_out, info)
base/modules/tools/psb_d_tools_mod.F90
+11
View File
@@ -454,6 +454,17 @@ Module psb_d_tools_mod
end function
end interface
interface psb_setelem
subroutine psb_d_setelem(index,val,x,desc_a,info)
import
type(psb_d_vect_type), intent(inout) :: x
integer(psb_lpk_), intent(in) :: index
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) ::val
end subroutine psb_d_setelem
end interface
interface psb_remap
subroutine psb_d_remap(np_remap, desc_in, a_in, &
& ipd, isrc, nrsrc, naggr, desc_out, a_out, info)
base/modules/tools/psb_s_tools_mod.F90
+11
View File
@@ -454,6 +454,17 @@ Module psb_s_tools_mod
end function
end interface
interface psb_setelem
subroutine psb_s_setelem(index,val,x,desc_a,info)
import
type(psb_s_vect_type), intent(inout) :: x
integer(psb_lpk_), intent(in) :: index
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) ::val
end subroutine psb_s_setelem
end interface
interface psb_remap
subroutine psb_s_remap(np_remap, desc_in, a_in, &
& ipd, isrc, nrsrc, naggr, desc_out, a_out, info)
base/modules/tools/psb_z_tools_mod.F90
+11
View File
@@ -454,6 +454,17 @@ Module psb_z_tools_mod
end function
end interface
interface psb_setelem
subroutine psb_z_setelem(index,val,x,desc_a,info)
import
type(psb_z_vect_type), intent(inout) :: x
integer(psb_lpk_), intent(in) :: index
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) ::val
end subroutine psb_z_setelem
end interface
interface psb_remap
subroutine psb_z_remap(np_remap, desc_in, a_in, &
& ipd, isrc, nrsrc, naggr, desc_out, a_out, info)
base/serial/impl/Makefile
+5 -1
View File
@@ -4,7 +4,11 @@ include ../../../Make.inc
# The object files
#
BOBJS=psb_base_mat_impl.o \
psb_s_base_mat_impl.o psb_d_base_mat_impl.o psb_c_base_mat_impl.o psb_z_base_mat_impl.o
psb_s_base_mat_impl.o psb_d_base_mat_impl.o psb_c_base_mat_impl.o psb_z_base_mat_impl.o \
psb_i_base_vect_impl.o psb_l_base_vect_impl.o \
psb_s_base_vect_impl.o psb_d_base_vect_impl.o \
psb_c_base_vect_impl.o psb_z_base_vect_impl.o
#\
psb_s_lbase_mat_impl.o psb_d_lbase_mat_impl.o psb_c_lbase_mat_impl.o psb_z_lbase_mat_impl.o
SOBJS=psb_s_csr_impl.o psb_s_coo_impl.o psb_s_csc_impl.o psb_s_mat_impl.o\
base/serial/impl/psb_c_base_vect_impl.F90
+3841
View File
File diff suppressed because it is too large Load Diff
base/serial/impl/psb_d_base_vect_impl.F90
+4018
View File
File diff suppressed because it is too large Load Diff
base/serial/impl/psb_i_base_vect_impl.F90
+2354
View File
File diff suppressed because it is too large Load Diff
base/serial/impl/psb_l_base_vect_impl.F90
+2354
View File
File diff suppressed because it is too large Load Diff
base/serial/impl/psb_s_base_vect_impl.F90
+4018
View File
File diff suppressed because it is too large Load Diff
base/serial/impl/psb_z_base_vect_impl.F90
+3841
View File
File diff suppressed because it is too large Load Diff
base/tools/Makefile
+2 -1
View File
@@ -28,7 +28,8 @@ FOBJS = psb_cdall.o psb_cdals.o psb_cdalv.o psb_cd_inloc.o psb_cdins.o psb_cdprt
psb_s_map.o psb_d_map.o psb_c_map.o psb_z_map.o \
psb_s_par_csr_spspmm.o psb_d_par_csr_spspmm.o psb_c_par_csr_spspmm.o psb_z_par_csr_spspmm.o \
psb_s_glob_transpose.o psb_d_glob_transpose.o psb_c_glob_transpose.o psb_z_glob_transpose.o \
psb_cgetelem.o psb_dgetelem.o psb_sgetelem.o psb_zgetelem.o
psb_cgetelem.o psb_dgetelem.o psb_sgetelem.o psb_zgetelem.o \
psb_csetelem.o psb_dsetelem.o psb_ssetelem.o psb_zsetelem.o
MPFOBJS = psb_icdasb.o psb_ssphalo.o psb_dsphalo.o psb_csphalo.o psb_zsphalo.o \
psb_dcdbldext.o psb_zcdbldext.o psb_scdbldext.o psb_ccdbldext.o \
base/tools/psb_csetelem.f90
+112
View File
@@ -0,0 +1,112 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
! Function: psb_c_setelem
! Set entries into a dense vector. Note: the row indices in index
! are assumed to be in global numbering and are converted on the fly.
! Row indices not belonging to the current process have to be in the halo,
! othewise failure is ensured.
!
! Arguments:
! x - type(psb_c_vect_type) The source vector
! desc_a - type(psb_desc_type). The communication descriptor.
! index - integer. Row index of x of the value to extract
! iam - integer. Index of the process requesting the value
! info - integer. return code
subroutine psb_c_setelem(index,val,x,desc_a,info)
use psb_base_mod, psb_protect_name => psb_c_setelem
use psi_mod
implicit none
type(psb_c_vect_type), intent(inout) :: x
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(in) :: index
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: val
!locals
integer(psb_ipk_) :: localindex(1)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act
integer(psb_lpk_) :: gindex(1)
integer(psb_lpk_), allocatable :: myidx(:),mylocal(:)
character(len=20) :: name
logical, parameter :: debug = .false.
info = 0
gindex(1) = index
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
name = 'psb_c_getelem'
if (.not.desc_a%is_ok()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
end if
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
call desc_a%indxmap%g2l(gindex,localindex,info,owned=.false.)
if(debug.and.(localindex(1) < 1)) then
write(*,*)"Process ",me," owns ",desc_a%get_local_rows()," rows"," Global index is ",gindex,"Local index is ",localindex
myidx = desc_a%get_global_indices(owned=.false.)
mylocal = desc_a%get_global_indices(owned=.true.)
write(*,*)"My (local+halo) indexes are: ",myidx
write(*,*)"My (local) indexes are: ",mylocal
end if
if ( localindex(1) < 1) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err="Index not in the HALO")
goto 9999
else
call x%set_entry(localindex(1),val)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ctxt,err_act)
return
end subroutine psb_c_setelem
base/tools/psb_dsetelem.f90
+112
View File
@@ -0,0 +1,112 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
! Function: psb_d_setelem
! Set entries into a dense vector. Note: the row indices in index
! are assumed to be in global numbering and are converted on the fly.
! Row indices not belonging to the current process have to be in the halo,
! othewise failure is ensured.
!
! Arguments:
! x - type(psb_d_vect_type) The source vector
! desc_a - type(psb_desc_type). The communication descriptor.
! index - integer. Row index of x of the value to extract
! iam - integer. Index of the process requesting the value
! info - integer. return code
subroutine psb_d_setelem(index,val,x,desc_a,info)
use psb_base_mod, psb_protect_name => psb_d_setelem
use psi_mod
implicit none
type(psb_d_vect_type), intent(inout) :: x
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(in) :: index
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: val
!locals
integer(psb_ipk_) :: localindex(1)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act
integer(psb_lpk_) :: gindex(1)
integer(psb_lpk_), allocatable :: myidx(:),mylocal(:)
character(len=20) :: name
logical, parameter :: debug = .false.
info = 0
gindex(1) = index
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
name = 'psb_d_getelem'
if (.not.desc_a%is_ok()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
end if
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
call desc_a%indxmap%g2l(gindex,localindex,info,owned=.false.)
if(debug.and.(localindex(1) < 1)) then
write(*,*)"Process ",me," owns ",desc_a%get_local_rows()," rows"," Global index is ",gindex,"Local index is ",localindex
myidx = desc_a%get_global_indices(owned=.false.)
mylocal = desc_a%get_global_indices(owned=.true.)
write(*,*)"My (local+halo) indexes are: ",myidx
write(*,*)"My (local) indexes are: ",mylocal
end if
if ( localindex(1) < 1) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err="Index not in the HALO")
goto 9999
else
call x%set_entry(localindex(1),val)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ctxt,err_act)
return
end subroutine psb_d_setelem
base/tools/psb_ssetelem.f90
+112
View File
@@ -0,0 +1,112 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
! Function: psb_s_setelem
! Set entries into a dense vector. Note: the row indices in index
! are assumed to be in global numbering and are converted on the fly.
! Row indices not belonging to the current process have to be in the halo,
! othewise failure is ensured.
!
! Arguments:
! x - type(psb_s_vect_type) The source vector
! desc_a - type(psb_desc_type). The communication descriptor.
! index - integer. Row index of x of the value to extract
! iam - integer. Index of the process requesting the value
! info - integer. return code
subroutine psb_s_setelem(index,val,x,desc_a,info)
use psb_base_mod, psb_protect_name => psb_s_setelem
use psi_mod
implicit none
type(psb_s_vect_type), intent(inout) :: x
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(in) :: index
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: val
!locals
integer(psb_ipk_) :: localindex(1)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act
integer(psb_lpk_) :: gindex(1)
integer(psb_lpk_), allocatable :: myidx(:),mylocal(:)
character(len=20) :: name
logical, parameter :: debug = .false.
info = 0
gindex(1) = index
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
name = 'psb_s_getelem'
if (.not.desc_a%is_ok()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
end if
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
call desc_a%indxmap%g2l(gindex,localindex,info,owned=.false.)
if(debug.and.(localindex(1) < 1)) then
write(*,*)"Process ",me," owns ",desc_a%get_local_rows()," rows"," Global index is ",gindex,"Local index is ",localindex
myidx = desc_a%get_global_indices(owned=.false.)
mylocal = desc_a%get_global_indices(owned=.true.)
write(*,*)"My (local+halo) indexes are: ",myidx
write(*,*)"My (local) indexes are: ",mylocal
end if
if ( localindex(1) < 1) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err="Index not in the HALO")
goto 9999
else
call x%set_entry(localindex(1),val)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ctxt,err_act)
return
end subroutine psb_s_setelem
base/tools/psb_zsetelem.f90
+112
View File
@@ -0,0 +1,112 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
! Function: psb_z_setelem
! Set entries into a dense vector. Note: the row indices in index
! are assumed to be in global numbering and are converted on the fly.
! Row indices not belonging to the current process have to be in the halo,
! othewise failure is ensured.
!
! Arguments:
! x - type(psb_z_vect_type) The source vector
! desc_a - type(psb_desc_type). The communication descriptor.
! index - integer. Row index of x of the value to extract
! iam - integer. Index of the process requesting the value
! info - integer. return code
subroutine psb_z_setelem(index,val,x,desc_a,info)
use psb_base_mod, psb_protect_name => psb_z_setelem
use psi_mod
implicit none
type(psb_z_vect_type), intent(inout) :: x
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(in) :: index
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: val
!locals
integer(psb_ipk_) :: localindex(1)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act
integer(psb_lpk_) :: gindex(1)
integer(psb_lpk_), allocatable :: myidx(:),mylocal(:)
character(len=20) :: name
logical, parameter :: debug = .false.
info = 0
gindex(1) = index
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
name = 'psb_z_getelem'
if (.not.desc_a%is_ok()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
end if
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
call desc_a%indxmap%g2l(gindex,localindex,info,owned=.false.)
if(debug.and.(localindex(1) < 1)) then
write(*,*)"Process ",me," owns ",desc_a%get_local_rows()," rows"," Global index is ",gindex,"Local index is ",localindex
myidx = desc_a%get_global_indices(owned=.false.)
mylocal = desc_a%get_global_indices(owned=.true.)
write(*,*)"My (local+halo) indexes are: ",myidx
write(*,*)"My (local) indexes are: ",mylocal
end if
if ( localindex(1) < 1) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err="Index not in the HALO")
goto 9999
else
call x%set_entry(localindex(1),val)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ctxt,err_act)
return
end subroutine psb_z_setelem
cbind/base/psb_base_cbind_mod.f90
+4
View File
@@ -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
+8 -2
View File
@@ -40,6 +40,8 @@ psb_i_t psb_c_cgefree(psb_c_cvector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_cgereinit(psb_c_cvector *xh, psb_c_descriptor *cdh, bool clear);
psb_c_t psb_c_cgetelem(psb_c_cvector *xh,psb_l_t index,psb_c_descriptor *cd);
psb_c_t psb_c_cmatgetelem(psb_c_cspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh);
psb_i_t psb_c_csetelem(psb_l_t index, psb_c_t val,
psb_c_cvector *xh, psb_c_descriptor *cd);
/* sparse matrices*/
psb_c_cspmat* psb_c_new_cspmat();
@@ -64,8 +66,12 @@ 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_scal_bound(psb_c_cvector *xh, psb_c_t val,
psb_i_t ifirst, psb_i_t ilast);
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_ccomm.h
+4 -2
View File
@@ -12,13 +12,15 @@ extern "C" {
psb_i_t psb_c_covrl(psb_c_cvector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_covrl_opt(psb_c_cvector *xh, psb_c_descriptor *cdh,
psb_i_t update, psb_i_t mode);
psb_i_t psb_c_cvscatter(psb_l_t ng, psb_c_t *gx, psb_c_cvector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_cvscatter(psb_l_t ng, psb_c_t *gx, psb_c_cvector *xh,
psb_c_descriptor *cdh);
psb_c_t* psb_c_cvgather(psb_c_cvector *xh, psb_c_descriptor *cdh);
psb_c_cspmat* psb_c_cspgather(psb_c_cspmat *ah, psb_c_descriptor *cdh);
psb_i_t psb_c_cvgather_f(psb_c_t* gv, psb_c_cvector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_cspgather_f(psb_c_cspmat* ga, psb_c_cspmat *ah, psb_c_descriptor *cdh);
psb_i_t psb_c_cspgather_f(psb_c_cspmat* ga, psb_c_cspmat *ah,
psb_c_descriptor *cdh);
#ifdef __cplusplus
cbind/base/psb_c_dbase.h
+10 -4
View File
@@ -23,7 +23,6 @@ psb_i_t psb_c_dvect_f_get_cpy(psb_d_t *v, psb_c_dvector *xh);
psb_i_t psb_c_dvect_zero(psb_c_dvector *xh);
psb_d_t *psb_c_dvect_f_get_pnt( psb_c_dvector *xh);
psb_i_t psb_c_dvect_clone(psb_c_dvector *xh,psb_c_dvector *yh);
psb_i_t psb_c_dgeall(psb_c_dvector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_dgeall_remote(psb_c_dvector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_dgeall_remote_options(psb_c_dvector *xh, psb_c_descriptor *cdh,
@@ -35,12 +34,15 @@ psb_i_t psb_c_dgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_d_t *val,
psb_i_t psb_c_dgeasb(psb_c_dvector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_dgeasb_options(psb_c_dvector *xh, psb_c_descriptor *cdh, psb_i_t dupl);
psb_i_t psb_c_dgeasb_options_format(psb_c_dvector *xh, psb_c_descriptor *cdh,
psb_i_t dupl, const char *fmt);
psb_i_t dupl, const char *fmt);
psb_i_t psb_c_dgefree(psb_c_dvector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_dgereinit(psb_c_dvector *xh, psb_c_descriptor *cdh, bool clear);
psb_d_t psb_c_dgetelem(psb_c_dvector *xh,psb_l_t index,psb_c_descriptor *cd);
psb_d_t psb_c_dmatgetelem(psb_c_dspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh);
psb_d_t psb_c_dmatgetelem(psb_c_dspmat *ah,psb_l_t rowindex,
psb_l_t colindex,psb_c_descriptor *cdh);
psb_d_t psb_c_dgetelem(psb_c_dvector *xh, psb_l_t index,psb_c_descriptor *cd);
psb_i_t psb_c_dsetelem(psb_l_t index, psb_d_t val,
psb_c_dvector *xh, psb_c_descriptor *cd);
/* sparse matrices*/
psb_c_dspmat* psb_c_new_dspmat();
@@ -66,7 +68,11 @@ psb_i_t psb_c_dspasb_opt(psb_c_dspmat *mh, psb_c_descriptor *cdh,
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_scal_bound(psb_c_dvector *xh, psb_d_t val,
psb_i_t ifirst, psb_i_t ilast);
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_sbase.h
+9 -3
View File
@@ -35,12 +35,14 @@ psb_i_t psb_c_sgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_s_t *val,
psb_i_t psb_c_sgeasb(psb_c_svector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_sgeasb_options(psb_c_svector *xh, psb_c_descriptor *cdh, psb_i_t dupl);
psb_i_t psb_c_sgeasb_options_format(psb_c_svector *xh, psb_c_descriptor *cdh,
const char *fmt, psb_i_t dupl);
const char *fmt, psb_i_t dupl);
psb_i_t psb_c_sgefree(psb_c_svector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_sgereinit(psb_c_svector *xh, psb_c_descriptor *cdh, bool clear);
psb_s_t psb_c_sgetelem(psb_c_svector *xh,psb_l_t index,psb_c_descriptor *cd);
psb_s_t psb_c_smatgetelem(psb_c_sspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh);
psb_s_t psb_c_smatgetelem(psb_c_sspmat *ah,psb_l_t rowindex,
psb_l_t colindex,psb_c_descriptor *cdh);
psb_i_t psb_c_ssetelem(psb_l_t index, psb_s_t val,
psb_c_svector *xh, psb_c_descriptor *cd);
/* sparse matrices*/
psb_c_sspmat* psb_c_new_sspmat();
@@ -66,7 +68,11 @@ psb_i_t psb_c_scopy_mat(psb_c_sspmat *ah,psb_c_sspmat *bh,psb_c_descriptor *cd
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_scal_bound(psb_c_svector *xh, psb_s_t val,
psb_i_t ifirst, psb_i_t ilast);
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
+68
View File
@@ -176,6 +176,30 @@ contains
end function psb_c_cvect_set_scal
function psb_c_cvect_set_scal_bound(x,val,ifirst,ilast) 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 :: ifirst, ilast
complex(c_float_complex) :: val
info = -1;
if (c_associated(x%item)) then
call c_f_pointer(x%item,xp)
else
return
end if
call xp%set(val,first=ifirst,last=ilast)
info = 0
end function psb_c_cvect_set_scal_bound
function psb_c_cvect_set_vect(x,val,n) bind(c) result(info)
use psb_base_mod
implicit none
@@ -200,6 +224,50 @@ 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
+36 -1
View File
@@ -659,6 +659,42 @@ contains
end function psb_c_cgetelem
function psb_c_csetelem(index,val,xh,cdh) bind(c) result(res)
implicit none
type(psb_c_cvector) :: xh
integer(psb_c_lpk_), value :: index
type(psb_c_descriptor) :: cdh
complex(c_float_complex), value :: val
integer(psb_c_ipk_) :: res
type(psb_c_vect_type), pointer :: xp
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_setelem(index,val,xp,descp,info)
else
call psb_setelem(index+(1-ixb),val,xp,descp,info)
end if
res=info
return
end function psb_c_csetelem
function psb_c_cmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
implicit none
@@ -666,7 +702,6 @@ contains
integer(psb_c_lpk_), value :: rowindex, colindex
type(psb_c_descriptor) :: cdh
complex(c_float_complex) :: res
type(psb_cspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
cbind/base/psb_c_zbase.h
+8 -2
View File
@@ -39,8 +39,10 @@ psb_i_t psb_c_zgeasb_options_format(psb_c_zvector *xh, psb_c_descriptor *cdh,
psb_i_t psb_c_zgefree(psb_c_zvector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_zgereinit(psb_c_zvector *xh, psb_c_descriptor *cdh, bool clear);
psb_z_t psb_c_zgetelem(psb_c_zvector *xh,psb_l_t index,psb_c_descriptor *cd);
psb_z_t psb_c_zmatgetelem(psb_c_zspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh);
psb_z_t psb_c_zmatgetelem(psb_c_zspmat *ah,psb_l_t rowindex,
psb_l_t colindex,psb_c_descriptor *cdh);
psb_i_t psb_c_zsetelem(psb_l_t index, psb_z_t val,
psb_c_zvector *xh, psb_c_descriptor *cd);
/* sparse matrices*/
psb_c_zspmat* psb_c_new_zspmat();
@@ -67,7 +69,11 @@ psb_i_t psb_c_zspasb_opt(psb_c_zspmat *mh, psb_c_descriptor *cdh,
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_scal_bound(psb_c_zvector *xh, psb_z_t val,
psb_i_t ifirst, psb_i_t ilast);
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_serial_cbind_mod.F90
+68
View File
@@ -176,6 +176,30 @@ contains
end function psb_c_dvect_set_scal
function psb_c_dvect_set_scal_bound(x,val,ifirst,ilast) 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 :: ifirst, ilast
real(c_double) :: val
info = -1;
if (c_associated(x%item)) then
call c_f_pointer(x%item,xp)
else
return
end if
call xp%set(val,first=ifirst,last=ilast)
info = 0
end function psb_c_dvect_set_scal_bound
function psb_c_dvect_set_vect(x,val,n) bind(c) result(info)
use psb_base_mod
implicit none
@@ -200,6 +224,50 @@ 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
+36 -1
View File
@@ -669,6 +669,42 @@ contains
end function psb_c_dgetelem
function psb_c_dsetelem(index,val,xh,cdh) bind(c) result(res)
implicit none
type(psb_c_dvector) :: xh
integer(psb_c_lpk_), value :: index
type(psb_c_descriptor) :: cdh
real(c_double), value :: val
integer(psb_c_ipk_) :: res
type(psb_d_vect_type), pointer :: xp
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_setelem(index,val,xp,descp,info)
else
call psb_setelem(index+(1-ixb),val,xp,descp,info)
end if
res=info
return
end function psb_c_dsetelem
function psb_c_dmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
implicit none
@@ -676,7 +712,6 @@ contains
integer(psb_c_lpk_), value :: rowindex, colindex
type(psb_c_descriptor) :: cdh
real(c_double) :: res
type(psb_dspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
cbind/base/psb_s_serial_cbind_mod.F90
+68
View File
@@ -176,6 +176,30 @@ contains
end function psb_c_svect_set_scal
function psb_c_svect_set_scal_bound(x,val,ifirst,ilast) 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 :: ifirst, ilast
real(c_float) :: val
info = -1;
if (c_associated(x%item)) then
call c_f_pointer(x%item,xp)
else
return
end if
call xp%set(val,first=ifirst,last=ilast)
info = 0
end function psb_c_svect_set_scal_bound
function psb_c_svect_set_vect(x,val,n) bind(c) result(info)
use psb_base_mod
implicit none
@@ -200,6 +224,50 @@ 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
+36 -1
View File
@@ -669,6 +669,42 @@ contains
end function psb_c_sgetelem
function psb_c_ssetelem(index,val,xh,cdh) bind(c) result(res)
implicit none
type(psb_c_svector) :: xh
integer(psb_c_lpk_), value :: index
type(psb_c_descriptor) :: cdh
real(c_float), value :: val
integer(psb_c_ipk_) :: res
type(psb_s_vect_type), pointer :: xp
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_setelem(index,val,xp,descp,info)
else
call psb_setelem(index+(1-ixb),val,xp,descp,info)
end if
res=info
return
end function psb_c_ssetelem
function psb_c_smatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
implicit none
@@ -676,7 +712,6 @@ contains
integer(psb_c_lpk_), value :: rowindex, colindex
type(psb_c_descriptor) :: cdh
real(c_float) :: res
type(psb_sspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
cbind/base/psb_z_serial_cbind_mod.F90
+68
View File
@@ -176,6 +176,30 @@ contains
end function psb_c_zvect_set_scal
function psb_c_zvect_set_scal_bound(x,val,ifirst,ilast) 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 :: ifirst, ilast
complex(c_double_complex) :: val
info = -1;
if (c_associated(x%item)) then
call c_f_pointer(x%item,xp)
else
return
end if
call xp%set(val,first=ifirst,last=ilast)
info = 0
end function psb_c_zvect_set_scal_bound
function psb_c_zvect_set_vect(x,val,n) bind(c) result(info)
use psb_base_mod
implicit none
@@ -200,6 +224,50 @@ 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
+36 -1
View File
@@ -659,6 +659,42 @@ contains
end function psb_c_zgetelem
function psb_c_zsetelem(index,val,xh,cdh) bind(c) result(res)
implicit none
type(psb_c_zvector) :: xh
integer(psb_c_lpk_), value :: index
type(psb_c_descriptor) :: cdh
complex(c_double_complex), value :: val
integer(psb_c_ipk_) :: res
type(psb_z_vect_type), pointer :: xp
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_setelem(index,val,xp,descp,info)
else
call psb_setelem(index+(1-ixb),val,xp,descp,info)
end if
res=info
return
end function psb_c_zsetelem
function psb_c_zmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
implicit none
@@ -666,7 +702,6 @@ contains
integer(psb_c_lpk_), value :: rowindex, colindex
type(psb_c_descriptor) :: cdh
complex(c_double_complex) :: res
type(psb_zspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
cbind/linsolve/psb_linsolve_cbind.h
+1 -1
View File
@@ -26,7 +26,7 @@ typedef struct psb_c_solveroptions {
int psb_c_DefaultSolverOptions(psb_c_SolverOptions *opt);
int psb_c_PrintSolverOptions(psb_c_SolverOptions *opt);
int psb_c_skrylov(const char *method, psb_c_sspmat *ah, psb_c_sprec *ph,
psb_c_svector *bh, psb_c_svector *xh,
psb_c_descriptor *cdh, psb_c_SolverOptions *opt);
configure
Vendored
+5 -136
View File
@@ -4282,10 +4282,7 @@ _ACEOF
break
fi
done
# aligned with autoconf, so not including core; see bug#72225.
rm -f -r a.out a.exe b.out conftest.$ac_ext conftest.$ac_objext \
conftest.dSYM conftest1.$ac_ext conftest1.$ac_objext conftest1.dSYM \
conftest2.$ac_ext conftest2.$ac_objext conftest2.dSYM
rm -f core conftest*
unset am_i ;;
esac
fi
@@ -5935,7 +5932,7 @@ else
fi
am__api_version='1.18'
am__api_version='1.17'
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether sleep supports fractional seconds" >&5
printf %s "checking whether sleep supports fractional seconds... " >&6; }
@@ -6104,14 +6101,10 @@ am_lf='
'
case `pwd` in
*[\\\"\#\$\&\'\`$am_lf]*)
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
as_fn_error $? "unsafe absolute working directory name" "$LINENO" 5;;
esac
case $srcdir in
*[\\\"\#\$\&\'\`$am_lf\ \ ]*)
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
as_fn_error $? "unsafe srcdir value: '$srcdir'" "$LINENO" 5;;
esac
@@ -6636,133 +6629,9 @@ AMTAR='$${TAR-tar}'
# We'll loop over all known methods to create a tar archive until one works.
_am_tools='gnutar plaintar pax cpio none'
_am_tools='gnutar pax cpio none'
# The POSIX 1988 'ustar' format is defined with fixed-size fields.
# There is notably a 21 bits limit for the UID and the GID. In fact,
# the 'pax' utility can hang on bigger UID/GID (see automake bug#8343
# and bug#13588).
am_max_uid=2097151 # 2^21 - 1
am_max_gid=$am_max_uid
# The $UID and $GID variables are not portable, so we need to resort
# to the POSIX-mandated id(1) utility. Errors in the 'id' calls
# below are definitely unexpected, so allow the users to see them
# (that is, avoid stderr redirection).
am_uid=`id -u || echo unknown`
am_gid=`id -g || echo unknown`
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether UID '$am_uid' is supported by ustar format" >&5
printf %s "checking whether UID '$am_uid' is supported by ustar format... " >&6; }
if test x$am_uid = xunknown; then
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: ancient id detected; assuming current UID is ok, but dist-ustar might not work" >&5
printf "%s\n" "$as_me: WARNING: ancient id detected; assuming current UID is ok, but dist-ustar might not work" >&2;}
elif test $am_uid -le $am_max_uid; then
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
else
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
_am_tools=none
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether GID '$am_gid' is supported by ustar format" >&5
printf %s "checking whether GID '$am_gid' is supported by ustar format... " >&6; }
if test x$gm_gid = xunknown; then
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: ancient id detected; assuming current GID is ok, but dist-ustar might not work" >&5
printf "%s\n" "$as_me: WARNING: ancient id detected; assuming current GID is ok, but dist-ustar might not work" >&2;}
elif test $am_gid -le $am_max_gid; then
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
else
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
_am_tools=none
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to create a ustar tar archive" >&5
printf %s "checking how to create a ustar tar archive... " >&6; }
# Go ahead even if we have the value already cached. We do so because we
# need to set the values for the 'am__tar' and 'am__untar' variables.
_am_tools=${am_cv_prog_tar_ustar-$_am_tools}
for _am_tool in $_am_tools; do
case $_am_tool in
gnutar)
for _am_tar in tar gnutar gtar; do
{ echo "$as_me:$LINENO: $_am_tar --version" >&5
($_am_tar --version) >&5 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && break
done
am__tar="$_am_tar --format=ustar -chf - "'"$$tardir"'
am__tar_="$_am_tar --format=ustar -chf - "'"$tardir"'
am__untar="$_am_tar -xf -"
;;
plaintar)
# Must skip GNU tar: if it does not support --format= it doesn't create
# ustar tarball either.
(tar --version) >/dev/null 2>&1 && continue
am__tar='tar chf - "$$tardir"'
am__tar_='tar chf - "$tardir"'
am__untar='tar xf -'
;;
pax)
am__tar='pax -L -x ustar -w "$$tardir"'
am__tar_='pax -L -x ustar -w "$tardir"'
am__untar='pax -r'
;;
cpio)
am__tar='find "$$tardir" -print | cpio -o -H ustar -L'
am__tar_='find "$tardir" -print | cpio -o -H ustar -L'
am__untar='cpio -i -H ustar -d'
;;
none)
am__tar=false
am__tar_=false
am__untar=false
;;
esac
# If the value was cached, stop now. We just wanted to have am__tar
# and am__untar set.
test -n "${am_cv_prog_tar_ustar}" && break
# tar/untar a dummy directory, and stop if the command works.
rm -rf conftest.dir
mkdir conftest.dir
echo GrepMe > conftest.dir/file
{ echo "$as_me:$LINENO: tardir=conftest.dir && eval $am__tar_ >conftest.tar" >&5
(tardir=conftest.dir && eval $am__tar_ >conftest.tar) >&5 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }
rm -rf conftest.dir
if test -s conftest.tar; then
{ echo "$as_me:$LINENO: $am__untar <conftest.tar" >&5
($am__untar <conftest.tar) >&5 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }
{ echo "$as_me:$LINENO: cat conftest.dir/file" >&5
(cat conftest.dir/file) >&5 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }
grep GrepMe conftest.dir/file >/dev/null 2>&1 && break
fi
done
rm -rf conftest.dir
if test ${am_cv_prog_tar_ustar+y}
then :
printf %s "(cached) " >&6
else case e in #(
e) am_cv_prog_tar_ustar=$_am_tool ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $am_cv_prog_tar_ustar" >&5
printf "%s\n" "$am_cv_prog_tar_ustar" >&6; }
am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -'
@@ -9122,6 +8991,7 @@ else
AR="$ac_cv_prog_AR"
fi
AR="${AR} -cr"
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
set dummy ${ac_tool_prefix}ranlib; ac_word=$2
@@ -9226,7 +9096,6 @@ else
RANLIB="$ac_cv_prog_RANLIB"
fi
AR="$AR -cr"
###############################################################################
# BLAS library presence checks
cuda/License-spgpu
+26 -26
View File
@@ -1,26 +1,26 @@
(C) Copyright 2011-2026 Davide Barbieri
(C) Copyright 2011-2026 Salvatore Filippone
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions, and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the of the copyright holder nor the names of its contributors
may be used to endorse or promote products derived from this
software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
(C) Copyright 2011-2026 Davide Barbieri
(C) Copyright 2011-2026 Salvatore Filippone
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions, and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the of the copyright holder nor the names of its contributors
may be used to endorse or promote products derived from this
software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.