diff --git a/Makefile b/Makefile index d3c36e25..01d79f13 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ include Make.inc - + all: dirs mods objs libd @echo "=====================================" @echo "PSBLAS libraries Compilation Successful." diff --git a/base/tools/Makefile b/base/tools/Makefile index 771e85fc..c5945e19 100644 --- a/base/tools/Makefile +++ b/base/tools/Makefile @@ -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 \ diff --git a/base/tools/psb_csetelem.f90 b/base/tools/psb_csetelem.f90 new file mode 100644 index 00000000..f186ef1f --- /dev/null +++ b/base/tools/psb_csetelem.f90 @@ -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 + diff --git a/base/tools/psb_dsetelem.f90 b/base/tools/psb_dsetelem.f90 new file mode 100644 index 00000000..3c99e657 --- /dev/null +++ b/base/tools/psb_dsetelem.f90 @@ -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 + diff --git a/base/tools/psb_ssetelem.f90 b/base/tools/psb_ssetelem.f90 new file mode 100644 index 00000000..99247c77 --- /dev/null +++ b/base/tools/psb_ssetelem.f90 @@ -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 + diff --git a/base/tools/psb_zsetelem.f90 b/base/tools/psb_zsetelem.f90 new file mode 100644 index 00000000..abf25dc5 --- /dev/null +++ b/base/tools/psb_zsetelem.f90 @@ -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 + diff --git a/cbind/base/psb_base_cbind_mod.f90 b/cbind/base/psb_base_cbind_mod.f90 index 036e662a..67d97aad 100644 --- a/cbind/base/psb_base_cbind_mod.f90 +++ b/cbind/base/psb_base_cbind_mod.f90 @@ -1,6 +1,10 @@ module psb_base_cbind_mod use psb_objhandle_mod use psb_cpenv_mod + use psb_s_serial_cbind_mod + use psb_d_serial_cbind_mod + use psb_c_serial_cbind_mod + use psb_z_serial_cbind_mod use psb_base_tools_cbind_mod use psb_s_tools_cbind_mod use psb_d_tools_cbind_mod diff --git a/cbind/base/psb_c_cbase.h b/cbind/base/psb_c_cbase.h index bff9633a..8fbd7f6b 100644 --- a/cbind/base/psb_c_cbase.h +++ b/cbind/base/psb_c_cbase.h @@ -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); diff --git a/cbind/base/psb_c_dbase.h b/cbind/base/psb_c_dbase.h index 591f885b..125139a4 100644 --- a/cbind/base/psb_c_dbase.h +++ b/cbind/base/psb_c_dbase.h @@ -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); diff --git a/cbind/base/psb_c_sbase.h b/cbind/base/psb_c_sbase.h index 68abefdd..c006d227 100644 --- a/cbind/base/psb_c_sbase.h +++ b/cbind/base/psb_c_sbase.h @@ -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); diff --git a/cbind/base/psb_c_zbase.h b/cbind/base/psb_c_zbase.h index 9a27e9c0..afbb7cb3 100644 --- a/cbind/base/psb_c_zbase.h +++ b/cbind/base/psb_c_zbase.h @@ -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); diff --git a/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 b/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 index a00a68bf..db9f9d35 100644 --- a/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 @@ -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 diff --git a/cbind/linsolve/psb_linsolve_cbind.h b/cbind/linsolve/psb_linsolve_cbind.h index 6dd7aa3c..d86bf216 100644 --- a/cbind/linsolve/psb_linsolve_cbind.h +++ b/cbind/linsolve/psb_linsolve_cbind.h @@ -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,