Modified internals to have tmp_ovrlap in local numbering.

Also simplified crea_index taking out isglob argument.
Fixed bldext, cdall & friends accordingly.
pull/7/head
Salvatore Filippone 7 years ago
parent dd946ef5e2
commit 462f1d098c

@ -3,7 +3,7 @@ include ../../Make.inc
FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \ 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_crea_ovr_elem.o psi_bld_tmpovrl.o psi_dl_check.o \
psi_bld_tmphalo.o psi_sort_dl.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 \ MPFOBJS = psi_desc_index.o psi_extrct_dl.o \
psi_fnd_owner.o psb_indx_map_fnd_owner.o psi_fnd_owner.o psb_indx_map_fnd_owner.o

@ -44,16 +44,12 @@
! mapping parts are used. ! mapping parts are used.
! index_in(:) - integer The index list, build format ! index_in(:) - integer The index list, build format
! index_out(:) - integer(psb_ipk_), allocatable The index list, assembled 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 ! nxch - integer The number of data exchanges on the calling process
! nsnd - integer Total send buffer size on the calling process ! nsnd - integer Total send buffer size on the calling process
! nrcv - integer Total receive 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_realloc_mod
use psb_desc_mod use psb_desc_mod
use psb_error_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(out) :: info,nxch,nsnd,nrcv
integer(psb_ipk_), intent(in) :: index_in(:) integer(psb_ipk_), intent(in) :: index_in(:)
integer(psb_ipk_), allocatable, intent(inout) :: index_out(:) integer(psb_ipk_), allocatable, intent(inout) :: index_out(:)
logical :: glob_idx
! ....local scalars... ! ....local scalars...
integer(psb_ipk_) :: ictxt, me, np, mode, err_act, dl_lda 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' & write(debug_unit,*) me,' ',trim(name),': calling psi_desc_index'
! Do the actual format conversion. ! Do the actual format conversion.
call psi_desc_index(desc_a,index_in,dep_list(1:,me),& 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_) & if(debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),': out of psi_desc_index',& & write(debug_unit,*) me,' ',trim(name),': out of psi_desc_index',&
& size(index_out) & size(index_out)

@ -61,10 +61,6 @@ subroutine psi_crea_ovr_elem(me,desc_overlap,ovr_elem,info)
integer(psb_ipk_) :: dim_ovr_elem integer(psb_ipk_) :: dim_ovr_elem
integer(psb_ipk_) :: pairtree(2) 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_) :: nel, ip, ix, iel, insize, err_act, iproc
integer(psb_ipk_), allocatable :: telem(:,:) integer(psb_ipk_), allocatable :: telem(:,:)

@ -102,7 +102,7 @@ subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold)
! first the halo index ! first the halo index
if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on halo',& if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on halo',&
& size(halo_in) & 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 if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_crea_index') call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_crea_index')
goto 9999 goto 9999
@ -115,7 +115,7 @@ subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold)
! then ext index ! then ext index
if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on ext' 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 if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_crea_index') call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_crea_index')
goto 9999 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' if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on ovrlap'
! then the overlap index ! 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 if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_crea_index') call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_crea_index')
goto 9999 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' 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) call psi_bld_ovr_mst(me,cdesc%ovrlap_elem,tmp_mst_idx,info)
if (info == psb_success_) call psi_crea_index(cdesc,& 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 (debug_level>0) write(debug_unit,*) me,'Done crea_indx'
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_bld_ovr_mst') call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_bld_ovr_mst')

