New psb_partidx_mod.F90.
Merged into psb_util. Updated all test/pargen progs.pull/6/head
Salvatore Filippone
7 years ago
parent
470c6658f9
commit
aaaf4c9f09
@ -0,0 +1,259 @@
|
||||
!
|
||||
! Parallel Sparse BLAS version 3.5
|
||||
! (C) Copyright 2006-2018
|
||||
! Salvatore Filippone
|
||||
! Alfredo Buttari
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
! POSSIBILITY OF SUCH DAMAGE.
|
||||
!
|
||||
!
|
||||
!
|
||||
! Purpose:
|
||||
! Proide functions to handle a distribution of a general
|
||||
! rectangular 2/3/n-dimensional domain onto
|
||||
! a rectangular 2/3/n-dimensional grid of processes
|
||||
!
|
||||
! See test/pargen/psb_X_pdeNd for examples of usage
|
||||
!
|
||||
module psb_partidx_mod
|
||||
use psb_base_mod, only : psb_ipk_
|
||||
|
||||
interface idx2ijk
|
||||
module procedure idx2ijk3d, idx2ijkv, idx2ijk2d
|
||||
end interface idx2ijk
|
||||
|
||||
interface ijk2idx
|
||||
module procedure ijk2idx3d, ijk2idxv, ijk2idx2d
|
||||
end interface ijk2idx
|
||||
|
||||
|
||||
contains
|
||||
!
|
||||
! Given a global index IDX and the domain size (NX,NY,NZ)
|
||||
! compute the point coordinates (I,J,K)
|
||||
! Optional argument: base 0 or 1, default 1
|
||||
!
|
||||
! This mapping is equivalent to a loop nesting:
|
||||
! idx = base
|
||||
! do i=1,nx
|
||||
! do j=1,ny
|
||||
! do k=1,nz
|
||||
! ijk2idx(i,j,k) = idx
|
||||
! idx = idx + 1
|
||||
subroutine idx2ijk3d(i,j,k,idx,nx,ny,nz,base)
|
||||
use psb_base_mod, only : psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(out) :: i,j,k
|
||||
integer(psb_ipk_), intent(in) :: idx,nx,ny,nz
|
||||
integer(psb_ipk_), intent(in), optional :: base
|
||||
|
||||
integer(psb_ipk_) :: coords(3)
|
||||
|
||||
call idx2ijk(coords,idx,[nx,ny,nz],base)
|
||||
|
||||
k = coords(3)
|
||||
j = coords(2)
|
||||
i = coords(1)
|
||||
|
||||
end subroutine idx2ijk3d
|
||||
|
||||
subroutine idx2ijk2d(i,j,idx,nx,ny,base)
|
||||
use psb_base_mod, only : psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(out) :: i,j
|
||||
integer(psb_ipk_), intent(in) :: idx,nx,ny
|
||||
integer(psb_ipk_), intent(in), optional :: base
|
||||
|
||||
integer(psb_ipk_) :: coords(2)
|
||||
|
||||
call idx2ijk(coords,idx,[nx,ny],base)
|
||||
|
||||
j = coords(2)
|
||||
i = coords(1)
|
||||
|
||||
end subroutine idx2ijk2d
|
||||
|
||||
!
|
||||
! Given a global index IDX and the domain size (NX,NY,NZ)
|
||||
! compute the point coordinates (I,J,K)
|
||||
! Optional argument: base 0 or 1, default 1
|
||||
!
|
||||
! This mapping is equivalent to a loop nesting:
|
||||
! idx = base
|
||||
! do i=1,nx
|
||||
! do j=1,ny
|
||||
! do k=1,nz
|
||||
! ijk2idx(i,j,k) = idx
|
||||
! idx = idx + 1
|
||||
subroutine idx2ijkv(coords,idx,dims,base)
|
||||
use psb_base_mod, only : psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(out) :: coords(:)
|
||||
integer(psb_ipk_), intent(in) :: idx,dims(:)
|
||||
integer(psb_ipk_), intent(in), optional :: base
|
||||
|
||||
integer(psb_ipk_) :: base_, idx_, i, sz
|
||||
if (present(base)) then
|
||||
base_ = base
|
||||
else
|
||||
base_ = 1
|
||||
end if
|
||||
|
||||
idx_ = idx - base_
|
||||
|
||||
if (size(coords) < size(dims)) then
|
||||
write(0,*) 'Error: size mismatch ',size(coords),size(dims)
|
||||
coords = 0
|
||||
return
|
||||
end if
|
||||
|
||||
!
|
||||
! This code is equivalent to (3D case)
|
||||
! k = mod(idx_,nz) + base_
|
||||
! j = mod(idx_/nz,ny) + base_
|
||||
! i = mod(idx_/(nx*ny),nx) + base_
|
||||
!
|
||||
do i=size(dims),1,-1
|
||||
coords(i) = mod(idx_,dims(i)) + base_
|
||||
idx_ = idx_ / dims(i)
|
||||
end do
|
||||
|
||||
end subroutine idx2ijkv
|
||||
|
||||
!
|
||||
! Given a triple (I,J,K) and the domain size (NX,NY,NZ)
|
||||
! compute the global index IDX
|
||||
! Optional argument: base 0 or 1, default 1
|
||||
!
|
||||
! This mapping is equivalent to a loop nesting:
|
||||
! idx = base
|
||||
! do i=1,nx
|
||||
! do j=1,ny
|
||||
! do k=1,nz
|
||||
! ijk2idx(i,j,k) = idx
|
||||
! idx = idx + 1
|
||||
subroutine ijk2idxv(idx,coords,dims,base)
|
||||
use psb_base_mod, only : psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: coords(:),dims(:)
|
||||
integer(psb_ipk_), intent(out) :: idx
|
||||
integer(psb_ipk_), intent(in), optional :: base
|
||||
|
||||
integer(psb_ipk_) :: base_, i, sz
|
||||
if (present(base)) then
|
||||
base_ = base
|
||||
else
|
||||
base_ = 1
|
||||
end if
|
||||
sz = size(coords)
|
||||
if (sz /= size(dims)) then
|
||||
write(0,*) 'Error: size mismatch ',size(coords),size(dims)
|
||||
idx = 0
|
||||
return
|
||||
end if
|
||||
|
||||
idx = coords(1) - base_
|
||||
do i=2, sz
|
||||
idx = (idx * dims(i)) + coords(i) - base_
|
||||
end do
|
||||
idx = idx + base_
|
||||
|
||||
end subroutine ijk2idxv
|
||||
!
|
||||
! Given a triple (I,J,K) and the domain size (NX,NY,NZ)
|
||||
! compute the global index IDX
|
||||
! Optional argument: base 0 or 1, default 1
|
||||
!
|
||||
! This mapping is equivalent to a loop nesting:
|
||||
! idx = base
|
||||
! do i=1,nx
|
||||
! do j=1,ny
|
||||
! do k=1,nz
|
||||
! ijk2idx(i,j,k) = idx
|
||||
! idx = idx + 1
|
||||
subroutine ijk2idx3d(idx,i,j,k,nx,ny,nz,base)
|
||||
use psb_base_mod, only : psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(out) :: idx
|
||||
integer(psb_ipk_), intent(in) :: i,j,k,nx,ny,nz
|
||||
integer(psb_ipk_), intent(in), optional :: base
|
||||
|
||||
! idx = ((i-base_)*nz*ny + (j-base_)*nz + k - base_) + base_
|
||||
call ijk2idx(idx,[i,j,k],[nx,ny,nz],base)
|
||||
end subroutine ijk2idx3d
|
||||
|
||||
subroutine ijk2idx2d(idx,i,j,nx,ny,base)
|
||||
use psb_base_mod, only : psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(out) :: idx
|
||||
integer(psb_ipk_), intent(in) :: i,j,nx,ny
|
||||
integer(psb_ipk_), intent(in), optional :: base
|
||||
|
||||
! idx = ((i-base_)*ny + (j-base_) + base_
|
||||
call ijk2idx(idx,[i,j],[nx,ny],base)
|
||||
end subroutine ijk2idx2d
|
||||
|
||||
!
|
||||
! dist1Didx
|
||||
! Given an index space [base : N-(1-base)] and
|
||||
! a set of NP processes, split the index base as
|
||||
! evenly as possible, i.e. difference in size
|
||||
! between any two processes is either 0 or 1,
|
||||
! then return the boundaries in a vector
|
||||
! such that
|
||||
! V(P) : first index owned by process P
|
||||
! V(P+1) : first index owned by process P+1
|
||||
!
|
||||
subroutine dist1Didx(v,n,np,base)
|
||||
use psb_base_mod, only : psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(out) :: v(:)
|
||||
integer(psb_ipk_), intent(in) :: n, np
|
||||
integer(psb_ipk_), intent(in), optional :: base
|
||||
!
|
||||
integer(psb_ipk_) :: base_, nb, i
|
||||
|
||||
if (present(base)) then
|
||||
base_ = base
|
||||
else
|
||||
base_ = 1
|
||||
end if
|
||||
|
||||
nb = n/np
|
||||
do i=1,mod(n,np)
|
||||
v(i) = nb + 1
|
||||
end do
|
||||
do i=mod(n,np)+1,np
|
||||
v(i) = nb
|
||||
end do
|
||||
v(2:np+1) = v(1:np)
|
||||
v(1) = base_
|
||||
do i=2,np+1
|
||||
v(i) = v(i) + v(i-1)
|
||||
end do
|
||||
end subroutine dist1Didx
|
||||
|
||||
end module psb_partidx_mod
|
||||
|
||||
Loading…
Reference in New Issue