scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

- real space grid initialization moved to fft_types module 

(it was acting only on descriptor variables, noneed to keep it into module)
- name change: all function/variables named *_dlay_* renamed *_type_* for consistency

- IMPORTANT: fft_type_allocate merged with real space grid initializaiton
  some other grid functions removed/merged with fft types.
  Since some initialization has been moved elseware there could be some SIDE EFFECT

- In practice, now grid dimensions (nr1, nr2, nr3) comes with fft variable definition
  and variable allocation. 
  NEXT: review of the initialization/setting of the fft parallelization

- real space grid initialization subroutines moved to fft_types module
  (it was acting only on descriptor variables, no need to keep it in Modules)
- name change: all function/variables named *_dlay_* renamed *_type_* for consistency

- IMPORTANT: fft_type_allocate merged with real space grid initializaiton
  some other grid functions removed/merged with fft types.
  Since some initialization has been moved elseware there could be some SIDE EFFECT

- In practice, now grid dimensions (nr1, nr2, nr3) comes with fft variable definition
  and variable allocation.
  NEXT: review of the initialization/setting of the fft parallelization



git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12703 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
ccavazzoni 2016-08-09 21:38:57 +00:00
parent 5ca293332c
commit 75cb15a76d
32 changed files with 436 additions and 441 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
CPV/src/dealloc.f90
View File

@ -28,7 +28,7 @@ SUBROUTINE deallocate_modules_var()
USE betax, ONLY : deallocate_betax
USE wavefunctions_module, ONLY : deallocate_wavefunctions
USE wannier_module, ONLY : deallocate_wannier
USE fft_types, ONLY : fft_dlay_descriptor, fft_dlay_deallocate
USE fft_types, ONLY : fft_type_descriptor, fft_type_deallocate
USE fft_smallbox_type, ONLY : fft_box_deallocate
USE fft_base, ONLY : dfftp, dffts, dfftb
USE stick_base, ONLY : sticks_deallocate
@ -68,8 +68,8 @@ SUBROUTINE deallocate_modules_var()
CALL deallocate_qgb_mod()
CALL deallocate_betax()
!
CALL fft_dlay_deallocate( dfftp )
CALL fft_dlay_deallocate( dffts )
CALL fft_type_deallocate( dfftp )
CALL fft_type_deallocate( dffts )
CALL fft_box_deallocate( dfftb )
CALL sticks_deallocate()
!

16
CPV/src/init.f90
View File

@ -26,7 +26,7 @@
use cell_base, only: ainv, at, omega, alat
use small_box, only: small_box_set
use smallbox_grid_dim, only: smallbox_grid_init,smallbox_grid_info
USE grid_subroutines, ONLY: realspace_grid_init, realspace_grids_info
USE fft_types, ONLY: fft_type_allocate, realspace_grids_info
use ions_base, only: nat
USE recvec_subs, ONLY: ggen
USE gvect, ONLY: mill_g, eigts1,eigts2,eigts3, gg, &
@ -93,15 +93,15 @@
WRITE( stdout,'(3X,"ref_cell_a2 =",1X,3f14.8,3x,"ref_cell_b2 =",3f14.8)') ref_at(:,2)*ref_alat,ref_bg(:,2)/ref_alat
WRITE( stdout,'(3X,"ref_cell_a3 =",1X,3f14.8,3x,"ref_cell_b3 =",3f14.8)') ref_at(:,3)*ref_alat,ref_bg(:,3)/ref_alat
!
CALL realspace_grid_init( dfftp, ref_at, ref_bg, gcutm )
CALL realspace_grid_init( dffts, ref_at, ref_bg, gcutms)
CALL realspace_grid_init( dfft3d, ref_at, ref_bg, gcutms)
CALL fft_type_allocate( dfftp, ref_at, ref_bg, gcutm, intra_bgrp_comm )
CALL fft_type_allocate( dffts, ref_at, ref_bg, gcutms, intra_bgrp_comm)
CALL fft_type_allocate( dfft3d, ref_at, ref_bg, gcutms, intra_bgrp_comm)
!
ELSE
!
CALL realspace_grid_init( dfftp, at, bg, gcutm )
CALL realspace_grid_init( dffts, at, bg, gcutms)
CALL realspace_grid_init( dfft3d, at, bg, gcutms)
CALL fft_type_allocate( dfftp, at, bg, gcutm, intra_bgrp_comm )
CALL fft_type_allocate( dffts, at, bg, gcutms, intra_bgrp_comm)
CALL fft_type_allocate( dfft3d, at, bg, gcutms, intra_bgrp_comm)
!
END IF
!
@ -150,7 +150,7 @@
!
! ... Print real-space grid dimensions
!
CALL realspace_grids_info ( dfftp, dffts, nproc_bgrp )
CALL realspace_grids_info ( dfftp, dffts, nproc_bgrp, ionode )
CALL smallbox_grid_info ( dfftb )
!
! ... generate g-space vectors (dense and smooth grid)

2
CPV/src/make.depend
View File

@ -494,13 +494,13 @@ gtable.o : ../../Modules/recvec.o
gtable.o : efield.o
init.o : ../../FFTXlib/fft_smallbox.o
init.o : ../../FFTXlib/fft_smallbox_type.o
init.o : ../../FFTXlib/fft_types.o
init.o : ../../FFTXlib/stick_set.o
init.o : ../../Modules/cell_base.o
init.o : ../../Modules/constants.o
init.o : ../../Modules/control_flags.o
init.o : ../../Modules/electrons_base.o
init.o : ../../Modules/fft_base.o
init.o : ../../Modules/griddim.o
init.o : ../../Modules/gvecw.o
init.o : ../../Modules/input_parameters.o
init.o : ../../Modules/invmat.o

4
CPV/src/smallbox_grid.f90
View File

@ -27,12 +27,12 @@
SUBROUTINE smallbox_grid_init( dfftp, dfftb )
!
USE fft_support, only: good_fft_dimension, good_fft_order
USE fft_types, only: fft_dlay_descriptor
USE fft_types, only: fft_type_descriptor
USE fft_smallbox_type, only: fft_box_descriptor
!
IMPLICIT NONE
!
TYPE(fft_dlay_descriptor), INTENT(IN) :: dfftp
TYPE(fft_type_descriptor), INTENT(IN) :: dfftp
TYPE(fft_box_descriptor), INTENT(INOUT) :: dfftb
!
! no default values for grid box: if nr*b=0, ignore

2
CPV/src/smallbox_lib.f90
View File

@ -17,7 +17,7 @@
USE control_flags, ONLY: iverbosity
USE io_global, ONLY: stdout
USE mp_global, ONLY: nproc_bgrp, me_bgrp, intra_bgrp_comm
USE fft_base, ONLY: dfftb, dfftp, dfftb, fft_dlay_descriptor
USE fft_base, ONLY: dfftb, dfftp, dfftb, fft_type_descriptor
USE fft_smallbox_type, ONLY: fft_box_set
IMPLICIT NONE

16
FFTXlib/fft_interfaces.f90
View File

@ -22,12 +22,12 @@ MODULE fft_interfaces
!! (the latter has an additional argument)
SUBROUTINE invfft_x( grid_type, f, dfft, dtgs )
USE fft_types, ONLY: fft_dlay_descriptor
USE fft_types, ONLY: fft_type_descriptor
USE task_groups, ONLY: task_groups_descriptor
IMPLICIT NONE
INTEGER, PARAMETER :: DP = selected_real_kind(14,200)
CHARACTER(LEN=*), INTENT(IN) :: grid_type
TYPE(fft_dlay_descriptor), INTENT(IN) :: dfft
TYPE(fft_type_descriptor), INTENT(IN) :: dfft
TYPE(task_groups_descriptor), OPTIONAL, INTENT(IN) :: dtgs
COMPLEX(DP) :: f(:)
END SUBROUTINE invfft_x
@ -44,12 +44,12 @@ MODULE fft_interfaces
INTERFACE fwfft
SUBROUTINE fwfft_x( grid_type, f, dfft, dtgs )
USE fft_types, ONLY: fft_dlay_descriptor
USE fft_types, ONLY: fft_type_descriptor
USE task_groups, ONLY: task_groups_descriptor
IMPLICIT NONE
INTEGER, PARAMETER :: DP = selected_real_kind(14,200)
CHARACTER(LEN=*), INTENT(IN) :: grid_type
TYPE(fft_dlay_descriptor), INTENT(IN) :: dfft
TYPE(fft_type_descriptor), INTENT(IN) :: dfft
TYPE(task_groups_descriptor), OPTIONAL, INTENT(IN) :: dtgs
COMPLEX(DP) :: f(:)
END SUBROUTINE fwfft_x
@ -90,14 +90,14 @@ SUBROUTINE invfft_x( grid_type, f, dfft, dtgs )
USE fft_scalar, ONLY: cfft3d, cfft3ds
USE fft_smallbox, ONLY: cft_b, cft_b_omp
USE fft_parallel, ONLY: tg_cft3s
USE fft_types, ONLY: fft_dlay_descriptor
USE fft_types, ONLY: fft_type_descriptor
USE task_groups, ONLY: task_groups_descriptor
IMPLICIT NONE
INTEGER, PARAMETER :: DP = selected_real_kind(14,200)
TYPE(fft_dlay_descriptor), INTENT(IN) :: dfft
TYPE(fft_type_descriptor), INTENT(IN) :: dfft
CHARACTER(LEN=*), INTENT(IN) :: grid_type
COMPLEX(DP) :: f(:)
TYPE(task_groups_descriptor), OPTIONAL, INTENT(IN) :: dtgs
@ -199,14 +199,14 @@ SUBROUTINE fwfft_x( grid_type, f, dfft, dtgs )
USE fft_scalar, ONLY: cfft3d, cfft3ds
USE fft_parallel, ONLY: tg_cft3s
USE fft_types, ONLY: fft_dlay_descriptor
USE fft_types, ONLY: fft_type_descriptor
USE task_groups, ONLY: task_groups_descriptor
IMPLICIT NONE
INTEGER, PARAMETER :: DP = selected_real_kind(14,200)
TYPE(fft_dlay_descriptor), INTENT(IN) :: dfft
TYPE(fft_type_descriptor), INTENT(IN) :: dfft
CHARACTER(LEN=*), INTENT(IN) :: grid_type
COMPLEX(DP) :: f(:)
TYPE(task_groups_descriptor), OPTIONAL, INTENT(IN) :: dtgs

56
FFTXlib/fft_parallel.f90
View File

