Permalink
Cannot retrieve contributors at this time
Join GitHub today
GitHub is home to over 28 million developers working together to host and review code, manage projects, and build software together.
Sign up
Fetching contributors…
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 Y to Z pencil | |
| subroutine transpose_y_to_z_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 | |
| #ifdef SHM | |
| real(mytype) :: work1(*), work2(*) | |
| POINTER (work1_p, work1), (work2_p, work2) ! Cray pointers | |
| #endif | |
| 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 | |
| #ifdef SHM | |
| work1_p = decomp%ROW_INFO%SND_P | |
| call mem_split_yz_real(src, s1, s2, s3, work1, dims(2), & | |
| decomp%y2dist, decomp) | |
| #else | |
| call mem_split_yz_real(src, s1, s2, s3, work1_r, dims(2), & | |
| decomp%y2dist, decomp) | |
| #endif | |
| ! define receive buffer | |
| #ifdef SHM | |
| work2_p = decomp%ROW_INFO%RCV_P | |
| call MPI_BARRIER(decomp%ROW_INFO%CORE_COMM, ierror) | |
| #endif | |
| #ifdef SHM | |
| if (decomp%ROW_INFO%CORE_ME==1) THEN | |
| call MPI_ALLTOALLV(work1, decomp%y2cnts_s, decomp%y2disp_s, & | |
| real_type, work2, decomp%z2cnts_s, decomp%z2disp_s, & | |
| real_type, decomp%ROW_INFO%SMP_COMM, ierror) | |
| end if | |
| #else | |
| #ifdef EVEN | |
| if (decomp%even) then | |
| call MPI_ALLTOALL(work1_r, decomp%y2count, & | |
| real_type, dst, decomp%z2count, & | |
| real_type, DECOMP_2D_COMM_ROW, ierror) | |
| else | |
| call MPI_ALLTOALL(work1_r, decomp%y2count, & | |
| real_type, work2_r, decomp%z2count, & | |
| real_type, DECOMP_2D_COMM_ROW, ierror) | |
| end if | |
| #else | |
| call MPI_ALLTOALLV(work1_r, decomp%y2cnts, decomp%y2disp, & | |
| real_type, dst, decomp%z2cnts, decomp%z2disp, & | |
| real_type, DECOMP_2D_COMM_ROW, ierror) | |
| #endif | |
| #endif | |
| ! rearrange receive buffer | |
| #ifdef SHM | |
| call MPI_BARRIER(decomp%ROW_INFO%CORE_COMM, ierror) | |
| call mem_merge_yz_real(work2, d1, d2, d3, dst, dims(2), & | |
| decomp%z2dist, decomp) | |
| #else | |
| #ifdef EVEN | |
| if (.not. decomp%even) then | |
| call mem_merge_yz_real(work2_r, d1, d2, d3, dst, dims(2), & | |
| decomp%z2dist, decomp) | |
| end if | |
| #else | |
| ! note the receive buffer is already in natural (i,j,k) order | |
| ! so no merge operation needed | |
| #endif | |
| #endif | |
| return | |
| end subroutine transpose_y_to_z_real | |
| #ifdef OCC | |
| subroutine transpose_y_to_z_real_start(handle, src, dst, sbuf, rbuf, & | |
| opt_decomp) | |
| implicit none | |
| integer :: handle | |
| real(mytype), dimension(:,:,:) :: src, dst, sbuf, rbuf | |
| TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp | |
| TYPE(DECOMP_INFO) :: decomp | |
| integer :: s1,s2,s3 | |
| 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) | |
| ! rearrange source array as send buffer | |
| call mem_split_yz_real(src, s1, s2, s3, sbuf, dims(2), & | |
| decomp%y2dist, decomp) | |
| #ifdef EVEN | |
| call NBC_IALLTOALL(sbuf, decomp%y2count, real_type, & | |
| rbuf, decomp%z2count, real_type, & | |
| DECOMP_2D_COMM_ROW, handle, ierror) | |
| #else | |
| call NBC_IALLTOALLV(sbuf, decomp%y2cnts, decomp%y2disp, real_type, & | |
| rbuf, decomp%z2cnts, decomp%z2disp, real_type, & | |
| DECOMP_2D_COMM_ROW, handle, ierror) | |
| #endif | |
| return | |
| end subroutine transpose_y_to_z_real_start | |
| subroutine transpose_y_to_z_real_wait(handle, src, dst, sbuf, rbuf, & | |
| opt_decomp) | |
| implicit none | |
| integer :: handle | |
| real(mytype), dimension(:,:,:) :: src, dst, sbuf, rbuf | |
| TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp | |
| TYPE(DECOMP_INFO) :: decomp | |
| integer :: ierror | |
| if (present(opt_decomp)) then | |
| decomp = opt_decomp | |
| else | |
| decomp = decomp_main | |
| end if | |
| call NBC_WAIT(handle, ierror) | |
| dst = rbuf | |
| return | |
| end subroutine transpose_y_to_z_real_wait | |
| #endif | |
| subroutine transpose_y_to_z_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 | |
| #ifdef SHM | |
| complex(mytype) :: work1(*), work2(*) | |
| POINTER (work1_p, work1), (work2_p, work2) ! Cray pointers | |
| #endif | |
| 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_yz_complex(src, s1, s2, s3, work1_c, dims(2), & | |
| decomp%y2dist, decomp) | |
| ! define receive buffer | |
| call MPI_ALLTOALLV(work1_c, decomp%y2cnts, decomp%y2disp, & | |
| complex_type, dst, decomp%z2cnts, decomp%z2disp, & | |
| complex_type, DECOMP_2D_COMM_ROW, ierror) | |
| ! note the receive buffer is already in natural (i,j,k) order | |
| ! so no merge operation needed | |
| return | |
| end subroutine transpose_y_to_z_complex | |
| #ifdef OCC | |
| subroutine transpose_y_to_z_complex_start(handle, src, dst, sbuf, & | |
| rbuf, opt_decomp) | |
| implicit none | |
| integer :: handle | |
| complex(mytype), dimension(:,:,:) :: src, dst, sbuf, rbuf | |
| TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp | |
| TYPE(DECOMP_INFO) :: decomp | |
| integer :: s1,s2,s3 | |
| 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) | |
| ! rearrange source array as send buffer | |
| call mem_split_yz_complex(src, s1, s2, s3, sbuf, dims(2), & | |
| decomp%y2dist, decomp) | |
| #ifdef EVEN | |
| call NBC_IALLTOALL(sbuf, decomp%y2count, & | |
| complex_type, rbuf, decomp%z2count, & | |
| complex_type, DECOMP_2D_COMM_ROW, handle, ierror) | |
| #else | |
| call NBC_IALLTOALLV(sbuf, decomp%y2cnts, decomp%y2disp, & | |
| complex_type, rbuf,decomp%z2cnts, decomp%z2disp, & | |
| complex_type, DECOMP_2D_COMM_ROW, handle, ierror) | |
| #endif | |
| return | |
| end subroutine transpose_y_to_z_complex_start | |
| subroutine transpose_y_to_z_complex_wait(handle, src, dst, sbuf, & | |
| rbuf, opt_decomp) | |
| implicit none | |
| integer :: handle | |
| complex(mytype), dimension(:,:,:) :: src, dst, sbuf, rbuf | |
| TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp | |
| TYPE(DECOMP_INFO) :: decomp | |
| integer :: ierror | |
| if (present(opt_decomp)) then | |
| decomp = opt_decomp | |
| else | |
| decomp = decomp_main | |
| end if | |
| call NBC_WAIT(handle, ierror) | |
| dst = rbuf | |
| return | |
| end subroutine transpose_y_to_z_complex_wait | |
| #endif | |
| ! pack/unpack ALLTOALL(V) buffers | |
| subroutine mem_split_yz_real(in,n1,n2,n3,out,iproc,dist,decomp) | |
| implicit none | |
| integer, intent(IN) :: n1,n2,n3 | |
| real(mytype), dimension(n1,n2,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 | |
| #ifdef SHM | |
| pos = decomp%y2disp_o(m) + 1 | |
| #else | |
| #ifdef EVEN | |
| pos = m * decomp%y2count + 1 | |
| #else | |
| pos = decomp%y2disp(m) + 1 | |
| #endif | |
| #endif | |
| do k=1,n3 | |
| do j=i1,i2 | |
| do i=1,n1 | |
| out(pos) = in(i,j,k) | |
| pos = pos + 1 | |
| end do | |
| end do | |
| end do | |
| end do | |
| return | |
| end subroutine mem_split_yz_real | |
| subroutine mem_split_yz_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 | |
| #ifdef SHM | |
| pos = decomp%y2disp_o(m) + 1 | |
| #else | |
| #ifdef EVEN | |
| pos = m * decomp%y2count + 1 | |
| #else | |
| pos = decomp%y2disp(m) + 1 | |
| #endif | |
| #endif | |
| do k=1,n3 | |
| do j=i1,i2 | |
| do i=1,n1 | |
| out(pos) = in(i,j,k) | |
| pos = pos + 1 | |
| end do | |
| end do | |
| end do | |
| end do | |
| return | |
| end subroutine mem_split_yz_complex | |
| subroutine mem_merge_yz_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(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 | |
| #ifdef SHM | |
| pos = decomp%z2disp_o(m) + 1 | |
| #else | |
| #ifdef EVEN | |
| pos = m * decomp%z2count + 1 | |
| #else | |
| pos = decomp%z2disp(m) + 1 | |
| #endif | |
| #endif | |
| do k=i1,i2 | |
| do j=1,n2 | |
| 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_yz_real | |
| subroutine mem_merge_yz_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 | |
| #ifdef SHM | |
| pos = decomp%z2disp_o(m) + 1 | |
| #else | |
| #ifdef EVEN | |
| pos = m * decomp%z2count + 1 | |
| #else | |
| pos = decomp%z2disp(m) + 1 | |
| #endif | |
| #endif | |
| do k=i1,i2 | |
| do j=1,n2 | |
| 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_yz_complex |