21 #include "../base/base_uses.f90"
27 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'ps_wavelet_util'
81 SUBROUTINE psolver(geocode, iproc, nproc, n01, n02, n03, hx, hy, hz, &
82 rhopot, karray, pw_grid)
83 CHARACTER(len=1),
INTENT(in) :: geocode
84 INTEGER,
INTENT(in) :: iproc, nproc, n01, n02, n03
85 REAL(kind=
dp),
INTENT(in) :: hx, hy, hz
86 REAL(kind=
dp),
DIMENSION(*),
INTENT(inout) :: rhopot
87 REAL(kind=
dp),
DIMENSION(*),
INTENT(in) :: karray
88 TYPE(pw_grid_type),
POINTER :: pw_grid
90 INTEGER :: i1, i2, i3, iend, istart, j2, m1, m2, &
91 m3, md1, md2, md3, n1, n2, n3, nd1, &
92 nd2, nd3, nlim, nwb, nwbl, nwbr, nxc, &
94 REAL(kind=
dp) :: factor, hgrid, red_fact, scal
95 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :, :) :: zf
100 IF (geocode ==
'P')
THEN
101 CALL p_fft_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
102 ELSE IF (geocode ==
'S')
THEN
103 CALL s_fft_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
104 ELSE IF (geocode ==
'F')
THEN
105 CALL f_fft_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
107 cpabort(
"PSolver: geometry code not admitted")
110 ALLOCATE (zf(md1, md3, md2/nproc))
127 istart = iproc*(md2/nproc)
128 iend = min((iproc + 1)*md2/nproc, m2)
136 nwb = nxcl + nxc + nxcr - 2
137 nxt = nwbr + nwb + nwbl
140 IF (geocode ==
'P')
THEN
142 ELSE IF (geocode ==
'S')
THEN
144 ELSE IF (geocode ==
'F')
THEN
151 IF (istart + 1 <= m2)
THEN
153 CALL scale_and_distribute(m1, m3, md1, md2, md3, nxc, rhopot, zf, nproc, red_fact)
154 ELSE IF (istart + 1 <= nlim)
THEN
155 DO i2 = istart + 1, min(nlim, istart + md2/nproc)
159 zf(i1, i3, j2) = 0._dp
166 IF (geocode ==
'P')
THEN
168 scal = 1._dp/real(n1*n2*n3, kind=
dp)
169 CALL p_poissonsolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, iproc, zf, &
170 scal, hx, hy, hz, pw_grid%para%rs_group)
171 ELSE IF (geocode ==
'S')
THEN
173 scal = hy/real(n1*n2*n3, kind=
dp)
174 CALL s_poissonsolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, iproc, karray, zf, &
175 scal, pw_grid%para%rs_group)
176 ELSE IF (geocode ==
'F')
THEN
177 hgrid = max(hx, hy, hz)
178 scal = hgrid**3/real(n1*n2*n3, kind=
dp)
179 CALL f_poissonsolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, iproc, karray, zf, &
180 scal, pw_grid%para%rs_group)
181 factor = 0.5_dp*hgrid**3
187 IF (geocode ==
'F')
THEN
193 CALL scale_and_distribute(m1, m3, md1, md2, md3, nxc, zf, rhopot, nproc, red_fact)
237 SUBROUTINE p_fft_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
238 INTEGER,
INTENT(in) :: n01, n02, n03
239 INTEGER,
INTENT(out) :: m1, m2, m3, n1, n2, n3, md1, md2, md3, &
241 INTEGER,
INTENT(in) :: nproc
243 INTEGER :: l1, l2, l3
258 print *,
'the FFT in the x direction is not allowed'
259 print *,
'n01 dimension', n01
266 print *,
'the FFT in the z direction is not allowed'
267 print *,
'n03 dimension', n03
273 print *,
'the FFT in the y direction is not allowed'
274 print *,
'n02 dimension', n02
283 DO WHILE (nproc*(md2/nproc) .LT. n2)
292 DO WHILE (
modulo(nd3, nproc) .NE. 0)
333 SUBROUTINE s_fft_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
334 INTEGER,
INTENT(in) :: n01, n02, n03
335 INTEGER,
INTENT(out) :: m1, m2, m3, n1, n2, n3, md1, md2, md3, &
337 INTEGER,
INTENT(in) :: nproc
339 CHARACTER(len=*),
PARAMETER :: routinen =
'S_FFT_dimensions'
341 INTEGER :: handle, l1, l2, l3
345 CALL timeset(routinen, handle)
357 print *,
'the FFT in the x direction is not allowed'
358 print *,
'n01 dimension', n01
365 print *,
'the FFT in the z direction is not allowed'
366 print *,
'n03 dimension', n03
371 IF (
modulo(n3, 2) == 0)
THEN
383 DO WHILE (nproc*(md2/nproc) .LT. n2)
395 DO WHILE (
modulo(nd3, nproc) .NE. 0)
398 CALL timestop(handle)
440 SUBROUTINE f_fft_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
441 INTEGER,
INTENT(in) :: n01, n02, n03
442 INTEGER,
INTENT(out) :: m1, m2, m3, n1, n2, n3, md1, md2, md3, &
444 INTEGER,
INTENT(in) :: nproc
446 INTEGER :: l1, l2, l3
459 IF (
modulo(n1, 2) == 0)
THEN
466 IF (
modulo(n2, 2) == 0)
THEN
473 IF (
modulo(n3, 2) == 0)
THEN
485 DO WHILE (nproc*(md2/nproc) .LT. n2/2)
495 DO WHILE (
modulo(nd3, nproc) .NE. 0)
514 SUBROUTINE scale_and_distribute(m1, m3, md1, md2, md3, nxc, &
515 rhopot, zf, nproc, factor)
518 INTEGER,
INTENT(in) :: m1, m3, md1, md2, md3, nxc, nproc
519 REAL(kind=
dp),
DIMENSION(md1, md3, md2/nproc), &
520 INTENT(inout) :: zf, rhopot
521 REAL(kind=
dp),
INTENT(in) :: factor
523 CHARACTER(len=*),
PARAMETER :: routinen =
'scale_and_distribute'
525 INTEGER :: handle, j1, j3, jp2
527 CALL timeset(routinen, handle)
533 zf(j1, j3, jp2) = factor*rhopot(j1, j3, jp2)
536 zf(j1, j3, jp2) = 0._dp
541 zf(j1, j3, jp2) = 0._dp
545 DO jp2 = nxc + 1, md2/nproc
548 zf(j1, j3, jp2) = 0._dp
555 CALL timestop(handle)
557 END SUBROUTINE scale_and_distribute
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
Defines the basic variable types.
integer, parameter, public dp
Definition of mathematical constants and functions.
real(kind=dp), parameter, public fourpi
Creates the wavelet kernel for the wavelet based poisson solver.
subroutine, public s_poissonsolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, iproc, pot, zf, scal, mpi_group)
!HERE POT MUST BE THE KERNEL (BEWARE THE HALF DIMENSION) ****h* BigDFT/S_PoissonSolver (Based on suit...
subroutine, public f_poissonsolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, iproc, pot, zf, scal, mpi_group)
(Based on suitable modifications of S.Goedecker routines) Applies the local FFT space Kernel to the d...
subroutine, public p_poissonsolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, iproc, zf, scal, hx, hy, hz, mpi_group)
...
subroutine, public fourier_dim(n, n_next)
Give a number n_next > n compatible for the FFT.
Performs a wavelet based solution of the Poisson equation.
subroutine, public p_fft_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
Calculate four sets of dimension needed for the calculation of the convolution for the periodic syste...
subroutine, public psolver(geocode, iproc, nproc, n01, n02, n03, hx, hy, hz, rhopot, karray, pw_grid)
Calculate the Poisson equation $\nabla^2 V(x,y,z)=-4 \pi \rho(x,y,z)$ from a given $\rho$,...
subroutine, public s_fft_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
Calculate four sets of dimension needed for the calculation of the convolution for the surface system...
subroutine, public f_fft_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
Calculate four sets of dimension needed for the calculation of the zero-padded convolution.