mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-18 11:52:11 +00:00
Merge branch 'maint-3.9.0' of github.com:sfilippone/psblas3 into maint-3.9.0
This commit is contained in:
sfilippone
@@ -1,5 +1,5 @@
|
||||
include Make.inc
|
||||
|
||||
|
||||
all: dirs mods objs libd
|
||||
@echo "====================================="
|
||||
@echo "PSBLAS libraries Compilation Successful."
|
||||
|
||||
+2
-1
@@ -27,7 +27,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 \
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -32,6 +32,8 @@ psb_i_t psb_c_cgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_c_t *val,
|
||||
psb_i_t psb_c_cgeasb(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgefree(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_c_t psb_c_cgetelem(psb_c_cvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
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();
|
||||
@@ -56,8 +58,12 @@ psb_i_t psb_c_ccopy_mat(psb_c_cspmat *ah,psb_c_cspmat *bh,psb_c_descriptor *cd
|
||||
/* 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);
|
||||
|
||||
@@ -22,7 +22,7 @@ psb_d_t *psb_c_dvect_get_cpy( psb_c_dvector *xh);
|
||||
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_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_dgeins(psb_i_t nz, const psb_l_t *irw, const psb_d_t *val,
|
||||
@@ -31,7 +31,9 @@ psb_i_t psb_c_dgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_d_t *val,
|
||||
psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeasb(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgefree(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgetelem(psb_c_dvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
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();
|
||||
@@ -57,7 +59,11 @@ psb_i_t psb_c_dcopy_mat(psb_c_dspmat *ah,psb_c_dspmat *bh,psb_c_descriptor *cd
|
||||
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);
|
||||
|
||||
@@ -32,6 +32,8 @@ 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_sgefree(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgetelem(psb_c_svector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
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();
|
||||
@@ -57,7 +59,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);
|
||||
|
||||
@@ -32,6 +32,8 @@ psb_i_t psb_c_zgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_z_t *val,
|
||||
psb_i_t psb_c_zgeasb(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgefree(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_z_t psb_c_zgetelem(psb_c_zvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
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();
|
||||
@@ -58,7 +60,11 @@ psb_i_t psb_c_zcopy_mat(psb_c_zspmat *ah,psb_c_zspmat *bh,psb_c_descriptor *cd
|
||||
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);
|
||||
|
||||
@@ -15,7 +15,6 @@ contains
|
||||
implicit none
|
||||
type(solveroptions) :: options
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
options%itmax = 1000
|
||||
options%itrace = 0
|
||||
options%istop = 2
|
||||
@@ -24,6 +23,21 @@ contains
|
||||
|
||||
res = 0
|
||||
end function psb_c_DefaultSolverOptions
|
||||
|
||||
function psb_c_PrintSolverOptions(options)&
|
||||
& bind(c,name='psb_c_PrintSolverOptions') result(res)
|
||||
implicit none
|
||||
type(solveroptions) :: options
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
write(*,*) 'PSBLAS C Interface Solver Options '
|
||||
write(*,*) ' Maximum number of iterations :', options%itmax
|
||||
write(*,*) ' Tracing :', options%itrace
|
||||
write(*,*) ' Stopping Criterion :', options%istop
|
||||
write(*,*) ' Restart :', options%irst
|
||||
write(*,*) ' EPS (tolerance) :', options%eps
|
||||
res = 0
|
||||
end function psb_c_PrintSolverOptions
|
||||
|
||||
|
||||
end module psb_base_linsolve_cbind_mod
|
||||
|
||||
@@ -25,6 +25,7 @@ typedef struct psb_c_solveroptions {
|
||||
} 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,
|
||||
|
||||
Reference in New Issue
Block a user