/AFiD

Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
Raw Blame History
252 lines (190 sloc) 6.04 KB
!=======================================================================
! This is part of the 2DECOMP&FFT library
!
! 2DECOMP&FFT is a software framework for general-purpose 2D (pencil)
! decomposition. It also implements a highly scalable distributed
! three-dimensional Fast Fourier Transform (FFT).
!
! Copyright (C) 2009-2012 Ning Li, the Numerical Algorithms Group (NAG)
!
!=======================================================================
! This file contains the routines that transpose data from X to Y pencil
subroutine transpose_x_to_y_real(src, dst, opt_decomp)
implicit none
real(mytype), dimension(:,:,:), intent(IN) :: src
real(mytype), dimension(:,:,:), intent(OUT) :: dst
TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp
TYPE(DECOMP_INFO) :: decomp
integer :: s1,s2,s3,d1,d2,d3
integer :: ierror
if (present(opt_decomp)) then
decomp = opt_decomp
else
decomp = decomp_main
end if
s1 = SIZE(src,1)
s2 = SIZE(src,2)
s3 = SIZE(src,3)
d1 = SIZE(dst,1)
d2 = SIZE(dst,2)
d3 = SIZE(dst,3)
! rearrange source array as send buffer
call mem_split_xy_real(src, s1, s2, s3, work1_r, dims(1), &
decomp%x1dist, decomp)
! transpose using MPI_ALLTOALL(V)
call MPI_ALLTOALLV(work1_r, decomp%x1cnts, decomp%x1disp, &
real_type, work2_r, decomp%y1cnts, decomp%y1disp, &
real_type, DECOMP_2D_COMM_COL, ierror)
! rearrange receive buffer
call mem_merge_xy_real(work2_r, d1, d2, d3, dst, dims(1), &
decomp%y1dist, decomp)
return
end subroutine transpose_x_to_y_real
subroutine transpose_x_to_y_complex(src, dst, opt_decomp)
implicit none
complex(mytype), dimension(:,:,:), intent(IN) :: src
complex(mytype), dimension(:,:,:), intent(OUT) :: dst
TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp
TYPE(DECOMP_INFO) :: decomp
integer :: s1,s2,s3,d1,d2,d3
integer :: ierror
if (present(opt_decomp)) then
decomp = opt_decomp
else
decomp = decomp_main
end if
s1 = SIZE(src,1)
s2 = SIZE(src,2)
s3 = SIZE(src,3)
d1 = SIZE(dst,1)
d2 = SIZE(dst,2)
d3 = SIZE(dst,3)
! rearrange source array as send buffer
call mem_split_xy_complex(src, s1, s2, s3, work1_c, dims(1), &
decomp%x1dist, decomp)
! transpose using MPI_ALLTOALL(V)
call MPI_ALLTOALLV(work1_c, decomp%x1cnts, decomp%x1disp, &
complex_type, work2_c, decomp%y1cnts, decomp%y1disp, &
complex_type, DECOMP_2D_COMM_COL, ierror)
! rearrange receive buffer
call mem_merge_xy_complex(work2_c, d1, d2, d3, dst, dims(1), &
decomp%y1dist, decomp)
return
end subroutine transpose_x_to_y_complex
! pack/unpack ALLTOALL(V) buffers
subroutine mem_split_xy_real(in,n1,n2,n3,out,iproc,dist,decomp)
implicit none
integer, intent(IN) :: n1,n2,n3
real(mytype), dimension(1:n1,1:n2,1:n3), intent(IN) :: in
real(mytype), dimension(*), intent(OUT) :: out
integer, intent(IN) :: iproc
integer, dimension(0:iproc-1), intent(IN) :: dist
TYPE(DECOMP_INFO), intent(IN) :: decomp
integer :: i,j,k, m,i1,i2,pos
do m=0,iproc-1
if (m==0) then
i1 = 1
i2 = dist(0)
else
i1 = i2+1
i2 = i1+dist(m)-1
end if
pos = decomp%x1disp(m) + 1
do k=1,n3
do j=1,n2
do i=i1,i2
out(pos) = in(i,j,k)
pos = pos + 1
end do
end do
end do
end do
return
end subroutine mem_split_xy_real
subroutine mem_split_xy_complex(in,n1,n2,n3,out,iproc,dist,decomp)
implicit none
integer, intent(IN) :: n1,n2,n3
complex(mytype), dimension(n1,n2,n3), intent(IN) :: in
complex(mytype), dimension(*), intent(OUT) :: out
integer, intent(IN) :: iproc
integer, dimension(0:iproc-1), intent(IN) :: dist
TYPE(DECOMP_INFO), intent(IN) :: decomp
integer :: i,j,k, m,i1,i2,pos
do m=0,iproc-1
if (m==0) then
i1 = 1
i2 = dist(0)
else
i1 = i2+1
i2 = i1+dist(m)-1
end if
pos = decomp%x1disp(m) + 1
do k=1,n3
do j=1,n2
do i=i1,i2
out(pos) = in(i,j,k)
pos = pos + 1
end do
end do
end do
end do
return
end subroutine mem_split_xy_complex
subroutine mem_merge_xy_real(in,n1,n2,n3,out,iproc,dist,decomp)
implicit none
integer, intent(IN) :: n1,n2,n3
real(mytype), dimension(*), intent(IN) :: in
real(mytype), dimension(1:n1,1:n2,1:n3), intent(OUT) :: out
integer, intent(IN) :: iproc
integer, dimension(0:iproc-1), intent(IN) :: dist
TYPE(DECOMP_INFO), intent(IN) :: decomp
integer :: i,j,k, m,i1,i2, pos
do m=0,iproc-1
if (m==0) then
i1 = 1
i2 = dist(0)
else
i1 = i2+1
i2 = i1+dist(m)-1
end if
pos = decomp%y1disp(m) + 1
do k=1,n3
do j=i1,i2
do i=1,n1
out(i,j,k) = in(pos)
pos = pos + 1
end do
end do
end do
end do
return
end subroutine mem_merge_xy_real
subroutine mem_merge_xy_complex(in,n1,n2,n3,out,iproc,dist,decomp)
implicit none
integer, intent(IN) :: n1,n2,n3
complex(mytype), dimension(*), intent(IN) :: in
complex(mytype), dimension(n1,n2,n3), intent(OUT) :: out
integer, intent(IN) :: iproc
integer, dimension(0:iproc-1), intent(IN) :: dist
TYPE(DECOMP_INFO), intent(IN) :: decomp
integer :: i,j,k, m,i1,i2, pos
do m=0,iproc-1
if (m==0) then
i1 = 1
i2 = dist(0)
else
i1 = i2+1
i2 = i1+dist(m)-1
end if
pos = decomp%y1disp(m) + 1
do k=1,n3
do j=i1,i2
do i=1,n1
out(i,j,k) = in(pos)
pos = pos + 1
end do
end do
end do
end do
return
end subroutine mem_merge_xy_complex