@ -38,16 +38,13 @@
! See below for a description of the formats. ! See below for a description of the formats.
! !
! Arguments: ! Arguments:
! desc_a - type(psb_desc_type) The descriptor; in this context only the index ! desc_a - type(psb_desc_type) The descriptor; in this context only the index
! mapping parts are used. ! mapping parts are used.
! index_in(:) - integer The index list, build format ! index_in(:) - integer The index list, build format
! index_out(:) - integer(psb_ipk_), allocatable The index list, assembled format ! index_out(:) - integer(psb_ipk_), allocatable The index list, assembled format
! glob_idx - logical Whether the input indices are in local or global ! nxch - integer The number of data exchanges on the calling process
! numbering; the global numbering is used when ! nsnd - integer Total send buffer size on the calling process
! converting the overlap exchange lists. ! 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 ! 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,& 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_desc_mod
use psb_realloc_mod use psb_realloc_mod
use psb_error_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_) :: index_in(:),dep_list(:)
integer(psb_ipk_),allocatable :: desc_index(:) integer(psb_ipk_),allocatable :: desc_index(:)
integer(psb_ipk_) :: length_dl,nsnd,nrcv,info integer(psb_ipk_) :: length_dl,nsnd,nrcv,info
logical :: isglob_in
! ....local scalars... ! ....local scalars...
integer(psb_ipk_) :: j,me,np,i,proc integer(psb_ipk_) :: j,me,np,i,proc
! ...parameters... ! ...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 ! note that here bsdinx is zero-based, hence the following loop
! !
if (isglob_in) then call desc%indxmap%l2g(index_in(i+1:i+nerv),&
do j=1, nerv & sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),&
sndbuf(bsdindx(proc+1)+j) = (index_in(i+j)) & info)
end do
else
call desc%indxmap%l2g(index_in(i+1:i+nerv),& if (info /= psb_success_) then
& sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),& call psb_errpush(psb_err_from_subroutine_,name,a_err='l2g')
& info) goto 9999
end if
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='l2g')
goto 9999
end if
endif
bsdindx(proc+1) = bsdindx(proc+1) + nerv bsdindx(proc+1) = bsdindx(proc+1) + nerv
i = i + nerv + 1 i = i + nerv + 1
end do end do

@ -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

@ -1,4 +1,4 @@
!
! Parallel Sparse BLAS version 3.5 ! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018 ! (C) Copyright 2006-2018
! Salvatore Filippone ! Salvatore Filippone
@ -142,9 +142,9 @@ module psb_desc_mod
! psb_ovrl subroutine. ! psb_ovrl subroutine.
! !
! 8. When the descriptor is in the BLD state the INDEX vectors contains only ! 8. When the descriptor is in the BLD state the INDEX vectors contains only
! the indices to be received, organized as a sequence ! the indices to be received, organized as a sequence of entries of
! of entries of the form (proc,N,(lx1,lx2,...,lxn)) with owning process, ! the form (proc,N,(lx1,lx2,...,lxn)) with owning process, number of indices
! number of indices (most often but not necessarily N=1), list of local 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 ! 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 ! 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 ! phase to be loosely synchronized. Thus we record the indices we have to ask
@ -1072,7 +1072,7 @@ contains
end subroutine psb_cd_clone 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_error_mod
use psb_penv_mod use psb_penv_mod
@ -1082,7 +1082,6 @@ contains
integer(psb_ipk_), intent(in) :: data integer(psb_ipk_), intent(in) :: data
Type(psb_desc_type), Intent(in), target :: desc Type(psb_desc_type), Intent(in), target :: desc
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: toglob
! .. Local Scalars .. ! .. Local Scalars ..
integer(psb_ipk_) :: incnt, outcnt, j, np, me, ictxt, l_tmp,& 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') call psb_errpush(info,name,a_err='psb_ensure_size')
goto 9999 goto 9999
end if end if
if (toglob) then tmp(outcnt) = proc
call desc%indxmap%l2g(idx,gidx,info) tmp(outcnt+1) = 1
If (gidx < 0) then tmp(outcnt+2) = idx
info=-3 tmp(outcnt+3) = -1
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
outcnt = outcnt+3 outcnt = outcnt+3
end Do end Do
incnt = incnt+n_elem_recv+n_elem_send+3 incnt = incnt+n_elem_recv+n_elem_send+3

