From 462f1d098cac86391058885cd116487661c866d0 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 15 Apr 2018 16:56:58 +0100 Subject: [PATCH] Modified internals to have tmp_ovrlap in local numbering. Also simplified crea_index taking out isglob argument. Fixed bldext, cdall & friends accordingly. --- base/internals/Makefile | 2 +- base/internals/psi_crea_index.f90 | 9 +--- base/internals/psi_crea_ovr_elem.f90 | 4 -- base/internals/psi_desc_impl.f90 | 8 +-- base/internals/psi_desc_index.F90 | 43 ++++++---------- base/internals/psi_exist_ovr_elem.f90 | 73 --------------------------- base/modules/desc/psb_desc_mod.F90 | 32 ++++-------- base/modules/psi_i_mod.f90 | 6 +-- base/tools/psb_ccdbldext.F90 | 29 +++-------- base/tools/psb_cd_inloc.f90 | 16 ++++++ base/tools/psb_cd_reinit.f90 | 6 +-- base/tools/psb_cdals.f90 | 16 +++++- base/tools/psb_dcdbldext.F90 | 29 +++-------- base/tools/psb_scdbldext.F90 | 29 +++-------- base/tools/psb_zcdbldext.F90 | 29 +++-------- test/pargen/runs/ppde.inp | 4 +- 16 files changed, 94 insertions(+), 241 deletions(-) delete mode 100644 base/internals/psi_exist_ovr_elem.f90 diff --git a/base/internals/Makefile b/base/internals/Makefile index de55e4b1..471fc383 100644 --- a/base/internals/Makefile +++ b/base/internals/Makefile @@ -3,7 +3,7 @@ include ../../Make.inc 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_bld_tmphalo.o psi_sort_dl.o \ - psi_desc_impl.o psi_exist_ovr_elem.o psi_list_search.o psi_srtlist.o + psi_desc_impl.o psi_list_search.o psi_srtlist.o MPFOBJS = psi_desc_index.o psi_extrct_dl.o \ psi_fnd_owner.o psb_indx_map_fnd_owner.o diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 7025413f..6c88ae2d 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -44,16 +44,12 @@ ! mapping parts are used. ! index_in(:) - integer The index list, build format ! index_out(:) - integer(psb_ipk_), allocatable The index list, assembled format -! glob_idx - logical Whether the input indices are in local or global -! numbering; the global numbering is used when -! converting the overlap exchange lists. ! nxch - integer The number of data exchanges on the calling process ! nsnd - integer Total send buffer size on the calling process ! nrcv - integer Total receive buffer size on the calling process ! ! -subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info) - +subroutine psi_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) use psb_realloc_mod use psb_desc_mod use psb_error_mod @@ -65,7 +61,6 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info integer(psb_ipk_), intent(out) :: info,nxch,nsnd,nrcv integer(psb_ipk_), intent(in) :: index_in(:) integer(psb_ipk_), allocatable, intent(inout) :: index_out(:) - logical :: glob_idx ! ....local scalars... integer(psb_ipk_) :: ictxt, me, np, mode, err_act, dl_lda @@ -135,7 +130,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info & write(debug_unit,*) me,' ',trim(name),': calling psi_desc_index' ! Do the actual format conversion. call psi_desc_index(desc_a,index_in,dep_list(1:,me),& - & length_dl(me),nsnd,nrcv, index_out,glob_idx,info) + & length_dl(me),nsnd,nrcv, index_out,info) if(debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),': out of psi_desc_index',& & size(index_out) diff --git a/base/internals/psi_crea_ovr_elem.f90 b/base/internals/psi_crea_ovr_elem.f90 index 13bf8af1..9fd69247 100644 --- a/base/internals/psi_crea_ovr_elem.f90 +++ b/base/internals/psi_crea_ovr_elem.f90 @@ -61,10 +61,6 @@ subroutine psi_crea_ovr_elem(me,desc_overlap,ovr_elem,info) integer(psb_ipk_) :: dim_ovr_elem integer(psb_ipk_) :: pairtree(2) - ! ...external function... - integer(psb_ipk_) :: psi_exist_ovr_elem - external :: psi_exist_ovr_elem - integer(psb_ipk_) :: nel, ip, ix, iel, insize, err_act, iproc integer(psb_ipk_), allocatable :: telem(:,:) diff --git a/base/internals/psi_desc_impl.f90 b/base/internals/psi_desc_impl.f90 index 8ab3bd0f..977af721 100644 --- a/base/internals/psi_desc_impl.f90 +++ b/base/internals/psi_desc_impl.f90 @@ -102,7 +102,7 @@ subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) ! first the halo index if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on halo',& & size(halo_in) - call psi_crea_index(cdesc,halo_in, idx_out,.false.,nxch,nsnd,nrcv,info) + call psi_crea_index(cdesc,halo_in, idx_out,nxch,nsnd,nrcv,info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_crea_index') goto 9999 @@ -115,7 +115,7 @@ subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) ! then ext index if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on ext' - call psi_crea_index(cdesc,ext_in, idx_out,.false.,nxch,nsnd,nrcv,info) + call psi_crea_index(cdesc,ext_in, idx_out,nxch,nsnd,nrcv,info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_crea_index') goto 9999 @@ -126,7 +126,7 @@ subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on ovrlap' ! then the overlap index - call psi_crea_index(cdesc,ovrlap_in, idx_out,.true.,nxch,nsnd,nrcv,info) + call psi_crea_index(cdesc,ovrlap_in, idx_out,nxch,nsnd,nrcv,info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_crea_index') goto 9999 @@ -150,7 +150,7 @@ subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) if (debug_level>0) write(debug_unit,*) me,'Calling bld_ovr_mst' call psi_bld_ovr_mst(me,cdesc%ovrlap_elem,tmp_mst_idx,info) if (info == psb_success_) call psi_crea_index(cdesc,& - & tmp_mst_idx,idx_out,.false.,nxch,nsnd,nrcv,info) + & tmp_mst_idx,idx_out,nxch,nsnd,nrcv,info) if (debug_level>0) write(debug_unit,*) me,'Done crea_indx' if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_bld_ovr_mst') diff --git a/base/internals/psi_desc_index.F90 b/base/internals/psi_desc_index.F90 index 386b89af..e5a890f4 100644 --- a/base/internals/psi_desc_index.F90 +++ b/base/internals/psi_desc_index.F90 @@ -38,16 +38,13 @@ ! See below for a description of the formats. ! ! Arguments: -! desc_a - type(psb_desc_type) The descriptor; in this context only the index -! mapping parts are used. -! index_in(:) - integer The index list, build format +! desc_a - type(psb_desc_type) The descriptor; in this context only the index +! mapping parts are used. +! index_in(:) - integer The index list, build format ! index_out(:) - integer(psb_ipk_), allocatable The index list, assembled format -! glob_idx - logical Whether the input indices are in local or global -! numbering; the global numbering is used when -! converting the overlap exchange lists. -! nxch - integer The number of data exchanges on the calling process -! nsnd - integer Total send buffer size on the calling process -! nrcv - integer Total receive buffer size on the calling process +! nxch - integer The number of data exchanges on the calling process +! nsnd - integer Total send buffer size on the calling process +! nrcv - integer Total receive buffer size on the calling process ! ! The format of the index lists. Copied from base/modules/psb_desc_type ! @@ -99,7 +96,7 @@ ! ! subroutine psi_desc_index(desc,index_in,dep_list,& - & length_dl,nsnd,nrcv,desc_index,isglob_in,info) + & length_dl,nsnd,nrcv,desc_index,info) use psb_desc_mod use psb_realloc_mod use psb_error_mod @@ -119,7 +116,6 @@ subroutine psi_desc_index(desc,index_in,dep_list,& integer(psb_ipk_) :: index_in(:),dep_list(:) integer(psb_ipk_),allocatable :: desc_index(:) integer(psb_ipk_) :: length_dl,nsnd,nrcv,info - logical :: isglob_in ! ....local scalars... integer(psb_ipk_) :: j,me,np,i,proc ! ...parameters... @@ -255,22 +251,15 @@ subroutine psi_desc_index(desc,index_in,dep_list,& ! ! note that here bsdinx is zero-based, hence the following loop ! - if (isglob_in) then - do j=1, nerv - sndbuf(bsdindx(proc+1)+j) = (index_in(i+j)) - end do - else - - call desc%indxmap%l2g(index_in(i+1:i+nerv),& - & sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),& - & info) - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='l2g') - goto 9999 - end if - - endif + call desc%indxmap%l2g(index_in(i+1:i+nerv),& + & sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),& + & info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='l2g') + goto 9999 + end if + bsdindx(proc+1) = bsdindx(proc+1) + nerv i = i + nerv + 1 end do diff --git a/base/internals/psi_exist_ovr_elem.f90 b/base/internals/psi_exist_ovr_elem.f90 deleted file mode 100644 index cd7d4712..00000000 --- a/base/internals/psi_exist_ovr_elem.f90 +++ /dev/null @@ -1,73 +0,0 @@ -! -! Parallel Sparse BLAS version 3.5 -! (C) Copyright 2006, 2010, 2015, 2017 -! Salvatore Filippone -! 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. -! -! -integer function psi_exist_ovr_elem(ovr_elem, dim_list,elem_searched) - use psb_const_mod - ! PURPOSE: - ! == = ==== - ! - ! If ELEM_SEARCHED exist in the list OVR_ELEM returns its position in - ! the list, else returns -1 - ! - ! - ! INPUT - ! == = === - ! OVRLAP_ELEMENT_D.: Contains for all overlap points belonging to - ! the current process: - ! 1. overlap point index - ! 2. Number of domains sharing that overlap point - ! the end is marked by a -1............................... - ! - ! DIM_LIST..........: Dimension of list OVRLAP_ELEMENT_D - ! - ! ELEM_SEARCHED.....:point's Local index identifier to be searched. - - implicit none - - ! ....Scalars parameters.... - integer(psb_ipk_) :: dim_list,elem_searched - ! ...array parameters.... - integer(psb_ipk_) :: ovr_elem(dim_list,*) - - ! ...local scalars.... - integer(psb_ipk_) :: i - - i=1 - do while ((i.le.dim_list).and.(ovr_elem(i,1).ne.elem_searched)) - i=i+1 - enddo - if ((i.le.dim_list).and.(ovr_elem(i,1).eq.elem_searched)) then - psi_exist_ovr_elem=i - else - psi_exist_ovr_elem=-1 - endif -end function psi_exist_ovr_elem - diff --git a/base/modules/desc/psb_desc_mod.F90 b/base/modules/desc/psb_desc_mod.F90 index 5d5b22a7..724b9114 100644 --- a/base/modules/desc/psb_desc_mod.F90 +++ b/base/modules/desc/psb_desc_mod.F90 @@ -1,4 +1,4 @@ -! + ! Parallel Sparse BLAS version 3.5 ! (C) Copyright 2006-2018 ! Salvatore Filippone @@ -142,9 +142,9 @@ module psb_desc_mod ! psb_ovrl subroutine. ! ! 8. When the descriptor is in the BLD state the INDEX vectors contains only - ! the indices to be received, organized as a sequence - ! of entries of the form (proc,N,(lx1,lx2,...,lxn)) with owning process, - ! number of indices (most often but not necessarily N=1), list of local indices. + ! the indices to be received, organized as a sequence of entries of + ! the form (proc,N,(lx1,lx2,...,lxn)) with owning process, number of indices + ! (most often but not necessarily N=1), list of local indices. ! This is because we only know the list of halo indices to be received ! as we go about building the sparse matrix pattern, and we want the build ! phase to be loosely synchronized. Thus we record the indices we have to ask @@ -1072,7 +1072,7 @@ contains end subroutine psb_cd_clone - Subroutine psb_cd_get_recv_idx(tmp,desc,data,info,toglob) + Subroutine psb_cd_get_recv_idx(tmp,desc,data,info) use psb_error_mod use psb_penv_mod @@ -1082,7 +1082,6 @@ contains integer(psb_ipk_), intent(in) :: data Type(psb_desc_type), Intent(in), target :: desc integer(psb_ipk_), intent(out) :: info - logical, intent(in) :: toglob ! .. Local Scalars .. integer(psb_ipk_) :: incnt, outcnt, j, np, me, ictxt, l_tmp,& @@ -1141,23 +1140,10 @@ contains call psb_errpush(info,name,a_err='psb_ensure_size') goto 9999 end if - if (toglob) then - call desc%indxmap%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif - tmp(outcnt) = proc - tmp(outcnt+1) = 1 - tmp(outcnt+2) = gidx - tmp(outcnt+3) = -1 - else - tmp(outcnt) = proc - tmp(outcnt+1) = 1 - tmp(outcnt+2) = idx - tmp(outcnt+3) = -1 - end if + tmp(outcnt) = proc + tmp(outcnt+1) = 1 + tmp(outcnt+2) = idx + tmp(outcnt+3) = -1 outcnt = outcnt+3 end Do incnt = incnt+n_elem_recv+n_elem_send+3 diff --git a/base/modules/psi_i_mod.f90 b/base/modules/psi_i_mod.f90 index 76d73726..c6e65f26 100644 --- a/base/modules/psi_i_mod.f90 +++ b/base/modules/psi_i_mod.f90 @@ -53,13 +53,12 @@ module psi_i_mod end interface interface - subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info) + subroutine psi_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) import type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info,nxch,nsnd,nrcv integer(psb_ipk_), intent(in) :: index_in(:) integer(psb_ipk_), allocatable, intent(inout) :: index_out(:) - logical :: glob_idx end subroutine psi_crea_index end interface @@ -74,13 +73,12 @@ module psi_i_mod interface subroutine psi_desc_index(desc,index_in,dep_list,& - & length_dl,nsnd,nrcv,desc_index,isglob_in,info) + & length_dl,nsnd,nrcv,desc_index,info) import type(psb_desc_type) :: desc integer(psb_ipk_) :: index_in(:),dep_list(:) integer(psb_ipk_),allocatable :: desc_index(:) integer(psb_ipk_) :: length_dl,nsnd,nrcv,info - logical :: isglob_in end subroutine psi_desc_index end interface diff --git a/base/tools/psb_ccdbldext.F90 b/base/tools/psb_ccdbldext.F90 index 0792222e..705e82af 100644 --- a/base/tools/psb_ccdbldext.F90 +++ b/base/tools/psb_ccdbldext.F90 @@ -84,7 +84,8 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) integer(psb_ipk_) :: i, j, err_act,m,& & lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo - integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,& + integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,& + & idx,proc,n_elem_recv,& & n_elem_send,tot_recv,tot_elem,cntov_o,& & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ @@ -255,12 +256,6 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_recv-1 idx = ovrlap(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -269,7 +264,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) end if orig_ovr(cntov_o)=proc orig_ovr(cntov_o+1)=1 - orig_ovr(cntov_o+2)=gidx + orig_ovr(cntov_o+2)=idx orig_ovr(cntov_o+3)=-1 cntov_o=cntov_o+3 end Do @@ -356,12 +351,6 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) end If idx = halo(counter+psb_elem_recv_+j) - call desc_ov%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -371,7 +360,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) tmp_ovr_idx(counter_o) = proc tmp_ovr_idx(counter_o+1) = 1 - tmp_ovr_idx(counter_o+2) = gidx + tmp_ovr_idx(counter_o+2) = idx tmp_ovr_idx(counter_o+3) = -1 counter_o=counter_o+3 call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione) @@ -400,12 +389,6 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_send-1 idx = halo(counter+psb_elem_send_+j) - call desc_ov%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -415,7 +398,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) tmp_ovr_idx(counter_o) = proc tmp_ovr_idx(counter_o+1) = 1 - tmp_ovr_idx(counter_o+2) = gidx + tmp_ovr_idx(counter_o+2) = idx tmp_ovr_idx(counter_o+3) = -1 counter_o=counter_o+3 @@ -599,7 +582,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) write(debug_unit,*) me,' ',trim(name),':Calling Crea_index' end if - call psi_crea_index(desc_ov,t_halo_in,t_halo_out,.false.,& + call psi_crea_index(desc_ov,t_halo_in,t_halo_out,& & nxch,nsnd,nrcv,info) if (debug_level >= psb_debug_outer_) then diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index 0310a7d9..1b31fe2e 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -369,6 +369,22 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) call aa%init(iictxt,vl(1:nlu),info) end select + + ! + ! Now that we have initialized indxmap we can convert the + ! indices to local numbering. + ! + block + integer(psb_ipk_) :: i,nprocs + i = 1 + do while (temp_ovrlap(i) /= -1) + call desc%indxmap%g2lip(temp_ovrlap(i),info) + i = i + 1 + nprocs = temp_ovrlap(i) + i = i + 1 + i = i + nprocs + enddo + end block call psi_bld_tmpovrl(temp_ovrlap,desc,info) if (info == psb_success_) deallocate(temp_ovrlap,vl,ix,stat=info) diff --git a/base/tools/psb_cd_reinit.f90 b/base/tools/psb_cd_reinit.f90 index f790218a..d579ba95 100644 --- a/base/tools/psb_cd_reinit.f90 +++ b/base/tools/psb_cd_reinit.f90 @@ -61,9 +61,9 @@ Subroutine psb_cd_reinit(desc,info) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': start' if (desc%is_asb()) then - call psb_cd_get_recv_idx(tmp_ovr,desc,psb_comm_ovr_,info,toglob=.true.) - call psb_cd_get_recv_idx(tmp_halo,desc,psb_comm_halo_,info,toglob=.false.) - call psb_cd_get_recv_idx(tmp_ext,desc,psb_comm_ext_,info,toglob=.false.) + call psb_cd_get_recv_idx(tmp_ovr,desc,psb_comm_ovr_,info) + call psb_cd_get_recv_idx(tmp_halo,desc,psb_comm_halo_,info) + call psb_cd_get_recv_idx(tmp_ext,desc,psb_comm_ext_,info) call psb_move_alloc(tmp_ovr,desc%ovrlap_index,info) call psb_move_alloc(tmp_halo,desc%halo_index,info) diff --git a/base/tools/psb_cdals.f90 b/base/tools/psb_cdals.f90 index 4c7131c7..e141a427 100644 --- a/base/tools/psb_cdals.f90 +++ b/base/tools/psb_cdals.f90 @@ -267,7 +267,21 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': error check:' ,err - + ! + ! Now that we have initialized indxmap we can convert the + ! indices to local numbering. + ! + block + integer(psb_ipk_) :: i,nprocs + i = 1 + do while (temp_ovrlap(i) /= -1) + call desc%indxmap%g2lip(temp_ovrlap(i),info) + i = i + 1 + nprocs = temp_ovrlap(i) + i = i + 1 + i = i + nprocs + enddo + end block call psi_bld_tmpovrl(temp_ovrlap,desc,info) if (info == psb_success_) deallocate(prc_v,temp_ovrlap,stat=info) diff --git a/base/tools/psb_dcdbldext.F90 b/base/tools/psb_dcdbldext.F90 index 14aa6976..99610cc3 100644 --- a/base/tools/psb_dcdbldext.F90 +++ b/base/tools/psb_dcdbldext.F90 @@ -84,7 +84,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) integer(psb_ipk_) :: i, j, err_act,m,& & lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo - integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,& + integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,& + & idx,proc,n_elem_recv,& & n_elem_send,tot_recv,tot_elem,cntov_o,& & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ @@ -255,12 +256,6 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_recv-1 idx = ovrlap(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -269,7 +264,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) end if orig_ovr(cntov_o)=proc orig_ovr(cntov_o+1)=1 - orig_ovr(cntov_o+2)=gidx + orig_ovr(cntov_o+2)=idx orig_ovr(cntov_o+3)=-1 cntov_o=cntov_o+3 end Do @@ -356,12 +351,6 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) end If idx = halo(counter+psb_elem_recv_+j) - call desc_ov%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -371,7 +360,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) tmp_ovr_idx(counter_o) = proc tmp_ovr_idx(counter_o+1) = 1 - tmp_ovr_idx(counter_o+2) = gidx + tmp_ovr_idx(counter_o+2) = idx tmp_ovr_idx(counter_o+3) = -1 counter_o=counter_o+3 call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione) @@ -400,12 +389,6 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_send-1 idx = halo(counter+psb_elem_send_+j) - call desc_ov%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -415,7 +398,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) tmp_ovr_idx(counter_o) = proc tmp_ovr_idx(counter_o+1) = 1 - tmp_ovr_idx(counter_o+2) = gidx + tmp_ovr_idx(counter_o+2) = idx tmp_ovr_idx(counter_o+3) = -1 counter_o=counter_o+3 @@ -599,7 +582,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) write(debug_unit,*) me,' ',trim(name),':Calling Crea_index' end if - call psi_crea_index(desc_ov,t_halo_in,t_halo_out,.false.,& + call psi_crea_index(desc_ov,t_halo_in,t_halo_out,& & nxch,nsnd,nrcv,info) if (debug_level >= psb_debug_outer_) then diff --git a/base/tools/psb_scdbldext.F90 b/base/tools/psb_scdbldext.F90 index 20fda8dc..d4dd77c2 100644 --- a/base/tools/psb_scdbldext.F90 +++ b/base/tools/psb_scdbldext.F90 @@ -84,7 +84,8 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) integer(psb_ipk_) :: i, j, err_act,m,& & lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo - integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,& + integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,& + & idx,proc,n_elem_recv,& & n_elem_send,tot_recv,tot_elem,cntov_o,& & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ @@ -255,12 +256,6 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_recv-1 idx = ovrlap(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -269,7 +264,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) end if orig_ovr(cntov_o)=proc orig_ovr(cntov_o+1)=1 - orig_ovr(cntov_o+2)=gidx + orig_ovr(cntov_o+2)=idx orig_ovr(cntov_o+3)=-1 cntov_o=cntov_o+3 end Do @@ -356,12 +351,6 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) end If idx = halo(counter+psb_elem_recv_+j) - call desc_ov%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -371,7 +360,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) tmp_ovr_idx(counter_o) = proc tmp_ovr_idx(counter_o+1) = 1 - tmp_ovr_idx(counter_o+2) = gidx + tmp_ovr_idx(counter_o+2) = idx tmp_ovr_idx(counter_o+3) = -1 counter_o=counter_o+3 call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione) @@ -400,12 +389,6 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_send-1 idx = halo(counter+psb_elem_send_+j) - call desc_ov%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -415,7 +398,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) tmp_ovr_idx(counter_o) = proc tmp_ovr_idx(counter_o+1) = 1 - tmp_ovr_idx(counter_o+2) = gidx + tmp_ovr_idx(counter_o+2) = idx tmp_ovr_idx(counter_o+3) = -1 counter_o=counter_o+3 @@ -599,7 +582,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) write(debug_unit,*) me,' ',trim(name),':Calling Crea_index' end if - call psi_crea_index(desc_ov,t_halo_in,t_halo_out,.false.,& + call psi_crea_index(desc_ov,t_halo_in,t_halo_out,& & nxch,nsnd,nrcv,info) if (debug_level >= psb_debug_outer_) then diff --git a/base/tools/psb_zcdbldext.F90 b/base/tools/psb_zcdbldext.F90 index 355d540c..e967190d 100644 --- a/base/tools/psb_zcdbldext.F90 +++ b/base/tools/psb_zcdbldext.F90 @@ -84,7 +84,8 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) integer(psb_ipk_) :: i, j, err_act,m,& & lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo - integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,& + integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,& + & idx,proc,n_elem_recv,& & n_elem_send,tot_recv,tot_elem,cntov_o,& & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ @@ -255,12 +256,6 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_recv-1 idx = ovrlap(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -269,7 +264,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) end if orig_ovr(cntov_o)=proc orig_ovr(cntov_o+1)=1 - orig_ovr(cntov_o+2)=gidx + orig_ovr(cntov_o+2)=idx orig_ovr(cntov_o+3)=-1 cntov_o=cntov_o+3 end Do @@ -356,12 +351,6 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) end If idx = halo(counter+psb_elem_recv_+j) - call desc_ov%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -371,7 +360,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) tmp_ovr_idx(counter_o) = proc tmp_ovr_idx(counter_o+1) = 1 - tmp_ovr_idx(counter_o+2) = gidx + tmp_ovr_idx(counter_o+2) = idx tmp_ovr_idx(counter_o+3) = -1 counter_o=counter_o+3 call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione) @@ -400,12 +389,6 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_send-1 idx = halo(counter+psb_elem_send_+j) - call desc_ov%l2g(idx,gidx,info) - If (gidx < 0) then - info=-3 - call psb_errpush(info,name) - goto 9999 - endif call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ @@ -415,7 +398,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) tmp_ovr_idx(counter_o) = proc tmp_ovr_idx(counter_o+1) = 1 - tmp_ovr_idx(counter_o+2) = gidx + tmp_ovr_idx(counter_o+2) = idx tmp_ovr_idx(counter_o+3) = -1 counter_o=counter_o+3 @@ -599,7 +582,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) write(debug_unit,*) me,' ',trim(name),':Calling Crea_index' end if - call psi_crea_index(desc_ov,t_halo_in,t_halo_out,.false.,& + call psi_crea_index(desc_ov,t_halo_in,t_halo_out,& & nxch,nsnd,nrcv,info) if (debug_level >= psb_debug_outer_) then diff --git a/test/pargen/runs/ppde.inp b/test/pargen/runs/ppde.inp index 5ae8f8db..4a1e7ab3 100644 --- a/test/pargen/runs/ppde.inp +++ b/test/pargen/runs/ppde.inp @@ -4,8 +4,8 @@ BJAC Preconditioner NONE DIAG BJAC CSR Storage format for matrix A: CSR COO 040 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) ) 2 Stopping criterion 1 2 -1000 MAXIT --1 ITRACE +0100 MAXIT +01 ITRACE 002 IRST restart for RGMRES and BiCGSTABL