Fixed gen_block_map_mod.

ILmat
Salvatore Filippone 8 years ago
parent 0b4854b6e9
commit 6e1b4e4788

@ -44,9 +44,6 @@
! 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

@ -302,7 +302,6 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,&
desc_index(i) = nerv desc_index(i) = nerv
call desc%indxmap%g2l(sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),& call desc%indxmap%g2l(sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),&
& desc_index(i+1:i+nerv),info) & desc_index(i+1:i+nerv),info)
i = i + nerv + 1 i = i + nerv + 1
nesd = rvsz(proc+1) nesd = rvsz(proc+1)
desc_index(i) = nesd desc_index(i) = nesd

@ -96,11 +96,11 @@ module psb_hash_mod
end interface hashval end interface hashval
interface psb_hash_searchinskey interface psb_hash_searchinskey
module procedure psb_hash_searchinskey module procedure psb_hash_isearchinskey
end interface psb_hash_searchinskey end interface psb_hash_searchinskey
interface psb_hash_searchkey interface psb_hash_searchkey
module procedure psb_hash_searchkey module procedure psb_hash_isearchkey
end interface psb_hash_searchkey end interface psb_hash_searchkey
#endif #endif
@ -372,7 +372,7 @@ contains
type(psb_hash_type), intent(inout) :: hash type(psb_hash_type), intent(inout) :: hash
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_hash_type) :: nhash type(psb_hash_type) :: nhash
integer(psb_ipk_) :: key, val, nextval,i integer(psb_lpk_) :: key, val, nextval,i
info = HashOk info = HashOk
@ -457,7 +457,7 @@ contains
end do end do
end subroutine psb_hash_lsearchinskey end subroutine psb_hash_lsearchinskey
recursive subroutine psb_hash_searchinskey(key,val,nextval,hash,info) recursive subroutine psb_hash_isearchinskey(key,val,nextval,hash,info)
integer(psb_ipk_), intent(in) :: key,nextval integer(psb_ipk_), intent(in) :: key,nextval
type(psb_hash_type) :: hash type(psb_hash_type) :: hash
integer(psb_ipk_), intent(out) :: val, info integer(psb_ipk_), intent(out) :: val, info
@ -515,9 +515,9 @@ contains
hk = hk - hd hk = hk - hd
if (hk < 0) hk = hk + hsize if (hk < 0) hk = hk + hsize
end do end do
end subroutine psb_hash_searchinskey end subroutine psb_hash_isearchinskey
subroutine psb_hash_searchkey(key,val,hash,info) subroutine psb_hash_isearchkey(key,val,hash,info)
integer(psb_ipk_), intent(in) :: key integer(psb_ipk_), intent(in) :: key
type(psb_hash_type) :: hash type(psb_hash_type) :: hash
integer(psb_ipk_), intent(out) :: val, info integer(psb_ipk_), intent(out) :: val, info
@ -554,7 +554,7 @@ contains
hk = hk - hd hk = hk - hd
if (hk < 0) hk = hk + hsize if (hk < 0) hk = hk + hsize
end do end do
end subroutine psb_hash_searchkey end subroutine psb_hash_isearchkey
subroutine psb_hash_lsearchkey(key,val,hash,info) subroutine psb_hash_lsearchkey(key,val,hash,info)
integer(psb_lpk_), intent(in) :: key integer(psb_lpk_), intent(in) :: key

