Split ldsc_pre_halo, preparing for restructuring of bldext.

psblas3-type-indexed
Salvatore Filippone 17 years ago
parent ee22b69b2f
commit 7aab3dc29c

@ -4,7 +4,7 @@ FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \
psi_crea_ovr_elem.o psi_dl_check.o \ psi_crea_ovr_elem.o psi_dl_check.o \
psi_gthsct_mod.o \ psi_gthsct_mod.o \
psi_sort_dl.o \ psi_sort_dl.o \
psi_ldsc_pre_halo.o\ psi_ldsc_pre_halo.o psi_bld_tmphalo.o psi_bld_hash.o\
psi_sort_dl.o psi_idx_cnv.o psi_idx_ins_cnv.o psi_fnd_owner.o psi_sort_dl.o psi_idx_cnv.o psi_idx_ins_cnv.o psi_fnd_owner.o
FOBJS2 = psi_exist_ovr_elem.o psi_list_search.o srtlist.o FOBJS2 = psi_exist_ovr_elem.o psi_list_search.o srtlist.o
COBJS = avltree.o srcht.o COBJS = avltree.o srcht.o

@ -35,13 +35,13 @@
! Figure out who owns global indices. ! Figure out who owns global indices.
! !
! Arguments: ! Arguments:
! nv - integer Number of indices required on the calling ! nv - integer Number of indices required on the calling
! process ! process
! idx(:) - integer Required indices on the calling process ! idx(:) - integer Required indices on the calling process
! iprc(:) - integer, allocatable Output: process identifiers for the corresponding ! iprc(:) - integer, allocatable Output: process identifiers for the corresponding
! indices ! indices
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code. ! info - integer. return code.
! !
subroutine psi_fnd_owner(nv,idx,iprc,desc,info) subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
use psb_descriptor_type use psb_descriptor_type
@ -54,7 +54,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
implicit none implicit none
integer, intent(in) :: nv integer, intent(in) :: nv
integer, intent(in) :: idx(:) integer, intent(in) :: idx(:)
integer, allocatable, intent(out) :: iprc(:) integer, allocatable, intent(out) :: iprc(:)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
integer, intent(out) :: info integer, intent(out) :: info

@ -92,96 +92,21 @@ subroutine psi_ldsc_pre_halo(desc,ext_hv,info)
goto 9999 goto 9999
end if end if
call psi_bld_hash(desc,info)
nk = n_col
call psb_realloc(nk,2,desc%glb_lc,info)
if (info ==0) call psb_realloc(psb_hash_size+1,desc%hashv,info,lb=0)
if (info /= 0) then if (info /= 0) then
ch_err='psb_realloc' ch_err='psi_bld_hash'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
! Build a hashed table of sorted lists to search for
! indices.
desc%hashv(0:psb_hash_size) = 0
do i=1, nk
key = desc%loc_to_glob(i)
ih = iand(key,psb_hash_mask)
desc%hashv(ih) = desc%hashv(ih) + 1
end do
nh = desc%hashv(0)
idx = 1
do i=1, psb_hash_size
desc%hashv(i-1) = idx
idx = idx + nh
nh = desc%hashv(i)
end do
do i=1, nk
key = desc%loc_to_glob(i)
ih = iand(key,psb_hash_mask)
idx = desc%hashv(ih)
desc%glb_lc(idx,1) = key
desc%glb_lc(idx,2) = i
desc%hashv(ih) = desc%hashv(ih) + 1
end do
do i = psb_hash_size, 1, -1
desc%hashv(i) = desc%hashv(i-1)
end do
desc%hashv(0) = 1
do i=0, psb_hash_size-1
idx = desc%hashv(i)
nh = desc%hashv(i+1) - desc%hashv(i)
if (nh > 1) then
call psb_msort(desc%glb_lc(idx:idx+nh-1,1),&
& ix=desc%glb_lc(idx:idx+nh-1,2),flag=psb_sort_keep_idx_)
end if
end do
if (.not.ext_hv) then if (.not.ext_hv) then
! Here we do not know yet who owns what, so we have call psi_bld_tmphalo(desc,info)
! to call fnd_owner. if (info /= 0) then
nh = (n_col-n_row) ch_err='psi_bld_tmphalo'
if (nh > 0) then call psb_errpush(info,name,a_err=ch_err)
Allocate(helem(nh),stat=info) goto 9999
if (info /= 0) then end if
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
do i=1, nh
helem(i) = desc%loc_to_glob(n_row+i)
end do
call psi_fnd_owner(nh,helem,hproc,desc,info)
allocate(tmphl((3*((n_col-n_row)+1)+1)),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
j = 1
do i=1,nh
tmphl(j+0) = hproc(i)
if (tmphl(j+0)<0) then
write(0,*) 'Unrecoverable error: missing proc from asb'
end if
tmphl(j+1) = 1
tmphl(j+2) = n_row+i
j = j + 3
end do
tmphl(j) = -1
lhalo = j
nhalo = (lhalo-1)/3
else
allocate(tmphl(1),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
tmphl=-1
endif
call psb_transfer(tmphl,desc%halo_index,info)
end if end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -236,6 +236,22 @@ module psi_mod
end subroutine psi_ldsc_pre_halo end subroutine psi_ldsc_pre_halo
end interface end interface
interface psi_bld_hash
subroutine psi_bld_hash(desc,info)
use psb_descriptor_type
type(psb_desc_type), intent(inout) :: desc
integer, intent(out) :: info
end subroutine psi_bld_hash
end interface
interface psi_bld_tmphalo
subroutine psi_bld_tmphalo(desc,info)
use psb_descriptor_type
type(psb_desc_type), intent(inout) :: desc
integer, intent(out) :: info
end subroutine psi_bld_tmphalo
end interface
interface psi_idx_cnv interface psi_idx_cnv
subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned) subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned)
use psb_descriptor_type use psb_descriptor_type

Loading…
Cancel
Save