fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fixed gen_block_map_mod.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 0b4854b6e9
commit 6e1b4e4788
6 changed files with 60 additions and 47 deletions
Show Stats Download Patch File Download Diff File

3
base/internals/psi_crea_index.f90
Unescape Escape View File

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

1
base/internals/psi_desc_index.F90
Unescape Escape View File

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

14
base/modules/auxil/psb_hash_mod.F90
Unescape Escape View File

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

80
base/modules/desc/psb_gen_block_map_mod.f90
Unescape Escape View File

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

5
base/tools/psb_cd_inloc.f90
Unescape Escape View File

@ -69,7 +69,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpk_) :: iictxt
real(psb_dpk_) :: t0, t1, t2, t3, t4, t5
logical :: do_timings=.true.
logical :: do_timings=.false.
logical :: check_, islarge
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'
islarge = psb_cd_is_large_size(m)
write(0,*) exch(3),m,islarge,check_
allocate(vl(loc_row),ix(loc_row),stat=info)
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
write(0,*) 'Doing globalchecks '
allocate(tmpgidx(m,2),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
@ -206,7 +204,6 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
end if
else
write(0,*) 'No globalchecks '
novrl = 0
norphan = 0
npr_ov = 0

4
test/pargen/runs/ppde.inp
Unescape Escape View File

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

Write Preview
Loading…
Cancel
Save