@ -784,8 +784,8 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:) logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned logical, intent(in), optional :: owned
integer(psb_ipk_) :: i, nv, is, ip, lip integer(psb_ipk_) :: i, nv, is
integer(psb_lpk_) :: tidx integer(psb_lpk_) :: tidx, ip, lip
integer(psb_mpk_) :: ictxt, iam, np integer(psb_mpk_) :: ictxt, iam, np
logical :: owned_ logical :: owned_
@ -795,7 +795,7 @@ contains
if (present(mask)) then if (present(mask)) then
if (size(mask) < size(idx)) then if (size(mask) < size(idx)) then
!!$ write(0,*) 'Block g2l: size of mask', size(mask),size(idx) !write(0,*) 'Block g2l: size of mask', size(mask),size(idx)
info = -1 info = -1
return return
end if end if
@ -812,7 +812,8 @@ contains
if (idxmap%is_asb()) then if (idxmap%is_asb()) then
do i=1, is do i=1, is
if (mask(i)) then if (mask(i)) then
if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idx(i)).and. &
& (idx(i) <= idxmap%max_glob_row)) then
idx(i) = idx(i) - idxmap%min_glob_row + 1 idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)& else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)&
&.and.(.not.owned_)) then &.and.(.not.owned_)) then
@ -828,7 +829,8 @@ contains
else if (idxmap%is_valid()) then else if (idxmap%is_valid()) then
do i=1,is do i=1,is
if (mask(i)) then if (mask(i)) then
if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idx(i)).and.&
& (idx(i) <= idxmap%max_glob_row)) then
idx(i) = idx(i) - idxmap%min_glob_row + 1 idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)& else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)&
&.and.(.not.owned_)) then &.and.(.not.owned_)) then
@ -850,7 +852,8 @@ contains
if (idxmap%is_asb()) then if (idxmap%is_asb()) then
do i=1, is do i=1, is
if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idx(i)).and.&
& (idx(i) <= idxmap%max_glob_row)) then
idx(i) = idx(i) - idxmap%min_glob_row + 1 idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)& else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)&
&.and.(.not.owned_)) then &.and.(.not.owned_)) then
@ -865,7 +868,8 @@ contains
else if (idxmap%is_valid()) then else if (idxmap%is_valid()) then
do i=1,is do i=1,is
if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idx(i)).and.&
& (idx(i) <= idxmap%max_glob_row)) then
idx(i) = idx(i) - idxmap%min_glob_row + 1 idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)& else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)&
&.and.(.not.owned_)) then &.and.(.not.owned_)) then
@ -877,7 +881,6 @@ contains
end if end if
end do end do
else else
!!$ write(0,*) 'Block status: invalid ',idxmap%get_state()
idx(1:is) = -1 idx(1:is) = -1
info = -1 info = -1
end if end if
@ -897,8 +900,8 @@ contains
logical, intent(in), optional :: mask(:) logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned logical, intent(in), optional :: owned
integer(psb_ipk_) :: i, nv, is, ip, lip, im integer(psb_ipk_) :: i, nv, is, im
integer(psb_lpk_) :: tidx integer(psb_lpk_) :: tidx, ip, lip
integer(psb_mpk_) :: ictxt, iam, np integer(psb_mpk_) :: ictxt, iam, np
logical :: owned_ logical :: owned_
@ -926,14 +929,16 @@ contains
if (idxmap%is_asb()) then if (idxmap%is_asb()) then
do i=1, im do i=1, im
if (mask(i)) then if (mask(i)) then
if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idxin(i)).and.&
& (idxin(i) <= idxmap%max_glob_row)) then
idxout(i) = idxin(i) - idxmap%min_glob_row + 1 idxout(i) = idxin(i) - idxmap%min_glob_row + 1
else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)& else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)&
&.and.(.not.owned_)) then &.and.(.not.owned_)) then
nv = size(idxmap%srt_l2g,1) nv = size(idxmap%srt_l2g,1)
tidx = idxin(i) tidx = idxin(i)
idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1)) idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1))
if (idxout(i) > 0) idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows if (idxout(i) > 0) &
& idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows
else else
idxout(i) = -1 idxout(i) = -1
end if end if
@ -942,7 +947,8 @@ contains
else if (idxmap%is_valid()) then else if (idxmap%is_valid()) then
do i=1,im do i=1,im
if (mask(i)) then if (mask(i)) then
if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idxin(i)).and.&
& (idxin(i) <= idxmap%max_glob_row)) then
idxout(i) = idxin(i) - idxmap%min_glob_row + 1 idxout(i) = idxin(i) - idxmap%min_glob_row + 1
else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)& else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)&
&.and.(.not.owned_)) then &.and.(.not.owned_)) then
@ -964,14 +970,16 @@ contains
if (idxmap%is_asb()) then if (idxmap%is_asb()) then
do i=1, im do i=1, im
if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idxin(i)).and.&
& (idxin(i) <= idxmap%max_glob_row)) then
idxout(i) = idxin(i) - idxmap%min_glob_row + 1 idxout(i) = idxin(i) - idxmap%min_glob_row + 1
else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)& else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)&
&.and.(.not.owned_)) then &.and.(.not.owned_)) then
nv = size(idxmap%srt_l2g,1) nv = size(idxmap%srt_l2g,1)
tidx = idxin(i) tidx = idxin(i)
idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1)) idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1))
if (idxout(i) > 0) idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows if (idxout(i) > 0) &
& idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows
else else
idxout(i) = -1 idxout(i) = -1
end if end if
@ -979,7 +987,8 @@ contains
else if (idxmap%is_valid()) then else if (idxmap%is_valid()) then
do i=1,im do i=1,im
if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idxin(i)).and.&
& (idxin(i) <= idxmap%max_glob_row)) then
idxout(i) = idxin(i) - idxmap%min_glob_row + 1 idxout(i) = idxin(i) - idxmap%min_glob_row + 1
else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)& else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)&
&.and.(.not.owned_)) then &.and.(.not.owned_)) then
@ -1532,7 +1541,8 @@ contains
do i=1, is do i=1, is
if (mask(i)) then if (mask(i)) then
if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idx(i)).and.&
& (idx(i) <= idxmap%max_glob_row)) then
idx(i) = idx(i) - idxmap%min_glob_row + 1 idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
@ -1572,7 +1582,8 @@ contains
do i=1, is do i=1, is
if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idx(i)).and.&
& (idx(i) <= idxmap%max_glob_row)) then
idx(i) = idx(i) - idxmap%min_glob_row + 1 idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
if (lidx(i) <= idxmap%local_rows) then if (lidx(i) <= idxmap%local_rows) then
@ -1612,7 +1623,8 @@ contains
if (present(mask)) then if (present(mask)) then
do i=1, is do i=1, is
if (mask(i)) then if (mask(i)) then
if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idx(i)).and.&
& (idx(i) <= idxmap%max_glob_row)) then
idx(i) = idx(i) - idxmap%min_glob_row + 1 idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
nv = idxmap%local_cols-idxmap%local_rows nv = idxmap%local_cols-idxmap%local_rows
@ -1648,7 +1660,8 @@ contains
do i=1, is do i=1, is
if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idx(i)).and.&
& (idx(i) <= idxmap%max_glob_row)) then
idx(i) = idx(i) - idxmap%min_glob_row + 1 idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
nv = idxmap%local_cols-idxmap%local_rows nv = idxmap%local_cols-idxmap%local_rows
@ -1734,7 +1747,8 @@ contains
do i=1, im do i=1, im
if (mask(i)) then if (mask(i)) then
if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idxin(i)).and.&
& (idxin(i) <= idxmap%max_glob_row)) then
idxout(i) = idxin(i) - idxmap%min_glob_row + 1 idxout(i) = idxin(i) - idxmap%min_glob_row + 1
else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
@ -1774,7 +1788,8 @@ contains
do i=1, im do i=1, im
if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idxin(i)).and.&
& (idxin(i) <= idxmap%max_glob_row)) then
idxout(i) = idxin(i) - idxmap%min_glob_row + 1 idxout(i) = idxin(i) - idxmap%min_glob_row + 1
else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
if (lidx(i) <= idxmap%local_rows) then if (lidx(i) <= idxmap%local_rows) then
@ -1814,7 +1829,8 @@ contains
if (present(mask)) then if (present(mask)) then
do i=1, im do i=1, im
if (mask(i)) then if (mask(i)) then
if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idxin(i)).and.&
& (idxin(i) <= idxmap%max_glob_row)) then
idxout(i) = idxin(i) - idxmap%min_glob_row + 1 idxout(i) = idxin(i) - idxmap%min_glob_row + 1
else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
nv = idxmap%local_cols-idxmap%local_rows nv = idxmap%local_cols-idxmap%local_rows
@ -1850,7 +1866,8 @@ contains
do i=1, im do i=1, im
if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then if ((idxmap%min_glob_row <= idxin(i)).and.&
& (idxin(i) <= idxmap%max_glob_row)) then
idxout(i) = idxin(i) - idxmap%min_glob_row + 1 idxout(i) = idxin(i) - idxmap%min_glob_row + 1
else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
nv = idxmap%local_cols-idxmap%local_rows nv = idxmap%local_cols-idxmap%local_rows
@ -1889,7 +1906,6 @@ contains
end if end if
if (is > im) then if (is > im) then
!!$ write(0,*) 'g2lv2_ins err -3'
info = -3 info = -3
end if end if
@ -1910,7 +1926,6 @@ contains
nv = size(idx) nv = size(idx)
allocate(iprc(nv),stat=info) allocate(iprc(nv),stat=info)
if (info /= 0) then if (info /= 0) then
!!$ write(0,*) 'Memory allocation failure in repl_map_fnd-owner'
return return
end if end if
do i=1, nv do i=1, nv
@ -1993,9 +2008,9 @@ contains
class(psb_gen_block_map), intent(inout) :: idxmap class(psb_gen_block_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: nhal integer(psb_ipk_) :: nhal, i
integer(psb_mpk_) :: ictxt, iam, np integer(psb_mpk_) :: ictxt, iam, np
logical :: debug=.false.
info = 0 info = 0
ictxt = idxmap%get_ctxt() ictxt = idxmap%get_ctxt()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -2008,6 +2023,11 @@ contains
call psb_msort(idxmap%srt_l2g(:,1),& call psb_msort(idxmap%srt_l2g(:,1),&
& ix=idxmap%srt_l2g(:,2),dir=psb_sort_up_) & ix=idxmap%srt_l2g(:,2),dir=psb_sort_up_)
if (debug) then
do i=1, nhal
write(0,*) iam,' block_l2g:',idxmap%srt_l2g(i,1:2)
end do
end if
call psb_free(idxmap%hash,info) call psb_free(idxmap%hash,info)
call idxmap%set_state(psb_desc_asb_) call idxmap%set_state(psb_desc_asb_)

@ -69,7 +69,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpk_) :: iictxt integer(psb_mpk_) :: iictxt
real(psb_dpk_) :: t0, t1, t2, t3, t4, t5 real(psb_dpk_) :: t0, t1, t2, t3, t4, t5
logical :: do_timings=.true. logical :: do_timings=.false.
logical :: check_, islarge logical :: check_, islarge
character(len=20) :: name character(len=20) :: name
@ -143,7 +143,6 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
& write(debug_unit,*) me,' ',trim(name),': doing global checks' & write(debug_unit,*) me,' ',trim(name),': doing global checks'
islarge = psb_cd_is_large_size(m) islarge = psb_cd_is_large_size(m)
write(0,*) exch(3),m,islarge,check_
allocate(vl(loc_row),ix(loc_row),stat=info) allocate(vl(loc_row),ix(loc_row),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -161,7 +160,6 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
! !
if (check_.or.(.not.islarge)) then if (check_.or.(.not.islarge)) then
write(0,*) 'Doing globalchecks '
allocate(tmpgidx(m,2),stat=info) allocate(tmpgidx(m,2),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_dealloc_ info=psb_err_alloc_dealloc_
@ -206,7 +204,6 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
end if end if
else else
write(0,*) 'No globalchecks '
novrl = 0 novrl = 0
norphan = 0 norphan = 0
npr_ov = 0 npr_ov = 0

@ -2,8 +2,8 @@
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES FCG CGR BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES FCG CGR
BJAC Preconditioner NONE DIAG BJAC BJAC Preconditioner NONE DIAG BJAC
CSR Storage format for matrix A: CSR COO CSR Storage format for matrix A: CSR COO
004 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) ) 040 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) )
1 Partition: 1 BLOCK 3 3D 3 Partition: 1 BLOCK 3 3D
2 Stopping criterion 1 2 2 Stopping criterion 1 2
1000 MAXIT 1000 MAXIT
-1 ITRACE -1 ITRACE

Loading…
Cancel
Save