From 70b5fb2f0083d3b13898fa37a61c21db61e85767 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 1 Oct 2013 15:58:28 +0000 Subject: [PATCH] psblas-3.99: base/internals/Makefile base/internals/psi_fnd_owner.F90 base/internals/psi_idx_cnv.f90 base/internals/psi_idx_ins_cnv.f90 base/modules/psi_i_mod.f90 base/tools/psb_ccdbldext.F90 base/tools/psb_cins.f90 base/tools/psb_dcdbldext.F90 base/tools/psb_dins.f90 base/tools/psb_glob_to_loc.f90 base/tools/psb_iins.f90 base/tools/psb_scdbldext.F90 base/tools/psb_sins.f90 base/tools/psb_zcdbldext.F90 base/tools/psb_zins.f90 Take out idx_cnv. --- base/internals/Makefile | 2 +- base/internals/psi_fnd_owner.F90 | 2 +- base/internals/psi_idx_cnv.f90 | 355 ------------------------ base/internals/psi_idx_ins_cnv.f90 | 419 ----------------------------- base/modules/psi_i_mod.f90 | 76 ------ base/tools/psb_ccdbldext.F90 | 6 +- base/tools/psb_cins.f90 | 26 +- base/tools/psb_dcdbldext.F90 | 6 +- base/tools/psb_dins.f90 | 26 +- base/tools/psb_glob_to_loc.f90 | 46 ++-- base/tools/psb_iins.f90 | 26 +- base/tools/psb_scdbldext.F90 | 6 +- base/tools/psb_sins.f90 | 26 +- base/tools/psb_zcdbldext.F90 | 6 +- base/tools/psb_zins.f90 | 26 +- 15 files changed, 81 insertions(+), 973 deletions(-) delete mode 100644 base/internals/psi_idx_cnv.f90 delete mode 100644 base/internals/psi_idx_ins_cnv.f90 diff --git a/base/internals/Makefile b/base/internals/Makefile index 073e9315..2d3729bc 100644 --- a/base/internals/Makefile +++ b/base/internals/Makefile @@ -4,7 +4,7 @@ FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \ psi_crea_ovr_elem.o psi_bld_tmpovrl.o psi_dl_check.o \ psi_sort_dl.o \ psi_ldsc_pre_halo.o psi_bld_tmphalo.o\ - psi_sort_dl.o psi_idx_cnv.o psi_idx_ins_cnv.o \ + psi_sort_dl.o \ psi_desc_impl.o psi_ovrl_restr.o psi_ovrl_save.o psi_ovrl_upd.o FOBJS2 = psi_exist_ovr_elem.o psi_list_search.o srtlist.o diff --git a/base/internals/psi_fnd_owner.F90 b/base/internals/psi_fnd_owner.F90 index f1f2c9bf..a133650e 100644 --- a/base/internals/psi_fnd_owner.F90 +++ b/base/internals/psi_fnd_owner.F90 @@ -104,7 +104,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info) goto 9999 endif - if (.not.(psb_is_ok_desc(desc))) then + if (.not.(desc%is_ok())) then call psb_errpush(psb_err_from_subroutine_,name,a_err='invalid desc') goto 9999 end if diff --git a/base/internals/psi_idx_cnv.f90 b/base/internals/psi_idx_cnv.f90 deleted file mode 100644 index e89fcd5f..00000000 --- a/base/internals/psi_idx_cnv.f90 +++ /dev/null @@ -1,355 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS version 3.1 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ 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 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. -!!$ -!!$ -! -! File: psi_idx_cnv.f90 -! -! Subroutine: psi_idx_cnv1 -! Converts a bunch of indices from global to local numbering. -! -! -! Arguments: -! nv - integer Number of indices required -! idxin(:) - integer Required indices, overwritten on output. -! desc - type(psb_desc_type). The communication descriptor. -! info - integer. return code. -! mask(:) - logical, optional Only do the conversion for specific indices. -! owned - logical,optional Restrict to local indices, no halo -! (default false) -subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned) - use psb_desc_mod - use psb_serial_mod - use psb_const_mod - use psb_error_mod - use psb_penv_mod - use psi_mod, psb_protect_name => psi_idx_cnv1 - implicit none - integer(psb_ipk_), intent(in) :: nv - integer(psb_ipk_), intent(inout) :: idxin(:) - type(psb_desc_type), intent(in) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned - integer(psb_ipk_) :: ictxt,mglob, nglob,ip,lip,i - integer(psb_ipk_) :: np, me - integer(psb_ipk_) :: nrow,ncol, err_act - integer(psb_ipk_), allocatable :: itmp(:) - integer(psb_ipk_), parameter :: relocsz=200 - character(len=20) :: name - logical :: owned_ - - info = psb_success_ - name = 'psb_idx_cnv' - call psb_erractionsave(err_act) - - ictxt = desc%get_context() - mglob = desc%get_global_rows() - nglob = desc%get_global_cols() - nrow = desc%get_local_rows() - ncol = desc%get_local_cols() - - call psb_info(ictxt, me, np) - - if (.not.allocated(desc%indxmap))then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif - if (.not.psb_is_valid_desc(desc)) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif - - if (nv < 0) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - if (nv == 0) return - - - if (size(idxin) < nv) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - - - if (present(mask)) then - if (size(mask) < nv) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - endif - - call desc%indxmap%g2lip(idxin(1:nv),info,mask=mask,owned=owned) - - if (info /= 0) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='g2l') - goto 9999 - end if - - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_ret_) then - return - else - call psb_error(ictxt) - end if - return - -end subroutine psi_idx_cnv1 -!!$ -!!$ Parallel Sparse BLAS version 3.1 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ 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 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. -!!$ -!!$ -! -! -! Subroutine: psi_idx_cnv2 -! Converts a bunch of indices from global to local numbering. -! -! -! Arguments: -! nv - integer Number of indices required -! idxin(:) - integer Required indices -! idxout(:) - integer Output values, negative for invalid input. -! desc - type(psb_desc_type). The communication descriptor. -! info - integer. return code. -! mask(:) - logical, optional Only do the conversion for specific indices. -! owned - logical,optional Restrict to local indices, no halo -! (default false) -subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned) - use psb_desc_mod - use psb_serial_mod - use psb_const_mod - use psb_error_mod - use psb_penv_mod - use psi_mod, psb_protect_name => psi_idx_cnv2 - implicit none - integer(psb_ipk_), intent(in) :: nv, idxin(:) - integer(psb_ipk_), intent(out) :: idxout(:) - type(psb_desc_type), intent(in) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned - integer(psb_ipk_) :: i,ictxt,mglob, nglob - integer(psb_ipk_) :: np, me - integer(psb_ipk_) :: nrow,ncol, err_act - integer(psb_ipk_), parameter :: relocsz=200 - character(len=20) :: name - logical, pointer :: mask_(:) - logical :: owned_ - - info = psb_success_ - name = 'psb_idx_cnv' - call psb_erractionsave(err_act) - - ictxt = desc%get_context() - mglob = desc%get_global_rows() - nglob = desc%get_global_cols() - nrow = desc%get_local_rows() - ncol = desc%get_local_cols() - - - call psb_info(ictxt, me, np) - - if (.not.psb_is_ok_desc(desc)) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif - - if (nv < 0) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - if (nv == 0) return - - if (size(idxin) < nv) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - - if (size(idxout) < nv) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - - idxout(1:nv) = idxin(1:nv) - call psi_idx_cnv1(nv,idxout,desc,info,mask=mask,owned=owned) - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_ret_) then - return - else - call psb_error(ictxt) - end if - return - - -end subroutine psi_idx_cnv2 -!!$ -!!$ Parallel Sparse BLAS version 3.1 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ 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 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. -!!$ -!!$ -! -! -! Subroutine: psi_idx_cnvs -! Converts an index from global to local numbering. -! -! -! Arguments: -! idxin - integer Required index -! idxout - integer Output value, negative for invalid input. -! desc - type(psb_desc_type). The communication descriptor. -! info - integer. return code. -! mask - logical, optional Only do the conversion if true. -! owned - logical,optional Restrict to local indices, no halo -! (default false) -subroutine psi_idx_cnvs(idxin,idxout,desc,info,mask,owned) - - use psi_mod, psb_protect_name => psi_idx_cnvs - use psb_desc_mod - integer(psb_ipk_), intent(in) :: idxin - integer(psb_ipk_), intent(out) :: idxout - type(psb_desc_type), intent(in) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned - logical :: mask_(1) - integer(psb_ipk_) :: iout(1) - - if (present(mask)) then - mask_ = mask - else - mask_=.true. - end if - iout = idxin - call psi_idx_cnv(ione,iout,desc,info,mask=mask_,owned=owned) - idxout=iout(1) - - return - -end subroutine psi_idx_cnvs -subroutine psi_idx_cnvs1(idxin,desc,info,mask,owned) - - use psi_mod, psb_protect_name => psi_idx_cnvs1 - use psb_desc_mod - integer(psb_ipk_), intent(inout) :: idxin - type(psb_desc_type), intent(in) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned - logical :: mask_(1) - integer(psb_ipk_) :: iout(1) - - if (present(mask)) then - mask_ = mask - else - mask_=.true. - end if - - iout(1) = idxin - call psi_idx_cnv(ione,iout,desc,info,mask=mask_,owned=owned) - idxin = iout(1) - - return - -end subroutine psi_idx_cnvs1 diff --git a/base/internals/psi_idx_ins_cnv.f90 b/base/internals/psi_idx_ins_cnv.f90 deleted file mode 100644 index d3ba24c6..00000000 --- a/base/internals/psi_idx_ins_cnv.f90 +++ /dev/null @@ -1,419 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS version 3.1 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ 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 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. -!!$ -!!$ -! -! File: psi_idx_ins_cnv.f90 -! -! Subroutine: psi_idx_ins_cnv1 -! Converts a bunch of indices from global to local numbering. -! This routine is called while the descriptor is in the build state; -! the idea is that if an index is not yet marked as local, it is a new -! connection to another process, i.e. a new entry into the halo. -! But we still need the mask, because we have to take out the column indices -! corresponding to row indices we do not own (see psb_cdins for how this is used). -! -! Arguments: -! nv - integer Number of indices required -! idxin(:) - integer Required indices, overwritten on output -! output is negative for masked entries -! desc - type(psb_desc_type). The communication descriptor. -! info - integer. return code. -! mask(:) - logical, optional Only do the conversion for specific indices. -! -subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask,lidx) - use psi_mod, psb_protect_name => psi_idx_ins_cnv1 - use psb_desc_mod - use psb_serial_mod - use psb_const_mod - use psb_error_mod - use psb_penv_mod - implicit none - integer(psb_ipk_), intent(in) :: nv - integer(psb_ipk_), intent(inout) :: idxin(:) - type(psb_desc_type), intent(inout) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - integer(psb_ipk_), intent(in), optional :: lidx(:) - integer(psb_ipk_) :: ictxt,mglob, nglob - integer(psb_ipk_) :: np, me - integer(psb_ipk_) :: nrow,ncol, err_act - integer(psb_ipk_) :: pnt_halo, nh, ip, lip,nxt,lipf,i,k,isize - logical :: pnt_h_ok - integer(psb_ipk_), parameter :: relocsz=200 - character(len=20) :: name,ch_err - - info = psb_success_ - name = 'psb_idx_ins_cnv' - call psb_erractionsave(err_act) - - ictxt = desc%get_context() - mglob = desc%get_global_rows() - nglob = desc%get_global_cols() - nrow = desc%get_local_rows() - ncol = desc%get_local_cols() - - call psb_info(ictxt, me, np) - - if ((.not.allocated(desc%indxmap)).or.& - & (.not.desc%is_bld())) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif - - if (nv < 0) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - if (nv == 0) return - - - if (size(idxin) < nv) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - - - if (present(mask)) then - if (size(mask) < nv) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - endif - - - call desc%indxmap%g2lip_ins(idxin(1:nv),info,mask=mask,lidx=lidx) - - if (info /= 0) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='g2l_ins') - goto 9999 - end if - -!!$ desc%matrix_data(psb_n_col_) = desc%indxmap%get_lc() - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_ret_) then - return - else - call psb_error(ictxt) - end if - return - -end subroutine psi_idx_ins_cnv1 -!!$ -!!$ Parallel Sparse BLAS version 3.1 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ 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 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. -!!$ -!!$ -! -! -! Subroutine: psi_idx_ins_cnv2 -! Converts a bunch of indices from global to local numbering. -! This routine is called while the descriptor is in the build state; -! the idea is that if an index is not yet marked as local, it is a new -! connection to another process, i.e. a new entry into the halo. -! But we still need the mask, because we have to take out the column indices -! corresponding to row indices we do not own (see psb_cdins for how this is used). -! -! Arguments: -! nv - integer Number of indices required -! idxin(:) - integer Required indices -! idxout(:) - integer Output values (negative for masked entries) -! desc - type(psb_desc_type). The communication descriptor. -! info - integer. return code. -! mask(:) - logical, optional Only do the conversion for specific indices. -! -subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask,lidx) - use psi_mod, psb_protect_name => psi_idx_ins_cnv2 - use psb_desc_mod - use psb_serial_mod - use psb_const_mod - use psb_error_mod - use psb_penv_mod - implicit none - integer(psb_ipk_), intent(in) :: nv, idxin(:) - integer(psb_ipk_), intent(out) :: idxout(:) - type(psb_desc_type), intent(inout) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - integer(psb_ipk_), intent(in), optional :: lidx(:) - - integer(psb_ipk_) :: i,ictxt,k,mglob, nglob - integer(psb_ipk_) :: np, me, isize - integer(psb_ipk_) :: pnt_halo,nrow,ncol, nh, ip, err_act,lip,nxt,lipf - logical :: pnt_h_ok - integer(psb_ipk_), parameter :: relocsz=200 - character(len=20) :: name,ch_err - - info = psb_success_ - name = 'psb_idx_ins_cnv' - call psb_erractionsave(err_act) - - ictxt = desc%get_context() - mglob = desc%get_global_rows() - nglob = desc%get_global_cols() - nrow = desc%get_local_rows() - ncol = desc%get_local_cols() - - call psb_info(ictxt, me, np) - - if ((.not.allocated(desc%indxmap)).or.& - & (.not.desc%is_bld())) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif - - if (nv < 0) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - if (nv == 0) return - - if (size(idxin) < nv) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - - if (size(idxout) < nv) then - info = 1111 - call psb_errpush(info,name) - goto 9999 - end if - - idxout(1:nv) = idxin(1:nv) - call psi_idx_ins_cnv(nv,idxout,desc,info,mask=mask,lidx=lidx) - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_ret_) then - return - else - call psb_error(ictxt) - end if - return - - -end subroutine psi_idx_ins_cnv2 -!!$ -!!$ Parallel Sparse BLAS version 3.1 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ 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 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. -!!$ -!!$ -! -! -! Subroutine: psi_idx_ins_cnvs -! Converts an index from global to local numbering. -! This routine is called while the descriptor is in the build state; -! the idea is that if an index is not yet marked as local, it is a new -! connection to another process, i.e. a new entry into the halo. -! But we still need the mask, because we have to take out the column indices -! corresponding to row indices we do not own (see psb_cdins for how this is used). -! -! Arguments: -! idxin - integer Required index s -! idxout - integer Output value (negative for masked entries) -! desc - type(psb_desc_type). The communication descriptor. -! info - integer. return code. -! mask - logical, optional Only do the conversion for specific indices. -! -subroutine psi_idx_ins_cnvs2(idxin,idxout,desc,info,mask,lidx) - use psi_mod, psb_protect_name => psi_idx_ins_cnvs2 - use psb_desc_mod - integer(psb_ipk_), intent(in) :: idxin - integer(psb_ipk_), intent(out) :: idxout - type(psb_desc_type), intent(inout) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - integer(psb_ipk_), intent(in), optional :: lidx - integer(psb_ipk_) :: iout(1),lidxv(1) - logical :: mask_(1) - - if (present(mask)) then - mask_ = mask - else - mask_ = .true. - end if - - iout(1) = idxin - if (present(lidx)) then - lidxv(1) = lidx - call psi_idx_ins_cnv(ione,iout,desc,info,mask=mask_,lidx=lidxv) - else - call psi_idx_ins_cnv(ione,iout,desc,info,mask=mask_) - end if - idxout = iout(1) - return - -end subroutine psi_idx_ins_cnvs2 -!!$ -!!$ Parallel Sparse BLAS version 3.1 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ 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 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. -!!$ -!!$ -! -! -! Subroutine: psi_idx_ins_cnvs -! Converts an index from global to local numbering. -! This routine is called while the descriptor is in the build state; -! the idea is that if an index is not yet marked as local, it is a new -! connection to another process, i.e. a new entry into the halo. -! But we still need the mask, because we have to take out the column indices -! corresponding to row indices we do not own (see psb_cdins for how this is used). -! -! Arguments: -! idxin - integer Required index s -! idxout - integer Output value (negative for masked entries) -! desc - type(psb_desc_type). The communication descriptor. -! info - integer. return code. -! mask - logical, optional Only do the conversion for specific indices. -! -subroutine psi_idx_ins_cnvs1(idxin,desc,info,mask,lidx) - use psi_mod, psb_protect_name => psi_idx_ins_cnvs1 - use psb_desc_mod - integer(psb_ipk_), intent(inout) :: idxin - type(psb_desc_type), intent(inout) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - integer(psb_ipk_), intent(in), optional :: lidx - integer(psb_ipk_) :: iout(1),lidxv(1) - logical :: mask_(1) - - if (present(mask)) then - mask_ = mask - else - mask_ = .true. - end if - - iout(1) = idxin - if (present(lidx)) then - lidxv(1) = lidx - call psi_idx_ins_cnv(ione,iout,desc,info,mask=mask_,lidx=lidxv) - else - call psi_idx_ins_cnv(ione,iout,desc,info,mask_) - end if - idxin = iout(1) - - return - -end subroutine psi_idx_ins_cnvs1 diff --git a/base/modules/psi_i_mod.f90 b/base/modules/psi_i_mod.f90 index af8f9b33..44268b18 100644 --- a/base/modules/psi_i_mod.f90 +++ b/base/modules/psi_i_mod.f90 @@ -148,82 +148,6 @@ module psi_i_mod end interface - interface psi_idx_cnv - subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned) - import :: psb_desc_type, psb_ipk_ - integer(psb_ipk_), intent(in) :: nv - integer(psb_ipk_), intent(inout) :: idxin(:) - type(psb_desc_type), intent(in) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned - end subroutine psi_idx_cnv1 - subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned) - import :: psb_desc_type, psb_ipk_ - integer(psb_ipk_), intent(in) :: nv, idxin(:) - integer(psb_ipk_), intent(out) :: idxout(:) - type(psb_desc_type), intent(in) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned - end subroutine psi_idx_cnv2 - subroutine psi_idx_cnvs(idxin,idxout,desc,info,mask,owned) - import :: psb_desc_type, psb_ipk_ - integer(psb_ipk_), intent(in) :: idxin - integer(psb_ipk_), intent(out) :: idxout - type(psb_desc_type), intent(in) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned - end subroutine psi_idx_cnvs - subroutine psi_idx_cnvs1(idxin,desc,info,mask,owned) - import :: psb_desc_type, psb_ipk_ - integer(psb_ipk_), intent(inout) :: idxin - type(psb_desc_type), intent(in) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned - end subroutine psi_idx_cnvs1 - end interface - - interface psi_idx_ins_cnv - subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask,lidx) - import :: psb_desc_type, psb_ipk_ - integer(psb_ipk_), intent(in) :: nv - integer(psb_ipk_), intent(inout) :: idxin(:) - type(psb_desc_type), intent(inout) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - integer(psb_ipk_), intent(in), optional :: lidx(:) - end subroutine psi_idx_ins_cnv1 - subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask,lidx) - import :: psb_desc_type, psb_ipk_ - integer(psb_ipk_), intent(in) :: nv, idxin(:) - integer(psb_ipk_), intent(out) :: idxout(:) - type(psb_desc_type), intent(inout) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - integer(psb_ipk_), intent(in), optional :: lidx(:) - end subroutine psi_idx_ins_cnv2 - subroutine psi_idx_ins_cnvs2(idxin,idxout,desc,info,mask,lidx) - import :: psb_desc_type, psb_ipk_ - integer(psb_ipk_), intent(in) :: idxin - integer(psb_ipk_), intent(out) :: idxout - type(psb_desc_type), intent(inout) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - integer(psb_ipk_), intent(in), optional :: lidx - end subroutine psi_idx_ins_cnvs2 - subroutine psi_idx_ins_cnvs1(idxin,desc,info,mask,lidx) - import :: psb_desc_type, psb_ipk_ - integer(psb_ipk_), intent(inout) :: idxin - type(psb_desc_type), intent(inout) :: desc - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - integer(psb_ipk_), intent(in), optional :: lidx - end subroutine psi_idx_ins_cnvs1 - end interface - interface psi_cnv_dsc subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type diff --git a/base/tools/psb_ccdbldext.F90 b/base/tools/psb_ccdbldext.F90 index eece3846..844c8163 100644 --- a/base/tools/psb_ccdbldext.F90 +++ b/base/tools/psb_ccdbldext.F90 @@ -529,7 +529,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) & write(debug_unit,*) me,' ',trim(name),& & ': going for first idx_cnv', desc_ov%indxmap%get_state() - call psi_idx_cnv(iszr,workr,maskr,desc_ov,info) + call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info) iszs = count(maskr(1:iszr)<=0) if (iszs > size(works)) call psb_realloc(iszs,works,info) j = 0 @@ -549,7 +549,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & ': going for fnd_owner', desc_ov%indxmap%get_state() - call psi_fnd_owner(iszs,works,temp,desc_a,info) + call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info) n_col = desc_ov%get_local_cols() if (debug_level >= psb_debug_outer_) & @@ -559,7 +559,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) do i=1,iszs idx = works(i) n_col = desc_ov%get_local_cols() - call psi_idx_ins_cnv(idx,lidx,desc_ov,info) + call desc_ov%indxmap%g2l_ins(idx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as diff --git a/base/tools/psb_cins.f90 b/base/tools/psb_cins.f90 index 280a7971..651dae00 100644 --- a/base/tools/psb_cins.f90 +++ b/base/tools/psb_cins.f90 @@ -78,8 +78,8 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionsave(err_act) name = 'psb_cinsvi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) return end if @@ -100,11 +100,6 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -139,7 +134,7 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) case(psb_dupl_ovwrt_) @@ -285,7 +280,7 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then @@ -405,7 +400,7 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if do i=1,n @@ -516,8 +511,8 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionsave(err_act) name = 'psb_cinsi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) return end if @@ -538,11 +533,6 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -579,7 +569,7 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) diff --git a/base/tools/psb_dcdbldext.F90 b/base/tools/psb_dcdbldext.F90 index 17961729..47c063c7 100644 --- a/base/tools/psb_dcdbldext.F90 +++ b/base/tools/psb_dcdbldext.F90 @@ -529,7 +529,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) & write(debug_unit,*) me,' ',trim(name),& & ': going for first idx_cnv', desc_ov%indxmap%get_state() - call psi_idx_cnv(iszr,workr,maskr,desc_ov,info) + call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info) iszs = count(maskr(1:iszr)<=0) if (iszs > size(works)) call psb_realloc(iszs,works,info) j = 0 @@ -549,7 +549,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & ': going for fnd_owner', desc_ov%indxmap%get_state() - call psi_fnd_owner(iszs,works,temp,desc_a,info) + call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info) n_col = desc_ov%get_local_cols() if (debug_level >= psb_debug_outer_) & @@ -559,7 +559,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) do i=1,iszs idx = works(i) n_col = desc_ov%get_local_cols() - call psi_idx_ins_cnv(idx,lidx,desc_ov,info) + call desc_ov%indxmap%g2l_ins(idx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as diff --git a/base/tools/psb_dins.f90 b/base/tools/psb_dins.f90 index 5bacd5c9..385f0575 100644 --- a/base/tools/psb_dins.f90 +++ b/base/tools/psb_dins.f90 @@ -78,8 +78,8 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionsave(err_act) name = 'psb_dinsvi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) return end if @@ -100,11 +100,6 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -139,7 +134,7 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) case(psb_dupl_ovwrt_) @@ -285,7 +280,7 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then @@ -405,7 +400,7 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if do i=1,n @@ -516,8 +511,8 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionsave(err_act) name = 'psb_dinsi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) return end if @@ -538,11 +533,6 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -579,7 +569,7 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) diff --git a/base/tools/psb_glob_to_loc.f90 b/base/tools/psb_glob_to_loc.f90 index ec35c141..7a8a1a08 100644 --- a/base/tools/psb_glob_to_loc.f90 +++ b/base/tools/psb_glob_to_loc.f90 @@ -59,10 +59,9 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) logical, intent(in), optional :: owned !....locals.... - integer(psb_ipk_) :: n + integer(psb_ipk_) :: n, ictxt, iam, np character :: act integer(psb_ipk_) :: int_err(5), err_act - logical :: owned_ integer(psb_ipk_), parameter :: zero=0 character(len=20) :: name @@ -70,6 +69,15 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) info=psb_success_ name = 'glob_to_loc' call psb_erractionsave(err_act) + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ictxt = desc_a%get_context() + call psb_info(ictxt,iam,np) + if (present(iact)) then act=iact @@ -77,15 +85,16 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) act='I' endif act = psb_toupper(act) - if (present(owned)) then - owned_=owned + if (present(iact)) then + act=iact else - owned_=.false. - end if - - int_err = 0 + act='I' + endif + + act = psb_toupper(act) + n = size(x) - call psi_idx_cnv(n,x,y,desc_a,info,owned=owned_) + call desc_a%indxmap%g2l(x(1:n),y(1:n),info,owned=owned) select case(act) case('E','I') @@ -181,7 +190,6 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) integer(psb_ipk_) :: n character :: act integer(psb_ipk_) :: err_act - logical :: owned_ integer(psb_ipk_), parameter :: zero=0 character(len=20) :: name integer(psb_ipk_) :: ictxt, iam, np @@ -189,25 +197,27 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'glob_to_loc' + + call psb_erractionsave(err_act) + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + ictxt = desc_a%get_context() call psb_info(ictxt,iam,np) - call psb_erractionsave(err_act) + if (present(iact)) then act=iact else act='I' endif - if (present(owned)) then - owned_=owned - else - owned_=.false. - end if act = psb_toupper(act) - n = size(x) - call psi_idx_cnv(n,x,desc_a,info,owned=owned_) + call desc_a%indxmap%g2lip(x,info,owned=owned) select case(act) case('E','I') diff --git a/base/tools/psb_iins.f90 b/base/tools/psb_iins.f90 index 3daf280f..44b6f695 100644 --- a/base/tools/psb_iins.f90 +++ b/base/tools/psb_iins.f90 @@ -77,12 +77,11 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionsave(err_act) name = 'psb_insvi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) return end if - ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -99,11 +98,6 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl,local) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -138,7 +132,7 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) case(psb_dupl_ovwrt_) @@ -268,12 +262,11 @@ subroutine psb_iinsi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionsave(err_act) name = 'psb_iinsi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) return end if - ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -290,11 +283,6 @@ subroutine psb_iinsi(m, irw, val, x, desc_a, info, dupl,local) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -332,7 +320,7 @@ subroutine psb_iinsi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) @@ -487,7 +475,7 @@ subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then diff --git a/base/tools/psb_scdbldext.F90 b/base/tools/psb_scdbldext.F90 index 407ee1a5..b92a7354 100644 --- a/base/tools/psb_scdbldext.F90 +++ b/base/tools/psb_scdbldext.F90 @@ -529,7 +529,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) & write(debug_unit,*) me,' ',trim(name),& & ': going for first idx_cnv', desc_ov%indxmap%get_state() - call psi_idx_cnv(iszr,workr,maskr,desc_ov,info) + call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info) iszs = count(maskr(1:iszr)<=0) if (iszs > size(works)) call psb_realloc(iszs,works,info) j = 0 @@ -549,7 +549,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & ': going for fnd_owner', desc_ov%indxmap%get_state() - call psi_fnd_owner(iszs,works,temp,desc_a,info) + call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info) n_col = desc_ov%get_local_cols() if (debug_level >= psb_debug_outer_) & @@ -559,7 +559,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) do i=1,iszs idx = works(i) n_col = desc_ov%get_local_cols() - call psi_idx_ins_cnv(idx,lidx,desc_ov,info) + call desc_ov%indxmap%g2l_ins(idx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as diff --git a/base/tools/psb_sins.f90 b/base/tools/psb_sins.f90 index dd410637..6023b626 100644 --- a/base/tools/psb_sins.f90 +++ b/base/tools/psb_sins.f90 @@ -78,8 +78,8 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionsave(err_act) name = 'psb_sinsvi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) return end if @@ -100,11 +100,6 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -139,7 +134,7 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) case(psb_dupl_ovwrt_) @@ -285,7 +280,7 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then @@ -405,7 +400,7 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if do i=1,n @@ -516,8 +511,8 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionsave(err_act) name = 'psb_sinsi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) return end if @@ -538,11 +533,6 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -579,7 +569,7 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) diff --git a/base/tools/psb_zcdbldext.F90 b/base/tools/psb_zcdbldext.F90 index ea0edf89..8fb88fa6 100644 --- a/base/tools/psb_zcdbldext.F90 +++ b/base/tools/psb_zcdbldext.F90 @@ -529,7 +529,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) & write(debug_unit,*) me,' ',trim(name),& & ': going for first idx_cnv', desc_ov%indxmap%get_state() - call psi_idx_cnv(iszr,workr,maskr,desc_ov,info) + call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info) iszs = count(maskr(1:iszr)<=0) if (iszs > size(works)) call psb_realloc(iszs,works,info) j = 0 @@ -549,7 +549,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & ': going for fnd_owner', desc_ov%indxmap%get_state() - call psi_fnd_owner(iszs,works,temp,desc_a,info) + call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info) n_col = desc_ov%get_local_cols() if (debug_level >= psb_debug_outer_) & @@ -559,7 +559,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) do i=1,iszs idx = works(i) n_col = desc_ov%get_local_cols() - call psi_idx_ins_cnv(idx,lidx,desc_ov,info) + call desc_ov%indxmap%g2l_ins(idx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as diff --git a/base/tools/psb_zins.f90 b/base/tools/psb_zins.f90 index 8f51a945..6ded6f52 100644 --- a/base/tools/psb_zins.f90 +++ b/base/tools/psb_zins.f90 @@ -78,8 +78,8 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionsave(err_act) name = 'psb_zinsvi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) return end if @@ -100,11 +100,6 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -139,7 +134,7 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) case(psb_dupl_ovwrt_) @@ -285,7 +280,7 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then @@ -405,7 +400,7 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if do i=1,n @@ -516,8 +511,8 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionsave(err_act) name = 'psb_zinsi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) return end if @@ -538,11 +533,6 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -579,7 +569,7 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_)