Permalink
Cannot retrieve contributors at this time
| !======================================================================= | |
| ! 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 |