Branch data Line data Source code
1 : : !!****m* ABINIT/m_FFT_prof
2 : : !! NAME
3 : : !! m_FFT_prof
4 : : !!
5 : : !! COPYRIGHT
6 : : !! Copyright (C) 2008-2026 ABINIT group (MG)
7 : : !! This file is distributed under the terms of the
8 : : !! GNU General Public License, see ~abinit/COPYING
9 : : !! or http://www.gnu.org/copyleft/gpl.txt .
10 : : !!
11 : : !! SOURCE
12 : :
13 : : #if defined HAVE_CONFIG_H
14 : : #include "config.h"
15 : : #endif
16 : :
17 : : #include "abi_common.h"
18 : :
19 : : module m_FFT_prof
20 : :
21 : : use defs_basis
22 : : use m_xomp
23 : : use m_errors
24 : : use m_abicore
25 : : use m_fftw3
26 : : use m_fft
27 : : use m_distribfft
28 : :
29 : : use defs_abitypes, only : MPI_type
30 : : use m_fstrings, only : sjoin, itoa
31 : : use m_numeric_tools, only : arth
32 : : use m_time, only : cwtime
33 : : use m_io_tools, only : open_file
34 : : use m_geometry, only : metric
35 : : use m_hide_blas, only : xcopy
36 : : use m_cgtools, only : set_istwfk
37 : : use m_fftcore, only : get_kg, print_ngfft, fftalg_info, kgindex, getng, sphereboundary
38 : : use m_fft_mesh, only : calc_eigr, calc_ceigr
39 : : use m_mpinfo, only : nullify_mpi_enreg, destroy_mpi_enreg, copy_mpi_enreg, initmpi_seq
40 : : use m_oscillators, only : rho_tw_g
41 : :
42 : : implicit none
43 : :
44 : : private
45 : :
46 : : integer,private,parameter :: TNAME_LEN=100
47 : : !!***
48 : :
49 : : !----------------------------------------------------------------------
50 : :
51 : : public :: fftprof_ncalls_per_test
52 : :
53 : : ! Routines for benchmarking
54 : : public :: prof_fourdp
55 : : public :: prof_fourwf
56 : : public :: prof_rhotwg
57 : :
58 : : !----------------------------------------------------------------------
59 : :
60 : : !!****t* m_fft_mesh/FFT_test_t
61 : : !! NAME
62 : : !! FFT_test_t
63 : : !!
64 : : !! FUNCTION
65 : : !! Parameters passed to the FFT routines used in abinit (fourdp|fourwf).
66 : : !!
67 : : !! SOURCE
68 : :
69 : : type, public :: FFT_test_t
70 : :
71 : : integer :: available = 0
72 : : integer :: istwf_k = -1
73 : : integer :: mgfft = -1
74 : : integer :: ndat = -1
75 : : integer :: nfft = -1
76 : : integer :: nthreads = 1
77 : : integer :: npw_k = -1
78 : : integer :: npw_kout = -1
79 : : integer :: paral_kgb = -1
80 : : integer :: gpu_option = 0
81 : :
82 : : real(dp) :: ecut=zero
83 : : integer :: ngfft(18)=-1
84 : :
85 : : real(dp) :: kpoint(3) = [zero,zero,zero]
86 : : real(dp) :: rprimd(3,3),rmet(3,3)
87 : : real(dp) :: gprimd(3,3),gmet(3,3)
88 : :
89 : : integer,allocatable :: kg_k(:,:)
90 : : integer,allocatable :: kg_kout(:,:)
91 : : integer,allocatable :: indpw_k(:)
92 : :
93 : : type(MPI_type) :: MPI_enreg
94 : :
95 : : contains
96 : : procedure :: init => fft_test_init
97 : : procedure :: free => fft_test_free_0D
98 : : procedure :: print => fft_test_print
99 : : procedure :: get_name
100 : :
101 : : ! Timing routines.
102 : : procedure :: time_fourdp
103 : : procedure :: time_fftbox
104 : : procedure :: time_fourwf
105 : : procedure :: time_rhotwg
106 : : procedure :: time_fftu
107 : : end type FFT_test_t
108 : :
109 : : public :: fft_tests_free
110 : :
111 : : interface fft_tests_free
112 : : module procedure fft_test_free_0D
113 : : module procedure fft_test_free_1D
114 : : end interface fft_tests_free
115 : : !!***
116 : :
117 : : !----------------------------------------------------------------------
118 : :
119 : : !!****t* m_fft_mesh/FFT_prof_t
120 : : !! NAME
121 : : !! FFT_prof_t
122 : : !!
123 : : !! FUNCTION
124 : : !! The results of the tests
125 : : !!
126 : : !! SOURCE
127 : :
128 : : type,public :: FFT_prof_t
129 : : integer :: ncalls
130 : : integer :: ndat
131 : : integer :: gpu_option
132 : : integer :: nthreads
133 : : real(dp) :: cpu_time
134 : : real(dp) :: wall_time
135 : : real(dp) :: gflops
136 : : character(len=TNAME_LEN) :: test_name
137 : : complex(dp),allocatable :: results(:)
138 : :
139 : : contains
140 : : procedure :: init => fftprof_init
141 : : procedure :: free => fftprof_free_0D
142 : : end type FFT_prof_t
143 : :
144 : : public :: fftprofs_free
145 : : public :: fftprofs_print
146 : :
147 : : interface fftprofs_free
148 : : module procedure fftprof_free_0D
149 : : module procedure fftprof_free_1D
150 : : end interface fftprofs_free
151 : : !!***
152 : :
153 : : !----------------------------------------------------------------------
154 : : ! Number of calls of each FFT algo, used to have a betters statistics for timing.
155 : : integer,save,private :: NCALLS_FOR_TEST=10
156 : :
157 : : integer,private,parameter :: CACHE_KBSIZE=0
158 : : ! Argument of empty_cache. Set it to zero if the cache should not be emptied.
159 : :
160 : : CONTAINS !====================================================================
161 : : !!***
162 : :
163 : : !----------------------------------------------------------------------
164 : :
165 : : !!****f* m_FFT_prof/fft_test_init
166 : : !! NAME
167 : : !! fft_test_init
168 : : !!
169 : : !! FUNCTION
170 : : !! Creation method for the FFT_test_t structured datatype.
171 : : !!
172 : : !! INPUTS
173 : : !!
174 : : !! OUTPUT
175 : : !!
176 : : !! SOURCE
177 : :
178 : 98 : subroutine fft_test_init(Ftest, fft_setup, kpoint, ecut, boxcutmin, rprimd, nsym, symrel, MPI_enreg_in)
179 : :
180 : : !Arguments -----------------------------------
181 : : !scalars
182 : : class(FFT_test_t),intent(inout) :: Ftest
183 : : integer,intent(in) :: nsym
184 : : real(dp),intent(in) :: ecut,boxcutmin
185 : : class(MPI_type),intent(in) :: MPI_enreg_in
186 : : !arrays
187 : : integer,intent(in) :: fft_setup(6),symrel(3,3,nsym)
188 : : real(dp),intent(in) :: kpoint(3),rprimd(3,3)
189 : :
190 : : !Local variables-------------------------------
191 : : !scalars
192 : : integer :: fftalg,fftcache,ndat
193 : : real(dp) :: ucvol
194 : : !arrays
195 : 98 : logical,allocatable :: mask(:)
196 : : real(dp),parameter :: k0(3)=zero
197 : : real(dp) :: gmet(3,3),gprimd(3,3),rmet(3,3)
198 : 98 : real(dp),allocatable :: tnons(:,:)
199 : : ! *************************************************************************
200 : :
201 : 98 : call nullify_mpi_enreg(Ftest%MPI_enreg)
202 : :
203 : 98 : call metric(gmet,gprimd,-1,rmet,rprimd,ucvol)
204 : :
205 [ + + + + ]: 1274 : Ftest%rprimd = rprimd
206 [ + + + + ]: 1274 : Ftest%rmet = rmet
207 [ + + + + ]: 1274 : Ftest%gprimd = gprimd
208 [ + + + + ]: 1274 : Ftest%gmet = gmet
209 : 98 : Ftest%ecut = ecut
210 : :
211 : 98 : fftalg = fft_setup(1)
212 : 98 : fftcache = fft_setup(2)
213 : 98 : ndat = fft_setup(3)
214 : 98 : Ftest%nthreads = fft_setup(4)
215 : 98 : Ftest%available = fft_setup(5)
216 : 98 : Ftest%gpu_option = fft_setup(6)
217 : :
218 : 98 : Ftest%paral_kgb = 0
219 [ + + ]: 392 : Ftest%kpoint = kpoint
220 : 98 : Ftest%ndat = ndat
221 : :
222 : 98 : Ftest%istwf_k = set_istwfk(kpoint)
223 : :
224 [ - + ]: 98 : call get_kg(Ftest%kpoint,Ftest%istwf_k,ecut,gmet,Ftest%npw_k,Ftest%kg_k)
225 [ - + ]: 98 : call get_kg(Ftest%kpoint,Ftest%istwf_k,ecut,gmet,Ftest%npw_kout,Ftest%kg_kout)
226 : :
227 : 98 : call copy_mpi_enreg(MPI_enreg_in,Ftest%MPI_enreg)
228 : :
229 : 98 : Ftest%ngfft(7) = fftalg
230 : 98 : Ftest%ngfft(8) = fftcache
231 : :
232 : : ! Fill part of ngfft
233 [ - + + - : 686 : ABI_CALLOC(tnons,(3,nsym))
+ - + - -
+ - + + +
+ + ]
234 : :
235 : : call getng(boxcutmin,0,ecut,gmet,k0,Ftest%MPI_enreg%me_fft,Ftest%mgfft,Ftest%nfft,Ftest%ngfft,Ftest%MPI_enreg%nproc_fft,nsym,&
236 : 98 : Ftest%MPI_enreg%paral_kgb,symrel,tnons, unit=dev_null, gpu_option=ftest%gpu_option)
237 : :
238 [ - + ]: 98 : ABI_FREE(tnons)
239 : :
240 : 98 : call Ftest%MPI_enreg%distribfft%init('c',Ftest%MPI_enreg%nproc_fft,Ftest%ngfft(2),Ftest%ngfft(3))
241 : :
242 : : ! Compute the index of each plane wave in the FFT grid.
243 [ - + + - : 294 : ABI_MALLOC(Ftest%indpw_k,(Ftest%npw_k))
+ - + - -
+ - + -
+ ]
244 : :
245 [ - + + - : 196 : ABI_MALLOC(mask,(Ftest%npw_k))
- + - + ]
246 : 98 : call kgindex(Ftest%indpw_k,Ftest%kg_k,mask,Ftest%MPI_enreg,Ftest%ngfft,Ftest%npw_k)
247 [ + + + - : 2474319 : ABI_CHECK(ALL(mask),"FFT parallelism not supported in fftprof")
- + ]
248 [ - + ]: 98 : ABI_FREE(mask)
249 : :
250 : 98 : end subroutine fft_test_init
251 : : !!***
252 : :
253 : : !----------------------------------------------------------------------
254 : :
255 : : !!****f* m_FFT_prof/fft_test_free_0D
256 : : !! NAME
257 : : !! fft_test_free_0D
258 : : !!
259 : : !! FUNCTION
260 : : !! Destruction method for the FFT_test_t structured datatype.
261 : : !!
262 : : !! INPUTS
263 : : !!
264 : : !! OUTPUT
265 : : !!
266 : : !! SOURCE
267 : :
268 : 98 : subroutine fft_test_free_0D(Ftest)
269 : :
270 : : !Arguments -----------------------------------
271 : : class(FFT_test_t),intent(inout) :: Ftest
272 : : ! *********************************************************************
273 : :
274 [ + - ]: 98 : ABI_SFREE(Ftest%indpw_k)
275 [ + - ]: 98 : ABI_SFREE(Ftest%kg_k)
276 [ + - ]: 98 : ABI_SFREE(Ftest%kg_kout)
277 : :
278 : 98 : call destroy_mpi_enreg(Ftest%MPI_enreg)
279 : :
280 : 98 : end subroutine fft_test_free_0D
281 : : !!***
282 : :
283 : : !----------------------------------------------------------------------
284 : :
285 : : !!****f* m_FFT_prof/fft_test_free_1D
286 : : !! NAME
287 : : !! fft_test_free_1D
288 : : !!
289 : : !! FUNCTION
290 : : !! Destruction method for the FFT_test_t structured datatype.
291 : : !!
292 : : !! INPUTS
293 : : !!
294 : : !! OUTPUT
295 : : !!
296 : : !! SOURCE
297 : :
298 : 17 : subroutine fft_test_free_1D(Ftest)
299 : :
300 : : !Arguments -----------------------------------
301 : : class(FFT_test_t),intent(inout) :: Ftest(:)
302 : :
303 : : !Local variables-------------------------------
304 : : integer :: ii
305 : : ! *********************************************************************
306 : :
307 [ + - + + ]: 132 : do ii=LBOUND(Ftest,DIM=1),UBOUND(Ftest,DIM=1)
308 : 115 : call Ftest(ii)%free()
309 : : end do
310 : :
311 : 17 : end subroutine fft_test_free_1D
312 : : !!***
313 : :
314 : : !----------------------------------------------------------------------
315 : :
316 : : !!****f* m_FFT_prof/fft_test_print
317 : : !! NAME
318 : : !! fft_test_print
319 : : !!
320 : : !! FUNCTION
321 : : !! Printout of the FFT_test_t structured datatype.
322 : : !!
323 : : !! INPUTS
324 : : !!
325 : : !! OUTPUT
326 : : !!
327 : : !! SOURCE
328 : :
329 : 98 : subroutine fft_test_print(Ftest, header, unit, mode_paral, prtvol)
330 : :
331 : : !Arguments -----------------------------------
332 : : class(FFT_test_t),intent(in) :: Ftest
333 : : integer,optional,intent(in) :: unit,prtvol
334 : : character(len=4),optional,intent(in) :: mode_paral
335 : : character(len=*),optional,intent(in) :: header
336 : :
337 : : !Local variables-------------------------------
338 : : !scalars
339 : : integer :: my_unt,my_prtvol
340 : : character(len=4) :: my_mode
341 : : character(len=500) :: msg
342 : : ! *********************************************************************
343 : :
344 : 0 : my_unt =std_out; if (PRESENT(unit )) my_unt =unit
345 : 98 : my_prtvol=0 ; if (PRESENT(prtvol )) my_prtvol=prtvol
346 [ - + ]: 98 : my_mode ='COLL' ; if (PRESENT(mode_paral)) my_mode =mode_paral
347 : :
348 : : !msg=' ==== Info on the FFT test object ==== '
349 [ - + ]: 98 : if (PRESENT(header)) then
350 [ # # # # ]: 0 : msg=' ==== '//TRIM(ADJUSTL(header))//' ==== '
351 : 0 : call wrtout(my_unt,msg,my_mode)
352 : : end if
353 : :
354 : 98 : write(msg,'(a,i3)')"FFT setup for fftalg ",Ftest%ngfft(7)
355 [ + + ]: 196 : call print_ngfft([my_unt], Ftest%ngfft, header=msg)
356 : :
357 [ - + ]: 98 : end subroutine fft_test_print
358 : : !!***
359 : :
360 : : !----------------------------------------------------------------------
361 : :
362 : : !!****f* m_FFT_prof/get_name
363 : : !! NAME
364 : : !! get_name
365 : : !!
366 : : !! FUNCTION
367 : : !! Returns a string with info on the test.
368 : : !!
369 : : !! INPUTS
370 : : !!
371 : : !! OUTPUT
372 : : !!
373 : : !! SOURCE
374 : :
375 : 403 : character(len=TNAME_LEN) function get_name(Ftest)
376 : :
377 : : !Arguments -----------------------------------
378 : : class(FFT_test_t),intent(in) :: Ftest
379 : :
380 : : !Local variables-------------------------------
381 : : character(len=TNAME_LEN) :: library_name,cplex_mode,padding_mode
382 : : ! *********************************************************************
383 : :
384 [ + - ]: 403 : if (ftest%gpu_option == 0) then
385 : 403 : call fftalg_info(Ftest%ngfft(7), library_name, cplex_mode, padding_mode)
386 : : !get_name = TRIM(library_name)//"; "//TRIM(cplex_mode)//"; "//TRIM(padding_mode)
387 : 403 : write(get_name,'(i3)')Ftest%ngfft(7)
388 [ + - ]: 403 : get_name = TRIM(library_name)//" ("//TRIM(get_name)//")"
389 : : else
390 : 0 : get_name = "GPU_FLAVOR"
391 : : end if
392 : :
393 : 403 : end function get_name
394 : : !!***
395 : :
396 : : !----------------------------------------------------------------------
397 : :
398 : : !!****f* m_FFT_prof/fftprof_init
399 : : !! NAME
400 : : !! fftprof_init
401 : : !!
402 : : !! FUNCTION
403 : : !! Creation method for the FFT_prof_t structured datatype.
404 : : !!
405 : : !! INPUTS
406 : : !! gflops = Gigaflops
407 : : !!
408 : : !! OUTPUT
409 : : !!
410 : : !! SOURCE
411 : :
412 [ + - - + : 403 : subroutine fftprof_init(Ftprof, test_name, nthreads, ncalls, ndat, gpu_option, cpu_time, wall_time, gflops, results)
+ - ]
413 : :
414 : : !Arguments -----------------------------------
415 : : class(FFT_prof_t),intent(out) :: Ftprof
416 : : integer,intent(in) :: ncalls,nthreads,ndat, gpu_option
417 : : real(dp),intent(in) :: cpu_time,wall_time,gflops
418 : : character(len=*),intent(in) :: test_name
419 : : !arrays
420 : : complex(dp),optional,intent(in) :: results(:)
421 : : ! *************************************************************************
422 : :
423 : 403 : Ftprof%ncalls = ncalls
424 : 403 : Ftprof%nthreads = nthreads
425 : 403 : Ftprof%ndat = ndat
426 : 403 : Ftprof%gpu_option = gpu_option
427 : 403 : Ftprof%cpu_time = cpu_time
428 : 403 : Ftprof%wall_time = wall_time
429 : 403 : Ftprof%gflops = gflops
430 [ - + ]: 403 : Ftprof%test_name = test_name
431 : :
432 [ + + ]: 403 : if (present(results)) then
433 [ - + - + : 921 : ABI_REMALLOC(Ftprof%results, (size(results)))
+ - + - +
- - + - +
- + ]
434 [ + - - + : 280722773 : Ftprof%results = results
- - + + ]
435 : : end if
436 : :
437 [ + + ]: 403 : end subroutine fftprof_init
438 : : !!***
439 : :
440 : : !----------------------------------------------------------------------
441 : :
442 : : !!****f* m_FFT_prof/fftprof_free_0D
443 : : !! NAME
444 : : !! fftprof_free_0D
445 : : !!
446 : : !! FUNCTION
447 : : !! Destruction method for the FFT_prof_t structured datatype.
448 : : !!
449 : : !! SOURCE
450 : :
451 : 501 : subroutine fftprof_free_0D(Ftprof)
452 : :
453 : : !Arguments -----------------------------------
454 : : class(FFT_prof_t),intent(inout) :: Ftprof
455 : : ! *********************************************************************
456 : :
457 [ + + ]: 501 : ABI_SFREE(Ftprof%results)
458 : :
459 : 501 : end subroutine fftprof_free_0D
460 : : !!***
461 : :
462 : : !----------------------------------------------------------------------
463 : :
464 : : !!****f* m_FFT_prof/fftprof_free_1D
465 : : !! NAME
466 : : !! fftprof_free_1D
467 : : !!
468 : : !! FUNCTION
469 : : !! Destruction method for the FFT_prof_t structured datatype.
470 : : !!
471 : : !! INPUTS
472 : : !!
473 : : !! OUTPUT
474 : : !!
475 : : !! SOURCE
476 : :
477 : 75 : subroutine fftprof_free_1D(Ftprof)
478 : :
479 : : !Arguments -----------------------------------
480 : : class(FFT_prof_t),intent(inout) :: Ftprof(:)
481 : :
482 : : !Local variables-------------------------------
483 : : integer :: ii
484 : : ! *********************************************************************
485 : :
486 [ + - + + ]: 651 : do ii=LBOUND(Ftprof,DIM=1),UBOUND(Ftprof,DIM=1)
487 : 576 : call fftprof_free_0D(Ftprof(ii))
488 : : end do
489 : :
490 : 75 : end subroutine fftprof_free_1D
491 : : !!***
492 : :
493 : : !----------------------------------------------------------------------
494 : :
495 : : !!****f* m_FFT_prof/fftprofs_print
496 : : !! NAME
497 : : !! fftprofs_print
498 : : !!
499 : : !! FUNCTION
500 : : !! Printout of the FFT_prof_t structured datatype.
501 : : !!
502 : : !! INPUTS
503 : : !!
504 : : !! OUTPUT
505 : : !!
506 : : !! SOURCE
507 : :
508 : 116 : subroutine fftprofs_print(Fprof, header, unit, mode_paral, prtvol)
509 : :
510 : : !Arguments -----------------------------------
511 : : class(FFT_prof_t),intent(in) :: Fprof(:)
512 : : integer,optional,intent(in) :: unit,prtvol
513 : : character(len=4),optional,intent(in) :: mode_paral
514 : : character(len=*),optional,intent(in) :: header
515 : :
516 : : !Local variables-------------------------------
517 : : !scalars
518 : : integer :: my_unt,my_prtvol,ncalls, field1_w,ii,ref_lib !ifft
519 : : real(dp) :: mabs_err,mean_err,check_mabs_err,check_mean_err, ref_wtime,para_eff
520 : : character(len=4) :: my_mode
521 : : character(len=500) :: ofmt,hfmt,nafmt,msg
522 : : ! *********************************************************************
523 : :
524 [ - + ]: 58 : my_unt =std_out; if (PRESENT(unit )) my_unt =unit
525 : 58 : my_prtvol=0 ; if (PRESENT(prtvol )) my_prtvol=prtvol
526 [ - + ]: 58 : my_mode ='COLL' ; if (PRESENT(mode_paral)) my_mode =mode_paral
527 : :
528 : 58 : msg='==== Info on the FFT_prof_t object ===='
529 [ + - + - : 58 : if (PRESENT(header)) msg='==== '//TRIM(ADJUSTL(header))//' ===='
+ - ]
530 : :
531 [ - + + + ]: 3506 : call wrtout(my_unt,ch10//REPEAT("=",LEN_TRIM(msg)))
532 : 58 : call wrtout(my_unt,msg,my_mode)
533 [ - + + + ]: 3506 : call wrtout(my_unt,REPEAT("=",LEN_TRIM(msg)))
534 : :
535 : 58 : field1_w=0 ! Width of the field used to print key names.
536 [ + + ]: 461 : do ii=1,SIZE(Fprof)
537 : 461 : field1_w = MAX(field1_w, LEN_TRIM(Fprof(ii)%test_name))
538 : : end do
539 : :
540 [ - + ]: 58 : if (field1_w==0) RETURN
541 : 58 : field1_w = field1_w + 2 ! To account for ". "
542 : 58 : write(ofmt,*)"(a",field1_w,",2x,2(f7.4,4x),1x,i2,1x,a,i3,a,1x,i0,4x,2(es9.2,3x))"
543 : :
544 : 58 : write(hfmt,*)"(a",field1_w,",2x,a)"
545 : 58 : write(std_out,hfmt)" Library ","CPU-time WALL-time nthreads ncalls Max_|Err| <|Err|>"
546 : : !
547 : : ! Find reference library.
548 : 58 : ref_lib=0
549 [ + - ]: 58 : do ii=1,SIZE(Fprof)
550 [ - + ]: 58 : if (Fprof(ii)%ncalls>0) then
551 : : ref_lib = ii
552 : : EXIT
553 : : end if
554 : : end do
555 : : !ref_lib=3
556 : : !
557 : : ! Write timing analysis and error wrt reference library if available.
558 : 58 : check_mabs_err=zero; check_mean_err=zero
559 [ + + ]: 461 : do ii=1,SIZE(Fprof)
560 : 403 : ncalls = Fprof(ii)%ncalls
561 [ + + ]: 461 : if (ncalls > 0) then
562 : 307 : mabs_err = zero; mean_err=zero
563 [ + - ]: 307 : if (ref_lib>0) then
564 [ + - - + : 280722773 : mabs_err = MAXVAL( ABS(Fprof(ii)%results - Fprof(ref_lib)%results) )
- - + + ]
565 [ + + ]: 280722466 : mean_err = SUM( ABS(Fprof(ii)%results - Fprof(ref_lib)%results) ) / SIZE(Fprof(ref_lib)%results)
566 : : ! Relative error is not a good estimator because some components are close to zero within machine accuracy.
567 : : !mean_err = 100 * MAXVAL( ABS(Fprof(ii)%results - Fprof(1)%results)/ ABS(Fprof(1)%results ))
568 : : !ifft = imax_loc( ABS(Fprof(ii)%results - Fprof(1)%results)/ ABS(Fprof(1)%results) )
569 : : !write(std_out,*) Fprof(ii)%results(ifft),Fprof(1)%results(ifft)
570 : : end if
571 [ + - ]: 307 : if (Fprof(ii)%nthreads==1) ref_wtime = Fprof(ii)%wall_time
572 : 307 : para_eff = 100 * ref_wtime / ( Fprof(ii)%wall_time * Fprof(ii)%nthreads)
573 : : write(std_out,ofmt)&
574 : 307 : "- "//Fprof(ii)%test_name,Fprof(ii)%cpu_time/ncalls,Fprof(ii)%wall_time/ncalls,&
575 : 614 : Fprof(ii)%nthreads,"(",NINT(para_eff),"%)",ncalls,mabs_err,mean_err
576 : 307 : check_mabs_err = MAX(check_mabs_err, mabs_err)
577 : 307 : check_mean_err = MAX(check_mean_err, mean_err)
578 : : else
579 : 96 : write(nafmt,*)"(a",field1_w,",2x,a)"
580 : 96 : write(std_out,nafmt)"- "//Fprof(ii)%test_name," N/A N/A N/A N/A N/A N/A"
581 : : end if
582 : : end do
583 : :
584 [ + - ]: 58 : if (ref_lib > 0) then
585 : : write(std_out,'(/,2(a,es9.2),2a)')&
586 : 58 : " Consistency check: MAX(Max_|Err|) = ",check_mabs_err,&
587 [ + - ]: 116 : ", Max(<|Err|>) = ",check_mean_err,", reference_lib: ",TRIM(Fprof(ref_lib)%test_name)
588 : : end if
589 : 58 : write(std_out,*)
590 : :
591 [ - + ]: 58 : end subroutine fftprofs_print
592 : : !!***
593 : :
594 : : !----------------------------------------------------------------------
595 : :
596 : : !!****f* m_FFT_prof/time_fourdp
597 : : !! NAME
598 : : !! time_fourdp
599 : : !!
600 : : !! FUNCTION
601 : : !! Profiling of the fourdp routine.
602 : : !!
603 : : !! INPUTS
604 : : !!
605 : : !! OUTPUT
606 : : !!
607 : : !! SOURCE
608 : :
609 : 16 : subroutine time_fourdp(Ftest, isign, cplex, header, Ftprof)
610 : :
611 : : !Arguments -----------------------------------
612 : : class(FFT_test_t),intent(inout) :: Ftest
613 : : integer,intent(in) :: cplex,isign
614 : : character(len=500),intent(out) :: header
615 : : class(FFT_prof_t),intent(out) :: Ftprof
616 : :
617 : : !Local variables-------------------------------
618 : : !scalars
619 : : integer,parameter :: nspinor1=1
620 : : integer :: icall,i1,i2,i3,n1,n2,n3,ifft
621 : : real(dp) :: cpu_time,wall_time,gflops,gsq
622 : : !character(len=500) :: msg
623 : : character(len=TNAME_LEN) :: test_name
624 : : !arrays
625 : : integer,parameter :: g0(3)=(/1,2,-1/)
626 : : integer :: gg(3)
627 : 16 : real(dp),allocatable :: fofg(:,:),fofr(:)
628 [ + - ]: 16 : complex(dp),allocatable :: results(:),ctmp(:)
629 : : ! *********************************************************************
630 : :
631 : 16 : test_name = Ftest%get_name()
632 : 16 : n1=Ftest%ngfft(1); n2=Ftest%ngfft(2); n3=Ftest%ngfft(3)
633 : :
634 : 16 : write(header,'(2(a,i2),a)')" fourdp with cplex ",cplex,", isign ",isign,", ndat 1"
635 : :
636 [ + + ]: 16 : if (Ftest%available == 0) then
637 : 4 : call Ftprof%init(test_name,0,0,0,0,zero,zero,zero)
638 : : RETURN
639 : : end if
640 : :
641 : 12 : call xomp_set_num_threads(Ftest%nthreads)
642 : :
643 [ - + ]: 12 : if (Ftest%ngfft(7)/100 == FFT_FFTW3) call fftw3_set_nthreads(Ftest%nthreads)
644 : :
645 [ - + + - : 36 : ABI_MALLOC(fofg,(2,Ftest%nfft))
+ - + - -
+ - + ]
646 [ - + + - : 36 : ABI_MALLOC(fofr,(cplex*Ftest%nfft))
+ - + - -
+ - + ]
647 : :
648 : : ! Initialize input data.
649 [ + + ]: 12 : if (isign==1) then
650 : : ! initialize fofg
651 [ + + + + ]: 13122006 : fofg = zero
652 : : ifft=0
653 [ + + ]: 546 : do i3=1,n3
654 [ + + ]: 540 : gg(3)=i3-1; if (i3>1+n3/2) gg(3)=i3-n3-1 ! TODO recheck this
655 [ + + ]: 49146 : do i2=1,n2
656 [ + + ]: 48600 : gg(2)=i2-1; if (i2>1+n2/2) gg(2)=i2-n2-1
657 [ + + ]: 4423140 : do i1=1,n1
658 [ + + ]: 4374000 : gg(1)=i1-1; if (i1>1+n1/2) gg(1)=i1-n1-1
659 [ + + + + : 83106000 : gsq = two_pi**2 * DOT_PRODUCT(gg,MATMUL(Ftest%gmet,gg))
+ + + + ]
660 : 4374000 : ifft=ifft+1
661 : 4374000 : fofg(1,ifft) = EXP(-gsq)
662 : 4422600 : fofg(2,ifft) = zero
663 : : end do
664 : : end do
665 : : end do
666 : :
667 : : else
668 : : ! init fofr
669 [ + + ]: 6 : if (cplex==2) then
670 : 3 : call calc_eigr(g0,Ftest%nfft,Ftest%ngfft,fofr)
671 [ + - ]: 3 : else if (cplex==1) then
672 [ - + + - : 9 : ABI_MALLOC(ctmp,(Ftest%nfft))
+ - + - -
+ - + ]
673 : 3 : call calc_ceigr(g0,Ftest%nfft,nspinor1,Ftest%ngfft,ctmp)
674 [ + - - + : 2187006 : fofr = REAL(ctmp)
- - + + ]
675 [ - + ]: 3 : ABI_FREE(ctmp)
676 : : else
677 : 0 : ABI_ERROR(sjoin("Wrong cplex:", itoa(cplex)))
678 : : end if
679 : : end if
680 : :
681 [ - + + - : 8748036 : ABI_CALLOC(results, (Ftest%nfft))
+ - + - -
+ - + +
+ ]
682 : 12 : call cwtime(cpu_time, wall_time, gflops, "start")
683 : :
684 [ + + ]: 72 : do icall=1,NCALLS_FOR_TEST
685 : 60 : ifft = empty_cache(CACHE_KBSIZE)
686 : 60 : call fourdp(cplex,fofg,fofr,isign,Ftest%MPI_enreg,Ftest%nfft,1,Ftest%ngfft,0)
687 : :
688 : : ! Store results at the first call.
689 [ + + ]: 72 : if (icall==1) then
690 [ + + ]: 12 : if (isign==1) then
691 [ + + ]: 6 : if (cplex==1) then
692 [ + - - + : 2187006 : results = DCMPLX(fofr, zero)
- - + + ]
693 [ + - ]: 3 : else if (cplex==2) then
694 [ + - - + : 2187006 : results = DCMPLX( fofr(1:2*Ftest%nfft:2), fofr(2:2*Ftest%nfft:2) )
- - + + ]
695 : : end if
696 [ + - ]: 6 : else if (isign==-1) then
697 [ + - - + : 4374012 : results = DCMPLX(fofg(1,:),fofg(2,:))
- - + + ]
698 : : end if
699 : : end if
700 : : end do
701 : :
702 : 12 : call cwtime(cpu_time, wall_time, gflops, "stop")
703 : : call Ftprof%init(test_name,Ftest%nthreads,NCALLS_FOR_TEST,Ftest%ndat,ftest%gpu_option, &
704 : 12 : cpu_time,wall_time,gflops,results=results)
705 : :
706 [ - + ]: 12 : ABI_FREE(fofg)
707 [ - + ]: 12 : ABI_FREE(fofr)
708 [ - + ]: 12 : ABI_FREE(results)
709 : :
710 : 24 : end subroutine time_fourdp
711 : : !!***
712 : :
713 : : !----------------------------------------------------------------------
714 : :
715 : : !!****f* m_FFT_prof/time_fftbox
716 : : !! NAME
717 : : !! time_fftbox
718 : : !!
719 : : !! FUNCTION
720 : : !! Profiling of the fftbox_[io]p routines.
721 : : !!
722 : : !! INPUTS
723 : : !!
724 : : !! OUTPUT
725 : : !!
726 : : !! SOURCE
727 : :
728 : 12 : subroutine time_fftbox(Ftest, isign, inplace, header, Ftprof)
729 : :
730 : : !Arguments -----------------------------------
731 : : class(FFT_test_t),intent(inout) :: Ftest
732 : : integer,intent(in) :: isign,inplace
733 : : character(len=500),intent(inout) :: header
734 : : class(FFT_prof_t),intent(out) :: Ftprof
735 : :
736 : : !Local variables-------------------------------
737 : : !scalars
738 : : integer,parameter :: nspinor1 = 1, fftcache0 = 0
739 : : integer :: icall,i1,i2,i3,n1,n2,n3,ifft,ndat,nfft,dat,padat
740 : : real(dp) :: cpu_time,wall_time,gflops,gsq
741 : : !character(len=500) :: msg
742 : : character(len=TNAME_LEN) :: test_name
743 : : type(fftbox_plan3_t) :: plan
744 : : !arrays
745 : : integer,parameter :: g0(3) = [1,-2,1]
746 : : integer :: gg(3)
747 : 12 : complex(dp),allocatable :: ffc(:),ggc(:),results(:)
748 : : ! *********************************************************************
749 : :
750 : 12 : test_name = Ftest%get_name()
751 : :
752 [ + + ]: 12 : if (Ftest%available == 0) then
753 : 4 : call Ftprof%init(test_name, 0, 0, 0, 0, zero, zero, zero)
754 : : return
755 : : end if
756 : :
757 : 8 : call xomp_set_num_threads(Ftest%nthreads)
758 : :
759 [ - + ]: 8 : if (Ftest%ngfft(7)/100 == FFT_FFTW3) call fftw3_set_nthreads(Ftest%nthreads)
760 : :
761 : 8 : n1 = Ftest%ngfft(1); n2 = Ftest%ngfft(2); n3 = Ftest%ngfft(3)
762 : 8 : nfft = Ftest%nfft; ndat = Ftest%ndat
763 : 8 : write(header,'(3(a,i2))')" fftbox with isign ",isign,", in-place ",inplace,", ndat ",ndat
764 : :
765 [ - + + - : 5832024 : ABI_CALLOC(ffc, (nfft*ndat))
+ - + - -
+ - + +
+ ]
766 [ - + + - : 5832016 : ABI_CALLOC(ggc, (nfft*ndat))
- + - + +
+ ]
767 [ - + + - : 5832016 : ABI_CALLOC(results, (nfft*ndat))
- + - + +
+ ]
768 : :
769 [ + + ]: 8 : if (isign==-1) then
770 : 4 : call calc_ceigr(g0,nfft,nspinor1,Ftest%ngfft,ffc)
771 [ + - ]: 4 : else if (isign==1) then
772 : : ifft=0
773 [ + + ]: 364 : do i3=1,n3
774 [ + + ]: 360 : gg(3)=i3-1; if (i3>1+n3/2) gg(3)=i3-n3-1 ! TODO recheck this
775 [ + + ]: 32764 : do i2=1,n2
776 [ + + ]: 32400 : gg(2)=i2-1; if (i2>1+n2/2) gg(2)=i2-n2-1
777 [ + + ]: 2948760 : do i1=1,n1
778 [ + + ]: 2916000 : gg(1)=i1-1; if (i1>1+n1/2) gg(1)=i1-n1-1
779 [ + + + + : 55404000 : gsq = two_pi**2 * DOT_PRODUCT(gg,MATMUL(Ftest%gmet,gg))
+ + + + ]
780 : 2916000 : ifft=ifft+1
781 : 2948400 : ffc(ifft) = EXP(-gsq)
782 : : end do
783 : : end do
784 : : end do
785 : : else
786 : 0 : ABI_ERROR("Wrong isign")
787 : : end if
788 : :
789 : : ! Replicate and scale input data
790 [ - + ]: 8 : do dat=2,ndat
791 : 0 : padat = (dat-1) * nfft
792 [ - - ]: 8 : do ifft=1,nfft
793 : 0 : ffc(ifft+padat) = DBLE(dat) * ffc(ifft)
794 : : end do
795 : : end do
796 : :
797 : 8 : call cwtime(cpu_time, wall_time, gflops, "start")
798 : :
799 : : ! No augmentation here.
800 : 8 : call plan%init(ndat, Ftest%ngfft(1:3), Ftest%ngfft(1:3), Ftest%ngfft(7), fftcache0, ftest%gpu_option)
801 : :
802 : : if (plan%gpu_option == ABI_GPU_OPENMP) then
803 : : #ifdef HAVE_OPENMP_OFFLOAD
804 : : !$OMP TARGET ENTER DATA MAP(to:ffc, ggc)
805 : : #endif
806 : : end if
807 : :
808 : 12 : select case (inplace)
809 : : case (0)
810 [ + + ]: 24 : do icall=1,NCALLS_FOR_TEST
811 : 20 : ifft = empty_cache(CACHE_KBSIZE)
812 : 20 : call plan%execute(ffc, ggc, isign, ndat, iscale=0)
813 : : ! Store results at the first call.
814 [ + + ]: 24 : if (icall == 1) then
815 : : #ifdef HAVE_OPENMP_OFFLOAD
816 : : !$omp target update from(ggc)
817 : : #endif
818 [ + - - + : 2916008 : results = ggc
- - + + ]
819 : : end if
820 : : end do
821 : : case (1)
822 [ + + ]: 24 : do icall=1,NCALLS_FOR_TEST
823 : 20 : ifft = empty_cache(CACHE_KBSIZE)
824 : 20 : call plan%execute(ffc, isign, ndat, iscale=0)
825 : : ! Store results at the first call.
826 [ + + ]: 24 : if (icall == 1) then
827 : : #ifdef HAVE_OPENMP_OFFLOAD
828 : : !$omp target update from(ffc)
829 : : #endif
830 [ + - - + : 2916008 : results = ffc
- - + + ]
831 : : end if
832 : : end do
833 : : case default
834 [ + + - ]: 8 : ABI_ERROR(sjoin("Wrong value for inplace:", itoa(inplace)))
835 : : end select
836 : :
837 : 8 : call cwtime(cpu_time, wall_time, gflops, "stop")
838 : : call Ftprof%init(test_name,Ftest%nthreads,NCALLS_FOR_TEST,Ftest%ndat,ftest%gpu_option, &
839 : 8 : cpu_time,wall_time,gflops,results=results)
840 : :
841 : 8 : call plan%free()
842 : :
843 : : if (plan%gpu_option == ABI_GPU_OPENMP) then
844 : : #ifdef HAVE_OPENMP_OFFLOAD
845 : : !$OMP TARGET EXIT DATA MAP(delete:ffc, ggc)
846 : : #endif
847 : : end if
848 [ - + ]: 8 : ABI_FREE(ffc)
849 [ - + ]: 8 : ABI_FREE(ggc)
850 [ - + ]: 8 : ABI_FREE(results)
851 : :
852 [ + + + + : 100 : end subroutine time_fftbox
+ - ]
853 : : !!***
854 : :
855 : : !----------------------------------------------------------------------
856 : :
857 : : !!****f* m_FFT_prof/time_fourwf
858 : : !! NAME
859 : : !! time_fourwf
860 : : !!
861 : : !! FUNCTION
862 : : !! Profiling of the fourwf routine.
863 : : !!
864 : : !! INPUTS
865 : : !!
866 : : !! OUTPUT
867 : : !!
868 : : !! SOURCE
869 : :
870 : 363 : subroutine time_fourwf(Ftest, cplex, option_fourwf, header, Ftprof)
871 : :
872 : : !Arguments -----------------------------------
873 : : class(FFT_test_t),intent(inout) :: Ftest
874 : : integer,intent(in) :: cplex,option_fourwf
875 : : character(len=500),intent(out) :: header
876 : : class(FFT_prof_t),intent(out) :: Ftprof
877 : :
878 : : !Local variables-------------------------------
879 : : !scalars
880 : : integer,parameter :: tim0=0
881 : : integer :: n1,n2,n3,n4,n5,n6,npw_out,icall,i1,i2,i3,idx,ipw,ndat,cnt,dat,padat
882 : : integer :: fftalg,fftalga,fftalgc
883 : : real(dp),parameter :: weight_i=one,weight_r=one
884 : : real(dp) :: cpu_time,wall_time,gflops,gsq,g0dotr
885 : : logical :: isbuggy,not_supported
886 : : !character(len=500) :: msg
887 : : character(len=TNAME_LEN) :: test_name
888 : : !arrays
889 : : integer,parameter :: g0(3)=[1,-1,2] !g0(3)=[1,0,0]
890 : : integer :: gg(3)
891 : 363 : integer,allocatable :: gbound_in(:,:),gbound_out(:,:)
892 : 363 : real(dp),allocatable :: denpot(:,:,:),fofg_in(:,:), fofr_4(:,:,:,:),fofg_out(:,:)
893 [ + - ]: 363 : complex(dp),allocatable :: results(:)
894 : : ! *********************************************************************
895 : :
896 : 363 : test_name = Ftest%get_name()
897 : :
898 : 363 : fftalg = Ftest%ngfft(7); fftalga = fftalg/100; fftalgc = MOD(fftalg,10)
899 : :
900 : : isbuggy = &
901 : : (option_fourwf==3 .and. fftalga==FFT_SG2002 .and. fftalgc /= 0 .and. &
902 [ + + + + : 2008 : any(Ftest%istwf_k == [3,4,5,6,7,8,9])) ! see sg_fourwf
+ + + + +
+ ]
903 : : !isbuggy = .False.
904 : :
905 : : !FIXME problems with the unitary tests reference files!
906 : : not_supported = ( &
907 [ + + + + : 363 : (fftalgc == 2 .and. option_fourwf==0 .and. Ftest%istwf_k > 2))
+ + ]
908 : : !not_supported = .FALSE.
909 : :
910 : 363 : npw_out= Ftest%npw_kout
911 : 363 : ndat = Ftest%ndat
912 : 363 : n1=Ftest%ngfft(1); n2=Ftest%ngfft(2); n3=Ftest%ngfft(3)
913 : 363 : n4=Ftest%ngfft(4); n5=Ftest%ngfft(5); n6=Ftest%ngfft(6)
914 : :
915 : 363 : write(header,'(4(a,i2))')" fourwf with option ",option_fourwf,", cplex ",cplex,", ndat ",ndat,", istwf_k ",Ftest%istwf_k
916 : :
917 [ + + + + ]: 363 : if (isbuggy .or. not_supported .or. Ftest%available==0) then
918 : 81 : call Ftprof%init(test_name,0,0,0,0,zero,zero,zero)
919 : 81 : RETURN
920 : : end if
921 : :
922 : 282 : call xomp_set_num_threads(Ftest%nthreads)
923 : :
924 [ - + ]: 282 : if (Ftest%ngfft(7)/100 == FFT_FFTW3) call fftw3_set_nthreads(Ftest%nthreads)
925 : :
926 : : ! FFTW3 does not need gbound_in but oh well
927 [ + - - + : 1128 : ABI_MALLOC(gbound_in, (2*Ftest%mgfft+8,2))
+ - + - +
- + - - +
- + ]
928 : 282 : call sphereboundary(gbound_in,Ftest%istwf_k,Ftest%kg_k,Ftest%mgfft,Ftest%npw_k)
929 : :
930 [ + - - + : 1128 : ABI_MALLOC(gbound_out, (2*Ftest%mgfft+8,2))
+ - + - +
- + - - +
- + ]
931 : 282 : call sphereboundary(gbound_out,Ftest%istwf_k,Ftest%kg_kout,Ftest%mgfft,Ftest%npw_kout)
932 : :
933 [ + + + - : 118451490 : ABI_CALLOC(denpot, (cplex*n4,n5,n6))
- + + - -
+ + - + -
+ + - + -
+ + + + +
+ + ]
934 [ - + + - : 38832138 : ABI_CALLOC(fofg_in, (2,Ftest%npw_k*ndat))
+ - + - -
+ - + + +
+ + ]
935 [ - + + - : 38832138 : ABI_CALLOC(fofg_out, (2,npw_out*ndat))
+ - + - -
+ - + + +
+ + ]
936 [ - + + - : 811367790 : ABI_CALLOC(fofr_4, (2,n4,n5,n6*ndat))
- + + - -
+ + - + -
+ - - + -
+ + + + +
+ + + + ]
937 [ - + + - : 264648846 : ABI_CALLOC(results, (Ftest%nfft*ndat))
+ - + - -
+ - + +
+ ]
938 : :
939 : : select case (option_fourwf)
940 : : case (0, 1, 2)
941 : : !! for option==0, fofgin(2,npwin*ndat)=holds input wavefunction in G sphere;
942 : : !! fofr(2,n4,n5,n6) contains the output Fourier Transform of fofgin;
943 : : !! no use of denpot, fofgout and npwout.
944 : : !! for option==1, fofgin(2,npwin*ndat)=holds input wavefunction in G sphere;
945 : : !! denpot(cplex*n4,n5,n6) contains the input density at input,
946 : : !! and the updated density at output (accumulated);
947 : : !! no use of fofgout and npwout.
948 : : !! for option==2, fofgin(2,npwin*ndat)=holds input wavefunction in G sphere;
949 : : !! denpot(cplex*n4,n5,n6) contains the input local potential;
950 : : !! fofgout(2,npwout*ndat) contains the output function;
951 : : !!
952 [ + + ]: 10259385 : do cnt=0, (Ftest%npw_k * ndat) - 1
953 : 10259165 : ipw = 1 + MOD(cnt, Ftest%npw_k)
954 [ + + ]: 41036660 : gg = Ftest%kg_k(:,ipw)
955 [ + + + + : 194924135 : gsq = two_pi**2 * DOT_PRODUCT(gg,MATMUL(Ftest%gmet,gg))
+ + + + ]
956 : 10259165 : fofg_in(1,cnt+1) = EXP(-gsq)
957 : 10259385 : fofg_in(2,cnt+1) = zero
958 : : end do
959 : :
960 [ + + + + : 45465740 : if (option_fourwf==1) denpot = one
+ + + + ]
961 : :
962 [ + + ]: 220 : if (option_fourwf==2) then
963 : : ! Init denpot
964 [ + + ]: 89 : if (cplex==1) then
965 [ + + ]: 6556 : do i3=0,n3-1
966 [ + + ]: 529116 : do i2=0,n2-1
967 [ + + ]: 44721040 : do i1=0,n1-1
968 : : g0dotr= two_pi*( g0(1)*(i1/DBLE(n1)) &
969 : : +g0(2)*(i2/DBLE(n2)) &
970 : 44192000 : +g0(3)*(i3/DBLE(n3)) )
971 : 44714560 : denpot(i1+1,i2+1,i3+1)=COS(g0dotr)
972 : : end do
973 : : end do
974 : : end do
975 [ + - ]: 13 : else if (cplex==2) then
976 [ + + ]: 1313 : do i3=0,n3-1
977 [ + + ]: 131313 : do i2=0,n2-1
978 : : idx=1
979 [ + + ]: 13131300 : do i1=0,n1-1
980 : : g0dotr= two_pi*( g0(1)*(i1/DBLE(n1)) &
981 : : +g0(2)*(i2/DBLE(n2)) &
982 : 13000000 : +g0(3)*(i3/DBLE(n3)) )
983 : :
984 : 13000000 : denpot(idx, i2+1,i3+1)= COS(g0dotr)
985 : 13000000 : denpot(idx+1,i2+1,i3+1)= SIN(g0dotr)
986 : 13130000 : idx=idx+2
987 : : end do
988 : : end do
989 : : end do
990 : : end if
991 : : end if
992 : :
993 : : case (3)
994 : : !! for option==3, fofr(2,n4,n5,n6*ndat) contains the input real space wavefunction;
995 : : !! fofgout(2,npwout*ndat) contains its output Fourier transform;
996 : : !! no use of fofgin and npwin.
997 : : idx=0
998 [ + + ]: 142 : do dat=1,ndat
999 : 80 : padat = (dat-1)*n6
1000 [ + + ]: 7302 : do i3=0,n3-1
1001 [ + + ]: 629160 : do i2=0,n2-1
1002 [ + + ]: 56773080 : do i1=0,n1-1
1003 : : g0dotr= two_pi*( g0(1)*(i1/DBLE(n1)) &
1004 : : +g0(2)*(i2/DBLE(n2)) &
1005 : 56144000 : +g0(3)*(i3/DBLE(n3)) )
1006 : : !fofr_4(1,i1+1,i2+1,i3+1+padat)=COS(g0dotr)
1007 : : !fofr_4(2,i1+1,i2+1,i3+1+padat)=SIN(g0dotr)
1008 : 56144000 : fofr_4(1,i1+1,i2+1,i3+1+padat)=10 * EXP(-g0dotr**2)
1009 : 56144000 : fofr_4(2,i1+1,i2+1,i3+1+padat)=zero
1010 : 56144000 : idx=idx+1
1011 : 56765920 : results(idx) = DCMPLX(fofr_4(1,i1+1,i2+1,i3+1+padat), fofr_4(2,i1+1,i2+1,i3+1+padat))
1012 : : end do
1013 : : end do
1014 : : end do
1015 : : end do
1016 : :
1017 : : case default
1018 [ + + - ]: 282 : ABI_ERROR(sjoin("Wrong value for option_fourwf:", itoa(option_fourwf)))
1019 : : end select
1020 : :
1021 : 282 : call cwtime(cpu_time, wall_time, gflops, "start")
1022 : :
1023 [ + + ]: 1602 : do icall=1,NCALLS_FOR_TEST
1024 : :
1025 : 1320 : i1 = empty_cache(CACHE_KBSIZE)
1026 : :
1027 : : call fourwf(cplex,denpot,fofg_in,fofg_out,fofr_4,gbound_in,gbound_out,Ftest%istwf_k,&
1028 : : Ftest%kg_k,Ftest%kg_kout,Ftest%mgfft,Ftest%MPI_enreg,ndat,Ftest%ngfft,Ftest%npw_k,npw_out,n4,n5,n6,option_fourwf,&
1029 : 1320 : tim0,weight_r,weight_i, gpu_option=ftest%gpu_option)
1030 : :
1031 : : ! Store results at the first call.
1032 [ + + ]: 1602 : if (icall == 1) then
1033 : : select case (option_fourwf)
1034 : : case (0)
1035 : : !! for option==0, fofgin(2,npwin*ndat)=holds input wavefunction in G sphere;
1036 : : !! fofr(2,n4,n5,n6) contains the output Fourier Transform of fofgin;
1037 : : !! no use of denpot, fofgout and npwout.
1038 : : idx=0
1039 [ + + ]: 128 : do dat=1,ndat
1040 : 73 : padat = (dat-1)*n6
1041 [ + + ]: 6728 : do i3=1,n3
1042 [ + + ]: 588273 : do i2=1,n2
1043 [ + + ]: 53708200 : do i1=1,n1
1044 : 53120000 : idx=idx+1
1045 : 53701600 : results(idx) = DCMPLX(fofr_4(1,i1,i2,i3+padat),fofr_4(2,i1,i2,i3+padat))
1046 : : end do
1047 : : end do
1048 : : end do
1049 : : end do
1050 : : case (1)
1051 : : !! for option==1, fofgin(2,npwin*ndat)=holds input wavefunction in G sphere;
1052 : : !! denpot(cplex*n4,n5,n6) contains the input density at input,
1053 : : !! and the updated density at output (accumulated);
1054 : : !! no use of fofgout and npwout.
1055 [ + - ]: 76 : if (cplex==1) then
1056 : : idx=0
1057 [ + + ]: 6556 : do i3=1,n3
1058 [ + + ]: 529116 : do i2=1,n2
1059 [ + + ]: 44721040 : do i1=1,n1
1060 : 44192000 : idx=idx+1
1061 : 44714560 : results(idx) = DCMPLX(denpot(i1,i2,i3),zero)
1062 : : end do
1063 : : end do
1064 : : end do
1065 : :
1066 [ # # ]: 0 : else if (cplex==2) then
1067 : : idx=0
1068 [ # # ]: 0 : do i3=1,n3
1069 [ # # ]: 0 : do i2=1,n2
1070 [ # # ]: 0 : do i1=1,2*n1,2
1071 : 0 : idx=idx+1
1072 [ # # ]: 0 : results(idx) = DCMPLX(denpot(i1,i2,i3),denpot(i1+1,i2,i3))
1073 : : end do
1074 : : end do
1075 : : end do
1076 : : else
1077 : 0 : ABI_ERROR("Wrong cplex")
1078 : : end if
1079 : :
1080 : : case (2)
1081 : : !! for option==2, fofgin(2,npwin*ndat)=holds input wavefunction in G sphere;
1082 : : !! denpot(cplex*n4,n5,n6) contains the input local potential;
1083 : : !! fofgout(2,npwout*ndat) contains the output function;
1084 [ + + ]: 4803443 : do ipw=1,npw_out*ndat
1085 : 4803443 : results(ipw) = DCMPLX(fofg_out(1,ipw),fofg_out(2,ipw))
1086 : : end do
1087 : :
1088 : : case (3)
1089 : : !! for option==3, fofr(2,n4,n5,n6*ndat) contains the input real space wavefunction;
1090 : : !! fofgout(2,npwout*ndat) contains its output Fourier transform;
1091 : : !! no use of fofgin and npwin.
1092 [ + + + + : 2684881 : do ipw=1,npw_out*ndat
- + + ]
1093 : 2684661 : results(ipw) = DCMPLX(fofg_out(1,ipw),fofg_out(2,ipw))
1094 : : end do
1095 : : !write(Ftest%ngfft(7),*)"results opt 3 Ftest%ngfft(7)",Ftest%ngfft(7)
1096 : : !do dat=1,ndat
1097 : : ! do ipw=1,npw_out
1098 : : ! idx = ipw + (dat-1)*npw_out
1099 : : ! write(Ftest%ngfft(7),*)ipw,dat,results(idx)
1100 : : ! end do
1101 : : !end do
1102 : : end select
1103 : : end if
1104 : : end do
1105 : :
1106 : 282 : call cwtime(cpu_time, wall_time, gflops, "stop")
1107 : : call Ftprof%init(test_name,Ftest%nthreads,NCALLS_FOR_TEST,Ftest%ndat,ftest%gpu_option,&
1108 : 282 : cpu_time,wall_time,gflops,results=results)
1109 : :
1110 [ - + ]: 282 : ABI_FREE(denpot)
1111 [ - + ]: 282 : ABI_FREE(fofg_in)
1112 [ - + ]: 282 : ABI_FREE(fofg_out)
1113 [ - + ]: 282 : ABI_FREE(fofr_4)
1114 [ - + ]: 282 : ABI_FREE(gbound_in)
1115 [ - + ]: 282 : ABI_FREE(gbound_out)
1116 [ - + ]: 282 : ABI_FREE(results)
1117 : :
1118 [ - + ]: 927 : end subroutine time_fourwf
1119 : : !!***
1120 : :
1121 : : !----------------------------------------------------------------------
1122 : :
1123 : : !!****f* m_FFT_prof/fftprof_ncalls_per_test
1124 : : !! NAME
1125 : : !! fftprof_ncalls_per_test
1126 : : !!
1127 : : !! FUNCTION
1128 : : !! Helper function used to set the number of calls to be used in each time_* routine.
1129 : : !!
1130 : : !! INPUTS
1131 : : !! ncalls=Number of calls to be used.
1132 : : !!
1133 : : !! SIDE EFFECTS
1134 : : !! NCALLS_FOR_TEST = ncalls
1135 : : !!
1136 : : !! SOURCE
1137 : :
1138 : 17 : subroutine fftprof_ncalls_per_test(ncalls)
1139 : :
1140 : : !Arguments -----------------------------------
1141 : : integer,intent(in) :: ncalls
1142 : : ! *********************************************************************
1143 : :
1144 : 17 : NCALLS_FOR_TEST = ncalls
1145 : :
1146 : 17 : end subroutine fftprof_ncalls_per_test
1147 : : !!***
1148 : :
1149 : : !----------------------------------------------------------------------
1150 : :
1151 : : !!****f* m_FFT_prof/time_rhotwg
1152 : : !! NAME
1153 : : !! time_rhotwg
1154 : : !!
1155 : : !! FUNCTION
1156 : : !! Profiling of the rho_tw_g routine.
1157 : : !!
1158 : : !! INPUTS
1159 : : !!
1160 : : !! OUTPUT
1161 : : !!
1162 : : !! SOURCE
1163 : :
1164 : 6 : subroutine time_rhotwg(Ftest, map2sphere, use_padfft, osc_npw, osc_gvec, header, Ftprof)
1165 : :
1166 : : !Arguments -----------------------------------
1167 : : !scalars
1168 : : class(FFT_test_t),intent(inout) :: Ftest
1169 : : integer,intent(in) :: map2sphere,use_padfft,osc_npw
1170 : : character(len=500),intent(out) :: header
1171 : : class(FFT_prof_t),intent(out) :: Ftprof
1172 : : !arrays
1173 : : integer,intent(in) :: osc_gvec(3,osc_npw)
1174 : :
1175 : : !Local variables-------------------------------
1176 : : !scalars
1177 : : integer,parameter :: nspinor1=1,dim_rtwg1=1,istwfk1=1
1178 : : integer :: icall,ifft,itim1,itim2,nfft,dat,sprc,ptr,ndat, n1,n2,n3,n4,n5,n6
1179 : : real(dp) :: cpu_time,wall_time,gflops
1180 : : complex(dp) :: ktabp1 = cone, ktabp2 = cone
1181 : : character(len=TNAME_LEN) :: test_name
1182 : : logical :: not_implemented
1183 : 6 : type(MPI_type) :: MPI_enreg_seq
1184 : : !arrays
1185 : : !integer,parameter :: g1(3)=[1,1,2],g2(3)=[-1,-2,-1]
1186 : : integer,parameter :: g1(3)=[-1,0,0], g2(3)=[1,0,0]
1187 : 6 : integer,allocatable :: gbound(:,:), ktabr1(:), ktabr2(:), igfftg0(:)
1188 : : real(dp),parameter :: spinrot1(4)=(/one,zero,zero,one/),spinrot2(4)=(/one,zero,zero,one/)
1189 : 6 : logical,allocatable :: mask(:)
1190 : 6 : complex(dp),allocatable :: results(:)
1191 [ + - ]: 6 : complex(gwp),allocatable :: rhotwg(:), wfn1(:), wfn2(:)
1192 : : ! *********************************************************************
1193 : :
1194 : 6 : test_name = Ftest%get_name()
1195 : :
1196 : 6 : nfft = Ftest%nfft; ndat = Ftest%ndat
1197 : 6 : n1=Ftest%ngfft(1); n2=Ftest%ngfft(2); n3=Ftest%ngfft(3)
1198 : 6 : n4=Ftest%ngfft(4); n5=Ftest%ngfft(5); n6=Ftest%ngfft(6)
1199 : :
1200 : 6 : write(header,'(3(a,i2))')"rho_tw_g with use_padfft ",use_padfft,", map2sphere ",map2sphere,", ndat ",ndat
1201 : :
1202 : : ! TODO: zero-pad not available with SG2001 routines.
1203 [ + + + + ]: 6 : not_implemented = (use_padfft==1.and.Ftest%ngfft(7) == 412)
1204 : :
1205 [ + + + + ]: 6 : if (Ftest%available==0.or.not_implemented) then
1206 : 3 : call Ftprof%init(test_name,0,0,0,0,zero,zero,zero)
1207 : 3 : return
1208 : : end if
1209 : :
1210 : 3 : call xomp_set_num_threads(Ftest%nthreads)
1211 : :
1212 [ - + ]: 3 : if (Ftest%ngfft(7)/100 == FFT_FFTW3) call fftw3_set_nthreads(Ftest%nthreads)
1213 : :
1214 : 3 : call initmpi_seq(MPI_enreg_seq)
1215 : 3 : call MPI_enreg_seq%distribfft%init_seq('c',n2,n3,'all')
1216 : :
1217 : 3 : itim1=1; itim2=1
1218 [ - + + - : 9 : ABI_MALLOC(ktabr1,(nfft))
+ - + - -
+ - + ]
1219 [ - + + - : 6 : ABI_MALLOC(ktabr2,(nfft))
- + - + ]
1220 : :
1221 [ + + ]: 2187003 : do ifft=1,nfft
1222 : 2187000 : ktabr1(ifft)= ifft
1223 : 2187003 : ktabr2(ifft)= ifft
1224 : : end do
1225 : :
1226 [ - + + - : 9 : ABI_MALLOC(igfftg0,(osc_npw*map2sphere))
+ - + - -
+ - + ]
1227 : :
1228 [ + - ]: 3 : if (map2sphere > 0) then
1229 [ - + + - : 9 : ABI_MALLOC(mask,(osc_npw))
+ - + - -
+ - + ]
1230 : 3 : call kgindex(igfftg0,osc_gvec,mask,MPI_enreg_seq,Ftest%ngfft,osc_npw)
1231 [ + + + - : 36162 : ABI_CHECK(ALL(mask)," FFT parallelism not supported")
- + ]
1232 [ - + ]: 3 : ABI_FREE(mask)
1233 : : end if
1234 : :
1235 [ + - - + : 12 : ABI_MALLOC(gbound,(2*Ftest%mgfft+8,2*use_padfft))
+ - + + +
+ + - + -
+ + - + -
+ ]
1236 [ + + ]: 3 : if (use_padfft == 1) call sphereboundary(gbound,istwfk1,osc_gvec,Ftest%mgfft,osc_npw)
1237 : :
1238 [ - + + - : 9 : ABI_MALLOC(wfn1, (nfft*nspinor1*ndat))
+ - + - -
+ - + ]
1239 [ - + + - : 6 : ABI_MALLOC(wfn2, (nfft*nspinor1*ndat))
- + - + ]
1240 : :
1241 [ + + ]: 6 : do dat=1,ndat
1242 [ + + ]: 9 : do sprc=1,nspinor1
1243 : 3 : ptr = 1 + (sprc-1)*nfft + (dat-1)*nfft*nspinor1
1244 : 3 : call calc_ceigr(g1,nfft,nspinor1,Ftest%ngfft,wfn1(ptr:))
1245 : 6 : call calc_ceigr(g2,nfft,nspinor1,Ftest%ngfft,wfn2(ptr:))
1246 : : end do
1247 : : end do
1248 : :
1249 [ - + + - : 9 : ABI_MALLOC(rhotwg,(osc_npw*dim_rtwg1*ndat))
+ - + - -
+ - + ]
1250 [ - + + - : 6 : ABI_MALLOC(results,(osc_npw*dim_rtwg1*ndat))
- + - + ]
1251 : :
1252 : 3 : call cwtime(cpu_time, wall_time, gflops, "start")
1253 : :
1254 [ + + ]: 18 : do icall=1,NCALLS_FOR_TEST
1255 : 15 : ifft = empty_cache(CACHE_KBSIZE)
1256 : : call rho_tw_g(nspinor1,osc_npw,nfft,ndat,Ftest%ngfft,map2sphere,use_padfft,igfftg0,gbound,&
1257 : : wfn1,itim1,ktabr1,ktabp1,spinrot1,&
1258 : : wfn2,itim2,ktabr2,ktabp2,spinrot2,&
1259 : 15 : dim_rtwg1,rhotwg)
1260 : : ! Store results at the first call.
1261 [ + + + - : 36180 : if (icall==1) results = rhotwg
- + - - +
+ ]
1262 : : end do
1263 : :
1264 : 3 : call cwtime(cpu_time, wall_time, gflops, "stop")
1265 : : call Ftprof%init(test_name,Ftest%nthreads,NCALLS_FOR_TEST,Ftest%ndat,ftest%gpu_option, &
1266 : 3 : cpu_time,wall_time,gflops,results=results)
1267 : :
1268 [ - + ]: 3 : ABI_FREE(ktabr1)
1269 [ - + ]: 3 : ABI_FREE(ktabr2)
1270 [ - + ]: 3 : ABI_FREE(igfftg0)
1271 [ - + ]: 3 : ABI_FREE(gbound)
1272 [ - + ]: 3 : ABI_FREE(rhotwg)
1273 [ - + ]: 3 : ABI_FREE(wfn1)
1274 [ - + ]: 3 : ABI_FREE(wfn2)
1275 [ - + ]: 3 : ABI_FREE(results)
1276 : 3 : call destroy_mpi_enreg(MPI_enreg_seq)
1277 : :
1278 [ - + - + : 12 : end subroutine time_rhotwg
- + - + -
+ - + - +
- + - + -
+ - + - +
- + ]
1279 : : !!***
1280 : :
1281 : : !----------------------------------------------------------------------
1282 : :
1283 : : !!****f* m_FFT_prof/time_fftu
1284 : : !! NAME
1285 : : !! time_fftu
1286 : : !!
1287 : : !! FUNCTION
1288 : : !! Profiling of the fftu routines.
1289 : : !!
1290 : : !! INPUTS
1291 : : !!
1292 : : !! OUTPUT
1293 : : !!
1294 : : !! SOURCE
1295 : :
1296 : 6 : subroutine time_fftu(Ftest, isign, header, Ftprof)
1297 : :
1298 : : !Arguments -----------------------------------
1299 : : class(FFT_test_t),intent(inout) :: Ftest
1300 : : integer,intent(in) :: isign
1301 : : character(len=500),intent(out) :: header
1302 : : class(FFT_prof_t),intent(out) :: Ftprof
1303 : :
1304 : : !Local variables-------------------------------
1305 : : !scalars
1306 : : integer,parameter :: nspinor1=1
1307 : : integer :: icall,i1,i2,i3,n1,n2,n3,ifft,npw_k,ndat,dat,nfft,cnt,ipw,padat,istwf_k
1308 : : !integer :: n4,n5,n6,n456,idx
1309 : : real(dp) :: cpu_time,wall_time,gflops,gsq,g0dotr
1310 : : logical :: not_implemented
1311 : : !character(len=500) :: msg
1312 : : character(len=TNAME_LEN) :: test_name
1313 : : !arrays
1314 : : integer,parameter :: g0(3) = [1,-2,1]
1315 : : integer :: gg(3)
1316 : 6 : integer,allocatable :: kg_k(:,:),gbound(:,:)
1317 [ + - ]: 6 : complex(dp),allocatable :: ug(:),results(:),ur(:)
1318 : : ! *********************************************************************
1319 : :
1320 : 6 : test_name = Ftest%get_name()
1321 : :
1322 : 6 : n1=Ftest%ngfft(1); n2=Ftest%ngfft(2); n3=Ftest%ngfft(3)
1323 : : !n4=Ftest%ngfft(4); n5=Ftest%ngfft(5); n6=Ftest%ngfft(6)
1324 : :
1325 : 6 : nfft = n1*n2*n3
1326 : : !n456 = n4*n5*n6
1327 : 6 : ndat = Ftest%ndat
1328 : :
1329 : 6 : write(header,'(2(a,i2))')" fftu with isign ",isign,", ndat ",ndat
1330 : :
1331 : : ! TODO: zero-pad not available with SG2001 routines.
1332 : 6 : not_implemented = (Ftest%ngfft(7) == 412)
1333 : :
1334 [ + + + + ]: 6 : if (Ftest%available==0.or.not_implemented) then
1335 : 4 : call Ftprof%init(test_name,0,0,0,0,zero,zero,zero)
1336 : : return
1337 : : end if
1338 : :
1339 : 2 : call xomp_set_num_threads(Ftest%nthreads)
1340 : :
1341 [ - + ]: 2 : if (Ftest%ngfft(7)/100 == FFT_FFTW3) call fftw3_set_nthreads(Ftest%nthreads)
1342 : : !
1343 : 2 : istwf_k = Ftest%istwf_k
1344 : : !istwf_k = 1 ! Do not use istwf_k trick here
1345 : 2 : call get_kg(Ftest%kpoint,istwf_k,Ftest%ecut,Ftest%gmet,npw_k,kg_k)
1346 : :
1347 [ + - - + : 8 : ABI_MALLOC(gbound,(2*Ftest%mgfft+8,2))
+ - + - +
- + - - +
- + ]
1348 : 2 : call sphereboundary(gbound,istwf_k,kg_k,Ftest%mgfft,npw_k)
1349 : :
1350 [ - + + - : 6 : ABI_MALLOC(ug,(npw_k*ndat))
+ - + - -
+ - + ]
1351 [ - + + - : 6 : ABI_MALLOC(ur, (nfft*ndat))
+ - + - -
+ - + ]
1352 [ - + + - : 4 : ABI_MALLOC(results,(nfft*ndat))
- + - + ]
1353 [ + + ]: 1458002 : results=czero ! needed for R --> G since npw_k < nfft
1354 : :
1355 [ + + ]: 2 : if (isign==1) then
1356 [ + + ]: 34169 : do cnt=0,(npw_k * ndat) - 1
1357 : 34168 : ipw = 1 + MOD(cnt, npw_k)
1358 [ + + ]: 136672 : gg = kg_k(:,ipw)
1359 [ + + + + : 649192 : gsq = two_pi**2 * DOT_PRODUCT(gg,MATMUL(Ftest%gmet,gg))
+ + + + ]
1360 : 34169 : ug(cnt+1) = DCMPLX(EXP(-gsq), zero)
1361 : : end do
1362 : : !
1363 : : ! Replicate input data
1364 [ + - ]: 1 : do dat=2,ndat
1365 : 0 : padat = (dat-1) * npw_k
1366 [ - - ]: 1 : do ipw=1,npw_k
1367 : 0 : ug(ipw+padat) = DBLE(dat) * ug(ipw)
1368 : : end do
1369 : : end do
1370 : :
1371 [ + - ]: 1 : else if (isign==-1) then
1372 : :
1373 [ + + ]: 91 : do i3=0,n3-1
1374 [ + + ]: 8191 : do i2=0,n2-1
1375 [ + + ]: 737190 : do i1=0,n1-1
1376 : : g0dotr= two_pi*( g0(1)*(i1/DBLE(n1)) &
1377 : : +g0(2)*(i2/DBLE(n2)) &
1378 : 729000 : +g0(3)*(i3/DBLE(n3)) )
1379 : 729000 : ifft = 1 + i1 + i2*n1 + i3*n2*n3
1380 : 737100 : ur(ifft)=DCMPLX(DCOS(g0dotr),DSIN(g0dotr))
1381 : : end do
1382 : : end do
1383 : : end do
1384 : : !
1385 : : ! Replicate input data
1386 [ + - ]: 1 : do dat=2,ndat
1387 : 0 : padat = (dat-1)*nfft
1388 [ - - ]: 1 : do ifft=1,nfft
1389 : 0 : ur(ifft+padat) = DBLE(dat) * ur(ifft)
1390 : : end do
1391 : : end do
1392 : :
1393 : : else
1394 : 0 : ABI_ERROR(sjoin("Wrong isign:", itoa(isign)))
1395 : : end if
1396 : :
1397 : 2 : call cwtime(cpu_time, wall_time, gflops, "start")
1398 : :
1399 [ + + ]: 12 : do icall=1,NCALLS_FOR_TEST
1400 : 10 : ifft = empty_cache(CACHE_KBSIZE)
1401 : :
1402 : : !call fftpad(ug,Ftest%ngfft,n1,n2,n3,n4,n5,n6,ndat,Ftest%mgfft,isign,gbound)
1403 [ + + ]: 12 : if (isign == +1) then
1404 : 5 : call fft_ug(npw_k,nfft,nspinor1,ndat,Ftest%mgfft,Ftest%ngfft,istwf_k,kg_k,gbound,ug,ur)
1405 : : ! Store results at the first call.
1406 [ + + ]: 5 : if (icall == 1) call xcopy(nfft*ndat,ur,1,results,1)
1407 : :
1408 : : else
1409 : 5 : call fft_ur(npw_k,nfft,nspinor1,ndat,Ftest%mgfft,Ftest%ngfft,istwf_k,kg_k,gbound,ur,ug)
1410 : : ! Store results at the first call.
1411 [ + + ]: 5 : if (icall==1) call xcopy(npw_k*ndat,ug,1,results,1)
1412 : : end if
1413 : : !if (isign==-1) then
1414 : : ! write(Ftest%ngfft(7),*)"ngfft, isign ",Ftest%ngfft(7),isign
1415 : : ! do idx =1,n4*n5*n6*ndat; write(Ftest%ngfft(7),*)idx,results(idx); end do
1416 : : !end if
1417 : : end do
1418 : :
1419 : 2 : call cwtime(cpu_time, wall_time, gflops, "stop")
1420 : : call Ftprof%init(test_name,Ftest%nthreads,NCALLS_FOR_TEST,ndat,ftest%gpu_option, &
1421 : 2 : cpu_time,wall_time,gflops,results=results)
1422 : :
1423 [ - + ]: 2 : ABI_FREE(kg_k)
1424 [ - + ]: 2 : ABI_FREE(gbound)
1425 [ - + ]: 2 : ABI_FREE(ug)
1426 [ - + ]: 2 : ABI_FREE(ur)
1427 [ - + ]: 2 : ABI_FREE(results)
1428 : :
1429 : 4 : end subroutine time_fftu
1430 : : !!***
1431 : :
1432 : : !----------------------------------------------------------------------
1433 : :
1434 : : !!****f* m_FFT_prof/prof_fourdp
1435 : : !! NAME
1436 : : !! prof_fourdp
1437 : : !!
1438 : : !! FUNCTION
1439 : : !! Profile fourdp
1440 : : !!
1441 : : !! INPUTS
1442 : : !!
1443 : : !! OUTPUT
1444 : : !!
1445 : : !! SOURCE
1446 : :
1447 [ # # ]: 0 : subroutine prof_fourdp(fft_setups, isign, cplex, necut, ecut_arth, boxcutmin, rprimd, nsym, symrel, MPI_enreg_in)
1448 : :
1449 : : !Arguments -----------------------------------
1450 : : !scalars
1451 : : integer,intent(in) :: nsym,isign,cplex,necut
1452 : : real(dp),intent(in) :: boxcutmin
1453 : : type(MPI_type),intent(in) :: MPI_enreg_in
1454 : : !arrays
1455 : : integer,intent(in) :: fft_setups(:,:),symrel(3,3,nsym)
1456 : : real(dp),intent(in) :: ecut_arth(2)
1457 : : real(dp),intent(in) :: rprimd(3,3)
1458 : :
1459 : : !Local variables-------------------------------
1460 : : !scalars
1461 : : integer :: iec,nsetups,set,funt
1462 [ # # # # ]: 0 : type(FFT_test_t) :: Ftest
1463 : 0 : type(FFT_prof_t) :: Ftprof
1464 : : character(len=500) :: msg,frm,header
1465 : : character(len=fnlen) :: fname
1466 : : !arrays
1467 : 0 : integer :: ngfft_ecut(18,necut)
1468 : : real(dp),parameter :: k_gamma(3)=zero
1469 : 0 : real(dp) :: ecut_list(necut)
1470 : 0 : real(dp),allocatable :: prof_res(:,:,:)
1471 : : ! *********************************************************************
1472 : :
1473 : 0 : nsetups = size(fft_setups, dim=2)
1474 : 0 : ecut_list = arth(ecut_arth(1), ecut_arth(2), necut)
1475 : :
1476 : : ! Open file and write header with info.
1477 : 0 : write(fname,'(2(a,i1))')"PROF_fourdp_cplex",cplex,"_isign",isign
1478 [ # # ]: 0 : if (open_file(fname, msg, newunit=funt) /= 0) then
1479 : 0 : ABI_ERROR(msg)
1480 : : end if
1481 : :
1482 : 0 : write(msg,'(2(a,i0))')"Benchmark: routine = fourdp, cplex =",cplex,", isign=",isign
1483 : 0 : write(std_out,'(a)')" Running "//TRIM(msg)
1484 : :
1485 : 0 : write(funt,'(a)')"# "//TRIM(msg)
1486 [ # # ]: 0 : do set=1,nsetups
1487 : 0 : write(funt,'(a, 6(a,i0))') "#",&
1488 : 0 : " fftalg = " ,fft_setups(1,set), &
1489 : 0 : ", fftcache = " ,fft_setups(2,set), &
1490 : 0 : ", ndat = " ,fft_setups(3,set), &
1491 : 0 : ", nthreads = " ,fft_setups(4,set), &
1492 : 0 : ", available = ",fft_setups(5,set), &
1493 : 0 : ", gpu_option = ",fft_setups(6,set)
1494 : : end do
1495 : :
1496 [ # # # # : 0 : ABI_MALLOC(prof_res,(2,necut,nsetups))
# # # # #
# # # # #
# # ]
1497 : :
1498 [ # # ]: 0 : do set=1,nsetups
1499 [ # # ]: 0 : do iec=1,necut
1500 [ # # # # : 0 : call Ftest%init(fft_setups(:,set),k_gamma,ecut_list(iec),boxcutmin,rprimd,nsym,symrel,MPI_enreg_in)
# # # # ]
1501 : 0 : call Ftest%time_fourdp(isign, cplex, header, Ftprof)
1502 : :
1503 : 0 : prof_res(1,iec,set) = Ftprof%cpu_time /Ftprof%ncalls
1504 : 0 : prof_res(2,iec,set) = Ftprof%wall_time/Ftprof%ncalls
1505 : :
1506 : : ! Save FFT divisions.
1507 [ # # # # ]: 0 : if (set == 1) ngfft_ecut(:,iec) = Ftest%ngfft
1508 : :
1509 : 0 : call Ftprof%free()
1510 : 0 : call Ftest%free()
1511 : : end do
1512 : : end do
1513 : :
1514 : : ! Write the wall-time as a function of ecut.
1515 : 0 : write(frm,*)"(f7.1,3i4,",nsetups,"(f7.4))"
1516 [ # # ]: 0 : do iec=1,necut
1517 : 0 : write(funt,frm) ecut_list(iec),ngfft_ecut(4:6,iec),prof_res(2,iec,:)
1518 : : end do
1519 : :
1520 : 0 : close(funt)
1521 [ # # ]: 0 : ABI_FREE(prof_res)
1522 : :
1523 [ # # # # : 0 : end subroutine prof_fourdp
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1524 : : !!***
1525 : :
1526 : : !----------------------------------------------------------------------
1527 : :
1528 : : !!****f* m_FFT_prof/prof_fourwf
1529 : : !! NAME
1530 : : !! prof_fourwf
1531 : : !!
1532 : : !! FUNCTION
1533 : : !! profile fourwf
1534 : : !!
1535 : : !! INPUTS
1536 : : !!
1537 : : !! OUTPUT
1538 : : !!
1539 : : !! SOURCE
1540 : :
1541 [ # # ]: 0 : subroutine prof_fourwf(fft_setups, cplex, option, kpoint, necut, ecut_arth, &
1542 : 0 : boxcutmin, rprimd, nsym, symrel, MPI_enreg_in)
1543 : :
1544 : : !Arguments -----------------------------------
1545 : : !scalars
1546 : : integer,intent(in) :: nsym,cplex,necut,option
1547 : : real(dp),intent(in) :: boxcutmin
1548 : : type(MPI_type),intent(in) :: MPI_enreg_in
1549 : : !arrays
1550 : : integer,intent(in) :: fft_setups(:,:),symrel(3,3,nsym)
1551 : : real(dp),intent(in) :: ecut_arth(2)
1552 : : real(dp),intent(in) :: kpoint(3),rprimd(3,3)
1553 : :
1554 : : !Local variables-------------------------------
1555 : : !scalars
1556 : : integer :: iec,nsetups,set,funt,istwf_k
1557 [ # # # # ]: 0 : type(FFT_test_t) :: Ftest
1558 : 0 : type(FFT_prof_t) :: Ftprof
1559 : : character(len=500) :: msg,frm,header
1560 : : character(len=fnlen) :: fname
1561 : : !arrays
1562 : 0 : integer :: ngfft_ecut(18,necut)
1563 : 0 : real(dp) :: ecut_list(necut)
1564 : 0 : real(dp),allocatable :: prof_res(:,:,:)
1565 : : ! *********************************************************************
1566 : :
1567 : 0 : nsetups = size(fft_setups, dim=2)
1568 : 0 : ecut_list = arth(ecut_arth(1), ecut_arth(2), necut)
1569 : 0 : istwf_k = set_istwfk(kpoint)
1570 : :
1571 : : ! Open file and write header with info.
1572 : 0 : write(fname,'(3(a,i1))')"PROF_fourwf_cplex",cplex,"_option",option,"_istwfk",istwf_k
1573 [ # # ]: 0 : if (open_file(fname, msg, newunit=funt) /= 0) then
1574 : 0 : ABI_ERROR(msg)
1575 : : end if
1576 : :
1577 : 0 : write(msg,'(3(a,i1))')"Benchmark: routine = fourwf, cplex = ",cplex,", option= ",option,", istwfk= ",istwf_k
1578 : 0 : write(std_out,'(a)')" Running "//TRIM(msg)
1579 : :
1580 : 0 : write(funt,'(a)')"# "//TRIM(msg)
1581 [ # # ]: 0 : do set=1,nsetups
1582 : 0 : write(funt,'(a,6(a,i0))') "#",&
1583 : 0 : " fftalg = " ,fft_setups(1,set), &
1584 : 0 : ", fftcache = " ,fft_setups(2,set), &
1585 : 0 : ", ndat = " ,fft_setups(3,set), &
1586 : 0 : ", nthreads = " ,fft_setups(4,set), &
1587 : 0 : ", available = ",fft_setups(5,set), &
1588 : 0 : ", gpu_option = ",fft_setups(6,set)
1589 : : end do
1590 : :
1591 [ # # # # : 0 : ABI_MALLOC(prof_res,(2,necut,nsetups))
# # # # #
# # # # #
# # ]
1592 : :
1593 [ # # ]: 0 : do set=1,nsetups
1594 [ # # ]: 0 : do iec=1,necut
1595 [ # # # # : 0 : call Ftest%init(fft_setups(:,set),kpoint,ecut_list(iec),boxcutmin,rprimd,nsym,symrel,MPI_enreg_in)
# # # # ]
1596 : 0 : call Ftest%time_fourwf(cplex, option, header, Ftprof)
1597 : :
1598 : 0 : prof_res(1,iec,set) = Ftprof%cpu_time /Ftprof%ncalls
1599 : 0 : prof_res(2,iec,set) = Ftprof%wall_time/Ftprof%ncalls
1600 : :
1601 : : ! Save FFT divisions.
1602 [ # # # # ]: 0 : if (set == 1) ngfft_ecut(:,iec) = Ftest%ngfft
1603 : 0 : call Ftprof%free()
1604 : 0 : call Ftest%free()
1605 : : end do
1606 : : end do
1607 : :
1608 : : ! Write the wall-time as a function of ecut.
1609 : 0 : write(frm,*)"(f7.1,3i4,",nsetups,"(f7.4))"
1610 [ # # ]: 0 : do iec=1,necut
1611 : 0 : write(funt,frm) ecut_list(iec),ngfft_ecut(4:6,iec),prof_res(2,iec,:)
1612 : : end do
1613 : :
1614 : 0 : close(funt)
1615 [ # # ]: 0 : ABI_FREE(prof_res)
1616 : :
1617 [ # # # # : 0 : end subroutine prof_fourwf
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1618 : : !!***
1619 : :
1620 : : !----------------------------------------------------------------------
1621 : :
1622 : : !!****f* m_FFT_prof/prof_rhotwg
1623 : : !! NAME
1624 : : !! prof_rhotwg
1625 : : !!
1626 : : !! FUNCTION
1627 : : !! profile rhotwg
1628 : : !!
1629 : : !! INPUTS
1630 : : !!
1631 : : !! OUTPUT
1632 : : !!
1633 : : !! SOURCE
1634 : :
1635 [ # # ]: 0 : subroutine prof_rhotwg(fft_setups,map2sphere,use_padfft,necut,ecut_arth,osc_ecut,boxcutmin,&
1636 : 0 : rprimd,nsym,symrel,gmet,MPI_enreg_in)
1637 : :
1638 : : !Arguments -----------------------------------
1639 : : !scalars
1640 : : integer,intent(in) :: nsym,necut,map2sphere,use_padfft
1641 : : real(dp),intent(in) :: boxcutmin,osc_ecut
1642 : : type(MPI_type),intent(in) :: MPI_enreg_in
1643 : : !arrays
1644 : : integer,intent(in) :: fft_setups(:,:),symrel(3,3,nsym)
1645 : : real(dp),intent(in) :: ecut_arth(2)
1646 : : real(dp),intent(in) :: rprimd(3,3),gmet(3,3)
1647 : :
1648 : : !Local variables-------------------------------
1649 : : !scalars
1650 : : integer :: iec,nsetups,set,funt,osc_npw
1651 [ # # # # ]: 0 : type(FFT_test_t) :: Ftest
1652 : 0 : type(FFT_prof_t) :: Ftprof
1653 : : character(len=500) :: msg,frm,header
1654 : : character(len=fnlen) :: fname
1655 : : !arrays
1656 : 0 : integer,allocatable :: osc_gvec(:,:)
1657 : 0 : integer :: ngfft_ecut(18,necut)
1658 : : real(dp),parameter :: k_gamma(3)=zero
1659 : 0 : real(dp) :: ecut_list(necut)
1660 : 0 : real(dp),allocatable :: prof_res(:,:,:)
1661 : : ! *********************************************************************
1662 : :
1663 : 0 : nsetups = size(fft_setups, dim=2)
1664 : 0 : ecut_list = arth(ecut_arth(1), ecut_arth(2), necut)
1665 : :
1666 : : ! Open file and write header with info.
1667 : 0 : write(fname,'(2(a,i1))')"PROF_rhotwg_map2sphere",map2sphere,"_use_padfft",use_padfft
1668 [ # # ]: 0 : if (open_file(fname, msg, newunit=funt) /= 0) then
1669 : 0 : ABI_ERROR(msg)
1670 : : end if
1671 : :
1672 : : write(msg,'(2(a,i0),a,f5.1)') &
1673 : 0 : "Benchmark: routine = rho_tw_g, map2sphere = ",map2sphere,", use_padfft = ",use_padfft,", osc_ecut = ",osc_ecut
1674 : 0 : write(std_out,'(a)')" Running "//TRIM(msg)
1675 : :
1676 : 0 : write(funt,'(a)')"# "//TRIM(msg)
1677 [ # # ]: 0 : do set=1,nsetups
1678 : 0 : write(funt,'(a,6(a,i0))') "#",&
1679 : 0 : " fftalg = " ,fft_setups(1,set),&
1680 : 0 : ", fftcache = " ,fft_setups(2,set),&
1681 : 0 : ", ndat = " ,fft_setups(3,set),&
1682 : 0 : ", nthreads = " ,fft_setups(4,set),&
1683 : 0 : ", available = ",fft_setups(5,set),&
1684 : 0 : ", gpu_option = ",fft_setups(6,set)
1685 : : end do
1686 : :
1687 : 0 : call get_kg([zero,zero,zero],1,osc_ecut,gmet,osc_npw,osc_gvec)
1688 : : ! TODO should reorder by shells to be consistent with the GW part!
1689 : : ! Moreover I guess this ordering is more efficient when we have
1690 : : ! to map the box to the G-sphere!
1691 : :
1692 [ # # # # : 0 : ABI_MALLOC(prof_res,(2,necut,nsetups))
# # # # #
# # # # #
# # ]
1693 : :
1694 [ # # ]: 0 : do set=1,nsetups
1695 [ # # ]: 0 : do iec=1,necut
1696 [ # # # # : 0 : call Ftest%init(fft_setups(:,set),k_gamma,ecut_list(iec),boxcutmin,rprimd,nsym,symrel,MPI_enreg_in)
# # # # ]
1697 : :
1698 : 0 : call Ftest%time_rhotwg(map2sphere,use_padfft,osc_npw,osc_gvec,header,Ftprof)
1699 : :
1700 : 0 : prof_res(1,iec,set) = Ftprof%cpu_time /Ftprof%ncalls
1701 : 0 : prof_res(2,iec,set) = Ftprof%wall_time/Ftprof%ncalls
1702 : : ! Save FFT divisions.
1703 [ # # # # ]: 0 : if (set==1) ngfft_ecut(:,iec) = Ftest%ngfft
1704 : :
1705 : 0 : call Ftprof%free()
1706 : 0 : call Ftest%free()
1707 : : end do
1708 : : end do
1709 : :
1710 : : ! Write the wall-time as a function of ecut.
1711 : 0 : write(frm,*)"(f7.1,3i4,",nsetups,"(f7.4))"
1712 [ # # ]: 0 : do iec=1,necut
1713 : 0 : write(funt,frm) ecut_list(iec),ngfft_ecut(4:6,iec),prof_res(2,iec,:)
1714 : : end do
1715 : :
1716 : 0 : close(funt)
1717 [ # # ]: 0 : ABI_FREE(prof_res)
1718 [ # # ]: 0 : ABI_FREE(osc_gvec)
1719 : :
1720 [ # # # # : 0 : end subroutine prof_rhotwg
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1721 : : !!***
1722 : :
1723 : : !----------------------------------------------------------------------
1724 : :
1725 : : !!****f* m_FFT_prof/empty_cache
1726 : : !! NAME
1727 : : !! empty_cache
1728 : : !!
1729 : : !! FUNCTION
1730 : : !! Empty the memory cache
1731 : : !!
1732 : : !! INPUTS
1733 : : !!
1734 : : !! OUTPUT
1735 : : !!
1736 : : !! SOURCE
1737 : :
1738 : 1445 : integer function empty_cache(kbsize) result(fake)
1739 : :
1740 : : !Arguments -----------------------------------
1741 : : integer,intent(in) :: kbsize
1742 : :
1743 : : !Local variables-------------------------------
1744 : : integer :: sz
1745 : 1445 : real(dp),allocatable :: chunk(:)
1746 : : ! *********************************************************************
1747 : :
1748 : 1445 : fake = 0
1749 [ - + ]: 1445 : if (kbsize <= 0) RETURN
1750 : :
1751 : 0 : sz = int((100._dp * kbsize) / dp)
1752 : :
1753 [ # # # # : 0 : ABI_MALLOC(chunk,(sz))
# # # # #
# # # ]
1754 : 0 : call random_number(chunk)
1755 [ # # ]: 0 : fake = int(SUM(chunk)) ! Need a result, otherwise smart compilers may skip the call.
1756 [ # # ]: 0 : ABI_FREE(chunk)
1757 : :
1758 [ - + ]: 1445 : end function empty_cache
1759 : : !!***
1760 : :
1761 : : !----------------------------------------------------------------------
1762 : :
1763 [ - + - - : 1612 : end module m_FFT_prof
+ + - + +
- - + # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1764 : : !!***
|