@ -53,13 +53,12 @@ module psi_i_mod
end interface end interface
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 import
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info,nxch,nsnd,nrcv integer(psb_ipk_), intent(out) :: info,nxch,nsnd,nrcv
integer(psb_ipk_), intent(in) :: index_in(:) integer(psb_ipk_), intent(in) :: index_in(:)
integer(psb_ipk_), allocatable, intent(inout) :: index_out(:) integer(psb_ipk_), allocatable, intent(inout) :: index_out(:)
logical :: glob_idx
end subroutine psi_crea_index end subroutine psi_crea_index
end interface end interface
@ -74,13 +73,12 @@ module psi_i_mod
interface interface
subroutine psi_desc_index(desc,index_in,dep_list,& 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 import
type(psb_desc_type) :: desc type(psb_desc_type) :: desc
integer(psb_ipk_) :: index_in(:),dep_list(:) integer(psb_ipk_) :: index_in(:),dep_list(:)
integer(psb_ipk_),allocatable :: desc_index(:) integer(psb_ipk_),allocatable :: desc_index(:)
integer(psb_ipk_) :: length_dl,nsnd,nrcv,info integer(psb_ipk_) :: length_dl,nsnd,nrcv,info
logical :: isglob_in
end subroutine psi_desc_index end subroutine psi_desc_index
end interface end interface

@ -84,7 +84,8 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
integer(psb_ipk_) :: i, j, err_act,m,& integer(psb_ipk_) :: i, j, err_act,m,&
& lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
& index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo & 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,& & n_elem_send,tot_recv,tot_elem,cntov_o,&
& counter_t,n_elem,i_ovr,jj,proc_id,isz, & & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & 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 Do j=0,n_elem_recv-1
idx = ovrlap(counter+psb_elem_recv_+j) 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) call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
@ -269,7 +264,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
end if end if
orig_ovr(cntov_o)=proc orig_ovr(cntov_o)=proc
orig_ovr(cntov_o+1)=1 orig_ovr(cntov_o+1)=1
orig_ovr(cntov_o+2)=gidx orig_ovr(cntov_o+2)=idx
orig_ovr(cntov_o+3)=-1 orig_ovr(cntov_o+3)=-1
cntov_o=cntov_o+3 cntov_o=cntov_o+3
end Do end Do
@ -356,12 +351,6 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
end If end If
idx = halo(counter+psb_elem_recv_+j) 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) call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ 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) = proc
tmp_ovr_idx(counter_o+1) = 1 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 tmp_ovr_idx(counter_o+3) = -1
counter_o=counter_o+3 counter_o=counter_o+3
call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione) 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 Do j=0,n_elem_send-1
idx = halo(counter+psb_elem_send_+j) 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) call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ 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) = proc
tmp_ovr_idx(counter_o+1) = 1 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 tmp_ovr_idx(counter_o+3) = -1
counter_o=counter_o+3 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' write(debug_unit,*) me,' ',trim(name),':Calling Crea_index'
end if 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) & nxch,nsnd,nrcv,info)
if (debug_level >= psb_debug_outer_) then if (debug_level >= psb_debug_outer_) then

@ -369,6 +369,22 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
call aa%init(iictxt,vl(1:nlu),info) call aa%init(iictxt,vl(1:nlu),info)
end select 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) call psi_bld_tmpovrl(temp_ovrlap,desc,info)
if (info == psb_success_) deallocate(temp_ovrlap,vl,ix,stat=info) if (info == psb_success_) deallocate(temp_ovrlap,vl,ix,stat=info)

@ -61,9 +61,9 @@ Subroutine psb_cd_reinit(desc,info)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': start' & write(debug_unit,*) me,' ',trim(name),': start'
if (desc%is_asb()) then 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_ovr,desc,psb_comm_ovr_,info)
call psb_cd_get_recv_idx(tmp_halo,desc,psb_comm_halo_,info,toglob=.false.) 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,toglob=.false.) 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_ovr,desc%ovrlap_index,info)
call psb_move_alloc(tmp_halo,desc%halo_index,info) call psb_move_alloc(tmp_halo,desc%halo_index,info)

@ -267,7 +267,21 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': error check:' ,err & 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) call psi_bld_tmpovrl(temp_ovrlap,desc,info)
if (info == psb_success_) deallocate(prc_v,temp_ovrlap,stat=info) if (info == psb_success_) deallocate(prc_v,temp_ovrlap,stat=info)

@ -84,7 +84,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
integer(psb_ipk_) :: i, j, err_act,m,& integer(psb_ipk_) :: i, j, err_act,m,&
& lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
& index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo & 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,& & n_elem_send,tot_recv,tot_elem,cntov_o,&
& counter_t,n_elem,i_ovr,jj,proc_id,isz, & & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & 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 Do j=0,n_elem_recv-1
idx = ovrlap(counter+psb_elem_recv_+j) 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) call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
@ -269,7 +264,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
end if end if
orig_ovr(cntov_o)=proc orig_ovr(cntov_o)=proc
orig_ovr(cntov_o+1)=1 orig_ovr(cntov_o+1)=1
orig_ovr(cntov_o+2)=gidx orig_ovr(cntov_o+2)=idx
orig_ovr(cntov_o+3)=-1 orig_ovr(cntov_o+3)=-1
cntov_o=cntov_o+3 cntov_o=cntov_o+3
end Do end Do
@ -356,12 +351,6 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
end If end If
idx = halo(counter+psb_elem_recv_+j) 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) call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ 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) = proc
tmp_ovr_idx(counter_o+1) = 1 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 tmp_ovr_idx(counter_o+3) = -1
counter_o=counter_o+3 counter_o=counter_o+3
call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione) 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 Do j=0,n_elem_send-1
idx = halo(counter+psb_elem_send_+j) 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) call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ 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) = proc
tmp_ovr_idx(counter_o+1) = 1 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 tmp_ovr_idx(counter_o+3) = -1
counter_o=counter_o+3 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' write(debug_unit,*) me,' ',trim(name),':Calling Crea_index'
end if 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) & nxch,nsnd,nrcv,info)
if (debug_level >= psb_debug_outer_) then if (debug_level >= psb_debug_outer_) then

