|
|
|
@ -42,7 +42,22 @@
|
|
|
|
|
! there will be few processes, compared to indices, so it is possible
|
|
|
|
|
! to answer the ownership question without resorting to data exchange
|
|
|
|
|
! (well, the data exchange is needed but only once at initial allocation
|
|
|
|
|
! time).
|
|
|
|
|
! time). These are stored in VNL in a format similar to the pointers
|
|
|
|
|
! in CSR.
|
|
|
|
|
!
|
|
|
|
|
! The halo indices may be stored in three different places:
|
|
|
|
|
! 1. map%loc_to_glob(:)
|
|
|
|
|
! This stores the global indices corresponding to local halo
|
|
|
|
|
! indices, not the owned indices that can be determined from
|
|
|
|
|
! min_glob_row and max_glob_row; hence any access into this
|
|
|
|
|
! vector has to be rescaled by N_ROW.
|
|
|
|
|
! 2. map%srt_g2l(:,:)
|
|
|
|
|
! This contains in column 1 the same global indices as in loc_to_glob
|
|
|
|
|
! sorted for quick access, and in column 2 the corresponding local
|
|
|
|
|
! index; it is set up at assembly time.
|
|
|
|
|
! 3. map%hash
|
|
|
|
|
! This is used when the map is in the bld state, so that g2l queries can
|
|
|
|
|
! be answered quickly before the availability of srt_g2l.
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
module psb_gen_block_map_mod
|
|
|
|
@ -54,7 +69,7 @@ module psb_gen_block_map_mod
|
|
|
|
|
type, extends(psb_indx_map) :: psb_gen_block_map
|
|
|
|
|
integer(psb_lpk_) :: min_glob_row = -1
|
|
|
|
|
integer(psb_lpk_) :: max_glob_row = -1
|
|
|
|
|
integer(psb_lpk_), allocatable :: loc_to_glob(:), srt_l2g(:,:), vnl(:)
|
|
|
|
|
integer(psb_lpk_), allocatable :: loc_to_glob(:), srt_g2l(:,:), vnl(:)
|
|
|
|
|
type(psb_hash_type) :: hash
|
|
|
|
|
contains
|
|
|
|
|
|
|
|
|
@ -134,8 +149,8 @@ contains
|
|
|
|
|
val = val + 2 * psb_sizeof_lp
|
|
|
|
|
if (allocated(idxmap%loc_to_glob)) &
|
|
|
|
|
& val = val + size(idxmap%loc_to_glob)*psb_sizeof_lp
|
|
|
|
|
if (allocated(idxmap%srt_l2g)) &
|
|
|
|
|
& val = val + size(idxmap%srt_l2g)*psb_sizeof_lp
|
|
|
|
|
if (allocated(idxmap%srt_g2l)) &
|
|
|
|
|
& val = val + size(idxmap%srt_g2l)*psb_sizeof_lp
|
|
|
|
|
if (allocated(idxmap%vnl)) &
|
|
|
|
|
& val = val + size(idxmap%vnl)*psb_sizeof_lp
|
|
|
|
|
val = val + psb_sizeof(idxmap%hash)
|
|
|
|
@ -148,10 +163,10 @@ contains
|
|
|
|
|
integer(psb_ipk_) :: info
|
|
|
|
|
if (allocated(idxmap%loc_to_glob)) &
|
|
|
|
|
& deallocate(idxmap%loc_to_glob)
|
|
|
|
|
if (allocated(idxmap%srt_l2g)) &
|
|
|
|
|
& deallocate(idxmap%srt_l2g)
|
|
|
|
|
if (allocated(idxmap%srt_g2l)) &
|
|
|
|
|
& deallocate(idxmap%srt_g2l)
|
|
|
|
|
|
|
|
|
|
if (allocated(idxmap%srt_l2g)) &
|
|
|
|
|
if (allocated(idxmap%srt_g2l)) &
|
|
|
|
|
& deallocate(idxmap%vnl)
|
|
|
|
|
call psb_free(idxmap%hash,info)
|
|
|
|
|
call idxmap%psb_indx_map%free()
|
|
|
|
@ -550,10 +565,10 @@ contains
|
|
|
|
|
!!$ idx(i) = idx(i) - idxmap%min_glob_row + 1
|
|
|
|
|
!!$ else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)&
|
|
|
|
|
!!$ &.and.(.not.owned_)) then
|
|
|
|
|
!!$ nv = size(idxmap%srt_l2g,1)
|
|
|
|
|
!!$ nv = size(idxmap%srt_g2l,1)
|
|
|
|
|
!!$ tidx = idx(i)
|
|
|
|
|
!!$ idx(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1))
|
|
|
|
|
!!$ if (idx(i) > 0) idx(i) = idxmap%srt_l2g(idx(i),2)+idxmap%local_rows
|
|
|
|
|
!!$ idx(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
|
|
|
|
|
!!$ if (idx(i) > 0) idx(i) = idxmap%srt_g2l(idx(i),2)+idxmap%local_rows
|
|
|
|
|
!!$ else
|
|
|
|
|
!!$ idx(i) = -1
|
|
|
|
|
!!$ end if
|
|
|
|
@ -588,10 +603,10 @@ contains
|
|
|
|
|
!!$ idx(i) = idx(i) - idxmap%min_glob_row + 1
|
|
|
|
|
!!$ else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)&
|
|
|
|
|
!!$ &.and.(.not.owned_)) then
|
|
|
|
|
!!$ nv = size(idxmap%srt_l2g,1)
|
|
|
|
|
!!$ nv = size(idxmap%srt_g2l,1)
|
|
|
|
|
!!$ tidx = idx(i)
|
|
|
|
|
!!$ idx(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1))
|
|
|
|
|
!!$ if (idx(i) > 0) idx(i) = idxmap%srt_l2g(idx(i),2)+idxmap%local_rows
|
|
|
|
|
!!$ idx(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
|
|
|
|
|
!!$ if (idx(i) > 0) idx(i) = idxmap%srt_g2l(idx(i),2)+idxmap%local_rows
|
|
|
|
|
!!$ else
|
|
|
|
|
!!$ idx(i) = -1
|
|
|
|
|
!!$ end if
|
|
|
|
@ -664,10 +679,10 @@ contains
|
|
|
|
|
!!$ 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)
|
|
|
|
|
!!$ nv = size(idxmap%srt_g2l,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
|
|
|
|
|
!!$ idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
|
|
|
|
|
!!$ if (idxout(i) > 0) idxout(i) = idxmap%srt_g2l(idxout(i),2)+idxmap%local_rows
|
|
|
|
|
!!$ else
|
|
|
|
|
!!$ idxout(i) = -1
|
|
|
|
|
!!$ end if
|
|
|
|
@ -702,10 +717,10 @@ contains
|
|
|
|
|
!!$ 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)
|
|
|
|
|
!!$ nv = size(idxmap%srt_g2l,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
|
|
|
|
|
!!$ idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
|
|
|
|
|
!!$ if (idxout(i) > 0) idxout(i) = idxmap%srt_g2l(idxout(i),2)+idxmap%local_rows
|
|
|
|
|
!!$ else
|
|
|
|
|
!!$ idxout(i) = -1
|
|
|
|
|
!!$ end if
|
|
|
|
@ -822,10 +837,10 @@ contains
|
|
|
|
|
idx(i) = idx(i) - idxmap%min_glob_row + 1
|
|
|
|
|
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)&
|
|
|
|
|
&.and.(.not.owned_)) then
|
|
|
|
|
nv = size(idxmap%srt_l2g,1)
|
|
|
|
|
nv = size(idxmap%srt_g2l,1)
|
|
|
|
|
tidx = idx(i)
|
|
|
|
|
idx(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1))
|
|
|
|
|
if (idx(i) > 0) idx(i) = idxmap%srt_l2g(idx(i),2)+idxmap%local_rows
|
|
|
|
|
idx(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
|
|
|
|
|
if (idx(i) > 0) idx(i) = idxmap%srt_g2l(idx(i),2)+idxmap%local_rows
|
|
|
|
|
else
|
|
|
|
|
idx(i) = -1
|
|
|
|
|
end if
|
|
|
|
@ -862,10 +877,10 @@ contains
|
|
|
|
|
idx(i) = idx(i) - idxmap%min_glob_row + 1
|
|
|
|
|
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)&
|
|
|
|
|
&.and.(.not.owned_)) then
|
|
|
|
|
nv = size(idxmap%srt_l2g,1)
|
|
|
|
|
nv = size(idxmap%srt_g2l,1)
|
|
|
|
|
tidx = idx(i)
|
|
|
|
|
idx(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1))
|
|
|
|
|
if (idx(i) > 0) idx(i) = idxmap%srt_l2g(idx(i),2)+idxmap%local_rows
|
|
|
|
|
idx(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
|
|
|
|
|
if (idx(i) > 0) idx(i) = idxmap%srt_g2l(idx(i),2)+idxmap%local_rows
|
|
|
|
|
else
|
|
|
|
|
idx(i) = -1
|
|
|
|
|
end if
|
|
|
|
@ -939,11 +954,11 @@ contains
|
|
|
|
|
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)
|
|
|
|
|
nv = size(idxmap%srt_g2l,1)
|
|
|
|
|
tidx = idxin(i)
|
|
|
|
|
idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1))
|
|
|
|
|
idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
|
|
|
|
|
if (idxout(i) > 0) &
|
|
|
|
|
& idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows
|
|
|
|
|
& idxout(i) = idxmap%srt_g2l(idxout(i),2)+idxmap%local_rows
|
|
|
|
|
else
|
|
|
|
|
idxout(i) = -1
|
|
|
|
|
end if
|
|
|
|
@ -980,11 +995,11 @@ contains
|
|
|
|
|
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)
|
|
|
|
|
nv = size(idxmap%srt_g2l,1)
|
|
|
|
|
tidx = idxin(i)
|
|
|
|
|
idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1))
|
|
|
|
|
idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
|
|
|
|
|
if (idxout(i) > 0) &
|
|
|
|
|
& idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows
|
|
|
|
|
& idxout(i) = idxmap%srt_g2l(idxout(i),2)+idxmap%local_rows
|
|
|
|
|
else
|
|
|
|
|
idxout(i) = -1
|
|
|
|
|
end if
|
|
|
|
@ -2024,14 +2039,14 @@ contains
|
|
|
|
|
nhal = idxmap%local_cols-idxmap%local_rows
|
|
|
|
|
|
|
|
|
|
call psb_realloc(nhal,idxmap%loc_to_glob,info)
|
|
|
|
|
call psb_realloc(nhal,2,idxmap%srt_l2g,info)
|
|
|
|
|
idxmap%srt_l2g(1:nhal,1) = idxmap%loc_to_glob(1:nhal)
|
|
|
|
|
call psb_realloc(nhal,2,idxmap%srt_g2l,info)
|
|
|
|
|
idxmap%srt_g2l(1:nhal,1) = idxmap%loc_to_glob(1:nhal)
|
|
|
|
|
|
|
|
|
|
call psb_msort(idxmap%srt_l2g(:,1),&
|
|
|
|
|
& ix=idxmap%srt_l2g(:,2),dir=psb_sort_up_)
|
|
|
|
|
call psb_msort(idxmap%srt_g2l(:,1),&
|
|
|
|
|
& ix=idxmap%srt_g2l(:,2),dir=psb_sort_up_)
|
|
|
|
|
if (debug) then
|
|
|
|
|
do i=1, nhal
|
|
|
|
|
write(0,*) iam,' block_l2g:',idxmap%srt_l2g(i,1:2)
|
|
|
|
|
write(0,*) iam,' block_l2g:',idxmap%srt_g2l(i,1:2)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
@ -2085,7 +2100,7 @@ contains
|
|
|
|
|
if (info == psb_success_)&
|
|
|
|
|
& call psb_safe_ab_cpy(idxmap%vnl,outmap%vnl,info)
|
|
|
|
|
if (info == psb_success_)&
|
|
|
|
|
& call psb_safe_ab_cpy(idxmap%srt_l2g,outmap%srt_l2g,info)
|
|
|
|
|
& call psb_safe_ab_cpy(idxmap%srt_g2l,outmap%srt_g2l,info)
|
|
|
|
|
if (info == psb_success_)&
|
|
|
|
|
& call psb_hash_copy(idxmap%hash,outmap%hash,info)
|
|
|
|
|
|
|
|
|
|