diff --git a/CPV/Makefile b/CPV/Makefile index daa3a41e2..b3afc732a 100644 --- a/CPV/Makefile +++ b/CPV/Makefile @@ -34,7 +34,6 @@ emptystates.o \ ensemble_dft.o \ environment.o \ exch_corr.o \ -fftdrv.o \ fft.o \ forces.o \ fromscra.o \ diff --git a/CPV/cpr.f90 b/CPV/cpr.f90 index f89b32b85..e5f109fac 100644 --- a/CPV/cpr.f90 +++ b/CPV/cpr.f90 @@ -910,6 +910,7 @@ SUBROUTINE terminate_run() CALL print_clock( 'calphi' ) CALL print_clock( 'ortho' ) CALL print_clock( 'ortho_iter' ) + CALL print_clock( 'rsg' ) CALL print_clock( 'rhoset' ) CALL print_clock( 'updatc' ) CALL print_clock( 'gram' ) @@ -927,22 +928,14 @@ SUBROUTINE terminate_run() CALL print_clock( 'fft' ) CALL print_clock( 'ffts' ) CALL print_clock( 'fftw' ) - CALL print_clock( 'fftzf' ) - CALL print_clock( 'fftzb' ) - CALL print_clock( 'fftxyf' ) - CALL print_clock( 'fftxyb' ) CALL print_clock( 'fftb' ) - CALL print_clock( 'rsg' ) + CALL print_clock( 'cft3s' ) + CALL print_clock( 'fft_scatter' ) ! IF (tcg) call print_clock_tcg() ! IF( use_task_groups ) THEN ! - CALL print_clock( 'tg_invfftw') - CALL print_clock( 'tg_fftw') - CALL print_clock( '1D' ) - CALL print_clock( '2D' ) - CALL print_clock( 'SCATTER' ) CALL print_clock( 'ALLTOALL' ) ! END IF diff --git a/CPV/fft.f90 b/CPV/fft.f90 index e06c75afd..4315c0af8 100644 --- a/CPV/fft.f90 +++ b/CPV/fft.f90 @@ -38,10 +38,10 @@ ! USE kinds, ONLY: DP - use fft_cp, only: cfft_cp use fft_base, only: dfftp, dffts, dfftb use fft_scalar, only: cfft3d, cfft3ds, cft_b use fft_parallel, only: tg_cft3s + use control_flags, only: use_task_groups IMPLICIT none @@ -73,15 +73,11 @@ END IF IF( grid_type == 'Dense' ) THEN - call cfft_cp(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,1,dfftp) + call tg_cft3s( f, dfftp, 1 ) ELSE IF( grid_type == 'Smooth' ) THEN - call cfft_cp(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,1,dffts) + call tg_cft3s( f, dffts, 1 ) ELSE IF( grid_type == 'Wave' ) THEN - IF( dffts%use_task_groups ) THEN - call tg_cft3s(f,dffts,2) - ELSE - call cfft_cp(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,2,dffts) - END IF + call tg_cft3s( f, dffts, 2, use_task_groups ) ELSE IF( grid_type == 'Box' .AND. np3 > 0 ) THEN call cft_b(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,imin3,imax3,1) END IF @@ -134,10 +130,10 @@ ! on the smooth grid . On output, f is overwritten ! USE kinds, ONLY: DP - use fft_cp, only: cfft_cp use fft_base, only: dfftp, dffts use fft_scalar, only: cfft3d, cfft3ds use fft_parallel, only: tg_cft3s + use control_flags, only: use_task_groups implicit none @@ -158,15 +154,11 @@ #if defined __PARA && !defined __USE_3D_FFT IF( grid_type == 'Dense' ) THEN - call cfft_cp(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,-1,dfftp) + call tg_cft3s(f,dfftp,-1) ELSE IF( grid_type == 'Smooth' ) THEN - call cfft_cp(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,-1,dffts) + call tg_cft3s(f,dffts,-1) ELSE IF( grid_type == 'Wave' ) THEN - IF( dffts%use_task_groups ) THEN - call tg_cft3s(f,dffts,-2) - ELSE - call cfft_cp(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,-2,dffts) - END IF + call tg_cft3s(f,dffts,-2, use_task_groups ) END IF #else diff --git a/CPV/fftdrv.f90 b/CPV/fftdrv.f90 deleted file mode 100644 index b4ebab25a..000000000 --- a/CPV/fftdrv.f90 +++ /dev/null @@ -1,235 +0,0 @@ -! -! Copyright (C) 2002-2005 FPMD-CPV groups -! 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 . -! -! ---------------------------------------------- -! This Module written by Carlo Cavazzoni -! Last modified April 2003 -! ---------------------------------------------- - -#include "f_defs.h" - -!=---------------------------------------------------------------------==! -! -! -! FFT high level Driver -! ( Charge density and Wave Functions ) -! -! -!=---------------------------------------------------------------------==! -! - -MODULE fft_cp - - USE fft_types, ONLY: fft_dlay_descriptor - - IMPLICIT NONE - SAVE - -CONTAINS - -!---------------------------------------------------------------------- - SUBROUTINE cfft_cp ( f, nr1, nr2, nr3, nr1x, nr2x, nr3x, sign, dfft ) -!---------------------------------------------------------------------- -! -! sign = +-1 : parallel 3d fft for rho and for the potential -! sign = +-2 : parallel 3d fft for wavefunctions -! -! sign = + : G-space to R-space, output = \sum_G f(G)exp(+iG*R) -! fft along z using pencils (cft_1z) -! transpose across nodes (fft_scatter) -! and reorder -! fft along y (using planes) and x (cft_2xy) -! sign = - : R-space to G-space, output = \int_R f(R)exp(-iG*R)/Omega -! fft along x and y(using planes) (cft_2xy) -! transpose across nodes (fft_scatter) -! and reorder -! fft along z using pencils (cft_1z) -! -! 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 -! "empty" = no active components are present in f(i,*,*) -! after (sign>0) or before (sign<0) the fft on z direction -! -! Note that if sign=+/-1 (fft on rho and pot.) all fft's are needed -! and all planes(i) are set to 1 -! -! based on code written by Stefano de Gironcoli for PWSCF -! - use kinds, only: DP - use mp_global, only: me_image, nproc_image, intra_image_comm - use fft_scalar, only: cft_1z, cft_2xy -! - implicit none - ! - integer, intent(in) :: nr1, nr2, nr3, nr1x, nr2x, nr3x, sign - type (fft_dlay_descriptor), intent(in) :: dfft - complex(DP) :: f( : ) - complex(DP), allocatable :: aux( : ) - - integer mc, i, j, ii, proc, k, me - integer planes(nr1x) -! -! see comments in cfftp for the logic (or lack of it) of the following -! - if ( nr1 /= dfft%nr1 ) call errore(' cfft ',' wrong dims ', 1) - if ( nr2 /= dfft%nr2 ) call errore(' cfft ',' wrong dims ', 2) - if ( nr3 /= dfft%nr3 ) call errore(' cfft ',' wrong dims ', 3) - if ( nr1x /= dfft%nr1x ) call errore(' cfft ',' wrong dims ', 4) - if ( nr2x /= dfft%nr2x ) call errore(' cfft ',' wrong dims ', 5) - if ( nr3x /= dfft%nr3x ) call errore(' cfft ',' wrong dims ', 6) - - me = me_image + 1 - - allocate( aux( dfft%nnr ) ) - - if ( sign > 0 ) then - ! - if ( sign /= 2 ) then - call cft_1z( f, dfft%nsp(me), nr3, nr3x, sign, aux ) - CALL fw_scatter( sign ) ! forwart scatter from stick to planes - planes = dfft%iplp - else - call cft_1z( f, dfft%nsw(me), nr3, nr3x, sign, aux ) - CALL fw_scatter( sign ) ! forwart scatter from stick to planes - planes = dfft%iplw - end if - ! - call cft_2xy( f, dfft%npp( me ), nr1, nr2, nr1x, nr2x, sign, planes ) - ! - else - ! - if ( sign .ne. -2 ) then - planes = dfft%iplp - else - planes = dfft%iplw - endif - ! - call cft_2xy( f, dfft%npp(me), nr1, nr2, nr1x, nr2x, sign, planes) - ! - if ( sign /= -2 ) then - call bw_scatter( sign ) - call cft_1z( aux, dfft%nsp( me ), nr3, nr3x, sign, f ) - else - call bw_scatter( sign ) - call cft_1z( aux, dfft%nsw( me ), nr3, nr3x, sign, f ) - end if - ! - end if -! - deallocate( aux ) - - RETURN - ! - ! - CONTAINS - ! - ! - SUBROUTINE fw_scatter( iopt ) - ! - use fft_base, only: fft_scatter - ! - INTEGER, INTENT(IN) :: iopt - INTEGER :: nppx - ! - ! - IF( iopt == 2 ) THEN - ! - if ( nproc_image == 1 ) then - nppx = dfft%nr3x - else - nppx = dfft%npp( me ) - end if - call fft_scatter( aux, nr3x, dfft%nnr, f, dfft%nsw, dfft%npp, iopt ) - f(:) = (0.d0, 0.d0) - ii = 0 - do proc = 1, nproc_image - do i = 1, dfft%nsw( proc ) - mc = dfft%ismap( i + dfft%iss( proc ) ) - ii = ii + 1 - do j = 1, dfft%npp( me ) - f( mc + ( j - 1 ) * dfft%nnp ) = aux( j + ( ii - 1 ) * nppx ) - end do - end do - end do - ! - ELSE IF( iopt == 1 ) THEN - ! - if ( nproc_image == 1 ) then - nppx = dfft%nr3x - else - nppx = dfft%npp( me ) - end if - call fft_scatter( aux, nr3x, dfft%nnr, f, dfft%nsp, dfft%npp, iopt ) - f(:) = (0.d0, 0.d0) - do i = 1, dfft%nst - mc = dfft%ismap( i ) - do j = 1, dfft%npp( me ) - f( mc + ( j - 1 ) * dfft%nnp ) = aux( j + ( i - 1 ) * nppx ) - end do - end do - ! - END IF - ! - RETURN - END SUBROUTINE fw_scatter - ! - ! - ! - SUBROUTINE bw_scatter( iopt ) - ! - use fft_base, only: fft_scatter - ! - INTEGER, INTENT(IN) :: iopt - INTEGER :: nppx - ! - ! - IF( iopt == -2 ) THEN - ! - if ( nproc_image == 1 ) then - nppx = dfft%nr3x - else - nppx = dfft%npp( me ) - end if - ii = 0 - do proc = 1, nproc_image - do i = 1, dfft%nsw( proc ) - mc = dfft%ismap( i + dfft%iss( proc ) ) - ii = ii + 1 - do j = 1, dfft%npp( me ) - aux( j + ( ii - 1 ) * nppx ) = f( mc + ( j - 1 ) * dfft%nnp ) - end do - end do - end do - call fft_scatter( aux, nr3x, dfft%nnr, f, dfft%nsw, dfft%npp, iopt ) - ! - ELSE IF( iopt == -1 ) THEN - ! - if ( nproc_image == 1 ) then - nppx = dfft%nr3x - else - nppx = dfft%npp( me ) - end if - do i = 1, dfft%nst - mc = dfft%ismap( i ) - do j = 1, dfft%npp( me ) - aux( j + ( i - 1 ) * nppx ) = f( mc + ( j - 1 ) * dfft%nnp ) - end do - end do - call fft_scatter( aux, nr3x, dfft%nnr, f, dfft%nsp, dfft%npp, iopt ) - ! - END IF - ! - RETURN - END SUBROUTINE bw_scatter - ! - ! - ! - END SUBROUTINE cfft_cp - ! - ! -END MODULE fft_cp diff --git a/CPV/make.depend b/CPV/make.depend index f6f234909..c62f1ce92 100644 --- a/CPV/make.depend +++ b/CPV/make.depend @@ -408,6 +408,7 @@ exch_corr.o : ../Modules/recvec.o exch_corr.o : ../Modules/sic.o exch_corr.o : cp_interfaces.o exch_corr.o : modules.o +fft.o : ../Modules/control_flags.o fft.o : ../Modules/fft_base.o fft.o : ../Modules/fft_parallel.o fft.o : ../Modules/fft_scalar.o @@ -415,12 +416,6 @@ fft.o : ../Modules/griddim.o fft.o : ../Modules/kind.o fft.o : ../Modules/mp_global.o fft.o : ../Modules/recvec.o -fft.o : fftdrv.o -fftdrv.o : ../Modules/fft_base.o -fftdrv.o : ../Modules/fft_scalar.o -fftdrv.o : ../Modules/fft_types.o -fftdrv.o : ../Modules/kind.o -fftdrv.o : ../Modules/mp_global.o forceconv.o : ../Modules/kind.o forces.o : ../Modules/cell_base.o forces.o : ../Modules/constants.o @@ -1133,7 +1128,6 @@ electrons.o : ../include/f_defs.h emptystates.o : ../include/f_defs.h exch_corr.o : ../include/f_defs.h fft.o : ../include/f_defs.h -fftdrv.o : ../include/f_defs.h forceconv.o : ../include/f_defs.h forces.o : ../include/f_defs.h fromscra.o : ../include/f_defs.h