From 4aea0d40e8b2c11557622c99e392835b61af67c3 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Wed, 17 Jun 2026 10:09:40 +0200 Subject: [PATCH] Fix setelem definition and impl. --- base/modules/tools/psb_c_tools_mod.F90 | 11 +++ base/modules/tools/psb_d_tools_mod.F90 | 11 +++ base/modules/tools/psb_s_tools_mod.F90 | 11 +++ base/modules/tools/psb_z_tools_mod.F90 | 11 +++ base/tools/Makefile | 3 +- base/tools/psb_csetelem.f90 | 112 +++++++++++++++++++++++++ base/tools/psb_dsetelem.f90 | 112 +++++++++++++++++++++++++ base/tools/psb_ssetelem.f90 | 112 +++++++++++++++++++++++++ base/tools/psb_zsetelem.f90 | 112 +++++++++++++++++++++++++ cbind/base/psb_c_tools_cbind_mod.F90 | 2 +- cbind/base/psb_d_tools_cbind_mod.F90 | 2 +- cbind/base/psb_s_tools_cbind_mod.F90 | 2 +- cbind/base/psb_z_tools_cbind_mod.F90 | 2 +- 13 files changed, 498 insertions(+), 5 deletions(-) create mode 100644 base/tools/psb_csetelem.f90 create mode 100644 base/tools/psb_dsetelem.f90 create mode 100644 base/tools/psb_ssetelem.f90 create mode 100644 base/tools/psb_zsetelem.f90 diff --git a/base/modules/tools/psb_c_tools_mod.F90 b/base/modules/tools/psb_c_tools_mod.F90 index 148ddf59f..bb99662cc 100644 --- a/base/modules/tools/psb_c_tools_mod.F90 +++ b/base/modules/tools/psb_c_tools_mod.F90 @@ -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) diff --git a/base/modules/tools/psb_d_tools_mod.F90 b/base/modules/tools/psb_d_tools_mod.F90 index 97f70fc13..9b289aad4 100644 --- a/base/modules/tools/psb_d_tools_mod.F90 +++ b/base/modules/tools/psb_d_tools_mod.F90 @@ -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) diff --git a/base/modules/tools/psb_s_tools_mod.F90 b/base/modules/tools/psb_s_tools_mod.F90 index c87607bc9..40bf34186 100644 --- a/base/modules/tools/psb_s_tools_mod.F90 +++ b/base/modules/tools/psb_s_tools_mod.F90 @@ -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) diff --git a/base/modules/tools/psb_z_tools_mod.F90 b/base/modules/tools/psb_z_tools_mod.F90 index 8a6c2d34c..3ecf759a6 100644 --- a/base/modules/tools/psb_z_tools_mod.F90 +++ b/base/modules/tools/psb_z_tools_mod.F90 @@ -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) diff --git a/base/tools/Makefile b/base/tools/Makefile index 1cd67af5b..3d8fce37a 100644 --- a/base/tools/Makefile +++ b/base/tools/Makefile @@ -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 \ diff --git a/base/tools/psb_csetelem.f90 b/base/tools/psb_csetelem.f90 new file mode 100644 index 000000000..f186ef1f8 --- /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 000000000..3c99e6572 --- /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 000000000..99247c778 --- /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 000000000..abf25dc56 --- /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_c_tools_cbind_mod.F90 b/cbind/base/psb_c_tools_cbind_mod.F90 index d796ffab2..6e2332f6e 100644 --- a/cbind/base/psb_c_tools_cbind_mod.F90 +++ b/cbind/base/psb_c_tools_cbind_mod.F90 @@ -692,7 +692,7 @@ contains ixb = psb_c_get_index_base() if (ixb == 1) then - call psb_setelem(index,val,xp,descp,info) + call psb_setelem(index,val,xp,descp,info) else call psb_setelem(index+(1-ixb),val,xp,descp,info) end if diff --git a/cbind/base/psb_d_tools_cbind_mod.F90 b/cbind/base/psb_d_tools_cbind_mod.F90 index 56acfe0c3..97d82ec8c 100644 --- a/cbind/base/psb_d_tools_cbind_mod.F90 +++ b/cbind/base/psb_d_tools_cbind_mod.F90 @@ -702,7 +702,7 @@ contains ixb = psb_c_get_index_base() if (ixb == 1) then - call psb_setelem(index,val,xp,descp,info) + call psb_setelem(index,val,xp,descp,info) else call psb_setelem(index+(1-ixb),val,xp,descp,info) end if diff --git a/cbind/base/psb_s_tools_cbind_mod.F90 b/cbind/base/psb_s_tools_cbind_mod.F90 index b36b878ea..53f161cb7 100644 --- a/cbind/base/psb_s_tools_cbind_mod.F90 +++ b/cbind/base/psb_s_tools_cbind_mod.F90 @@ -702,7 +702,7 @@ contains ixb = psb_c_get_index_base() if (ixb == 1) then - call psb_setelem(index,val,xp,descp,info) + call psb_setelem(index,val,xp,descp,info) else call psb_setelem(index+(1-ixb),val,xp,descp,info) end if diff --git a/cbind/base/psb_z_tools_cbind_mod.F90 b/cbind/base/psb_z_tools_cbind_mod.F90 index 12d20d76d..00ac22f49 100644 --- a/cbind/base/psb_z_tools_cbind_mod.F90 +++ b/cbind/base/psb_z_tools_cbind_mod.F90 @@ -692,7 +692,7 @@ contains ixb = psb_c_get_index_base() if (ixb == 1) then - call psb_setelem(index,val,xp,descp,info) + call psb_setelem(index,val,xp,descp,info) else call psb_setelem(index+(1-ixb),val,xp,descp,info) end if