@ -84,7 +84,8 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
integer(psb_ipk_) :: i, j, err_act,m,& integer(psb_ipk_) :: i, j, err_act,m,&
& lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
& index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo & 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,& & n_elem_send,tot_recv,tot_elem,cntov_o,&
& counter_t,n_elem,i_ovr,jj,proc_id,isz, & & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & 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 Do j=0,n_elem_recv-1
idx = ovrlap(counter+psb_elem_recv_+j) 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) call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
@ -269,7 +264,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
end if end if
orig_ovr(cntov_o)=proc orig_ovr(cntov_o)=proc
orig_ovr(cntov_o+1)=1 orig_ovr(cntov_o+1)=1
orig_ovr(cntov_o+2)=gidx orig_ovr(cntov_o+2)=idx
orig_ovr(cntov_o+3)=-1 orig_ovr(cntov_o+3)=-1
cntov_o=cntov_o+3 cntov_o=cntov_o+3
end Do end Do
@ -356,12 +351,6 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
end If end If
idx = halo(counter+psb_elem_recv_+j) 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) call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ 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) = proc
tmp_ovr_idx(counter_o+1) = 1 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 tmp_ovr_idx(counter_o+3) = -1
counter_o=counter_o+3 counter_o=counter_o+3
call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione) 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 Do j=0,n_elem_send-1
idx = halo(counter+psb_elem_send_+j) 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) call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ 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) = proc
tmp_ovr_idx(counter_o+1) = 1 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 tmp_ovr_idx(counter_o+3) = -1
counter_o=counter_o+3 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' write(debug_unit,*) me,' ',trim(name),':Calling Crea_index'
end if 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) & nxch,nsnd,nrcv,info)
if (debug_level >= psb_debug_outer_) then if (debug_level >= psb_debug_outer_) then

@ -84,7 +84,8 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
integer(psb_ipk_) :: i, j, err_act,m,& integer(psb_ipk_) :: i, j, err_act,m,&
& lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
& index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo & 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,& & n_elem_send,tot_recv,tot_elem,cntov_o,&
& counter_t,n_elem,i_ovr,jj,proc_id,isz, & & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & 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 Do j=0,n_elem_recv-1
idx = ovrlap(counter+psb_elem_recv_+j) 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) call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
@ -269,7 +264,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
end if end if
orig_ovr(cntov_o)=proc orig_ovr(cntov_o)=proc
orig_ovr(cntov_o+1)=1 orig_ovr(cntov_o+1)=1
orig_ovr(cntov_o+2)=gidx orig_ovr(cntov_o+2)=idx
orig_ovr(cntov_o+3)=-1 orig_ovr(cntov_o+3)=-1
cntov_o=cntov_o+3 cntov_o=cntov_o+3
end Do end Do
@ -356,12 +351,6 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
end If end If
idx = halo(counter+psb_elem_recv_+j) 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) call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ 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) = proc
tmp_ovr_idx(counter_o+1) = 1 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 tmp_ovr_idx(counter_o+3) = -1
counter_o=counter_o+3 counter_o=counter_o+3
call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione) 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 Do j=0,n_elem_send-1
idx = halo(counter+psb_elem_send_+j) 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) call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ 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) = proc
tmp_ovr_idx(counter_o+1) = 1 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 tmp_ovr_idx(counter_o+3) = -1
counter_o=counter_o+3 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' write(debug_unit,*) me,' ',trim(name),':Calling Crea_index'
end if 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) & nxch,nsnd,nrcv,info)
if (debug_level >= psb_debug_outer_) then if (debug_level >= psb_debug_outer_) then

@ -4,8 +4,8 @@ BJAC Preconditioner NONE DIAG BJAC
CSR Storage format for matrix A: CSR COO CSR Storage format for matrix A: CSR COO
040 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) ) 040 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) )
2 Stopping criterion 1 2 2 Stopping criterion 1 2
1000 MAXIT 0100 MAXIT
-1 ITRACE 01 ITRACE
002 IRST restart for RGMRES and BiCGSTABL 002 IRST restart for RGMRES and BiCGSTABL

Loading…
Cancel
Save