@ -64,7 +64,7 @@ SUBROUTINE tg_cft3s( f, dfft, isgn, dtgs )
!
USE fft_scalar, ONLY : cft_1z, cft_2xy
USE scatter_mod, ONLY : fft_scatter
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE task_groups, ONLY : task_groups_descriptor
!
@ -74,7 +74,7 @@ SUBROUTINE tg_cft3s( f, dfft, isgn, dtgs )
#endif
!
COMPLEX(DP), INTENT(inout) :: f( : ) ! array containing data to be transformed
TYPE (fft_dlay_descriptor), INTENT(in) :: dfft
TYPE (fft_type_descriptor), INTENT(in) :: dfft
! descriptor of fft data layout
INTEGER, INTENT(in) :: isgn ! fft direction
TYPE (task_groups_descriptor), OPTIONAL, INTENT(in) :: dtgs
@ -277,7 +277,7 @@ SUBROUTINE fw_tg_cft3_z( f_in, dfft, f_out, dtgs )
!----------------------------------------------------------------------------
!
USE fft_scalar, ONLY : cft_1z
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE task_groups, ONLY : task_groups_descriptor
!
IMPLICIT NONE
@ -287,7 +287,7 @@ SUBROUTINE fw_tg_cft3_z( f_in, dfft, f_out, dtgs )
!
COMPLEX(DP), INTENT(inout) :: f_in( : ) ! INPUT array containing data to be transformed
COMPLEX(DP), INTENT(inout) :: f_out (:) ! OUTPUT
TYPE (fft_dlay_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (fft_type_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (task_groups_descriptor), INTENT(in) :: dtgs ! descriptor of fft data layout
!
CALL cft_1z( f_in, dtgs%tg_nsw( dtgs%mype + 1 ), dfft%nr3, dfft%nr3x, 2, f_out )
@ -299,7 +299,7 @@ SUBROUTINE bw_tg_cft3_z( f_out, dfft, f_in, dtgs )
!----------------------------------------------------------------------------
!
USE fft_scalar, ONLY : cft_1z
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE task_groups, ONLY : task_groups_descriptor
!
IMPLICIT NONE
@ -309,7 +309,7 @@ SUBROUTINE bw_tg_cft3_z( f_out, dfft, f_in, dtgs )
!
COMPLEX(DP), INTENT(inout) :: f_out( : ) ! OUTPUT
COMPLEX(DP), INTENT(inout) :: f_in (:) ! INPUT array containing data to be transformed
TYPE (fft_dlay_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (fft_type_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (task_groups_descriptor), INTENT(in) :: dtgs ! descriptor of fft data layout
!
CALL cft_1z( f_in, dtgs%tg_nsw( dtgs%mype + 1 ), dfft%nr3, dfft%nr3x, -2, f_out )
@ -321,13 +321,13 @@ SUBROUTINE fw_tg_cft3_scatter( f, dfft, aux, dtgs )
!----------------------------------------------------------------------------
!
USE scatter_mod, ONLY : fft_scatter
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE task_groups, ONLY : task_groups_descriptor
!
IMPLICIT NONE
!
COMPLEX(DP), INTENT(inout) :: f( : ), aux( : ) ! array containing data to be transformed
TYPE (fft_dlay_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (fft_type_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (task_groups_descriptor), INTENT(in) :: dtgs ! descriptor of fft data layout
!
CALL fft_scatter( dfft, aux, dfft%nr3x, dtgs%nogrp*dtgs%tg_nnr, f, dtgs%tg_nsw, dtgs%tg_npp, 2, dtgs )
@ -339,13 +339,13 @@ SUBROUTINE bw_tg_cft3_scatter( f, dfft, aux, dtgs )
!----------------------------------------------------------------------------
!
USE scatter_mod, ONLY : fft_scatter
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE task_groups, ONLY : task_groups_descriptor
!
IMPLICIT NONE
!
COMPLEX(DP), INTENT(inout) :: f( : ), aux( : ) ! array containing data to be transformed
TYPE (fft_dlay_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (fft_type_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (task_groups_descriptor), INTENT(in) :: dtgs ! descriptor of fft data layout
!
CALL fft_scatter( dfft, aux, dfft%nr3x, dtgs%nogrp*dtgs%tg_nnr, f, dtgs%tg_nsw, dtgs%tg_npp, -2, dtgs )
@ -357,13 +357,13 @@ SUBROUTINE fw_tg_cft3_xy( f, dfft, dtgs )
!----------------------------------------------------------------------------
!
USE fft_scalar, ONLY : cft_2xy
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE task_groups, ONLY : task_groups_descriptor
!
IMPLICIT NONE
!
COMPLEX(DP), INTENT(inout) :: f( : ) ! INPUT/OUTPUT array containing data to be transformed
TYPE (fft_dlay_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (fft_type_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (task_groups_descriptor), INTENT(in) :: dtgs ! descriptor of fft data layout
INTEGER :: planes( dfft%nr1x )
!
@ -377,13 +377,13 @@ SUBROUTINE bw_tg_cft3_xy( f, dfft, dtgs )
!----------------------------------------------------------------------------
!
USE fft_scalar, ONLY : cft_2xy
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE task_groups, ONLY : task_groups_descriptor
!
IMPLICIT NONE
!
COMPLEX(DP), INTENT(inout) :: f( : ) ! INPUT/OUTPUT array containing data to be transformed
TYPE (fft_dlay_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (fft_type_descriptor), INTENT(in) :: dfft ! descriptor of fft data layout
TYPE (task_groups_descriptor), INTENT(in) :: dtgs ! descriptor of fft data layout
INTEGER :: planes( dfft%nr1x )
!
@ -395,7 +395,7 @@ END SUBROUTINE bw_tg_cft3_xy
#ifdef __DOUBLE_BUFFER
SUBROUTINE pack_group_sticks_i( f, yf, dfft, req)
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
IMPLICIT NONE
#if defined(__MPI)
@ -404,7 +404,7 @@ END SUBROUTINE bw_tg_cft3_xy
COMPLEX(DP), INTENT(in) :: f( : ) ! array containing all bands, and gvecs distributed across processors
COMPLEX(DP), INTENT(out) :: yf( : ) ! array containing bands collected into task groups
TYPE (fft_dlay_descriptor), INTENT(in) :: dfft
TYPE (fft_type_descriptor), INTENT(in) :: dfft
INTEGER :: ierr,req
!
IF( dfft%tg_rdsp(dfft%nogrp) + dfft%tg_rcv(dfft%nogrp) > size( yf ) ) THEN
@ -541,7 +541,7 @@ END SUBROUTINE bw_tg_cft3_xy
SUBROUTINE tg_gather( dffts, dtgs, v, tg_v )
!
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE task_groups, ONLY : task_groups_descriptor
! T.G.
@ -552,7 +552,7 @@ SUBROUTINE tg_gather( dffts, dtgs, v, tg_v )
INCLUDE 'mpif.h'
#endif
TYPE(fft_dlay_descriptor), INTENT(in) :: dffts
TYPE(fft_type_descriptor), INTENT(in) :: dffts
TYPE(task_groups_descriptor), INTENT(in) :: dtgs
REAL(DP) :: v(:)
@ -605,7 +605,7 @@ END SUBROUTINE tg_gather
!
SUBROUTINE tg_cgather( dffts, dtgs, v, tg_v )
!
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE task_groups, ONLY : task_groups_descriptor
! T.G.
@ -616,7 +616,7 @@ SUBROUTINE tg_cgather( dffts, dtgs, v, tg_v )
INCLUDE 'mpif.h'
#endif
TYPE(fft_dlay_descriptor), INTENT(in) :: dffts
TYPE(fft_type_descriptor), INTENT(in) :: dffts
TYPE(task_groups_descriptor), INTENT(in) :: dtgs
COMPLEX(DP) :: v(:)
@ -679,12 +679,12 @@ END SUBROUTINE tg_cgather
COMPLEX (DP) FUNCTION get_f_of_R (i,j,k,f,dfft)
!------ read from a distributed complex array f(:) in direct space
!
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
IMPLICIT NONE
#if defined(__MPI)
INCLUDE 'mpif.h'
#endif
TYPE (fft_dlay_descriptor), INTENT(IN) :: dfft
TYPE (fft_type_descriptor), INTENT(IN) :: dfft
INTEGER, INTENT (IN) :: i,j,k
COMPLEX(DP), INTENT (IN) :: f(:)
INTEGER :: kk, ii, jj, ierr
@ -711,12 +711,12 @@ END FUNCTION get_f_of_R
SUBROUTINE put_f_of_R (f_in,i,j,k,f,dfft)
!------ write on a distributed complex array f(:) in direct space
!
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
IMPLICIT NONE
#if defined(__MPI)
INCLUDE 'mpif.h'
#endif
TYPE (fft_dlay_descriptor), INTENT(IN) :: dfft
TYPE (fft_type_descriptor), INTENT(IN) :: dfft
INTEGER, INTENT (IN) :: i,j,k
COMPLEX(DP), INTENT (IN) :: f_in
COMPLEX(DP), INTENT (INOUT) :: f(:)
@ -742,14 +742,14 @@ END SUBROUTINE put_f_of_R
COMPLEX (DP) FUNCTION get_f_of_G (i,j,k,f,dfft)
!------ read from a distributed complex array f(:) in reciprocal space
!
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
IMPLICIT NONE
#if defined(__MPI)
INCLUDE 'mpif.h'
#endif
INTEGER, INTENT (IN) :: i,j,k
COMPLEX(DP), INTENT (IN) :: f(:)
TYPE (fft_dlay_descriptor), INTENT(IN) :: dfft
TYPE (fft_type_descriptor), INTENT(IN) :: dfft
INTEGER :: ii, jj, ierr
COMPLEX(DP) :: f_aux
@ -772,7 +772,7 @@ END FUNCTION get_f_of_G
SUBROUTINE put_f_of_G (f_in,i,j,k,f,dfft)
!------ write on a distributed complex array f(:) in reciprocal space
!
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
IMPLICIT NONE
#if defined(__MPI)
INCLUDE 'mpif.h'
@ -780,7 +780,7 @@ SUBROUTINE put_f_of_G (f_in,i,j,k,f,dfft)
COMPLEX(DP), INTENT (IN) :: f_in
INTEGER, INTENT (IN) :: i,j,k
COMPLEX(DP), INTENT (INOUT) :: f(:)
TYPE (fft_dlay_descriptor), INTENT(IN) :: dfft
TYPE (fft_type_descriptor), INTENT(IN) :: dfft
INTEGER :: ii, jj
IF ( i <= 0 .OR. i > dfft%nr1 ) CALL fftx_error__( ' put_f_of_G', ' first index out of range ', 1 )

4
FFTXlib/fft_param.f90
View File

@ -11,7 +11,9 @@
!! Number of different FFT tables that the module
!!could keep into memory without reinitialization
INTEGER, PARAMETER :: ndims = 3
INTEGER, PARAMETER :: ndims = 10
!!Max allowed fft dimension
INTEGER, PARAMETER :: DP = selected_real_kind(14,200)
INTEGER, PARAMETER :: stdout = 6 ! unit connected to standard output

322
FFTXlib/fft_types.f90
View File

@ -7,15 +7,21 @@
! or http://www.gnu.org/copyleft/gpl.txt .
!
!=----------------------------------------------------------------------------=!
MODULE fft_types
!=----------------------------------------------------------------------------=!
IMPLICIT NONE
PRIVATE
SAVE
INTEGER :: stdout = 6
#if defined(__MPI)
INCLUDE 'mpif.h'
#endif
TYPE fft_dlay_descriptor
#include "fft_param.f90"
TYPE fft_type_descriptor
INTEGER :: nst ! total number of sticks
INTEGER, POINTER :: nsp(:) ! number of sticks per processor ( potential )
@ -58,7 +64,11 @@ MODULE fft_types
! fft parallelization
!
INTEGER :: mype = 0 ! my processor id (starting from 0) in the fft group
#ifdef __MPI
INTEGER :: comm = MPI_COMM_NULL
#else
INTEGER :: comm = 0 ! communicator of the fft gruop
#endif
INTEGER :: nproc = 1 ! number of processor in the fft group
INTEGER :: root = 0 ! root processor
!
@ -67,28 +77,30 @@ MODULE fft_types
INTEGER, PRIVATE :: icount = 0
PUBLIC :: fft_type_descriptor, fft_type_set, fft_type_scalar
PUBLIC :: realspace_grids_info, fft_type_allocate, fft_type_deallocate
CONTAINS
!=----------------------------------------------------------------------------=!
SUBROUTINE fft_dlay_set_dims( desc, nr1, nr2, nr3, nr1x, nr2x, nr3x)
SUBROUTINE fft_type_set_dims( desc, nr1, nr2, nr3, nr1x, nr2x, nr3x)
!
! routine that defines the dimensions of fft_dlay_descriptor
! must be called before fft_dlay_allocate and fft_dlay_set
! routine that defines the dimensions of fft_type_descriptor
! must be called before fft_type_allocate and fft_type_set
!
TYPE (fft_dlay_descriptor) :: desc
TYPE (fft_type_descriptor) :: desc
INTEGER, INTENT(in) :: nr1, nr2, nr3 ! size of real space grid
INTEGER, INTENT(in) :: nr1x, nr2x, nr3x ! padded size of real space grid
IF (desc%dimensions_have_been_set ) &
CALL fftx_error__(' fft_dlay_set_dims ', ' fft dimensions already set ', 1 )
CALL fftx_error__(' fft_type_set_dims ', ' fft dimensions already set ', 1 )
! Set fft actual and leading dimensions of fft_dlay_descriptor from input
! Set fft actual and leading dimensions of fft_type_descriptor from input
IF( nr1 > nr1x ) CALL fftx_error__( ' fft_dlay_set_dims ', ' wrong fft dimensions ', 1 )
IF( nr2 > nr2x ) CALL fftx_error__( ' fft_dlay_set_dims ', ' wrong fft dimensions ', 2 )
IF( nr3 > nr3x ) CALL fftx_error__( ' fft_dlay_set_dims ', ' wrong fft dimensions ', 3 )
IF( nr1 > nr1x ) CALL fftx_error__( ' fft_type_set_dims ', ' wrong fft dimensions ', 1 )
IF( nr2 > nr2x ) CALL fftx_error__( ' fft_type_set_dims ', ' wrong fft dimensions ', 2 )
IF( nr3 > nr3x ) CALL fftx_error__( ' fft_type_set_dims ', ' wrong fft dimensions ', 3 )
desc%nr1 = nr1
desc%nr2 = nr2
@ -99,24 +111,46 @@ CONTAINS
desc%dimensions_have_been_set = .true.
END SUBROUTINE fft_dlay_set_dims
END SUBROUTINE fft_type_set_dims
!-------------------------------------------------------
SUBROUTINE fft_dlay_allocate( desc, mype, root, nproc, comm, nogrp )
SUBROUTINE fft_type_allocate( desc, at, bg, gcutm, comm, fft_fact )
!
! routine that allocate arrays of fft_dlay_descriptor
! must be called before fft_dlay_set
! routine that allocate arrays of fft_type_descriptor
! must be called before fft_type_set
!
TYPE (fft_dlay_descriptor) :: desc
INTEGER, INTENT(in) :: mype, root, nproc, comm ! mype starting from 0
INTEGER, INTENT(in) :: nogrp ! number of task groups
INTEGER :: nx, ny
TYPE (fft_type_descriptor) :: desc
REAL(DP), INTENT(IN) :: at(3,3), bg(3,3)
REAL(DP), INTENT(IN) :: gcutm
INTEGER, INTENT(IN), OPTIONAL :: fft_fact(3)
INTEGER, INTENT(in) :: comm ! mype starting from 0
INTEGER :: nx, ny, ierr
INTEGER :: mype, root, nproc ! mype starting from 0
IF (desc%arrays_have_been_allocated ) &
CALL fftx_error__(' fft_dlay_allocate ', ' fft arrays already allocated ', 1 )
CALL fftx_error__(' fft_type_allocate ', ' fft arrays already allocated ', 1 )
IF (.NOT. desc%dimensions_have_been_set ) &
CALL fftx_error__(' fft_dlay_allocate ', ' fft dimensions not yet set ', 1 )
IF (desc%dimensions_have_been_set ) &
CALL fftx_error__(' fft_type_allocate ', ' fft dimensions already set ', 1 )
desc%comm = comm
#ifdef __MPI
IF( desc%comm == MPI_COMM_NULL ) THEN
CALL fftx_error__( ' realspace_grid_init ', ' fft communicator is null ', 1 )
END IF
#endif
!
mype = 0
nproc = 1
root = 0
#ifdef __MPI
CALL MPI_COMM_RANK( comm, mype, ierr )
CALL MPI_COMM_SIZE( comm, nproc, ierr )
#endif
CALL realspace_grid_init( desc, at, bg, gcutm, fft_fact )
nx = desc%nr1x
ny = desc%nr2x
@ -153,11 +187,12 @@ CONTAINS
desc%root = root
desc%arrays_have_been_allocated = .TRUE.
desc%dimensions_have_been_set = .true.
END SUBROUTINE fft_dlay_allocate
END SUBROUTINE fft_type_allocate
SUBROUTINE fft_dlay_deallocate( desc )
TYPE (fft_dlay_descriptor) :: desc
SUBROUTINE fft_type_deallocate( desc )
TYPE (fft_type_descriptor) :: desc
IF ( associated( desc%nsp ) ) DEALLOCATE( desc%nsp )
IF ( associated( desc%nsw ) ) DEALLOCATE( desc%nsw )
IF ( associated( desc%ngl ) ) DEALLOCATE( desc%ngl )
@ -172,14 +207,22 @@ CONTAINS
desc%id = 0
desc%arrays_have_been_allocated = .FALSE.
desc%dimensions_have_been_set = .FALSE.
END SUBROUTINE fft_dlay_deallocate
#ifdef __MPI
desc%comm = MPI_COMM_NULL
#endif
desc%nr1 = 0
desc%nr2 = 0
desc%nr3 = 0
desc%nr1x = 0
desc%nr2x = 0
desc%nr3x = 0
END SUBROUTINE fft_type_deallocate
!=----------------------------------------------------------------------------=!
SUBROUTINE fft_dlay_set( desc, tk, nst, ub, lb, idx, in1, in2, ncp, ncpw, ngp, ngpw, st, stw )
SUBROUTINE fft_type_set( desc, tk, nst, ub, lb, idx, in1, in2, ncp, ncpw, ngp, ngpw, st, stw )
TYPE (fft_dlay_descriptor) :: desc
TYPE (fft_type_descriptor) :: desc
LOGICAL, INTENT(in) :: tk ! gamma/not-gamma logical
INTEGER, INTENT(in) :: nst ! total number of stiks
@ -205,10 +248,10 @@ CONTAINS
INTEGER :: sm
IF (.NOT. desc%arrays_have_been_allocated ) &
CALL fftx_error__(' fft_dlay_allocate ', ' fft arrays not yet allocated ', 1 )
CALL fftx_error__(' fft_type_allocate ', ' fft arrays not yet allocated ', 1 )
IF (.NOT. desc%dimensions_have_been_set ) &
CALL fftx_error__(' fft_dlay_set ', ' fft dimensions not yet set ', 1 )
CALL fftx_error__(' fft_type_set ', ' fft dimensions not yet set ', 1 )
! Set fft actual and leading dimensions to be used internally
@ -220,17 +263,17 @@ CONTAINS
nr3x = desc%nr3x
IF( ( nr1 > nr1x ) .or. ( nr2 > nr2x ) .or. ( nr3 > nr3x ) ) &
CALL fftx_error__( ' fft_dlay_set ', ' wrong fft dimensions ', 1 )
CALL fftx_error__( ' fft_type_set ', ' wrong fft dimensions ', 1 )
IF( ( size( desc%ngl ) < desc%nproc ) .or. ( size( desc%npp ) < desc%nproc ) .or. &
( size( desc%ipp ) < desc%nproc ) .or. ( size( desc%iss ) < desc%nproc ) ) &
CALL fftx_error__( ' fft_dlay_set ', ' wrong descriptor dimensions ', 2 )
CALL fftx_error__( ' fft_type_set ', ' wrong descriptor dimensions ', 2 )
IF( ( size( idx ) < nst ) .or. ( size( in1 ) < nst ) .or. ( size( in2 ) < nst ) ) &
CALL fftx_error__( ' fft_dlay_set ', ' wrong number of stick dimensions ', 3 )
CALL fftx_error__( ' fft_type_set ', ' wrong number of stick dimensions ', 3 )
IF( ( size( ncp ) < desc%nproc ) .or. ( size( ngp ) < desc%nproc ) ) &
CALL fftx_error__( ' fft_dlay_set ', ' wrong stick dimensions ', 4 )
CALL fftx_error__( ' fft_type_set ', ' wrong stick dimensions ', 4 )
! Set the number of "xy" planes for each processor
! in other word do a slab partition along the z axis
@ -298,10 +341,10 @@ CONTAINS
desc%nwl( 1:desc%nproc ) = ngpw( 1:desc%nproc ) ! local number of g vectors (wave) per processor
IF( size( desc%isind ) < ( nr1x * nr2x ) ) &
CALL fftx_error__( ' fft_dlay_set ', ' wrong descriptor dimensions, isind ', 5 )
CALL fftx_error__( ' fft_type_set ', ' wrong descriptor dimensions, isind ', 5 )
IF( size( desc%iplp ) < ( nr1x ) .or. size( desc%iplw ) < ( nr1x ) ) &
CALL fftx_error__( ' fft_dlay_set ', ' wrong descriptor dimensions, ipl ', 5 )
CALL fftx_error__( ' fft_type_set ', ' wrong descriptor dimensions, ipl ', 5 )
!
! 1. Temporarily store in the array "desc%isind" the index of the processor
@ -359,7 +402,7 @@ CONTAINS
! iss(1:nproc) is the index offset of the first column of a given processor
IF( size( desc%ismap ) < ( nst ) ) &
CALL fftx_error__( ' fft_dlay_set ', ' wrong descriptor dimensions ', 6 )
CALL fftx_error__( ' fft_type_set ', ' wrong descriptor dimensions ', 6 )
!
! 1. Set the array desc%ismap which maps stick indexes to
@ -391,7 +434,7 @@ CONTAINS
DO ip = 1, desc%nproc
WRITE( stdout,*) ' * ', ip, ' * ', nsp( ip ), ' /= ', ncpw( ip )
ENDDO
CALL fftx_error__( ' fft_dlay_set ', ' inconsistent number of sticks ', 7 )
CALL fftx_error__( ' fft_type_set ', ' inconsistent number of sticks ', 7 )
ENDIF
desc%nsw( 1:desc%nproc ) = nsp( 1:desc%nproc ) ! -- number of wave sticks per porcessor
@ -417,7 +460,7 @@ CONTAINS
DO ip = 1, desc%nproc
WRITE( stdout,*) ' * ', ip, ' * ', nsp( ip ), ' /= ', ncp( ip )
ENDDO
CALL fftx_error__( ' fft_dlay_set ', ' inconsistent number of sticks ', 8 )
CALL fftx_error__( ' fft_type_set ', ' inconsistent number of sticks ', 8 )
ENDIF
desc%nsp( 1:desc%nproc ) = nsp( 1:desc%nproc ) ! -- number of rho sticks per processor
@ -430,15 +473,15 @@ CONTAINS
desc%tptr = icount
RETURN
END SUBROUTINE fft_dlay_set
END SUBROUTINE fft_type_set
!=----------------------------------------------------------------------------=!
SUBROUTINE fft_dlay_scalar( desc, ub, lb, stw )
SUBROUTINE fft_type_scalar( desc, ub, lb, stw )
IMPLICIT NONE
TYPE (fft_dlay_descriptor) :: desc
TYPE (fft_type_descriptor) :: desc
INTEGER, INTENT(in) :: lb(:), ub(:)
INTEGER, INTENT(in) :: stw( lb(1) : ub(1), lb(2) : ub(2) )
@ -446,7 +489,7 @@ CONTAINS
INTEGER :: m1, m2, i1, i2
IF (.NOT. desc%dimensions_have_been_set ) &
CALL fftx_error__(' fft_dlay_scalar ', ' fft dimensions not yet set ', 1 )
CALL fftx_error__(' fft_type_scalar ', ' fft dimensions not yet set ', 1 )
nr1 = desc%nr1
nr2 = desc%nr2
@ -456,7 +499,7 @@ CONTAINS
nr3x = desc%nr3x
IF( size( desc%iplw ) < nr1x .or. size( desc%isind ) < nr1x * nr2x ) &
CALL fftx_error__(' fft_dlay_scalar ', ' wrong dimensions ', 1 )
CALL fftx_error__(' fft_type_scalar ', ' wrong dimensions ', 1 )
desc%isind = 0
desc%iplw = 0
@ -485,6 +528,191 @@ CONTAINS
!
RETURN
END SUBROUTINE fft_dlay_scalar
END SUBROUTINE fft_type_scalar
!=----------------------------------------------------------------------------=!
!=----------------------------------------------------------------------------=!
SUBROUTINE realspace_grid_init( dfft, at, bg, gcutm, fft_fact )
!
! ... Sets optimal values for dfft%nr[123] and dfft%nr[123]x
! ... If fft_fact is present, force nr[123] to be multiple of fft_fac([123])
!
USE fft_support, only: good_fft_dimension, good_fft_order
!
IMPLICIT NONE
!
REAL(DP), INTENT(IN) :: at(3,3), bg(3,3)
REAL(DP), INTENT(IN) :: gcutm
INTEGER, INTENT(IN), OPTIONAL :: fft_fact(3)
TYPE(fft_type_descriptor), INTENT(INOUT) :: dfft
!
IF( dfft%nr1 == 0 .OR. dfft%nr2 == 0 .OR. dfft%nr3 == 0 ) THEN
!
! ... calculate the size of the real-space dense grid for FFT
! ... first, an estimate of nr1,nr2,nr3, based on the max values
! ... of n_i indices in: G = i*b_1 + j*b_2 + k*b_3
! ... We use G*a_i = n_i => n_i .le. |Gmax||a_i|
!
dfft%nr1 = int ( sqrt (gcutm) * &
sqrt (at(1, 1)**2 + at(2, 1)**2 + at(3, 1)**2) ) + 1
dfft%nr2 = int ( sqrt (gcutm) * &
sqrt (at(1, 2)**2 + at(2, 2)**2 + at(3, 2)**2) ) + 1
dfft%nr3 = int ( sqrt (gcutm) * &
sqrt (at(1, 3)**2 + at(2, 3)**2 + at(3, 3)**2) ) + 1
!
CALL grid_set( dfft, bg, gcutm, dfft%nr1, dfft%nr2, dfft%nr3 )
!
ELSE
WRITE( stdout, '( /, 3X,"Info: using nr1, nr2, nr3 values from input" )' )
END IF
IF (PRESENT(fft_fact)) THEN
dfft%nr1 = good_fft_order( dfft%nr1, fft_fact(1) )
dfft%nr2 = good_fft_order( dfft%nr2, fft_fact(2) )
dfft%nr3 = good_fft_order( dfft%nr3, fft_fact(3) )
ELSE
dfft%nr1 = good_fft_order( dfft%nr1 )
dfft%nr2 = good_fft_order( dfft%nr2 )
dfft%nr3 = good_fft_order( dfft%nr3 )
END IF
dfft%nr1x = good_fft_dimension( dfft%nr1 )
dfft%nr2x = dfft%nr2
dfft%nr3x = good_fft_dimension( dfft%nr3 )
END SUBROUTINE realspace_grid_init
!=----------------------------------------------------------------------------=!
SUBROUTINE realspace_grids_info ( dfftp, dffts, nproc_ , ionode )
! Print info on local and global dimensions for real space grids
IMPLICIT NONE
TYPE(fft_type_descriptor), INTENT(IN) :: dfftp, dffts
INTEGER, INTENT(IN) :: nproc_
LOGICAL, INTENT(IN) :: ionode
INTEGER :: i
IF(ionode) THEN
WRITE( stdout,*)
WRITE( stdout,*) ' Real Mesh'
WRITE( stdout,*) ' ---------'
WRITE( stdout,1000) dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1, dfftp%nr2, dfftp%npl, 1, 1, nproc_
WRITE( stdout,1010) dfftp%nr1x, dfftp%nr2x, dfftp%nr3x
WRITE( stdout,1020) dfftp%nnr
WRITE( stdout,*) ' Number of x-y planes for each processors: '
WRITE( stdout, fmt = '( 3X, "nr3l = ", 10I5 )' ) &
( dfftp%npp( i ), i = 1, nproc_ )
WRITE( stdout,*)
WRITE( stdout,*) ' Smooth Real Mesh'
WRITE( stdout,*) ' ----------------'
WRITE( stdout,1000) dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1, dffts%nr2, dffts%npl,1,1, nproc_
WRITE( stdout,1010) dffts%nr1x, dffts%nr2x, dffts%nr3x
WRITE( stdout,1020) dffts%nnr
WRITE( stdout,*) ' Number of x-y planes for each processors: '
WRITE( stdout, fmt = '( 3X, "nr3sl = ", 10I5 )' ) &
( dffts%npp( i ), i = 1, nproc_ )
END IF
1000 FORMAT(3X, &
'Global Dimensions Local Dimensions Processor Grid',/,3X, &
'.X. .Y. .Z. .X. .Y. .Z. .X. .Y. .Z.',/, &
3(1X,I5),2X,3(1X,I5),2X,3(1X,I5) )
1010 FORMAT(3X, 'Array leading dimensions ( nr1x, nr2x, nr3x ) = ', 3(1X,I5) )
1020 FORMAT(3X, 'Local number of cell to store the grid ( nrxx ) = ', 1X, I9 )
RETURN
END SUBROUTINE realspace_grids_info
SUBROUTINE grid_set( dfft, bg, gcut, nr1, nr2, nr3 )
! this routine returns in nr1, nr2, nr3 the minimal 3D real-space FFT
! grid required to fit the G-vector sphere with G^2 <= gcut
! On input, nr1,nr2,nr3 must be set to values that match or exceed
! the largest i,j,k (Miller) indices in G(i,j,k) = i*b1 + j*b2 + k*b3
! ----------------------------------------------
IMPLICIT NONE
#if defined(__MPI)
INCLUDE 'mpif.h'
#endif
! ... declare arguments
TYPE(fft_type_descriptor), INTENT(IN) :: dfft
INTEGER, INTENT(INOUT) :: nr1, nr2, nr3
REAL(DP), INTENT(IN) :: bg(3,3), gcut
! ... declare other variables
INTEGER :: i, j, k, nr, nb(3)
REAL(DP) :: gsq, g(3)
! ----------------------------------------------
nb = 0
! ... calculate moduli of G vectors and the range of indices where
! ... |G|^2 < gcut (in parallel whenever possible)
DO k = -nr3, nr3
!
! ... me_image = processor number, starting from 0
!
IF( MOD( k + nr3, dfft%nproc ) == dfft%mype ) THEN
DO j = -nr2, nr2
DO i = -nr1, nr1
g( 1 ) = DBLE(i)*bg(1,1) + DBLE(j)*bg(1,2) + DBLE(k)*bg(1,3)
g( 2 ) = DBLE(i)*bg(2,1) + DBLE(j)*bg(2,2) + DBLE(k)*bg(2,3)
g( 3 ) = DBLE(i)*bg(3,1) + DBLE(j)*bg(3,2) + DBLE(k)*bg(3,3)
! ... calculate modulus
gsq = g( 1 )**2 + g( 2 )**2 + g( 3 )**2
IF( gsq < gcut ) THEN
! ... calculate maximum index
nb(1) = MAX( nb(1), ABS( i ) )
nb(2) = MAX( nb(2), ABS( j ) )
nb(3) = MAX( nb(3), ABS( k ) )
END IF
END DO
END DO
END IF
END DO
#ifdef __MPI
CALL MPI_ALLREDUCE( MPI_IN_PLACE, nb, 3, MPI_INTEGER, MPI_MAX, dfft%comm, i )
#endif
! ... the size of the required (3-dimensional) matrix depends on the
! ... maximum indices. Note that the following choice is slightly
! ... "small": 2*nb+2 would be needed in order to guarantee that the
! ... sphere in G-space never overlaps its periodic image
nr1 = 2 * nb(1) + 1
nr2 = 2 * nb(2) + 1
nr3 = 2 * nb(3) + 1
RETURN
END SUBROUTINE grid_set
!=----------------------------------------------------------------------------=!
END MODULE fft_types
!=----------------------------------------------------------------------------=!

2
FFTXlib/make.depend
View File

@ -8,6 +8,7 @@ fft_parallel.o : fft_scalar.o
fft_parallel.o : fft_types.o
fft_parallel.o : scatter_mod.o
fft_parallel.o : task_groups.o
fft_types.o : fft_support.o
scatter_mod.o : fft_types.o
scatter_mod.o : task_groups.o
stick_set.o : fft_types.o
@ -37,5 +38,6 @@ fft_stick.o : ../include/c_defs.h
fft_stick.o : fftw.c
fft_support.o : ../include/fft_defs.h
fft_support.o : fft_param.f90
fft_types.o : fft_param.f90
fftw.o :
fftw.o :

24
FFTXlib/scatter_mod.f90
View File

@ -15,7 +15,7 @@
MODULE scatter_mod
!=----------------------------------------------------------------------=!
USE fft_types, ONLY: fft_dlay_descriptor
USE fft_types, ONLY: fft_type_descriptor
USE task_groups, ONLY: task_groups_descriptor
IMPLICIT NONE
@ -34,7 +34,7 @@
PRIVATE
PUBLIC :: fft_dlay_descriptor
PUBLIC :: fft_type_descriptor
PUBLIC :: fft_scatter, gather_grid, scatter_grid
PUBLIC :: cgather_sym, cgather_sym_many, cscatter_sym_many
PUBLIC :: maps_sticks_to_3d
@ -87,7 +87,7 @@ SUBROUTINE fft_scatter ( dfft, f_in, nr3x, nxx_, f_aux, ncp_, npp_, isgn, dtgs )
INCLUDE 'mpif.h'
#endif
TYPE (fft_dlay_descriptor), INTENT(in) :: dfft
TYPE (fft_type_descriptor), INTENT(in) :: dfft
INTEGER, INTENT(in) :: nr3x, nxx_, isgn, ncp_ (:), npp_ (:)
COMPLEX (DP), INTENT(inout) :: f_in (nxx_), f_aux (nxx_)
TYPE (task_groups_descriptor), OPTIONAL, INTENT(in) :: dtgs
@ -417,7 +417,7 @@ SUBROUTINE fft_scatter ( dfft, f_in, nr3x, nxx_, f_aux, ncp_, npp_, isgn, dtgs )
INCLUDE 'mpif.h'
#endif
TYPE (fft_dlay_descriptor), INTENT(in) :: dfft
TYPE (fft_type_descriptor), INTENT(in) :: dfft
INTEGER, INTENT(in) :: nr3x, nxx_, isgn, ncp_ (:), npp_ (:)
COMPLEX (DP), INTENT(inout) :: f_in (nxx_), f_aux (nxx_)
TYPE (task_groups_descriptor), OPTIONAL, INTENT(in) :: dtgs
@ -759,7 +759,7 @@ SUBROUTINE maps_sticks_to_3d( dffts, dtgs, f_in, nxx_, f_aux, isgn )
INCLUDE 'mpif.h'
#endif
TYPE (fft_dlay_descriptor), INTENT(in) :: dffts
TYPE (fft_type_descriptor), INTENT(in) :: dffts
TYPE (task_groups_descriptor), INTENT(in) :: dtgs
INTEGER, INTENT(in) :: nxx_, isgn
COMPLEX (DP), INTENT(in) :: f_in (nxx_)
@ -811,7 +811,7 @@ SUBROUTINE gather_real_grid ( dfft, f_in, f_out )
!
REAL(DP), INTENT(in) :: f_in (:)
REAL(DP), INTENT(inout):: f_out(:)
TYPE ( fft_dlay_descriptor ), INTENT(IN) :: dfft
TYPE ( fft_type_descriptor ), INTENT(IN) :: dfft
!
#if defined(__MPI)
!
@ -877,7 +877,7 @@ SUBROUTINE gather_complex_grid ( dfft, f_in, f_out )
!
COMPLEX(DP), INTENT(in) :: f_in (:)
COMPLEX(DP), INTENT(inout):: f_out(:)
TYPE ( fft_dlay_descriptor ), INTENT(IN) :: dfft
TYPE ( fft_type_descriptor ), INTENT(IN) :: dfft
!
#if defined(__MPI)
!
@ -943,7 +943,7 @@ SUBROUTINE scatter_real_grid ( dfft, f_in, f_out )
!
REAL(DP), INTENT(in) :: f_in (:)
REAL(DP), INTENT(inout):: f_out(:)
TYPE ( fft_dlay_descriptor ), INTENT(IN) :: dfft
TYPE ( fft_type_descriptor ), INTENT(IN) :: dfft
!
#if defined(__MPI)
!
@ -1011,7 +1011,7 @@ SUBROUTINE scatter_complex_grid ( dfft, f_in, f_out )
!
COMPLEX(DP), INTENT(in) :: f_in (:)
COMPLEX(DP), INTENT(inout):: f_out(:)
TYPE ( fft_dlay_descriptor ), INTENT(IN) :: dfft
TYPE ( fft_type_descriptor ), INTENT(IN) :: dfft
!
#if defined(__MPI)
!
@ -1080,7 +1080,7 @@ SUBROUTINE cgather_sym( dfftp, f_in, f_out )
INCLUDE 'mpif.h'
#endif
!
TYPE (fft_dlay_descriptor), INTENT(in) :: dfftp
TYPE (fft_type_descriptor), INTENT(in) :: dfftp
COMPLEX(DP) :: f_in( : ), f_out(:)
!
#if defined(__MPI)
@ -1141,7 +1141,7 @@ SUBROUTINE cgather_sym_many( dfftp, f_in, f_out, nbnd, nbnd_proc, start_nbnd_pro
INCLUDE 'mpif.h'
#endif
!
TYPE (fft_dlay_descriptor), INTENT(in) :: dfftp
TYPE (fft_type_descriptor), INTENT(in) :: dfftp
INTEGER :: nbnd, nbnd_proc(dfftp%nproc), start_nbnd_proc(dfftp%nproc)
COMPLEX(DP) :: f_in(dfftp%nnr,nbnd)
COMPLEX(DP) :: f_out(dfftp%nnp*dfftp%nr3x,nbnd_proc(dfftp%mype+1))
@ -1219,7 +1219,7 @@ SUBROUTINE cscatter_sym_many( dfftp, f_in, f_out, target_ibnd, nbnd, nbnd_proc,
INCLUDE 'mpif.h'
#endif
!
TYPE (fft_dlay_descriptor), INTENT(in) :: dfftp
TYPE (fft_type_descriptor), INTENT(in) :: dfftp
INTEGER :: nbnd, nbnd_proc(dfftp%nproc), start_nbnd_proc(dfftp%nproc)
COMPLEX(DP) :: f_in(dfftp%nnp*dfftp%nr3x,nbnd_proc(dfftp%mype+1))
COMPLEX(DP) :: f_out(dfftp%nnr)

45
FFTXlib/stick_set.f90
View File

@ -14,9 +14,7 @@
! ... initialize FFT descriptors for both dense and smooth grids
USE stick_base
USE fft_types, ONLY: fft_dlay_descriptor, fft_dlay_set_dims, &
fft_dlay_allocate, fft_dlay_deallocate, &
fft_dlay_set, fft_dlay_scalar
USE fft_types, ONLY: fft_type_descriptor, fft_type_set, fft_type_scalar
IMPLICIT NONE
@ -41,7 +39,7 @@
! ... bg(:,1), bg(:,2), bg(:,3) reciprocal space base vectors.
REAL(DP), INTENT(in) :: bg(3,3)
REAL(DP), INTENT(in) :: gcut, gkcut, gcuts
TYPE(fft_dlay_descriptor), INTENT(inout) :: dfftp, dffts
TYPE(fft_type_descriptor), INTENT(inout) :: dfftp, dffts
INTEGER, INTENT(out) :: ngw, ngm, ngs
INTEGER, INTENT(IN) :: mype, root, nproc, comm
@ -50,7 +48,7 @@
INTEGER, INTENT(IN) :: stdout
TYPE(task_groups_descriptor), OPTIONAL, INTENT(inout) :: dtgs
TYPE(fft_dlay_descriptor), OPTIONAL, INTENT(inout) :: dfft3d
TYPE(fft_type_descriptor), OPTIONAL, INTENT(inout) :: dfft3d
LOGICAL :: tk
@ -124,13 +122,6 @@
INTEGER, ALLOCATABLE :: idx(:)
!
! fft descriptors are initialized in this routine even if they were already defined previously !
! therefore they are preliminarily cleaned (auxiliary arrays deallocated, logical flags reset)
! to avoid memory leaks and confusion
!
CALL fft_dlay_deallocate ( dffts ) ; CALL fft_dlay_deallocate ( dfftp )
if (present(dfft3d) ) CALL fft_dlay_deallocate( dfft3d )
tk = .not. gamma_only
ub(1) = ( dfftp%nr1 - 1 ) / 2
ub(2) = ( dfftp%nr2 - 1 ) / 2
@ -204,21 +195,15 @@
#if defined(__MPI)
CALL fft_dlay_set_dims( dfftp, dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x )
CALL fft_dlay_allocate( dfftp, mype, root, nproc, comm, nogrp_ )
CALL fft_dlay_set( dfftp, tk, nst, ub, lb, idx, ist(:,1), ist(:,2), nstp, nstpw, sstp, sstpw, st, stw )
CALL fft_type_set( dfftp, tk, nst, ub, lb, idx, ist(:,1), ist(:,2), nstp, nstpw, sstp, sstpw, st, stw )
CALL fft_dlay_set_dims( dffts, dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1x, dffts%nr2x, dffts%nr3x )
CALL fft_dlay_allocate( dffts, mype, root, nproc, comm, nogrp_ )
CALL fft_dlay_set( dffts, tk, nsts, ub, lb, idx, ist(:,1), ist(:,2), nstps, nstpw, sstps, sstpw, sts, stw )
CALL fft_type_set( dffts, tk, nsts, ub, lb, idx, ist(:,1), ist(:,2), nstps, nstpw, sstps, sstpw, sts, stw )
IF( PRESENT( dfft3d ) ) THEN
DEALLOCATE( stw )
ALLOCATE( stw( lb(1) : ub(1), lb(2) : ub(2) ) )
CALL sticks_maps_scalar( (.not.tk), ub, lb, bg(:,1),bg(:,2),bg(:,3), gcut, gkcut, gcuts, stw, ngm_ , ngs_ )
CALL fft_dlay_set_dims( dfft3d, dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1x, dffts%nr2x, dffts%nr3x )
CALL fft_dlay_allocate( dfft3d, mype, root, nproc, comm, 1 )
CALL fft_dlay_scalar( dfft3d, ub, lb, stw )
CALL fft_type_scalar( dfft3d, ub, lb, stw )
END IF
#else
@ -231,13 +216,9 @@
IF( ngm_ /= ngm ) CALL fftx_error__( ' pstickset ', ' inconsistent ngm ', abs( ngm - ngm_ ) )
IF( ngs_ /= ngs ) CALL fftx_error__( ' pstickset ', ' inconsistent ngs ', abs( ngs - ngs_ ) )
CALL fft_dlay_set_dims( dfftp, dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x )
CALL fft_dlay_allocate( dfftp, mype, root, nproc, comm, 1 )
CALL fft_dlay_scalar( dfftp, ub, lb, stw )
CALL fft_type_scalar( dfftp, ub, lb, stw )
CALL fft_dlay_set_dims( dffts, dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1x, dffts%nr2x, dffts%nr3x )
CALL fft_dlay_allocate( dffts, mype, root, nproc, comm, 1 )
CALL fft_dlay_scalar( dffts, ub, lb, stw )
CALL fft_type_scalar( dffts, ub, lb, stw )
#endif
@ -310,7 +291,7 @@
! ... bg(:,1), bg(:,2), bg(:,3) reciprocal space base vectors.
REAL(DP), INTENT(in) :: bg(3,3)
REAL(DP), INTENT(in) :: gcut, gkcut, gcuts
TYPE(fft_dlay_descriptor), INTENT(inout) :: dfftp, dffts
TYPE(fft_type_descriptor), INTENT(inout) :: dfftp, dffts
INTEGER, INTENT(inout) :: ngw, ngm, ngs
INTEGER, INTENT(IN) :: mype, root, nproc, comm
@ -454,9 +435,7 @@
#if defined(__MPI)
CALL fft_dlay_set_dims( dffts, dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1x, dffts%nr2x, dffts%nr3x )
CALL fft_dlay_allocate( dffts, mype, root, nproc, comm, nogrp_ )
CALL fft_dlay_set( dffts, tk, nsts, ub, lb, idx, ist(:,1), ist(:,2), nstps, nstpw, sstps, sstpw, sts, stw )
CALL fft_type_set( dffts, tk, nsts, ub, lb, idx, ist(:,1), ist(:,2), nstps, nstpw, sstps, sstpw, sts, stw )
#else
@ -467,9 +446,7 @@
IF( ngs_ /= ngs ) CALL fftx_error__( ' pstickset_custom ', ' inconsistent ngs ', abs( ngs - ngs_ ) )
CALL fft_dlay_set_dims( dffts, dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1x, dffts%nr2x, dffts%nr3x )
CALL fft_dlay_allocate( dffts, mype, root, nproc, comm, 1 )
CALL fft_dlay_scalar( dffts, ub, lb, stw )
CALL fft_type_scalar( dffts, ub, lb, stw )
#endif

8
FFTXlib/task_groups.f90
View File

@ -68,7 +68,7 @@
SUBROUTINE task_groups_init( dffts, dtgs, nogrp )
!
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
! T.G.
! NPGRP: Number of processors per group
@ -80,7 +80,7 @@ SUBROUTINE task_groups_init( dffts, dtgs, nogrp )
#endif
TYPE(fft_dlay_descriptor), INTENT(inout) :: dffts
TYPE(fft_type_descriptor), INTENT(inout) :: dffts
TYPE(task_groups_descriptor), INTENT(inout) :: dtgs
INTEGER, INTENT(in) :: nogrp ! number of task groups
@ -184,14 +184,14 @@ END SUBROUTINE task_groups_init
!
SUBROUTINE task_groups_init_first( dffts, dtgs, nogrp )
!
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
!
IMPLICIT NONE
#if defined(__MPI)
INCLUDE 'mpif.h'
#endif
!
TYPE(fft_dlay_descriptor), INTENT(inout) :: dffts
TYPE(fft_type_descriptor), INTENT(inout) :: dffts
TYPE(task_groups_descriptor), INTENT(inout) :: dtgs
INTEGER, INTENT(in) :: nogrp ! number of task groups

10
FFTXlib/test.f90
View File

@ -45,7 +45,7 @@ program test
!! calls as been implemented. This version requires the precompilation flags
!! -D__NON_BLOCKING_SCATTER and -D__DOUBLE_BUFFER
!!
USE fft_types, ONLY: fft_dlay_descriptor, fft_dlay_deallocate
USE fft_types, ONLY: fft_type_descriptor, fft_type_deallocate
USE task_groups, ONLY: task_groups_descriptor, task_groups_deallocate
USE stick_set, ONLY: pstickset
USE fft_parallel
@ -56,7 +56,7 @@ program test
include 'fft_param.f90'
INTEGER, ALLOCATABLE :: req_p(:),req_u(:)
#endif
TYPE(fft_dlay_descriptor) :: dfftp, dffts, dfft3d
TYPE(fft_type_descriptor) :: dfftp, dffts, dfft3d
TYPE(task_groups_descriptor) :: dtgs
INTEGER :: nx = 128
!! grid points along x (modified after)
@ -426,9 +426,9 @@ program test
DEALLOCATE( psis, aux )
CALL fft_dlay_deallocate( dffts )
CALL fft_dlay_deallocate( dfftp )
CALL fft_dlay_deallocate( dfft3d )
CALL fft_type_deallocate( dffts )
CALL fft_type_deallocate( dfftp )
CALL fft_type_deallocate( dfft3d )
CALL task_groups_deallocate( dtgs )
if( ncount > 0 ) then

10
FFTXlib/test0.f90
View File

@ -10,7 +10,7 @@
! & S. de Gironcoli, SISSA
program test
USE fft_types, ONLY: fft_dlay_descriptor, fft_dlay_deallocate
USE fft_types, ONLY: fft_type_descriptor, fft_type_deallocate
USE stick_set, ONLY: pstickset
USE fft_interfaces
USE fft_parallel
@ -21,7 +21,7 @@ program test
include 'mpif.h'
#endif
include 'fft_param.f90'
TYPE(fft_dlay_descriptor) :: dfftp, dffts, dfft3d
TYPE(fft_type_descriptor) :: dfftp, dffts, dfft3d
INTEGER :: nx = 128
INTEGER :: ny = 128
INTEGER :: nz = 256
@ -374,9 +374,9 @@ program test
DEALLOCATE( psis, aux )
CALL fft_dlay_deallocate( dffts )
CALL fft_dlay_deallocate( dfftp )
CALL fft_dlay_deallocate( dfft3d )
CALL fft_type_deallocate( dffts )
CALL fft_type_deallocate( dfftp )
CALL fft_type_deallocate( dfft3d )
if( ncount > 0 ) then
my_time = my_time / DBLE(ncount)

22
GWW/pw4gww/fft_custom.f90
View File

@ -14,7 +14,7 @@ MODULE fft_custom_gwl
USE kinds, ONLY: DP
USE parallel_include
USE fft_types, ONLY: fft_dlay_descriptor
USE fft_types, ONLY: fft_type_descriptor
IMPLICIT NONE
@ -24,7 +24,7 @@ MODULE fft_custom_gwl
! ... about fft data distribution for a given
! ... potential grid, and its wave functions sub-grid.
TYPE ( fft_dlay_descriptor ) :: dfftt ! descriptor for custom grim
TYPE ( fft_type_descriptor ) :: dfftt ! descriptor for custom grim
REAL(kind=DP) :: ecutt!custom cutoff in rydberg
REAL(kind=DP) :: dual_t!dual facor
@ -177,7 +177,7 @@ CONTAINS
USE mp_world, ONLY : world_comm, nproc
USE stick_base
USE fft_support, ONLY : good_fft_dimension
USE fft_types, ONLY : fft_dlay_allocate, fft_dlay_set, fft_dlay_scalar, fft_dlay_set_dims
USE fft_types, ONLY : fft_type_allocate, fft_type_set, fft_type_scalar
!
!
IMPLICIT NONE
@ -337,14 +337,12 @@ CONTAINS
ENDIF
ENDIF
CALL fft_dlay_set_dims( fc%dfftt, fc%nr1t, fc%nr2t, fc%nr3t, fc%nrx1t, fc%nrx2t, fc%nrx3t )
CALL fft_dlay_allocate( fc%dfftt, me_pool,root_pool,nproc_pool,intra_pool_comm ,0 )
CALL fft_type_allocate( fc%dfftt, fc%at_t, fc%bg_t, fc%gcutmt, intra_pool_comm )
! here set the fft data layout structures for dense and smooth mesh,
! according to stick distribution
CALL fft_dlay_set( fc%dfftt, tk, nct, ub, lb, idx, in1(:), in2(:), ncp, nkcp, ngp, ngkp, st, stw)
CALL fft_type_set( fc%dfftt, tk, nct, ub, lb, idx, in1(:), in2(:), ncp, nkcp, ngp, ngkp, st, stw)
! if tk = .FALSE. only half reciprocal space is considered, then we
! need to correct the number of sticks
@ -431,9 +429,7 @@ CONTAINS
nxx = fc%nrxxt
nxxs = fc%nrxxt
CALL fft_dlay_set_dims( fc%dfftt, fc%nr1t, fc%nr2t, fc%nr3t, fc%nrx1t, fc%nrx2t, fc%nrx3t )
CALL fft_dlay_allocate( fc%dfftt, me_pool,root_pool,nproc_pool, intra_pool_comm,0 )
CALL fft_type_allocate( fc%dfftt, fc%at_t, fc%bg_t, fc%gcutmt, intra_pool_comm )
CALL calculate_gkcut()
@ -486,7 +482,7 @@ CONTAINS
10 CONTINUE
ENDDO
CALL fft_dlay_scalar( fc%dfftt, ub, lb, stw )
CALL fft_type_scalar( fc%dfftt, ub, lb, stw )
DEALLOCATE( stw )
@ -854,14 +850,14 @@ END SUBROUTINE ggent
SUBROUTINE deallocate_fft_custom(fc)
!this subroutine deallocates all the fft custom stuff
USE fft_types, ONLY : fft_dlay_deallocate
USE fft_types, ONLY : fft_type_deallocate
implicit none
TYPE(fft_cus) :: fc
deallocate(fc%nlt,fc%nltm)
call fft_dlay_deallocate(fc%dfftt)
call fft_type_deallocate(fc%dfftt)
deallocate(fc%ig_l2gt,fc%ggt,fc%gt)
deallocate(fc%ig1t,fc%ig2t,fc%ig3t)

1
Modules/Makefile
View File

@ -33,7 +33,6 @@ fft_base.o \
fft_custom.o \
funct.o \
generate_function.o \
griddim.o \
gth.o \
gvecw.o \
input_parameters.o \

10
Modules/fft_base.f90
View File

@ -16,7 +16,7 @@
USE parallel_include
USE fft_types, ONLY: fft_dlay_descriptor
USE fft_types, ONLY: fft_type_descriptor
USE task_groups, ONLY: task_groups_descriptor
USE fft_smallbox_type, ONLY: fft_box_descriptor
@ -26,10 +26,10 @@
! ... about fft data distribution for a given
! ... potential grid, and its wave functions sub-grid.
TYPE ( fft_dlay_descriptor ) :: dfftp ! descriptor for dense grid
TYPE ( fft_type_descriptor ) :: dfftp ! descriptor for dense grid
! Dimensions of the 3D real and reciprocal space FFT grid
! relative to the charge density and potential ("dense" grid)
TYPE ( fft_dlay_descriptor ) :: dffts ! descriptor for smooth grid
TYPE ( fft_type_descriptor ) :: dffts ! descriptor for smooth grid
! Dimensions of the 3D real and reciprocal space
! FFT grid relative to the smooth part of the charge density
! (may differ from the full charge density grid for USPP )
@ -38,7 +38,7 @@
! FFT grid relative to the "small box" computation
! of the atomic augmentation part of the
! charge density used in USPP (to speed up CPV iterations)
TYPE ( fft_dlay_descriptor ) :: dfft3d
TYPE ( fft_type_descriptor ) :: dfft3d
!
TYPE ( task_groups_descriptor ) :: dtgs
! Dimensions of the task groups
@ -47,7 +47,7 @@
PRIVATE
PUBLIC :: dfftp, dffts, dfft3d, fft_dlay_descriptor
PUBLIC :: dfftp, dffts, dfft3d, fft_type_descriptor
PUBLIC :: dtgs, task_groups_descriptor
PUBLIC :: dfftb, fft_box_descriptor

8
Modules/fft_custom.f90
View File

@ -14,7 +14,7 @@ MODULE fft_custom
USE kinds, ONLY: DP
USE parallel_include
USE fft_types, ONLY: fft_dlay_descriptor
USE fft_types, ONLY: fft_type_descriptor
IMPLICIT NONE
@ -24,7 +24,7 @@ MODULE fft_custom
! ... about fft data distribution for a given
! ... potential grid, and its wave functions sub-grid.
TYPE ( fft_dlay_descriptor ) :: dfftt
TYPE ( fft_type_descriptor ) :: dfftt
! descriptor for the custom grid
REAL(kind=DP) :: ecutt
@ -420,7 +420,7 @@ CONTAINS
SUBROUTINE deallocate_fft_custom(fc)
!this subroutine deallocates all the fft custom stuff
USE fft_types, ONLY : fft_dlay_deallocate
USE fft_types, ONLY : fft_type_deallocate
IMPLICIT NONE
@ -429,7 +429,7 @@ CONTAINS
IF(.NOT. fc%initialized) RETURN
DEALLOCATE(fc%nlt,fc%nltm)
CALL fft_dlay_deallocate(fc%dfftt)
CALL fft_type_deallocate(fc%dfftt)
DEALLOCATE(fc%ig_l2gt,fc%ggt,fc%gt)
DEALLOCATE(fc%ig1t,fc%ig2t,fc%ig3t)
fc%initialized=.FALSE.

206
Modules/griddim.f90
View File

@ -1,206 +0,0 @@
!
! Copyright (C) 2002-2015 Quantum ESPRESSO group
! 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 .
!
!=----------------------------------------------------------------------------=!
MODULE grid_subroutines
!=----------------------------------------------------------------------------=!
! This module contains subroutines that are related to grids
! parameters
USE kinds, ONLY: DP
USE fft_types, ONLY: fft_dlay_descriptor
IMPLICIT NONE
SAVE
PRIVATE
PUBLIC :: realspace_grid_init, realspace_grids_info
CONTAINS
SUBROUTINE realspace_grid_init( dfft, at, bg, gcutm, fft_fact )
!
! ... Sets optimal values for dfft%nr[123] and dfft%nr[123]x
! ... If fft_fact is present, force nr[123] to be multiple of fft_fac([123])
!
USE fft_support, only: good_fft_dimension, good_fft_order
USE io_global, only: stdout
!
IMPLICIT NONE
!
REAL(DP), INTENT(IN) :: at(3,3), bg(3,3)
REAL(DP), INTENT(IN) :: gcutm
INTEGER, INTENT(IN), OPTIONAL :: fft_fact(3)
TYPE(fft_dlay_descriptor), INTENT(INOUT) :: dfft
!
IF( dfft%nr1 == 0 .OR. dfft%nr2 == 0 .OR. dfft%nr3 == 0 ) THEN
!
! ... calculate the size of the real-space dense grid for FFT
! ... first, an estimate of nr1,nr2,nr3, based on the max values
! ... of n_i indices in: G = i*b_1 + j*b_2 + k*b_3
! ... We use G*a_i = n_i => n_i .le. |Gmax||a_i|
!
dfft%nr1 = int ( sqrt (gcutm) * &
sqrt (at(1, 1)**2 + at(2, 1)**2 + at(3, 1)**2) ) + 1
dfft%nr2 = int ( sqrt (gcutm) * &
sqrt (at(1, 2)**2 + at(2, 2)**2 + at(3, 2)**2) ) + 1
dfft%nr3 = int ( sqrt (gcutm) * &
sqrt (at(1, 3)**2 + at(2, 3)**2 + at(3, 3)**2) ) + 1
!
CALL grid_set( bg, gcutm, dfft%nr1, dfft%nr2, dfft%nr3 )
!
ELSE
WRITE( stdout, '( /, 3X,"Info: using nr1, nr2, nr3 values from input" )' )
END IF
IF (PRESENT(fft_fact)) THEN
dfft%nr1 = good_fft_order( dfft%nr1, fft_fact(1) )
dfft%nr2 = good_fft_order( dfft%nr2, fft_fact(2) )
dfft%nr3 = good_fft_order( dfft%nr3, fft_fact(3) )
ELSE
dfft%nr1 = good_fft_order( dfft%nr1 )
dfft%nr2 = good_fft_order( dfft%nr2 )
dfft%nr3 = good_fft_order( dfft%nr3 )
END IF
dfft%nr1x = good_fft_dimension( dfft%nr1 )
dfft%nr2x = dfft%nr2
dfft%nr3x = good_fft_dimension( dfft%nr3 )
END SUBROUTINE realspace_grid_init
!=----------------------------------------------------------------------------=!
SUBROUTINE realspace_grids_info ( dfftp, dffts, nproc_ )
! Print info on local and global dimensions for real space grids
USE io_global, ONLY: ionode, stdout
USE fft_types, ONLY: fft_dlay_descriptor
IMPLICIT NONE
TYPE(fft_dlay_descriptor), INTENT(IN) :: dfftp, dffts
INTEGER, INTENT(IN) :: nproc_
INTEGER :: i
IF(ionode) THEN
WRITE( stdout,*)
WRITE( stdout,*) ' Real Mesh'
WRITE( stdout,*) ' ---------'
WRITE( stdout,1000) dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1, dfftp%nr2, dfftp%npl, 1, 1, nproc_
WRITE( stdout,1010) dfftp%nr1x, dfftp%nr2x, dfftp%nr3x
WRITE( stdout,1020) dfftp%nnr
WRITE( stdout,*) ' Number of x-y planes for each processors: '
WRITE( stdout, fmt = '( 3X, "nr3l = ", 10I5 )' ) &
( dfftp%npp( i ), i = 1, nproc_ )
WRITE( stdout,*)
WRITE( stdout,*) ' Smooth Real Mesh'
WRITE( stdout,*) ' ----------------'
WRITE( stdout,1000) dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1, dffts%nr2, dffts%npl,1,1, nproc_
WRITE( stdout,1010) dffts%nr1x, dffts%nr2x, dffts%nr3x
WRITE( stdout,1020) dffts%nnr
WRITE( stdout,*) ' Number of x-y planes for each processors: '
WRITE( stdout, fmt = '( 3X, "nr3sl = ", 10I5 )' ) &
( dffts%npp( i ), i = 1, nproc_ )
END IF
1000 FORMAT(3X, &
'Global Dimensions Local Dimensions Processor Grid',/,3X, &
'.X. .Y. .Z. .X. .Y. .Z. .X. .Y. .Z.',/, &
3(1X,I5),2X,3(1X,I5),2X,3(1X,I5) )
1010 FORMAT(3X, 'Array leading dimensions ( nr1x, nr2x, nr3x ) = ', 3(1X,I5) )
1020 FORMAT(3X, 'Local number of cell to store the grid ( nrxx ) = ', 1X, I9 )
RETURN
END SUBROUTINE realspace_grids_info
SUBROUTINE grid_set( bg, gcut, nr1, nr2, nr3 )
! this routine returns in nr1, nr2, nr3 the minimal 3D real-space FFT
! grid required to fit the G-vector sphere with G^2 <= gcut
! On input, nr1,nr2,nr3 must be set to values that match or exceed
! the largest i,j,k (Miller) indices in G(i,j,k) = i*b1 + j*b2 + k*b3
! ----------------------------------------------
! ... declare modules
USE kinds, ONLY: DP
USE mp, ONLY: mp_max, mp_min, mp_sum
USE mp_images, ONLY: me_image, nproc_image, intra_image_comm
IMPLICIT NONE
! ... declare arguments
INTEGER, INTENT(INOUT) :: nr1, nr2, nr3
REAL(DP), INTENT(IN) :: bg(3,3), gcut
! ... declare other variables
INTEGER :: i, j, k, nr, nb(3)
REAL(DP) :: gsq, g(3)
! ----------------------------------------------
nb = 0
! ... calculate moduli of G vectors and the range of indices where
! ... |G|^2 < gcut (in parallel whenever possible)
DO k = -nr3, nr3
!
! ... me_image = processor number, starting from 0
!
IF( MOD( k + nr3, nproc_image ) == me_image ) THEN
DO j = -nr2, nr2
DO i = -nr1, nr1
g( 1 ) = DBLE(i)*bg(1,1) + DBLE(j)*bg(1,2) + DBLE(k)*bg(1,3)
g( 2 ) = DBLE(i)*bg(2,1) + DBLE(j)*bg(2,2) + DBLE(k)*bg(2,3)
g( 3 ) = DBLE(i)*bg(3,1) + DBLE(j)*bg(3,2) + DBLE(k)*bg(3,3)
! ... calculate modulus
gsq = g( 1 )**2 + g( 2 )**2 + g( 3 )**2
IF( gsq < gcut ) THEN
! ... calculate maximum index
nb(1) = MAX( nb(1), ABS( i ) )
nb(2) = MAX( nb(2), ABS( j ) )
nb(3) = MAX( nb(3), ABS( k ) )
END IF
END DO
END DO
END IF
END DO
CALL mp_max( nb, intra_image_comm )
! ... the size of the required (3-dimensional) matrix depends on the
! ... maximum indices. Note that the following choice is slightly
! ... "small": 2*nb+2 would be needed in order to guarantee that the
! ... sphere in G-space never overlaps its periodic image
nr1 = 2 * nb(1) + 1
nr2 = 2 * nb(2) + 1
nr3 = 2 * nb(3) + 1
RETURN
END SUBROUTINE grid_set
!=----------------------------------------------------------------------------=!
END MODULE grid_subroutines
!=----------------------------------------------------------------------------=!

6
Modules/make.depend
View File

@ -112,12 +112,6 @@ generate_function.o : kind.o
generate_function.o : mp.o
generate_function.o : mp_bands.o
generate_k_along_lines.o : kind.o
griddim.o : ../FFTXlib/fft_support.o
griddim.o : ../FFTXlib/fft_types.o
griddim.o : io_global.o
griddim.o : kind.o
griddim.o : mp.o
griddim.o : mp_images.o
gth.o : cell_base.o
gth.o : constants.o
gth.o : funct.o

12
Modules/qmmm.f90
View File

@ -394,12 +394,12 @@ END SUBROUTINE qmmm_minimum_image
!
SUBROUTINE qmmm_update_forces( force, rho, nspin, dfftp )
!
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
IMPLICIT NONE
REAL(DP), INTENT(IN) :: force(:,:)
REAL(DP) :: rho(:,:)
INTEGER :: nspin
TYPE(fft_dlay_descriptor) :: dfftp
TYPE(fft_type_descriptor) :: dfftp
INTEGER :: ierr, i
IF (qmmm_mode < 0) RETURN
@ -444,7 +444,7 @@ END SUBROUTINE qmmm_minimum_image
USE ions_base, ONLY : zv, tau
USE constants, ONLY : e2, eps8, bohr_radius_angs
USE io_global, ONLY : stdout,ionode
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE kinds, ONLY : DP
!
USE constraints_module, ONLY : pbc
@ -452,7 +452,7 @@ END SUBROUTINE qmmm_minimum_image
IMPLICIT NONE
!
REAL(DP) :: vltot(:)
TYPE(fft_dlay_descriptor) :: dfftp
TYPE(fft_type_descriptor) :: dfftp
!
! local variables
!
@ -585,7 +585,7 @@ END SUBROUTINE qmmm_minimum_image
!
USE cell_base, ONLY : alat, at, omega
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE constants, ONLY : e2, eps8
USE io_global, ONLY : stdout,ionode
USE ions_base, ONLY : zv, tau
@ -595,7 +595,7 @@ END SUBROUTINE qmmm_minimum_image
!
REAL(DP) :: rho(:,:)
INTEGER :: nspin
TYPE(fft_dlay_descriptor) :: dfftp
TYPE(fft_type_descriptor) :: dfftp
!
! local variables
!

7
PP/src/average.f90
View File

@ -49,7 +49,7 @@ PROGRAM average
USE gvecs, ONLY : doublegrid, gcutms, dual
USE gvecw, ONLY : ecutwfc
USE fft_base, ONLY : dfftp
USE grid_subroutines, ONLY : realspace_grid_init
USE fft_types, ONLY : fft_type_allocate
USE fft_base, ONLY : dffts
USE ions_base, ONLY : zv, tau, nat, ntyp => nsp, ityp, atm
USE lsda_mod, ONLY : nspin
@ -57,6 +57,7 @@ PROGRAM average
USE io_files, ONLY : iunpun
USE scf, ONLY : rho
USE mp_global, ONLY : mp_startup
USE mp_bands, ONLY : intra_bgrp_comm
USE environment, ONLY : environment_start, environment_end
USE control_flags, ONLY : gamma_only
!
@ -178,8 +179,8 @@ PROGRAM average
CALL volume (alat, at (1, 1), at (1, 2), at (1, 3), omega)
CALL realspace_grid_init ( dfftp, at, bg, gcutm )
CALL realspace_grid_init ( dffts, at, bg, gcutms)
CALL fft_type_allocate ( dfftp, at, bg, gcutm, intra_bgrp_comm )
CALL fft_type_allocate ( dffts, at, bg, gcutms, intra_bgrp_comm)
CALL data_structure ( gamma_only )
CALL allocate_fft ( )
!

7
PP/src/chdens.f90
View File

@ -20,6 +20,7 @@ SUBROUTINE chdens (filplot,plot_num)
USE io_files, ONLY : nd_nmbr
USE mp_pools, ONLY : nproc_pool
USE mp_world, ONLY : world_comm
USE mp_bands, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_bcast
USE parameters, ONLY : ntypx
USE constants, ONLY : pi, fpi
@ -29,7 +30,7 @@ SUBROUTINE chdens (filplot,plot_num)
USE fft_base, ONLY : dfftp, dffts
USE scatter_mod, ONLY : scatter_grid
USE fft_interfaces, ONLY : fwfft
USE grid_subroutines,ONLY : realspace_grid_init
USE fft_types, ONLY : fft_type_allocate
USE gvect, ONLY : ngm, nl, g, gcutm
USE gvecs, ONLY : gcutms, doublegrid, dual, ecuts
USE recvec_subs,ONLY: ggen
@ -274,8 +275,8 @@ SUBROUTINE chdens (filplot,plot_num)
CALL recips (at(1,1), at(1,2), at(1,3), bg(1,1), bg(1,2), bg(1,3) )
CALL volume (alat, at(1,1), at(1,2), at(1,3), omega)
CALL realspace_grid_init ( dfftp, at, bg, gcutm )
CALL realspace_grid_init ( dffts, at, bg, gcutms)
CALL fft_type_allocate ( dfftp, at, bg, gcutm, intra_bgrp_comm )
CALL fft_type_allocate ( dffts, at, bg, gcutms, intra_bgrp_comm)
ENDIF
ALLOCATE (rhor(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x))

6
PP/src/make.depend
View File

@ -50,16 +50,18 @@ atomic_wfc_nc_proj.o : ../../Modules/recvec.o
atomic_wfc_nc_proj.o : ../../Modules/uspp.o
atomic_wfc_nc_proj.o : ../../PW/src/atomic_wfc_mod.o
atomic_wfc_nc_proj.o : ../../PW/src/pwcom.o
average.o : ../../FFTXlib/fft_types.o
average.o : ../../Modules/cell_base.o
average.o : ../../Modules/constants.o
average.o : ../../Modules/control_flags.o
average.o : ../../Modules/environment.o
average.o : ../../Modules/fft_base.o
average.o : ../../Modules/griddim.o
average.o : ../../Modules/gvecw.o
average.o : ../../Modules/io_files.o
average.o : ../../Modules/io_global.o
average.o : ../../Modules/ions_base.o
average.o : ../../Modules/kind.o
average.o : ../../Modules/mp_bands.o
average.o : ../../Modules/mp_global.o
average.o : ../../Modules/parameters.o
average.o : ../../Modules/recvec.o
@ -109,12 +111,12 @@ bgw2pw.o : ../../PW/src/symm_base.o
bgw2pw.o : ../../iotk/src/iotk_module.o
cft.o : ../../Modules/kind.o
chdens.o : ../../FFTXlib/fft_interfaces.o
chdens.o : ../../FFTXlib/fft_types.o
chdens.o : ../../FFTXlib/scatter_mod.o
chdens.o : ../../Modules/cell_base.o
chdens.o : ../../Modules/constants.o
chdens.o : ../../Modules/control_flags.o
chdens.o : ../../Modules/fft_base.o
chdens.o : ../../Modules/griddim.o
chdens.o : ../../Modules/gvecw.o
chdens.o : ../../Modules/io_files.o
chdens.o : ../../Modules/io_global.o

6
PW/src/clean_pw.f90
View File

@ -44,7 +44,7 @@ SUBROUTINE clean_pw( lflag )
USE extfield, ONLY : forcefield
USE fft_base, ONLY : dfftp, dffts
USE stick_base, ONLY : sticks_deallocate
USE fft_types, ONLY : fft_dlay_deallocate
USE fft_types, ONLY : fft_type_deallocate
USE spin_orb, ONLY : lspinorb, fcoef
USE noncollin_module, ONLY : deallocate_noncol
USE dynamics_module, ONLY : deallocate_dyn_vars
@ -168,8 +168,8 @@ SUBROUTINE clean_pw( lflag )
!
! ... fft structures allocated in data_structure.f90
!
CALL fft_dlay_deallocate( dfftp )
CALL fft_dlay_deallocate( dffts )
CALL fft_type_deallocate( dfftp )
CALL fft_type_deallocate( dffts )
!
! ... stick-owner matrix allocated in sticks_base
!

6
PW/src/exx.f90
View File

@ -124,7 +124,9 @@ MODULE exx
USE klist, ONLY : qnorm
USE cell_base, ONLY : at, bg, tpiba2
USE fft_custom, ONLY : set_custom_grid, ggent
USE grid_subroutines, ONLY : realspace_grid_init
USE fft_types, ONLY : fft_type_allocate
USE mp_bands, ONLY : intra_bgrp_comm
IMPLICIT NONE
@ -143,7 +145,7 @@ MODULE exx
ENDIF
!
exx_fft%gcutmt = exx_fft%dual_t*exx_fft%ecutt / tpiba2
CALL realspace_grid_init(exx_fft%dfftt, at, bg, exx_fft%gcutmt)
CALL fft_type_allocate( exx_fft%dfftt, at, bg, exx_fft%gcutmt, intra_bgrp_comm)
CALL data_structure_custom(exx_fft, gamma_only)
CALL ggent(exx_fft)
exx_fft%initialized = .true.

15
PW/src/make.depend
View File

@ -457,6 +457,7 @@ ewald_dipole.o : ../../Modules/mp_bands.o
ewald_dipole.o : ../../Modules/recvec.o
ewald_dipole.o : pwcom.o
exx.o : ../../FFTXlib/fft_interfaces.o
exx.o : ../../FFTXlib/fft_types.o
exx.o : ../../FFTXlib/scatter_mod.o
exx.o : ../../Modules/becmod.o
exx.o : ../../Modules/cell_base.o
@ -466,7 +467,6 @@ exx.o : ../../Modules/coulomb_vcut.o
exx.o : ../../Modules/fft_base.o
exx.o : ../../Modules/fft_custom.o
exx.o : ../../Modules/funct.o
exx.o : ../../Modules/griddim.o
exx.o : ../../Modules/gvecw.o
exx.o : ../../Modules/io_files.o
exx.o : ../../Modules/io_global.o
@ -1001,9 +1001,14 @@ martyna_tuckerman.o : ../../Modules/mp.o
martyna_tuckerman.o : ../../Modules/mp_bands.o
martyna_tuckerman.o : ../../Modules/recvec.o
martyna_tuckerman.o : ../../Modules/ws_base.o
memory_report.o : ../../Modules/cell_base.o
memory_report.o : ../../Modules/constants.o
memory_report.o : ../../Modules/control_flags.o
memory_report.o : ../../Modules/fft_base.o
memory_report.o : ../../Modules/gvecw.o
memory_report.o : ../../Modules/io_global.o
memory_report.o : ../../Modules/kind.o
memory_report.o : ../../Modules/mp_bands.o
memory_report.o : ../../Modules/mp_diag.o
memory_report.o : ../../Modules/noncol.o
memory_report.o : ../../Modules/recvec.o
@ -1027,6 +1032,7 @@ mix_rho.o : ../../Modules/uspp.o
mix_rho.o : ../../Modules/wavefunctions.o
mix_rho.o : pwcom.o
mix_rho.o : scf_mod.o
move_ions.o : ../../FFTXlib/fft_types.o
move_ions.o : ../../Modules/basic_algebra_routines.o
move_ions.o : ../../Modules/bfgs_module.o
move_ions.o : ../../Modules/cell_base.o
@ -1034,12 +1040,12 @@ move_ions.o : ../../Modules/constants.o
move_ions.o : ../../Modules/control_flags.o
move_ions.o : ../../Modules/fcp_variables.o
move_ions.o : ../../Modules/fft_base.o
move_ions.o : ../../Modules/griddim.o
move_ions.o : ../../Modules/io_files.o
move_ions.o : ../../Modules/io_global.o
move_ions.o : ../../Modules/ions_base.o
move_ions.o : ../../Modules/kind.o
move_ions.o : ../../Modules/mp.o
move_ions.o : ../../Modules/mp_bands.o
move_ions.o : ../../Modules/mp_images.o
move_ions.o : ../../Modules/recvec.o
move_ions.o : atomic_wfc_mod.o
@ -1488,18 +1494,19 @@ read_conf_from_file.o : ../../Modules/io_global.o
read_conf_from_file.o : ../../Modules/kind.o
read_conf_from_file.o : pw_restart.o
read_file.o : ../../FFTXlib/fft_interfaces.o
read_file.o : ../../FFTXlib/fft_types.o
read_file.o : ../../Modules/cell_base.o
read_file.o : ../../Modules/constants.o
read_file.o : ../../Modules/control_flags.o
read_file.o : ../../Modules/fft_base.o
read_file.o : ../../Modules/funct.o
read_file.o : ../../Modules/griddim.o
read_file.o : ../../Modules/gvecw.o
read_file.o : ../../Modules/io_files.o
read_file.o : ../../Modules/io_global.o
read_file.o : ../../Modules/ions_base.o
read_file.o : ../../Modules/kernel_table.o
read_file.o : ../../Modules/kind.o
read_file.o : ../../Modules/mp_bands.o
read_file.o : ../../Modules/noncol.o
read_file.o : ../../Modules/paw_variables.o
read_file.o : ../../Modules/qes_libs.o
@ -1692,6 +1699,7 @@ setlocal.o : esm.o
setlocal.o : martyna_tuckerman.o
setlocal.o : pwcom.o
setlocal.o : scf_mod.o
setup.o : ../../FFTXlib/fft_types.o
setup.o : ../../Modules/cell_base.o
setup.o : ../../Modules/constants.o
setup.o : ../../Modules/control_flags.o
@ -1699,7 +1707,6 @@ setup.o : ../../Modules/electrons_base.o
setup.o : ../../Modules/fcp_variables.o
setup.o : ../../Modules/fft_base.o
setup.o : ../../Modules/funct.o
setup.o : ../../Modules/griddim.o
setup.o : ../../Modules/gvecw.o
setup.o : ../../Modules/io_files.o
setup.o : ../../Modules/io_global.o

14
PW/src/move_ions.f90
View File

@ -30,7 +30,7 @@ SUBROUTINE move_ions ( idone )
USE ions_base, ONLY : nat, ityp, zv, tau, if_pos
USE fft_base, ONLY : dfftp
USE fft_base, ONLY : dffts
USE grid_subroutines, ONLY : realspace_grid_init
USE fft_types, ONLY : fft_type_allocate
USE gvect, ONLY : gcutm
USE gvecs, ONLY : gcutms
USE symm_base, ONLY : checkallsym
@ -42,6 +42,7 @@ SUBROUTINE move_ions ( idone )
USE relax, ONLY : epse, epsf, epsp, starting_scf_threshold
USE lsda_mod, ONLY : lsda, absmag
USE mp_images, ONLY : intra_image_comm
USE mp_bands, ONLY : intra_bgrp_comm
USE io_global, ONLY : ionode_id, ionode
USE mp, ONLY : mp_bcast
USE bfgs_module, ONLY : bfgs, terminate_bfgs
@ -331,15 +332,8 @@ SUBROUTINE move_ions ( idone )
conv_ions = .FALSE.
! ... allow re-calculation of FFT grid
!
dfftp%nr1=0; dfftp%nr2=0; dfftp%nr3=0; dffts%nr1=0; dffts%nr2=0; dffts%nr3=0
CALL realspace_grid_init (dfftp, at, bg, gcutm )
IF ( gcutms == gcutm ) THEN
! ... No double grid, the two grids are the same
dffts%nr1 = dfftp%nr1 ; dffts%nr2 = dfftp%nr2 ; dffts%nr3 = dfftp%nr3
dffts%nr1x= dfftp%nr1x; dffts%nr2x= dfftp%nr2x; dffts%nr3x= dfftp%nr3x
ELSE
CALL realspace_grid_init ( dffts, at, bg, gcutms)
END IF
CALL fft_type_allocate (dfftp, at, bg, gcutm, intra_bgrp_comm )
CALL fft_type_allocate (dffts, at, bg, gcutms, intra_bgrp_comm)
!
CALL init_run()
!

7
PW/src/read_file.f90
View File

@ -130,7 +130,7 @@ SUBROUTINE read_xml_file_internal(withbs)
USE cellmd, ONLY : cell_factor, lmovecell
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
USE grid_subroutines, ONLY : realspace_grid_init
USE fft_types, ONLY : fft_type_allocate
USE recvec_subs, ONLY : ggen
USE gvect, ONLY : gg, ngm, g, gcutm, &
eigts1, eigts2, eigts3, nl, gstart
@ -160,6 +160,7 @@ SUBROUTINE read_xml_file_internal(withbs)
USE funct, ONLY : get_inlc, get_dft_name
USE kernel_table, ONLY : initialize_kernel_table
USE esm, ONLY : do_comp_esm, esm_init
USE mp_bands, ONLY : intra_bgrp_comm
!
IMPLICIT NONE
@ -241,8 +242,8 @@ SUBROUTINE read_xml_file_internal(withbs)
ALLOCATE( tetra( 4, MAX( ntetra, 1 ) ) )
!
CALL set_dimensions()
CALL realspace_grid_init ( dfftp, at, bg, gcutm )
CALL realspace_grid_init ( dffts, at, bg, gcutms)
CALL fft_type_allocate ( dfftp, at, bg, gcutm, intra_bgrp_comm )
CALL fft_type_allocate ( dffts, at, bg, gcutms, intra_bgrp_comm)
!
! ... check whether LSDA
!

4
PW/src/realus.f90
View File

@ -208,12 +208,12 @@ MODULE realus
USE uspp, ONLY : okvan
USE uspp_param, ONLY : upf, nh
USE atom, ONLY : rgrid
USE fft_types, ONLY : fft_dlay_descriptor
USE fft_types, ONLY : fft_type_descriptor
USE mp_bands, ONLY : me_bgrp
!
IMPLICIT NONE
!
TYPE(fft_dlay_descriptor),INTENT(in) :: dfft
TYPE(fft_type_descriptor),INTENT(in) :: dfft
TYPE(realsp_augmentation),POINTER,INTENT(inout) :: tabp(:)
!
INTEGER :: ia, mbia

13
PW/src/setup.f90
View File

@ -45,7 +45,7 @@ SUBROUTINE setup()
USE gvecw, ONLY : gcutw, ecutwfc
USE fft_base, ONLY : dfftp
USE fft_base, ONLY : dffts
USE grid_subroutines, ONLY : realspace_grid_init
USE fft_types, ONLY : fft_type_allocate
USE gvecs, ONLY : doublegrid, gcutms, dual
USE klist, ONLY : xk, wk, nks, nelec, degauss, lgauss, &
lxkcry, nkstot, &
@ -75,6 +75,7 @@ SUBROUTINE setup()
USE fixed_occ, ONLY : f_inp, tfixed_occ, one_atom_occupations
USE funct, ONLY : set_dft_from_name
USE mp_pools, ONLY : kunit
USE mp_bands, ONLY : intra_bgrp_comm
USE spin_orb, ONLY : lspinorb, domag
USE noncollin_module, ONLY : noncolin, npol, m_loc, i_cons, &
angle1, angle2, bfield, ux, nspin_lsda, &
@ -435,14 +436,8 @@ SUBROUTINE setup()
!
! ... calculate dimensions of the FFT grid
!
CALL realspace_grid_init ( dfftp, at, bg, gcutm )
IF ( gcutms == gcutm ) THEN
! ... No double grid, the two grids are the same
dffts%nr1 = dfftp%nr1 ; dffts%nr2 = dfftp%nr2 ; dffts%nr3 = dfftp%nr3
dffts%nr1x= dfftp%nr1x; dffts%nr2x= dfftp%nr2x; dffts%nr3x= dfftp%nr3x
ELSE
CALL realspace_grid_init ( dffts, at, bg, gcutms)
END IF
CALL fft_type_allocate ( dfftp, at, bg, gcutm, intra_bgrp_comm )
CALL fft_type_allocate ( dffts, at, bg, gcutms, intra_bgrp_comm)
!
! ... generate transformation matrices for the crystal point group
! ... First we generate all the symmetry matrices of the Bravais lattice