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

Additional docs inside GEN_BLOCK_MAP.

Browse Source
scr-persistent-collective
Salvatore Filippone 6 years ago
parent c465f255c2
commit 99b23f26c1
1 changed files with 52 additions and 37 deletions
Show Stats Download Patch File Download Diff File

89
base/modules/desc/psb_gen_block_map_mod.F90
Unescape Escape View File

@ -42,7 +42,22 @@
! there will be few processes, compared to indices, so it is possible ! there will be few processes, compared to indices, so it is possible
! to answer the ownership question without resorting to data exchange ! to answer the ownership question without resorting to data exchange
! (well, the data exchange is needed but only once at initial allocation ! (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 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 type, extends(psb_indx_map) :: psb_gen_block_map
integer(psb_lpk_) :: min_glob_row = -1 integer(psb_lpk_) :: min_glob_row = -1
integer(psb_lpk_) :: max_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 type(psb_hash_type) :: hash
contains contains
@ -134,8 +149,8 @@ contains
val = val + 2 * psb_sizeof_lp val = val + 2 * psb_sizeof_lp
if (allocated(idxmap%loc_to_glob)) & if (allocated(idxmap%loc_to_glob)) &
& val = val + size(idxmap%loc_to_glob)*psb_sizeof_lp & val = val + size(idxmap%loc_to_glob)*psb_sizeof_lp
if (allocated(idxmap%srt_l2g)) & if (allocated(idxmap%srt_g2l)) &
& val = val + size(idxmap%srt_l2g)*psb_sizeof_lp & val = val + size(idxmap%srt_g2l)*psb_sizeof_lp
if (allocated(idxmap%vnl)) & if (allocated(idxmap%vnl)) &
& val = val + size(idxmap%vnl)*psb_sizeof_lp & val = val + size(idxmap%vnl)*psb_sizeof_lp
val = val + psb_sizeof(idxmap%hash) val = val + psb_sizeof(idxmap%hash)
@ -148,10 +163,10 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
if (allocated(idxmap%loc_to_glob)) & if (allocated(idxmap%loc_to_glob)) &
& deallocate(idxmap%loc_to_glob) & deallocate(idxmap%loc_to_glob)
if (allocated(idxmap%srt_l2g)) & if (allocated(idxmap%srt_g2l)) &
& deallocate(idxmap%srt_l2g) & deallocate(idxmap%srt_g2l)
if (allocated(idxmap%srt_l2g)) & if (allocated(idxmap%srt_g2l)) &
& deallocate(idxmap%vnl) & deallocate(idxmap%vnl)
call psb_free(idxmap%hash,info) call psb_free(idxmap%hash,info)
call idxmap%psb_indx_map%free() call idxmap%psb_indx_map%free()
@ -550,10 +565,10 @@ contains
!!$ 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
!!$ nv = size(idxmap%srt_l2g,1) !!$ nv = size(idxmap%srt_g2l,1)
!!$ tidx = idx(i) !!$ tidx = idx(i)
!!$ idx(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1)) !!$ idx(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
!!$ if (idx(i) > 0) idx(i) = idxmap%srt_l2g(idx(i),2)+idxmap%local_rows !!$ if (idx(i) > 0) idx(i) = idxmap%srt_g2l(idx(i),2)+idxmap%local_rows
!!$ else !!$ else
!!$ idx(i) = -1 !!$ idx(i) = -1
!!$ end if !!$ end if
@ -588,10 +603,10 @@ contains
!!$ 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
!!$ nv = size(idxmap%srt_l2g,1) !!$ nv = size(idxmap%srt_g2l,1)
!!$ tidx = idx(i) !!$ tidx = idx(i)
!!$ idx(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1)) !!$ idx(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
!!$ if (idx(i) > 0) idx(i) = idxmap%srt_l2g(idx(i),2)+idxmap%local_rows !!$ if (idx(i) > 0) idx(i) = idxmap%srt_g2l(idx(i),2)+idxmap%local_rows
!!$ else !!$ else
!!$ idx(i) = -1 !!$ idx(i) = -1
!!$ end if !!$ end if
@ -664,10 +679,10 @@ contains
!!$ 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_g2l,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_g2l(:,1))
!!$ if (idxout(i) > 0) idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows !!$ if (idxout(i) > 0) idxout(i) = idxmap%srt_g2l(idxout(i),2)+idxmap%local_rows
!!$ else !!$ else
!!$ idxout(i) = -1 !!$ idxout(i) = -1
!!$ end if !!$ end if
@ -702,10 +717,10 @@ contains
!!$ 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_g2l,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_g2l(:,1))
!!$ if (idxout(i) > 0) idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows !!$ if (idxout(i) > 0) idxout(i) = idxmap%srt_g2l(idxout(i),2)+idxmap%local_rows
!!$ else !!$ else
!!$ idxout(i) = -1 !!$ idxout(i) = -1
!!$ end if !!$ end if
@ -822,10 +837,10 @@ contains
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
nv = size(idxmap%srt_l2g,1) nv = size(idxmap%srt_g2l,1)
tidx = idx(i) tidx = idx(i)
idx(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1)) idx(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
if (idx(i) > 0) idx(i) = idxmap%srt_l2g(idx(i),2)+idxmap%local_rows if (idx(i) > 0) idx(i) = idxmap%srt_g2l(idx(i),2)+idxmap%local_rows
else else
idx(i) = -1 idx(i) = -1
end if end if
@ -862,10 +877,10 @@ contains
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
nv = size(idxmap%srt_l2g,1) nv = size(idxmap%srt_g2l,1)
tidx = idx(i) tidx = idx(i)
idx(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1)) idx(i) = psb_bsrch(tidx,nv,idxmap%srt_g2l(:,1))
if (idx(i) > 0) idx(i) = idxmap%srt_l2g(idx(i),2)+idxmap%local_rows if (idx(i) > 0) idx(i) = idxmap%srt_g2l(idx(i),2)+idxmap%local_rows
else else
idx(i) = -1 idx(i) = -1
end if end if
@ -939,11 +954,11 @@ contains
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_g2l,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_g2l(:,1))
if (idxout(i) > 0) & 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 else
idxout(i) = -1 idxout(i) = -1
end if end if
@ -980,11 +995,11 @@ contains
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_g2l,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_g2l(:,1))
if (idxout(i) > 0) & 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 else
idxout(i) = -1 idxout(i) = -1
end if end if
@ -2024,14 +2039,14 @@ contains
nhal = idxmap%local_cols-idxmap%local_rows nhal = idxmap%local_cols-idxmap%local_rows
call psb_realloc(nhal,idxmap%loc_to_glob,info) call psb_realloc(nhal,idxmap%loc_to_glob,info)
call psb_realloc(nhal,2,idxmap%srt_l2g,info) call psb_realloc(nhal,2,idxmap%srt_g2l,info)
idxmap%srt_l2g(1:nhal,1) = idxmap%loc_to_glob(1:nhal) idxmap%srt_g2l(1:nhal,1) = idxmap%loc_to_glob(1:nhal)
call psb_msort(idxmap%srt_l2g(:,1),& call psb_msort(idxmap%srt_g2l(:,1),&
& ix=idxmap%srt_l2g(:,2),dir=psb_sort_up_) & ix=idxmap%srt_g2l(:,2),dir=psb_sort_up_)
if (debug) then if (debug) then
do i=1, nhal 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 do
end if end if
@ -2085,7 +2100,7 @@ contains
if (info == psb_success_)& if (info == psb_success_)&
& call psb_safe_ab_cpy(idxmap%vnl,outmap%vnl,info) & call psb_safe_ab_cpy(idxmap%vnl,outmap%vnl,info)
if (info == psb_success_)& 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_)& if (info == psb_success_)&
& call psb_hash_copy(idxmap%hash,outmap%hash,info) & call psb_hash_copy(idxmap%hash,outmap%hash,info)

Write Preview
Loading…
Cancel
Save