(git:b6ef100)
Loading...
Searching...
No Matches
pw_gpu.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \note
10!> This module contains routines necessary to operate on plane waves on GPUs
11! > independently of the GPU platform.
12!> \par History
13!> BGL (06-Mar-2008) : Created
14!> AG (18-May-2012) : Refacturing:
15!> - added explicit interfaces to C routines
16!> - enable double precision complex transformations
17!> AG (11-Sept-2012) : Modifications:
18!> - use pointers if precision mapping is not required
19!> - use OMP for mapping
20!> MT (Jan 2022) : Modifications
21!> - use a generic interface for fft calls to GPUs
22!> - Support both Nvidia and AMD GPUs. Other GPUs manufacturers
23!> can be added easily.
24!> \author Benjamin G. Levine
25! **************************************************************************************************
26MODULE pw_gpu
27 USE iso_c_binding, ONLY: c_double,&
28 c_int,&
29 c_loc,&
30 c_ptr
31 USE fft_tools, ONLY: &
32 cube_transpose_1, cube_transpose_2, fft_scratch_sizes, fft_scratch_type, get_fft_scratch, &
33 release_fft_scratch, x_to_yz, xz_to_yz, yz_to_x, yz_to_xz
34 USE kinds, ONLY: dp
35 USE mathconstants, ONLY: z_zero
36 USE message_passing, ONLY: mp_cart_type
37 USE pw_grid_types, ONLY: fullspace
38 USE pw_types, ONLY: pw_c1d_gs_type,&
39 pw_r3d_rs_type
40#include "../base/base_uses.f90"
41
42 IMPLICIT NONE
43
44 PRIVATE
45
46 PUBLIC :: pw_gpu_r3dc1d_3d
47 PUBLIC :: pw_gpu_c1dr3d_3d
48 PUBLIC :: pw_gpu_r3dc1d_3d_ps
49 PUBLIC :: pw_gpu_c1dr3d_3d_ps
50 PUBLIC :: pw_gpu_init, pw_gpu_finalize
51
52 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pw_gpu'
53 LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .false.
54
55CONTAINS
56
57! **************************************************************************************************
58!> \brief Allocates resources on the gpu device for gpu fft acceleration
59!> \author Ole Schuett
60! **************************************************************************************************
61 SUBROUTINE pw_gpu_init()
62 INTEGER :: dummy
63 INTERFACE
64 SUBROUTINE pw_gpu_init_c() BIND(C, name="pw_gpu_init")
65 END SUBROUTINE pw_gpu_init_c
66 END INTERFACE
67
68 mark_used(dummy) ! TODO: fix fpretty
69#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
70 CALL pw_gpu_init_c()
71#else
72 ! Nothing to do.
73#endif
74 END SUBROUTINE pw_gpu_init
75
76! **************************************************************************************************
77!> \brief Releases resources on the gpu device for gpu fft acceleration
78!> \author Ole Schuett
79! **************************************************************************************************
80 SUBROUTINE pw_gpu_finalize()
81 INTEGER :: dummy
82 INTERFACE
83 SUBROUTINE pw_gpu_finalize_c() BIND(C, name="pw_gpu_finalize")
84 END SUBROUTINE pw_gpu_finalize_c
85 END INTERFACE
86
87 mark_used(dummy) ! TODO: fix fpretty
88#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
89 CALL pw_gpu_finalize_c()
90#else
91 ! Nothing to do.
92#endif
93 END SUBROUTINE pw_gpu_finalize
94
95! **************************************************************************************************
96!> \brief perform an fft followed by a gather on the gpu
97!> \param pw1 ...
98!> \param pw2 ...
99!> \author Benjamin G Levine
100! **************************************************************************************************
101 SUBROUTINE pw_gpu_r3dc1d_3d(pw1, pw2)
102 TYPE(pw_r3d_rs_type), INTENT(IN) :: pw1
103 TYPE(pw_c1d_gs_type), INTENT(INOUT) :: pw2
104
105 CHARACTER(len=*), PARAMETER :: routinen = 'pw_gpu_r3dc1d_3d'
106
107 COMPLEX(KIND=dp), POINTER :: ptr_pwout
108 INTEGER :: handle, l1, l2, l3, ngpts
109 INTEGER, DIMENSION(:), POINTER :: npts
110 INTEGER, POINTER :: ptr_ghatmap
111 REAL(kind=dp) :: scale
112 REAL(kind=dp), POINTER :: ptr_pwin
113 INTERFACE
114 SUBROUTINE pw_gpu_cfffg_c(din, zout, ghatmap, npts, ngpts, scale) BIND(C, name="pw_gpu_cfffg")
115 IMPORT
116 TYPE(c_ptr), INTENT(IN), VALUE :: din
117 TYPE(c_ptr), VALUE :: zout
118 TYPE(c_ptr), INTENT(IN), VALUE :: ghatmap
119 INTEGER(KIND=C_INT), DIMENSION(*), INTENT(IN):: npts
120 INTEGER(KIND=C_INT), INTENT(IN), VALUE :: ngpts
121 REAL(kind=c_double), INTENT(IN), VALUE :: scale
122
123 END SUBROUTINE pw_gpu_cfffg_c
124 END INTERFACE
125
126 CALL timeset(routinen, handle)
127
128 scale = 1.0_dp/real(pw1%pw_grid%ngpts, kind=dp)
129
130 ngpts = SIZE(pw2%pw_grid%gsq)
131 l1 = lbound(pw1%array, 1)
132 l2 = lbound(pw1%array, 2)
133 l3 = lbound(pw1%array, 3)
134 npts => pw1%pw_grid%npts
135
136 ! pointers to data arrays
137 ptr_pwin => pw1%array(l1, l2, l3)
138 ptr_pwout => pw2%array(1)
139
140 ! pointer to map array
141 ptr_ghatmap => pw2%pw_grid%g_hatmap(1, 1)
142
143 ! invoke the combined transformation
144#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
145 CALL pw_gpu_cfffg_c(c_loc(ptr_pwin), c_loc(ptr_pwout), c_loc(ptr_ghatmap), npts, ngpts, scale)
146#else
147 cpabort("Compiled without pw offloading.")
148#endif
149
150 CALL timestop(handle)
151 END SUBROUTINE pw_gpu_r3dc1d_3d
152
153! **************************************************************************************************
154!> \brief perform an scatter followed by a fft on the gpu
155!> \param pw1 ...
156!> \param pw2 ...
157!> \author Benjamin G Levine
158! **************************************************************************************************
159 SUBROUTINE pw_gpu_c1dr3d_3d(pw1, pw2)
160 TYPE(pw_c1d_gs_type), INTENT(IN) :: pw1
161 TYPE(pw_r3d_rs_type), INTENT(INOUT) :: pw2
162
163 CHARACTER(len=*), PARAMETER :: routinen = 'pw_gpu_c1dr3d_3d'
164
165 COMPLEX(KIND=dp), POINTER :: ptr_pwin
166 INTEGER :: handle, l1, l2, l3, ngpts, nmaps
167 INTEGER, DIMENSION(:), POINTER :: npts
168 INTEGER, POINTER :: ptr_ghatmap
169 REAL(kind=dp) :: scale
170 REAL(kind=dp), POINTER :: ptr_pwout
171 INTERFACE
172 SUBROUTINE pw_gpu_sfffc_c(zin, dout, ghatmap, npts, ngpts, nmaps, scale) BIND(C, name="pw_gpu_sfffc")
173 IMPORT
174 TYPE(c_ptr), INTENT(IN), VALUE :: zin
175 TYPE(c_ptr), VALUE :: dout
176 TYPE(c_ptr), INTENT(IN), VALUE :: ghatmap
177 INTEGER(KIND=C_INT), DIMENSION(*), INTENT(IN):: npts
178 INTEGER(KIND=C_INT), INTENT(IN), VALUE :: ngpts, nmaps
179 REAL(kind=c_double), INTENT(IN), VALUE :: scale
180 END SUBROUTINE pw_gpu_sfffc_c
181 END INTERFACE
182
183 CALL timeset(routinen, handle)
184
185 scale = 1.0_dp
186
187 ngpts = SIZE(pw1%pw_grid%gsq)
188 l1 = lbound(pw2%array, 1)
189 l2 = lbound(pw2%array, 2)
190 l3 = lbound(pw2%array, 3)
191 npts => pw1%pw_grid%npts
192
193 ! pointers to data arrays
194 ptr_pwin => pw1%array(1)
195 ptr_pwout => pw2%array(l1, l2, l3)
196
197 ! pointer to map array
198 nmaps = SIZE(pw1%pw_grid%g_hatmap, 2)
199 ptr_ghatmap => pw1%pw_grid%g_hatmap(1, 1)
200
201 ! invoke the combined transformation
202#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
203 CALL pw_gpu_sfffc_c(c_loc(ptr_pwin), c_loc(ptr_pwout), c_loc(ptr_ghatmap), npts, ngpts, nmaps, scale)
204#else
205 cpabort("Compiled without pw offloading")
206#endif
207
208 CALL timestop(handle)
209 END SUBROUTINE pw_gpu_c1dr3d_3d
210
211! **************************************************************************************************
212!> \brief perform an parallel fft followed by a gather on the gpu
213!> \param pw1 ...
214!> \param pw2 ...
215!> \author Andreas Gloess
216! **************************************************************************************************
217 SUBROUTINE pw_gpu_r3dc1d_3d_ps(pw1, pw2)
218 TYPE(pw_r3d_rs_type), INTENT(IN) :: pw1
219 TYPE(pw_c1d_gs_type), INTENT(INOUT) :: pw2
220
221 CHARACTER(len=*), PARAMETER :: routinen = 'pw_gpu_r3dc1d_3d_ps'
222
223 COMPLEX(KIND=dp), DIMENSION(:, :), POINTER :: grays, pbuf, qbuf, rbuf, sbuf
224 COMPLEX(KIND=dp), DIMENSION(:, :, :), POINTER :: tbuf
225 INTEGER :: g_pos, handle, lg, lmax, mg, mmax, mx2, &
226 mz2, n1, n2, ngpts, nmax, numtask, rp
227 INTEGER, ALLOCATABLE, DIMENSION(:) :: p2p
228 INTEGER, DIMENSION(2) :: r_dim, r_pos
229 INTEGER, DIMENSION(:), POINTER :: n, nloc, nyzray
230 INTEGER, DIMENSION(:, :, :, :), POINTER :: bo
231 REAL(kind=dp) :: scale
232 TYPE(fft_scratch_sizes) :: fft_scratch_size
233 TYPE(fft_scratch_type), POINTER :: fft_scratch
234 TYPE(mp_cart_type) :: rs_group
235
236 CALL timeset(routinen, handle)
237
238 scale = 1.0_dp/real(pw1%pw_grid%ngpts, kind=dp)
239
240 ! dimensions
241 n => pw1%pw_grid%npts
242 nloc => pw1%pw_grid%npts_local
243 grays => pw1%pw_grid%grays
244 ngpts = nloc(1)*nloc(2)*nloc(3)
245
246 !..transform
247 IF (pw1%pw_grid%para%ray_distribution) THEN
248 rs_group = pw1%pw_grid%para%group
249 nyzray => pw1%pw_grid%para%nyzray
250 bo => pw1%pw_grid%para%bo
251
252 g_pos = rs_group%mepos
253 numtask = rs_group%num_pe
254 r_dim = rs_group%num_pe_cart
255 r_pos = rs_group%mepos_cart
256
257 lg = SIZE(grays, 1)
258 mg = SIZE(grays, 2)
259 mmax = max(mg, 1)
260 lmax = max(lg, (ngpts/mmax + 1))
261
262 ALLOCATE (p2p(0:numtask - 1))
263
264 CALL rs_group%rank_compare(rs_group, p2p)
265
266 rp = p2p(g_pos)
267 mx2 = bo(2, 1, rp, 2) - bo(1, 1, rp, 2) + 1
268 mz2 = bo(2, 3, rp, 2) - bo(1, 3, rp, 2) + 1
269 n1 = maxval(bo(2, 1, :, 1) - bo(1, 1, :, 1) + 1)
270 n2 = maxval(bo(2, 2, :, 1) - bo(1, 2, :, 1) + 1)
271 nmax = max((2*n2)/numtask, 2)*mx2*mz2
272 nmax = max(nmax, n1*maxval(nyzray))
273
274 fft_scratch_size%nx = nloc(1)
275 fft_scratch_size%ny = nloc(2)
276 fft_scratch_size%nz = nloc(3)
277 fft_scratch_size%lmax = lmax
278 fft_scratch_size%mmax = mmax
279 fft_scratch_size%mx1 = bo(2, 1, rp, 1) - bo(1, 1, rp, 1) + 1
280 fft_scratch_size%mx2 = mx2
281 fft_scratch_size%my1 = bo(2, 2, rp, 1) - bo(1, 2, rp, 1) + 1
282 fft_scratch_size%mz2 = mz2
283 fft_scratch_size%lg = lg
284 fft_scratch_size%mg = mg
285 fft_scratch_size%nbx = maxval(bo(2, 1, :, 2))
286 fft_scratch_size%nbz = maxval(bo(2, 3, :, 2))
287 fft_scratch_size%mcz1 = maxval(bo(2, 3, :, 1) - bo(1, 3, :, 1) + 1)
288 fft_scratch_size%mcx2 = maxval(bo(2, 1, :, 2) - bo(1, 1, :, 2) + 1)
289 fft_scratch_size%mcz2 = maxval(bo(2, 3, :, 2) - bo(1, 3, :, 2) + 1)
290 fft_scratch_size%nmax = nmax
291 fft_scratch_size%nmray = maxval(nyzray)
292 fft_scratch_size%nyzray = nyzray(g_pos)
293 fft_scratch_size%rs_group = rs_group
294 fft_scratch_size%g_pos = g_pos
295 fft_scratch_size%r_pos = r_pos
296 fft_scratch_size%r_dim = r_dim
297 fft_scratch_size%numtask = numtask
298
299 IF (r_dim(2) > 1) THEN
300 !
301 ! real space is distributed over x and y coordinate
302 ! we have two stages of communication
303 !
304 IF (r_dim(1) == 1) THEN
305 cpabort("This processor distribution is not supported.")
306 END IF
307
308 CALL get_fft_scratch(fft_scratch, tf_type=300, n=n, fft_sizes=fft_scratch_size)
309
310 ! assign buffers
311 qbuf => fft_scratch%p2buf
312 rbuf => fft_scratch%p3buf
313 pbuf => fft_scratch%p4buf
314 sbuf => fft_scratch%p5buf
315
316 ! FFT along z
317 CALL pw_gpu_cf(pw1, qbuf)
318
319 ! Exchange data ( transpose of matrix )
320 CALL cube_transpose_2(qbuf, bo(:, :, :, 1), bo(:, :, :, 2), rbuf, fft_scratch)
321
322 ! FFT along y
323 ! use the inbuild fft-lib
324 ! CALL fft_1dm(fft_scratch%fft_plan(2), rbuf, pbuf, 1.0_dp, stat)
325 ! or cufft (works faster, but is only faster if plans are stored)
326 CALL pw_gpu_f(rbuf, pbuf, +1, n(2), mx2*mz2)
327
328 ! Exchange data ( transpose of matrix ) and sort
329 CALL xz_to_yz(pbuf, rs_group, r_dim, g_pos, p2p, pw1%pw_grid%para%yzp, nyzray, &
330 bo(:, :, :, 2), sbuf, fft_scratch)
331
332 ! FFT along x
333 CALL pw_gpu_fg(sbuf, pw2, scale)
334
335 CALL release_fft_scratch(fft_scratch)
336
337 ELSE
338 !
339 ! real space is only distributed over x coordinate
340 ! we have one stage of communication, after the transform of
341 ! direction x
342 !
343
344 CALL get_fft_scratch(fft_scratch, tf_type=200, n=n, fft_sizes=fft_scratch_size)
345
346 ! assign buffers
347 tbuf => fft_scratch%tbuf
348 sbuf => fft_scratch%r1buf
349
350 ! FFT along y and z
351 CALL pw_gpu_cff(pw1, tbuf)
352
353 ! Exchange data ( transpose of matrix ) and sort
354 CALL yz_to_x(tbuf, rs_group, g_pos, p2p, pw1%pw_grid%para%yzp, nyzray, &
355 bo(:, :, :, 2), sbuf, fft_scratch)
356
357 ! FFT along x
358 CALL pw_gpu_fg(sbuf, pw2, scale)
359
360 CALL release_fft_scratch(fft_scratch)
361
362 END IF
363
364 DEALLOCATE (p2p)
365
366!--------------------------------------------------------------------------
367 ELSE
368 cpabort("Not implemented (no ray_distr.) in: pw_gpu_r3dc1d_3d_ps.")
369 END IF
370
371 CALL timestop(handle)
372 END SUBROUTINE pw_gpu_r3dc1d_3d_ps
373
374! **************************************************************************************************
375!> \brief perform an parallel scatter followed by a fft on the gpu
376!> \param pw1 ...
377!> \param pw2 ...
378!> \author Andreas Gloess
379! **************************************************************************************************
380 SUBROUTINE pw_gpu_c1dr3d_3d_ps(pw1, pw2)
381 TYPE(pw_c1d_gs_type), INTENT(IN) :: pw1
382 TYPE(pw_r3d_rs_type), INTENT(INOUT) :: pw2
383
384 CHARACTER(len=*), PARAMETER :: routinen = 'pw_gpu_c1dr3d_3d_ps'
385
386 COMPLEX(KIND=dp), DIMENSION(:, :), POINTER :: grays, pbuf, qbuf, rbuf, sbuf
387 COMPLEX(KIND=dp), DIMENSION(:, :, :), POINTER :: tbuf
388 INTEGER :: g_pos, handle, lg, lmax, mg, mmax, mx2, &
389 mz2, n1, n2, ngpts, nmax, numtask, rp
390 INTEGER, ALLOCATABLE, DIMENSION(:) :: p2p
391 INTEGER, DIMENSION(2) :: r_dim, r_pos
392 INTEGER, DIMENSION(:), POINTER :: n, nloc, nyzray
393 INTEGER, DIMENSION(:, :, :, :), POINTER :: bo
394 REAL(kind=dp) :: scale
395 TYPE(fft_scratch_sizes) :: fft_scratch_size
396 TYPE(fft_scratch_type), POINTER :: fft_scratch
397 TYPE(mp_cart_type) :: rs_group
398
399 CALL timeset(routinen, handle)
400
401 scale = 1.0_dp
402
403 ! dimensions
404 n => pw1%pw_grid%npts
405 nloc => pw1%pw_grid%npts_local
406 grays => pw1%pw_grid%grays
407 ngpts = nloc(1)*nloc(2)*nloc(3)
408
409 !..transform
410 IF (pw1%pw_grid%para%ray_distribution) THEN
411 rs_group = pw1%pw_grid%para%group
412 nyzray => pw1%pw_grid%para%nyzray
413 bo => pw1%pw_grid%para%bo
414
415 g_pos = rs_group%mepos
416 numtask = rs_group%num_pe
417 r_dim = rs_group%num_pe_cart
418 r_pos = rs_group%mepos_cart
419
420 lg = SIZE(grays, 1)
421 mg = SIZE(grays, 2)
422 mmax = max(mg, 1)
423 lmax = max(lg, (ngpts/mmax + 1))
424
425 ALLOCATE (p2p(0:numtask - 1))
426
427 CALL rs_group%rank_compare(rs_group, p2p)
428
429 rp = p2p(g_pos)
430 mx2 = bo(2, 1, rp, 2) - bo(1, 1, rp, 2) + 1
431 mz2 = bo(2, 3, rp, 2) - bo(1, 3, rp, 2) + 1
432 n1 = maxval(bo(2, 1, :, 1) - bo(1, 1, :, 1) + 1)
433 n2 = maxval(bo(2, 2, :, 1) - bo(1, 2, :, 1) + 1)
434 nmax = max((2*n2)/numtask, 2)*mx2*mz2
435 nmax = max(nmax, n1*maxval(nyzray))
436
437 fft_scratch_size%nx = nloc(1)
438 fft_scratch_size%ny = nloc(2)
439 fft_scratch_size%nz = nloc(3)
440 fft_scratch_size%lmax = lmax
441 fft_scratch_size%mmax = mmax
442 fft_scratch_size%mx1 = bo(2, 1, rp, 1) - bo(1, 1, rp, 1) + 1
443 fft_scratch_size%mx2 = mx2
444 fft_scratch_size%my1 = bo(2, 2, rp, 1) - bo(1, 2, rp, 1) + 1
445 fft_scratch_size%mz2 = mz2
446 fft_scratch_size%lg = lg
447 fft_scratch_size%mg = mg
448 fft_scratch_size%nbx = maxval(bo(2, 1, :, 2))
449 fft_scratch_size%nbz = maxval(bo(2, 3, :, 2))
450 fft_scratch_size%mcz1 = maxval(bo(2, 3, :, 1) - bo(1, 3, :, 1) + 1)
451 fft_scratch_size%mcx2 = maxval(bo(2, 1, :, 2) - bo(1, 1, :, 2) + 1)
452 fft_scratch_size%mcz2 = maxval(bo(2, 3, :, 2) - bo(1, 3, :, 2) + 1)
453 fft_scratch_size%nmax = nmax
454 fft_scratch_size%nmray = maxval(nyzray)
455 fft_scratch_size%nyzray = nyzray(g_pos)
456 fft_scratch_size%rs_group = rs_group
457 fft_scratch_size%g_pos = g_pos
458 fft_scratch_size%r_pos = r_pos
459 fft_scratch_size%r_dim = r_dim
460 fft_scratch_size%numtask = numtask
461
462 IF (r_dim(2) > 1) THEN
463 !
464 ! real space is distributed over x and y coordinate
465 ! we have two stages of communication
466 !
467 IF (r_dim(1) == 1) THEN
468 cpabort("This processor distribution is not supported.")
469 END IF
470
471 CALL get_fft_scratch(fft_scratch, tf_type=300, n=n, fft_sizes=fft_scratch_size)
472
473 ! assign buffers
474 pbuf => fft_scratch%p7buf
475 qbuf => fft_scratch%p4buf
476 rbuf => fft_scratch%p3buf
477 sbuf => fft_scratch%p2buf
478
479 ! FFT along x
480 CALL pw_gpu_sf(pw1, pbuf, scale)
481
482 ! Exchange data ( transpose of matrix ) and sort
483 IF (pw1%pw_grid%grid_span /= fullspace) qbuf = z_zero
484 CALL yz_to_xz(pbuf, rs_group, r_dim, g_pos, p2p, pw1%pw_grid%para%yzp, nyzray, &
485 bo(:, :, :, 2), qbuf, fft_scratch)
486
487 ! FFT along y
488 ! use the inbuild fft-lib
489 ! CALL fft_1dm(fft_scratch%fft_plan(5), qbuf, rbuf, 1.0_dp, stat)
490 ! or cufft (works faster, but is only faster if plans are stored)
491 CALL pw_gpu_f(qbuf, rbuf, -1, n(2), mx2*mz2)
492
493 ! Exchange data ( transpose of matrix )
494 IF (pw1%pw_grid%grid_span /= fullspace) sbuf = z_zero
495
496 CALL cube_transpose_1(rbuf, bo(:, :, :, 2), bo(:, :, :, 1), sbuf, fft_scratch)
497
498 ! FFT along z
499 CALL pw_gpu_fc(sbuf, pw2)
500
501 CALL release_fft_scratch(fft_scratch)
502
503 ELSE
504 !
505 ! real space is only distributed over x coordinate
506 ! we have one stage of communication, after the transform of
507 ! direction x
508 !
509
510 CALL get_fft_scratch(fft_scratch, tf_type=200, n=n, fft_sizes=fft_scratch_size)
511
512 ! assign buffers
513 sbuf => fft_scratch%r1buf
514 tbuf => fft_scratch%tbuf
515
516 ! FFT along x
517 CALL pw_gpu_sf(pw1, sbuf, scale)
518
519 ! Exchange data ( transpose of matrix ) and sort
520 IF (pw1%pw_grid%grid_span /= fullspace) tbuf = z_zero
521 CALL x_to_yz(sbuf, rs_group, g_pos, p2p, pw1%pw_grid%para%yzp, nyzray, &
522 bo(:, :, :, 2), tbuf, fft_scratch)
523
524 ! FFT along y and z
525 CALL pw_gpu_ffc(tbuf, pw2)
526
527 CALL release_fft_scratch(fft_scratch)
528
529 END IF
530
531 DEALLOCATE (p2p)
532
533!--------------------------------------------------------------------------
534 ELSE
535 cpabort("Not implemented (no ray_distr.) in: pw_gpu_c1dr3d_3d_ps.")
536 END IF
537
538 CALL timestop(handle)
539 END SUBROUTINE pw_gpu_c1dr3d_3d_ps
540
541! **************************************************************************************************
542!> \brief perform a parallel real_to_complex copy followed by a 2D-FFT on the gpu
543!> \param pw1 ...
544!> \param pwbuf ...
545!> \author Andreas Gloess
546! **************************************************************************************************
547 SUBROUTINE pw_gpu_cff(pw1, pwbuf)
548 TYPE(pw_r3d_rs_type), INTENT(IN) :: pw1
549 COMPLEX(KIND=dp), DIMENSION(:, :, :), &
550 INTENT(INOUT), TARGET :: pwbuf
551
552 CHARACTER(len=*), PARAMETER :: routinen = 'pw_gpu_cff'
553
554 COMPLEX(KIND=dp), POINTER :: ptr_pwout
555 INTEGER :: handle, l1, l2, l3
556 INTEGER, DIMENSION(:), POINTER :: npts
557 REAL(kind=dp), POINTER :: ptr_pwin
558 INTERFACE
559 SUBROUTINE pw_gpu_cff_c(din, zout, npts) BIND(C, name="pw_gpu_cff")
560 IMPORT
561 TYPE(c_ptr), INTENT(IN), VALUE :: din
562 TYPE(c_ptr), VALUE :: zout
563 INTEGER(KIND=C_INT), DIMENSION(*), INTENT(IN):: npts
564 END SUBROUTINE pw_gpu_cff_c
565 END INTERFACE
566
567 CALL timeset(routinen, handle)
568
569 ! dimensions
570 npts => pw1%pw_grid%npts_local
571 l1 = lbound(pw1%array, 1)
572 l2 = lbound(pw1%array, 2)
573 l3 = lbound(pw1%array, 3)
574
575 ! pointers to data arrays
576 ptr_pwin => pw1%array(l1, l2, l3)
577 ptr_pwout => pwbuf(1, 1, 1)
578
579 ! invoke the combined transformation
580#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
581 CALL pw_gpu_cff_c(c_loc(ptr_pwin), c_loc(ptr_pwout), npts)
582#else
583 cpabort("Compiled without pw offloading")
584#endif
585
586 CALL timestop(handle)
587 END SUBROUTINE pw_gpu_cff
588
589! **************************************************************************************************
590!> \brief perform a parallel 2D-FFT followed by a complex_to_real copy on the gpu
591!> \param pwbuf ...
592!> \param pw2 ...
593!> \author Andreas Gloess
594! **************************************************************************************************
595 SUBROUTINE pw_gpu_ffc(pwbuf, pw2)
596 COMPLEX(KIND=dp), DIMENSION(:, :, :), INTENT(IN), &
597 TARGET :: pwbuf
598 TYPE(pw_r3d_rs_type), INTENT(IN) :: pw2
599
600 CHARACTER(len=*), PARAMETER :: routinen = 'pw_gpu_ffc'
601
602 COMPLEX(KIND=dp), POINTER :: ptr_pwin
603 INTEGER :: handle, l1, l2, l3
604 INTEGER, DIMENSION(:), POINTER :: npts
605 REAL(kind=dp), POINTER :: ptr_pwout
606 INTERFACE
607 SUBROUTINE pw_gpu_ffc_c(zin, dout, npts) BIND(C, name="pw_gpu_ffc")
608 IMPORT
609 TYPE(c_ptr), INTENT(IN), VALUE :: zin
610 TYPE(c_ptr), VALUE :: dout
611 INTEGER(KIND=C_INT), DIMENSION(*), INTENT(IN):: npts
612 END SUBROUTINE pw_gpu_ffc_c
613 END INTERFACE
614
615 CALL timeset(routinen, handle)
616
617 ! dimensions
618 npts => pw2%pw_grid%npts_local
619 l1 = lbound(pw2%array, 1)
620 l2 = lbound(pw2%array, 2)
621 l3 = lbound(pw2%array, 3)
622
623 ! pointers to data arrays
624 ptr_pwin => pwbuf(1, 1, 1)
625 ptr_pwout => pw2%array(l1, l2, l3)
626
627 ! invoke the combined transformation
628#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
629 CALL pw_gpu_ffc_c(c_loc(ptr_pwin), c_loc(ptr_pwout), npts)
630#else
631 cpabort("Compiled without pw offloading")
632#endif
633
634 CALL timestop(handle)
635 END SUBROUTINE pw_gpu_ffc
636
637! **************************************************************************************************
638!> \brief perform a parallel real_to_complex copy followed by a 1D-FFT on the gpu
639!> \param pw1 ...
640!> \param pwbuf ...
641!> \author Andreas Gloess
642! **************************************************************************************************
643 SUBROUTINE pw_gpu_cf(pw1, pwbuf)
644 TYPE(pw_r3d_rs_type), INTENT(IN) :: pw1
645 COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(INOUT), &
646 TARGET :: pwbuf
647
648 CHARACTER(len=*), PARAMETER :: routinen = 'pw_gpu_cf'
649
650 COMPLEX(KIND=dp), POINTER :: ptr_pwout
651 INTEGER :: handle, l1, l2, l3
652 INTEGER, DIMENSION(:), POINTER :: npts
653 REAL(kind=dp), POINTER :: ptr_pwin
654 INTERFACE
655 SUBROUTINE pw_gpu_cf_c(din, zout, npts) BIND(C, name="pw_gpu_cf")
656 IMPORT
657 TYPE(c_ptr), INTENT(IN), VALUE :: din
658 TYPE(c_ptr), VALUE :: zout
659 INTEGER(KIND=C_INT), DIMENSION(*), INTENT(IN):: npts
660 END SUBROUTINE pw_gpu_cf_c
661 END INTERFACE
662
663 CALL timeset(routinen, handle)
664
665 ! dimensions
666 npts => pw1%pw_grid%npts_local
667 l1 = lbound(pw1%array, 1)
668 l2 = lbound(pw1%array, 2)
669 l3 = lbound(pw1%array, 3)
670
671 ! pointers to data arrays
672 ptr_pwin => pw1%array(l1, l2, l3)
673 ptr_pwout => pwbuf(1, 1)
674
675 ! invoke the combined transformation
676#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
677 CALL pw_gpu_cf_c(c_loc(ptr_pwin), c_loc(ptr_pwout), npts)
678#else
679 cpabort("Compiled without pw offloading")
680#endif
681 CALL timestop(handle)
682 END SUBROUTINE pw_gpu_cf
683
684! **************************************************************************************************
685!> \brief perform a parallel 1D-FFT followed by a complex_to_real copy on the gpu
686!> \param pwbuf ...
687!> \param pw2 ...
688!> \author Andreas Gloess
689! **************************************************************************************************
690 SUBROUTINE pw_gpu_fc(pwbuf, pw2)
691 COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(IN), &
692 TARGET :: pwbuf
693 TYPE(pw_r3d_rs_type), INTENT(IN) :: pw2
694
695 CHARACTER(len=*), PARAMETER :: routinen = 'pw_gpu_fc'
696
697 COMPLEX(KIND=dp), POINTER :: ptr_pwin
698 INTEGER :: handle, l1, l2, l3
699 INTEGER, DIMENSION(:), POINTER :: npts
700 REAL(kind=dp), POINTER :: ptr_pwout
701 INTERFACE
702 SUBROUTINE pw_gpu_fc_c(zin, dout, npts) BIND(C, name="pw_gpu_fc")
703 IMPORT
704 TYPE(c_ptr), INTENT(IN), VALUE :: zin
705 TYPE(c_ptr), VALUE :: dout
706 INTEGER(KIND=C_INT), DIMENSION(*), INTENT(IN):: npts
707 END SUBROUTINE pw_gpu_fc_c
708 END INTERFACE
709
710 CALL timeset(routinen, handle)
711
712 npts => pw2%pw_grid%npts_local
713 l1 = lbound(pw2%array, 1)
714 l2 = lbound(pw2%array, 2)
715 l3 = lbound(pw2%array, 3)
716
717 ! pointers to data arrays
718 ptr_pwin => pwbuf(1, 1)
719 ptr_pwout => pw2%array(l1, l2, l3)
720
721 ! invoke the combined transformation
722#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
723 CALL pw_gpu_fc_c(c_loc(ptr_pwin), c_loc(ptr_pwout), npts)
724#else
725 cpabort("Compiled without pw offloading")
726#endif
727
728 CALL timestop(handle)
729 END SUBROUTINE pw_gpu_fc
730
731! **************************************************************************************************
732!> \brief perform a parallel 1D-FFT on the gpu
733!> \param pwbuf1 ...
734!> \param pwbuf2 ...
735!> \param dir ...
736!> \param n ...
737!> \param m ...
738!> \author Andreas Gloess
739! **************************************************************************************************
740 SUBROUTINE pw_gpu_f(pwbuf1, pwbuf2, dir, n, m)
741 COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(IN), &
742 TARGET :: pwbuf1
743 COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(INOUT), &
744 TARGET :: pwbuf2
745 INTEGER, INTENT(IN) :: dir, n, m
746
747 CHARACTER(len=*), PARAMETER :: routinen = 'pw_gpu_f'
748
749 COMPLEX(KIND=dp), POINTER :: ptr_pwin, ptr_pwout
750 INTEGER :: handle
751 INTERFACE
752 SUBROUTINE pw_gpu_f_c(zin, zout, dir, n, m) BIND(C, name="pw_gpu_f")
753 IMPORT
754 TYPE(c_ptr), INTENT(IN), VALUE :: zin
755 TYPE(c_ptr), VALUE :: zout
756 INTEGER(KIND=C_INT), INTENT(IN), VALUE :: dir, n, m
757 END SUBROUTINE pw_gpu_f_c
758 END INTERFACE
759
760 CALL timeset(routinen, handle)
761
762 IF (n*m /= 0) THEN
763 ! pointers to data arrays
764 ptr_pwin => pwbuf1(1, 1)
765 ptr_pwout => pwbuf2(1, 1)
766
767 ! invoke the combined transformation
768#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
769 CALL pw_gpu_f_c(c_loc(ptr_pwin), c_loc(ptr_pwout), dir, n, m)
770#else
771 mark_used(dir)
772 cpabort("Compiled without pw offloading")
773#endif
774 END IF
775
776 CALL timestop(handle)
777 END SUBROUTINE pw_gpu_f
778! **************************************************************************************************
779!> \brief perform a parallel 1D-FFT followed by a gather on the gpu
780!> \param pwbuf ...
781!> \param pw2 ...
782!> \param scale ...
783!> \author Andreas Gloess
784! **************************************************************************************************
785 SUBROUTINE pw_gpu_fg(pwbuf, pw2, scale)
786 COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(IN), &
787 TARGET :: pwbuf
788 TYPE(pw_c1d_gs_type), INTENT(IN) :: pw2
789 REAL(kind=dp), INTENT(IN) :: scale
790
791 CHARACTER(len=*), PARAMETER :: routinen = 'pw_gpu_fg'
792
793 COMPLEX(KIND=dp), POINTER :: ptr_pwin, ptr_pwout
794 INTEGER :: handle, mg, mmax, ngpts
795 INTEGER, DIMENSION(:), POINTER :: npts
796 INTEGER, POINTER :: ptr_ghatmap
797 INTERFACE
798 SUBROUTINE pw_gpu_fg_c(zin, zout, ghatmap, npts, mmax, ngpts, scale) BIND(C, name="pw_gpu_fg")
799 IMPORT
800 TYPE(c_ptr), INTENT(IN), VALUE :: zin
801 TYPE(c_ptr), VALUE :: zout
802 TYPE(c_ptr), INTENT(IN), VALUE :: ghatmap
803 INTEGER(KIND=C_INT), DIMENSION(*), INTENT(IN):: npts
804 INTEGER(KIND=C_INT), INTENT(IN), VALUE :: mmax, ngpts
805 REAL(kind=c_double), INTENT(IN), VALUE :: scale
806
807 END SUBROUTINE pw_gpu_fg_c
808 END INTERFACE
809
810 CALL timeset(routinen, handle)
811
812 ngpts = SIZE(pw2%pw_grid%gsq)
813 npts => pw2%pw_grid%npts
814
815 IF ((npts(1) /= 0) .AND. (ngpts /= 0)) THEN
816 mg = SIZE(pw2%pw_grid%grays, 2)
817 mmax = max(mg, 1)
818
819 ! pointers to data arrays
820 ptr_pwin => pwbuf(1, 1)
821 ptr_pwout => pw2%array(1)
822
823 ! pointer to map array
824 ptr_ghatmap => pw2%pw_grid%g_hatmap(1, 1)
825
826 ! invoke the combined transformation
827#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
828 CALL pw_gpu_fg_c(c_loc(ptr_pwin), c_loc(ptr_pwout), c_loc(ptr_ghatmap), npts, mmax, ngpts, scale)
829#else
830 mark_used(scale)
831 cpabort("Compiled without pw offloading")
832#endif
833 END IF
834
835 CALL timestop(handle)
836 END SUBROUTINE pw_gpu_fg
837
838! **************************************************************************************************
839!> \brief perform a parallel scatter followed by a 1D-FFT on the gpu
840!> \param pw1 ...
841!> \param pwbuf ...
842!> \param scale ...
843!> \author Andreas Gloess
844! **************************************************************************************************
845 SUBROUTINE pw_gpu_sf(pw1, pwbuf, scale)
846 TYPE(pw_c1d_gs_type), INTENT(IN) :: pw1
847 COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(INOUT), &
848 TARGET :: pwbuf
849 REAL(kind=dp), INTENT(IN) :: scale
850
851 CHARACTER(len=*), PARAMETER :: routinen = 'pw_gpu_sf'
852
853 COMPLEX(KIND=dp), POINTER :: ptr_pwin, ptr_pwout
854 INTEGER :: handle, mg, mmax, ngpts, nmaps
855 INTEGER, DIMENSION(:), POINTER :: npts
856 INTEGER, POINTER :: ptr_ghatmap
857 INTERFACE
858 SUBROUTINE pw_gpu_sf_c(zin, zout, ghatmap, npts, mmax, ngpts, nmaps, scale) BIND(C, name="pw_gpu_sf")
859 IMPORT
860 TYPE(c_ptr), INTENT(IN), VALUE :: zin
861 TYPE(c_ptr), VALUE :: zout
862 TYPE(c_ptr), INTENT(IN), VALUE :: ghatmap
863 INTEGER(KIND=C_INT), DIMENSION(*), INTENT(IN):: npts
864 INTEGER(KIND=C_INT), INTENT(IN), VALUE :: mmax, ngpts, nmaps
865 REAL(kind=c_double), INTENT(IN), VALUE :: scale
866
867 END SUBROUTINE pw_gpu_sf_c
868 END INTERFACE
869
870 CALL timeset(routinen, handle)
871
872 ngpts = SIZE(pw1%pw_grid%gsq)
873 npts => pw1%pw_grid%npts
874
875 IF ((npts(1) /= 0) .AND. (ngpts /= 0)) THEN
876 mg = SIZE(pw1%pw_grid%grays, 2)
877 mmax = max(mg, 1)
878
879 ! pointers to data arrays
880 ptr_pwin => pw1%array(1)
881 ptr_pwout => pwbuf(1, 1)
882
883 ! pointer to map array
884 nmaps = SIZE(pw1%pw_grid%g_hatmap, 2)
885 ptr_ghatmap => pw1%pw_grid%g_hatmap(1, 1)
886
887 ! invoke the combined transformation
888#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
889 CALL pw_gpu_sf_c(c_loc(ptr_pwin), c_loc(ptr_pwout), c_loc(ptr_ghatmap), npts, mmax, ngpts, nmaps, scale)
890#else
891 mark_used(scale)
892 cpabort("Compiled without pw offloading")
893#endif
894 END IF
895
896 CALL timestop(handle)
897 END SUBROUTINE pw_gpu_sf
898
899END MODULE pw_gpu
900
fft_tools
Definition fft_tools.F:29
fft_tools::yz_to_x
subroutine, public yz_to_x(tb, group, my_pos, p2p, yzp, nray, bo, sb, fft_scratch)
...
Definition fft_tools.F:1488
fft_tools::yz_to_xz
subroutine, public yz_to_xz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch)
...
Definition fft_tools.F:1605
fft_tools::cube_transpose_1
subroutine, public cube_transpose_1(cin, boin, boout, sout, fft_scratch)
...
Definition fft_tools.F:2009
fft_tools::release_fft_scratch
subroutine, public release_fft_scratch(fft_scratch)
...
Definition fft_tools.F:3253
fft_tools::x_to_yz
subroutine, public x_to_yz(sb, group, my_pos, p2p, yzp, nray, bo, tb, fft_scratch)
...
Definition fft_tools.F:1372
fft_tools::get_fft_scratch
subroutine, public get_fft_scratch(fft_scratch, tf_type, n, fft_sizes)
...
Definition fft_tools.F:2869
fft_tools::xz_to_yz
subroutine, public xz_to_yz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch)
...
Definition fft_tools.F:1815
fft_tools::cube_transpose_2
subroutine, public cube_transpose_2(cin, boin, boout, sout, fft_scratch)
...
Definition fft_tools.F:2099
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
mathconstants
Definition of mathematical constants and functions.
Definition mathconstants.F:16
mathconstants::z_zero
complex(kind=dp), parameter, public z_zero
Definition mathconstants.F:143
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:27
pw_gpu
Definition pw_gpu.F:26
pw_gpu::pw_gpu_c1dr3d_3d_ps
subroutine, public pw_gpu_c1dr3d_3d_ps(pw1, pw2)
perform an parallel scatter followed by a fft on the gpu
Definition pw_gpu.F:381
pw_gpu::pw_gpu_c1dr3d_3d
subroutine, public pw_gpu_c1dr3d_3d(pw1, pw2)
perform an scatter followed by a fft on the gpu
Definition pw_gpu.F:160
pw_gpu::pw_gpu_init
subroutine, public pw_gpu_init()
Allocates resources on the gpu device for gpu fft acceleration.
Definition pw_gpu.F:62
pw_gpu::pw_gpu_r3dc1d_3d
subroutine, public pw_gpu_r3dc1d_3d(pw1, pw2)
perform an fft followed by a gather on the gpu
Definition pw_gpu.F:102
pw_gpu::pw_gpu_finalize
subroutine, public pw_gpu_finalize()
Releases resources on the gpu device for gpu fft acceleration.
Definition pw_gpu.F:81
pw_gpu::pw_gpu_r3dc1d_3d_ps
subroutine, public pw_gpu_r3dc1d_3d_ps(pw1, pw2)
perform an parallel fft followed by a gather on the gpu
Definition pw_gpu.F:218
pw_grid_types
Definition pw_grid_types.F:13
pw_grid_types::fullspace
integer, parameter, public fullspace
Definition pw_grid_types.F:26
pw_types
Definition pw_types.F:24
fft_tools::fft_scratch_sizes
Definition fft_tools.F:62
fft_tools::fft_scratch_type
Definition fft_tools.F:77
message_passing::mp_cart_type
Definition message_passing.F:744
pw_types::pw_c1d_gs_type
Definition pw_types.F:127
pw_types::pw_r3d_rs_type
Definition pw_types.F:62