2007-12-27 18:22:43 +08:00
|
|
|
!
|
2009-08-02 15:44:03 +08:00
|
|
|
! Copyright (C) 2001-2009 Quantum ESPRESSO group
|
2007-12-27 18:22:43 +08:00
|
|
|
! This file is distributed under the terms of the
|
|
|
|
! GNU General Public License. See the file `License'
|
|
|
|
! in the root directory of the present distribution,
|
|
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
!=---------------------------------------------------------------------==!
|
|
|
|
!
|
|
|
|
!
|
2009-04-04 20:05:14 +08:00
|
|
|
! Parallel 3D FFT high level Driver
|
2007-12-29 18:09:28 +08:00
|
|
|
! ( Charge density and Wave Functions )
|
|
|
|
!
|
2009-04-04 20:05:14 +08:00
|
|
|
! Written and maintained by Carlo Cavazzoni
|
|
|
|
! Last update Apr. 2009
|
2007-12-29 18:09:28 +08:00
|
|
|
!
|
|
|
|
!=---------------------------------------------------------------------==!
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
|
|
|
MODULE fft_parallel
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
SAVE
|
|
|
|
!
|
|
|
|
CONTAINS
|
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
! General purpose driver, including Task groups parallelization
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
|
|
|
!----------------------------------------------------------------------------
|
2007-12-29 18:09:28 +08:00
|
|
|
SUBROUTINE tg_cft3s( f, dfft, isgn, use_task_groups )
|
2007-12-27 18:22:43 +08:00
|
|
|
!----------------------------------------------------------------------------
|
|
|
|
!
|
2007-12-28 22:08:17 +08:00
|
|
|
! ... isgn = +-1 : parallel 3d fft for rho and for the potential
|
2007-12-29 18:09:28 +08:00
|
|
|
! NOT IMPLEMENTED WITH TASK GROUPS
|
2007-12-28 22:08:17 +08:00
|
|
|
! ... isgn = +-2 : parallel 3d fft for wavefunctions
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-28 22:08:17 +08:00
|
|
|
! ... isgn = + : G-space to R-space, output = \sum_G f(G)exp(+iG*R)
|
2007-12-27 18:22:43 +08:00
|
|
|
! ... fft along z using pencils (cft_1z)
|
|
|
|
! ... transpose across nodes (fft_scatter)
|
|
|
|
! ... and reorder
|
|
|
|
! ... fft along y (using planes) and x (cft_2xy)
|
2007-12-28 22:08:17 +08:00
|
|
|
! ... isgn = - : R-space to G-space, output = \int_R f(R)exp(-iG*R)/Omega
|
2007-12-27 18:22:43 +08:00
|
|
|
! ... fft along x and y(using planes) (cft_2xy)
|
|
|
|
! ... transpose across nodes (fft_scatter)
|
|
|
|
! ... and reorder
|
|
|
|
! ... fft along z using pencils (cft_1z)
|
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
! ... The array "planes" signals whether a fft is needed along y :
|
|
|
|
! ... planes(i)=0 : column f(i,*,*) empty , don't do fft along y
|
|
|
|
! ... planes(i)=1 : column f(i,*,*) filled, fft along y needed
|
2007-12-27 18:22:43 +08:00
|
|
|
! ... "empty" = no active components are present in f(i,*,*)
|
2007-12-28 22:08:17 +08:00
|
|
|
! ... after (isgn>0) or before (isgn<0) the fft on z direction
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-28 22:08:17 +08:00
|
|
|
! ... Note that if isgn=+/-1 (fft on rho and pot.) all fft's are needed
|
2007-12-27 18:22:43 +08:00
|
|
|
! ... and all planes(i) are set to 1
|
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
! This driver is based on code written by Stefano de Gironcoli for PWSCF.
|
2009-04-04 20:05:14 +08:00
|
|
|
! Task Group added by Costas Bekas, Oct. 2005, adapted from the CPMD code
|
2007-12-29 18:09:28 +08:00
|
|
|
! (Alessandro Curioni) and revised by Carlo Cavazzoni 2007.
|
|
|
|
!
|
2007-12-27 18:22:43 +08:00
|
|
|
USE fft_scalar, ONLY : cft_1z, cft_2xy
|
|
|
|
USE fft_base, ONLY : fft_scatter
|
|
|
|
USE kinds, ONLY : DP
|
|
|
|
USE mp_global, only : me_pool, nproc_pool, ogrp_comm, npgrp, nogrp, &
|
2007-12-28 22:08:17 +08:00
|
|
|
intra_pool_comm, nolist, nplist
|
2007-12-27 18:22:43 +08:00
|
|
|
USE fft_types, ONLY : fft_dlay_descriptor
|
|
|
|
USE parallel_include
|
|
|
|
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
COMPLEX(DP), INTENT(INOUT) :: f( : ) ! array containing data to be transformed
|
2007-12-28 22:08:17 +08:00
|
|
|
type (fft_dlay_descriptor), intent(in) :: dfft
|
2007-12-29 18:09:28 +08:00
|
|
|
! descriptor of fft data layout
|
|
|
|
INTEGER, INTENT(IN) :: isgn ! fft direction
|
2009-04-04 20:05:14 +08:00
|
|
|
LOGICAL, OPTIONAL, INTENT(IN) :: use_task_groups
|
2007-12-29 18:09:28 +08:00
|
|
|
! specify if you want to use task groups parallelization
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
|
|
|
INTEGER :: me_p
|
|
|
|
INTEGER :: n1, n2, n3, nx1, nx2, nx3
|
|
|
|
COMPLEX(DP), ALLOCATABLE :: yf(:), aux (:)
|
2007-12-29 18:09:28 +08:00
|
|
|
INTEGER :: planes( dfft%nr1x )
|
|
|
|
LOGICAL :: use_tg
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2009-04-04 20:05:14 +08:00
|
|
|
!
|
2007-12-27 18:22:43 +08:00
|
|
|
CALL start_clock( 'cft3s' )
|
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
IF( PRESENT( use_task_groups ) ) THEN
|
|
|
|
use_tg = use_task_groups
|
|
|
|
ELSE
|
|
|
|
use_tg = .FALSE.
|
|
|
|
END IF
|
|
|
|
!
|
|
|
|
IF( use_tg .AND. .NOT. dfft%have_task_groups ) &
|
|
|
|
CALL errore( ' tg_cft3s ', ' call requiring task groups for a descriptor without task groups ', 1 )
|
|
|
|
!
|
2007-12-28 22:08:17 +08:00
|
|
|
n1 = dfft%nr1
|
|
|
|
n2 = dfft%nr2
|
|
|
|
n3 = dfft%nr3
|
|
|
|
nx1 = dfft%nr1x
|
|
|
|
nx2 = dfft%nr2x
|
|
|
|
nx3 = dfft%nr3x
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
IF( use_tg ) THEN
|
2008-01-03 02:00:00 +08:00
|
|
|
ALLOCATE( aux( nogrp * dfft%nnrx ) )
|
|
|
|
ALLOCATE( YF ( nogrp * dfft%nnrx ) )
|
2007-12-29 18:09:28 +08:00
|
|
|
ELSE
|
|
|
|
ALLOCATE( aux( dfft%nnrx ) )
|
|
|
|
END IF
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
|
|
|
me_p = me_pool + 1
|
|
|
|
!
|
2007-12-28 22:08:17 +08:00
|
|
|
IF ( isgn > 0 ) THEN
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-28 22:08:17 +08:00
|
|
|
IF ( isgn /= 2 ) THEN
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
IF( use_tg ) &
|
|
|
|
CALL errore( ' tg_cfft ', ' task groups on large mesh not implemented ', 1 )
|
|
|
|
!
|
|
|
|
call cft_1z( f, dfft%nsp( me_p ), n3, nx3, isgn, aux )
|
|
|
|
!
|
|
|
|
planes = dfft%iplp
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
|
|
|
ELSE
|
|
|
|
!
|
2007-12-28 22:08:17 +08:00
|
|
|
CALL pack_group_sticks()
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
IF( use_tg ) THEN
|
|
|
|
CALL cft_1z( yf, dfft%tg_nsw( me_p ), n3, nx3, isgn, aux )
|
|
|
|
ELSE
|
|
|
|
call cft_1z( f, dfft%nsw( me_p ), n3, nx3, isgn, aux )
|
|
|
|
END IF
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
planes = dfft%iplw
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
END IF
|
|
|
|
!
|
|
|
|
CALL fw_scatter( isgn ) ! forwart scatter from stick to planes
|
|
|
|
!
|
|
|
|
IF( use_tg ) THEN
|
|
|
|
CALL cft_2xy( f, dfft%tg_npp( me_p ), n1, n2, nx1, nx2, isgn, planes )
|
|
|
|
ELSE
|
|
|
|
CALL cft_2xy( f, dfft%npp( me_p ), n1, n2, nx1, nx2, isgn, planes )
|
|
|
|
END IF
|
|
|
|
!
|
|
|
|
ELSE
|
|
|
|
!
|
|
|
|
if ( isgn /= -2 ) then
|
2007-12-28 22:08:17 +08:00
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
IF( use_tg ) &
|
|
|
|
CALL errore( ' tg_cfft ', ' task groups on large mesh not implemented ', 1 )
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
planes = dfft%iplp
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
else
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
planes = dfft%iplw
|
|
|
|
!
|
|
|
|
endif
|
|
|
|
|
|
|
|
IF( use_tg ) THEN
|
|
|
|
CALL cft_2xy( f, dfft%tg_npp( me_p ), n1, n2, nx1, nx2, isgn, planes )
|
|
|
|
ELSE
|
|
|
|
call cft_2xy( f, dfft%npp( me_p ), n1, n2, nx1, nx2, isgn, planes)
|
2007-12-27 18:22:43 +08:00
|
|
|
END IF
|
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
CALL bw_scatter( isgn )
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-28 22:08:17 +08:00
|
|
|
IF ( isgn /= -2 ) THEN
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
call cft_1z( aux, dfft%nsp( me_p ), n3, nx3, isgn, f )
|
2009-04-04 20:05:14 +08:00
|
|
|
!
|
2007-12-27 18:22:43 +08:00
|
|
|
ELSE
|
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
IF( use_tg ) THEN
|
|
|
|
CALL cft_1z( aux, dfft%tg_nsw( me_p ), n3, nx3, isgn, yf )
|
|
|
|
ELSE
|
|
|
|
call cft_1z( aux, dfft%nsw( me_p ), n3, nx3, isgn, f )
|
|
|
|
END IF
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
2007-12-28 22:08:17 +08:00
|
|
|
CALL unpack_group_sticks()
|
2007-12-29 18:09:28 +08:00
|
|
|
!
|
2007-12-27 18:22:43 +08:00
|
|
|
END IF
|
|
|
|
!
|
|
|
|
END IF
|
|
|
|
!
|
|
|
|
DEALLOCATE( aux )
|
2007-12-29 18:09:28 +08:00
|
|
|
!
|
|
|
|
IF( use_tg ) THEN
|
|
|
|
DEALLOCATE( yf )
|
|
|
|
END IF
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
|
|
|
CALL stop_clock( 'cft3s' )
|
|
|
|
!
|
|
|
|
RETURN
|
2007-12-28 22:08:17 +08:00
|
|
|
!
|
|
|
|
CONTAINS
|
|
|
|
!
|
|
|
|
|
|
|
|
SUBROUTINE pack_group_sticks()
|
|
|
|
|
2009-05-29 23:48:39 +08:00
|
|
|
INTEGER :: ierr
|
2007-12-28 22:08:17 +08:00
|
|
|
!
|
2007-12-29 18:09:28 +08:00
|
|
|
if( .NOT. use_tg ) return
|
|
|
|
!
|
2009-05-29 23:48:39 +08:00
|
|
|
IF( dfft%tg_rdsp(nogrp) + dfft%tg_rcv(nogrp) > SIZE( yf ) ) THEN
|
2007-12-28 22:08:17 +08:00
|
|
|
CALL errore( ' tg_cfft ', ' inconsistent size ', 1 )
|
|
|
|
END IF
|
2009-05-29 23:48:39 +08:00
|
|
|
IF( dfft%tg_psdsp(nogrp) + dfft%tg_snd(nogrp) > SIZE( f ) ) THEN
|
2007-12-28 22:08:17 +08:00
|
|
|
CALL errore( ' tg_cfft ', ' inconsistent size ', 2 )
|
|
|
|
END IF
|
|
|
|
|
|
|
|
CALL start_clock( 'ALLTOALL' )
|
|
|
|
!
|
|
|
|
! Collect all the sticks of the different states,
|
|
|
|
! in "yf" processors will have all the sticks of the OGRP
|
|
|
|
|
|
|
|
#if defined __MPI
|
|
|
|
|
2009-05-29 23:48:39 +08:00
|
|
|
CALL MPI_ALLTOALLV( f(1), dfft%tg_snd, dfft%tg_psdsp, MPI_DOUBLE_COMPLEX, yf(1), dfft%tg_rcv, &
|
|
|
|
& dfft%tg_rdsp, MPI_DOUBLE_COMPLEX, ogrp_comm, IERR)
|
2007-12-28 22:08:17 +08:00
|
|
|
IF( ierr /= 0 ) THEN
|
|
|
|
CALL errore( ' tg_cfft ', ' alltoall error 1 ', ABS(ierr) )
|
|
|
|
END IF
|
|
|
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
CALL stop_clock( 'ALLTOALL' )
|
|
|
|
!
|
|
|
|
!YF Contains all ( ~ NOGRP*dfft%nsw(me) ) Z-sticks
|
|
|
|
!
|
|
|
|
RETURN
|
|
|
|
END SUBROUTINE pack_group_sticks
|
|
|
|
|
2007-12-29 18:09:28 +08:00
|
|
|
!
|
|
|
|
|
2007-12-28 22:08:17 +08:00
|
|
|
SUBROUTINE unpack_group_sticks()
|
|
|
|
!
|
|
|
|
! Bring pencils back to their original distribution
|
|
|
|
!
|
2009-05-29 23:48:39 +08:00
|
|
|
INTEGER :: ierr
|
2007-12-29 18:09:28 +08:00
|
|
|
!
|
|
|
|
if( .NOT. use_tg ) return
|
|
|
|
!
|
2009-05-29 23:48:39 +08:00
|
|
|
IF( dfft%tg_usdsp(nogrp) + dfft%tg_snd(nogrp) > SIZE( f ) ) THEN
|
2007-12-28 22:08:17 +08:00
|
|
|
CALL errore( ' tg_cfft ', ' inconsistent size ', 3 )
|
|
|
|
END IF
|
2009-05-29 23:48:39 +08:00
|
|
|
IF( dfft%tg_rdsp(nogrp) + dfft%tg_rcv(nogrp) > SIZE( yf ) ) THEN
|
2007-12-28 22:08:17 +08:00
|
|
|
CALL errore( ' tg_cfft ', ' inconsistent size ', 4 )
|
|
|
|
END IF
|
|
|
|
|
|
|
|
CALL start_clock( 'ALLTOALL' )
|
|
|
|
|
|
|
|
#if defined __MPI
|
|
|
|
CALL MPI_Alltoallv( yf(1), &
|
2009-05-29 23:48:39 +08:00
|
|
|
dfft%tg_rcv, dfft%tg_rdsp, MPI_DOUBLE_COMPLEX, f(1), &
|
|
|
|
dfft%tg_snd, dfft%tg_usdsp, MPI_DOUBLE_COMPLEX, ogrp_comm, IERR)
|
2007-12-28 22:08:17 +08:00
|
|
|
IF( ierr /= 0 ) THEN
|
|
|
|
CALL errore( ' tg_cfft ', ' alltoall error 2 ', ABS(ierr) )
|
|
|
|
END IF
|
2009-04-04 20:05:14 +08:00
|
|
|
#endif
|
2007-12-28 22:08:17 +08:00
|
|
|
|
|
|
|
CALL stop_clock( 'ALLTOALL' )
|
|
|
|
|
|
|
|
RETURN
|
|
|
|
END SUBROUTINE unpack_group_sticks
|
|
|
|
|
2007-12-29 18:09:28 +08:00
|
|
|
!
|
|
|
|
|
|
|
|
SUBROUTINE fw_scatter( iopt )
|
|
|
|
|
|
|
|
!Transpose data for the 2-D FFT on the x-y plane
|
|
|
|
!
|
|
|
|
!NOGRP*dfft%nnr: The length of aux and f
|
2009-04-04 20:05:14 +08:00
|
|
|
!nr3x: The length of each Z-stick
|
2007-12-29 18:09:28 +08:00
|
|
|
!aux: input - output
|
|
|
|
!f: working space
|
|
|
|
!isgn: type of scatter
|
|
|
|
!dfft%nsw(me) holds the number of Z-sticks proc. me has.
|
|
|
|
!dfft%npp: number of planes per processor
|
|
|
|
!
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
|
|
|
use fft_base, only: fft_scatter
|
|
|
|
!
|
|
|
|
INTEGER, INTENT(IN) :: iopt
|
2009-05-25 01:28:34 +08:00
|
|
|
INTEGER :: nppx, ip, nnp, npp, ii, i, mc, j, ioff, it
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
|
|
|
IF( iopt == 2 ) THEN
|
|
|
|
!
|
|
|
|
IF( use_tg ) THEN
|
|
|
|
!
|
|
|
|
nppx = dfft%tg_npp( me_p )
|
|
|
|
npp = dfft%tg_npp( me_p )
|
|
|
|
nnp = nx1*nx2
|
|
|
|
!
|
2008-01-03 02:00:00 +08:00
|
|
|
CALL fft_scatter( aux, nx3, nogrp*dfft%nnrx, f, dfft%tg_nsw, dfft%tg_npp, iopt, use_tg )
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
|
|
|
ELSE
|
|
|
|
!
|
|
|
|
nppx = dfft%npp( me_p )
|
|
|
|
IF( nproc_pool == 1 ) nppx = dfft%nr3x
|
|
|
|
npp = dfft%npp( me_p )
|
|
|
|
nnp = dfft%nnp
|
|
|
|
!
|
|
|
|
call fft_scatter( aux, nx3, dfft%nnr, f, dfft%nsw, dfft%npp, iopt )
|
|
|
|
!
|
|
|
|
END IF
|
|
|
|
!
|
2009-05-24 00:23:17 +08:00
|
|
|
!
|
2009-05-25 01:28:34 +08:00
|
|
|
!$omp parallel default(shared), private( ii, mc, j, i, ioff, ip, it )
|
2009-05-24 00:23:17 +08:00
|
|
|
!$omp do
|
|
|
|
do i = 1, SIZE( f )
|
|
|
|
f(i) = (0.d0, 0.d0)
|
|
|
|
end do
|
|
|
|
!
|
2007-12-31 19:00:25 +08:00
|
|
|
ii = 0
|
|
|
|
!
|
|
|
|
do ip = 1, nproc_pool
|
2009-05-24 00:23:17 +08:00
|
|
|
!
|
|
|
|
ioff = dfft%iss( ip )
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
2009-05-25 01:28:34 +08:00
|
|
|
!$omp do
|
2007-12-31 19:00:25 +08:00
|
|
|
do i = 1, dfft%nsw( ip )
|
|
|
|
!
|
2009-05-24 00:23:17 +08:00
|
|
|
mc = dfft%ismap( i + ioff )
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
2009-05-25 01:28:34 +08:00
|
|
|
it = ( ii + i - 1 ) * nppx
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
|
|
|
do j = 1, npp
|
2009-05-25 01:28:34 +08:00
|
|
|
f( mc + ( j - 1 ) * nnp ) = aux( j + it )
|
2007-12-31 19:00:25 +08:00
|
|
|
end do
|
|
|
|
!
|
|
|
|
end do
|
|
|
|
!
|
2009-05-25 01:28:34 +08:00
|
|
|
ii = ii + dfft%nsw( ip )
|
|
|
|
!
|
2007-12-31 19:00:25 +08:00
|
|
|
end do
|
2009-05-24 00:23:17 +08:00
|
|
|
!$omp end parallel
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
|
|
|
ELSE IF( iopt == 1 ) THEN
|
|
|
|
!
|
|
|
|
if ( nproc_pool == 1 ) then
|
|
|
|
nppx = dfft%nr3x
|
|
|
|
else
|
|
|
|
nppx = dfft%npp( me_p )
|
|
|
|
end if
|
|
|
|
!
|
|
|
|
call fft_scatter( aux, nx3, dfft%nnr, f, dfft%nsp, dfft%npp, iopt )
|
|
|
|
!
|
2009-05-24 00:23:17 +08:00
|
|
|
!$omp parallel default(shared)
|
|
|
|
!$omp do
|
|
|
|
do i = 1, SIZE(f)
|
|
|
|
f(i) = (0.d0, 0.d0)
|
|
|
|
end do
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
2009-05-24 00:23:17 +08:00
|
|
|
!$omp do private(mc,j)
|
2007-12-31 19:00:25 +08:00
|
|
|
do i = 1, dfft%nst
|
|
|
|
mc = dfft%ismap( i )
|
|
|
|
do j = 1, dfft%npp( me_p )
|
|
|
|
f( mc + ( j - 1 ) * dfft%nnp ) = aux( j + ( i - 1 ) * nppx )
|
|
|
|
end do
|
|
|
|
end do
|
2009-05-24 00:23:17 +08:00
|
|
|
!$omp end parallel
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
|
|
|
END IF
|
|
|
|
!
|
|
|
|
RETURN
|
2007-12-29 18:09:28 +08:00
|
|
|
END SUBROUTINE fw_scatter
|
2007-12-28 22:08:17 +08:00
|
|
|
|
2007-12-29 18:09:28 +08:00
|
|
|
!
|
2007-12-28 22:08:17 +08:00
|
|
|
|
2007-12-29 18:09:28 +08:00
|
|
|
SUBROUTINE bw_scatter( iopt )
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
|
|
|
use fft_base, only: fft_scatter
|
|
|
|
!
|
|
|
|
INTEGER, INTENT(IN) :: iopt
|
2009-05-25 01:28:34 +08:00
|
|
|
INTEGER :: nppx, ip, nnp, npp, ii, i, mc, j, it
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
2009-04-04 20:05:14 +08:00
|
|
|
!
|
2007-12-31 19:00:25 +08:00
|
|
|
IF( iopt == -2 ) THEN
|
2009-04-04 20:05:14 +08:00
|
|
|
!
|
2007-12-31 19:00:25 +08:00
|
|
|
IF( use_tg ) THEN
|
|
|
|
!
|
|
|
|
nppx = dfft%tg_npp( me_p )
|
|
|
|
npp = dfft%tg_npp( me_p )
|
|
|
|
nnp = nx1*nx2
|
|
|
|
!
|
|
|
|
ELSE
|
|
|
|
!
|
|
|
|
nppx = dfft%npp( me_p )
|
|
|
|
IF( nproc_pool == 1 ) nppx = dfft%nr3x
|
|
|
|
npp = dfft%npp( me_p )
|
|
|
|
nnp = dfft%nnp
|
|
|
|
!
|
|
|
|
END IF
|
2007-12-29 18:09:28 +08:00
|
|
|
|
|
|
|
|
2009-05-25 01:28:34 +08:00
|
|
|
!$omp parallel default(shared), private( mc, j, i, ii, ip, it )
|
2009-05-24 00:23:17 +08:00
|
|
|
ii = 0
|
2007-12-31 19:00:25 +08:00
|
|
|
do ip = 1, nproc_pool
|
2009-05-25 01:28:34 +08:00
|
|
|
!$omp do
|
2007-12-31 19:00:25 +08:00
|
|
|
do i = 1, dfft%nsw( ip )
|
|
|
|
mc = dfft%ismap( i + dfft%iss( ip ) )
|
2009-05-25 01:28:34 +08:00
|
|
|
it = (ii + i - 1)*nppx
|
2007-12-31 19:00:25 +08:00
|
|
|
do j = 1, npp
|
2009-05-25 01:28:34 +08:00
|
|
|
aux( j + it ) = f( mc + ( j - 1 ) * nnp )
|
2007-12-31 19:00:25 +08:00
|
|
|
end do
|
|
|
|
end do
|
2009-05-25 01:28:34 +08:00
|
|
|
ii = ii + dfft%nsw( ip )
|
2007-12-31 19:00:25 +08:00
|
|
|
end do
|
2009-05-24 00:23:17 +08:00
|
|
|
!$omp end parallel
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
|
|
|
IF( use_tg ) THEN
|
|
|
|
!
|
2008-01-03 02:00:00 +08:00
|
|
|
CALL fft_scatter( aux, nx3, nogrp*dfft%nnrx, f, dfft%tg_nsw, dfft%tg_npp, iopt, use_tg )
|
2007-12-31 19:00:25 +08:00
|
|
|
!
|
|
|
|
ELSE
|
|
|
|
!
|
|
|
|
call fft_scatter( aux, nx3, dfft%nnr, f, dfft%nsw, dfft%npp, iopt )
|
|
|
|
!
|
|
|
|
END IF
|
2009-04-04 20:05:14 +08:00
|
|
|
!
|
2007-12-31 19:00:25 +08:00
|
|
|
ELSE IF( iopt == -1 ) THEN
|
|
|
|
!
|
|
|
|
if ( nproc_pool == 1 ) then
|
|
|
|
nppx = dfft%nr3x
|
|
|
|
else
|
|
|
|
nppx = dfft%npp( me_p )
|
|
|
|
end if
|
2009-05-24 00:23:17 +08:00
|
|
|
!$omp parallel default(shared), private( mc, j, i )
|
|
|
|
!$omp do
|
2007-12-31 19:00:25 +08:00
|
|
|
do i = 1, dfft%nst
|
|
|
|
mc = dfft%ismap( i )
|
|
|
|
do j = 1, dfft%npp( me_p )
|
|
|
|
aux( j + ( i - 1 ) * nppx ) = f( mc + ( j - 1 ) * dfft%nnp )
|
|
|
|
end do
|
|
|
|
end do
|
2009-05-24 00:23:17 +08:00
|
|
|
!$omp end parallel
|
|
|
|
!
|
2007-12-31 19:00:25 +08:00
|
|
|
call fft_scatter( aux, nx3, dfft%nnr, f, dfft%nsp, dfft%npp, iopt )
|
|
|
|
!
|
|
|
|
END IF
|
|
|
|
!
|
|
|
|
RETURN
|
2007-12-29 18:09:28 +08:00
|
|
|
END SUBROUTINE bw_scatter
|
2007-12-27 18:22:43 +08:00
|
|
|
!
|
|
|
|
END SUBROUTINE tg_cft3s
|
|
|
|
!
|
|
|
|
END MODULE fft_parallel
|