Line data Source code
1 : !!****p* ABINIT/fftprof
2 : !! NAME
3 : !! fftprof
4 : !!
5 : !! FUNCTION
6 : !! Utility for profiling the FFT libraries supported by ABINIT.
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 2004-2026 ABINIT group (MG)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, see ~abinit/COPYING
12 : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : !!
14 : !! OUTPUT
15 : !! Timing analysis of the different FFT libraries and algorithms.
16 : !!
17 : !! NOTES
18 : !! Point-group symmetries are not taken into account in getng during the generation
19 : !! of the FFT mesh. Therefore the FFT mesh might differ from the one
20 : !! found by abinit for the same cutoff and Bravais lattice (actually it might be smaller).
21 : !!
22 : !! Description of the input file (Fortran NAMELIST):
23 : !!
24 : !! &CONTROL
25 : !! tasks = string specifying the tasks to perform i.e. the routines that should be tested or profiled.
26 : !! allowed values:
27 : !! fourdp --> Test FFT transforms of density and potentials on the full box.
28 : !! fourwf --> Test FFT transforms of wavefunctions using the zero-padded algorithm.
29 : !! gw_fft --> Test the FFT transforms used in the GW code.
30 : !! all --> Test all FFT routines (DEFAULT)
31 : !! fftalgs = list of fftalg values (used to select the FFT libraries to use, see abinit doc for more info)
32 : !! gpu_options = for each fftalg in fftalgs, it is set to 0 if the GPU version doesnt have
33 : !! to be used, or to the value selecting the GPU implementation (see defs_basis.F90)
34 : !! ncalls = integer defining the number of calls for each tests. The final Wall time and CPU time
35 : !! are computed by averaging the final results over ncalls executions.
36 : !! max_nthreads = Maximum number of threads (DEFAULT 1, meaningful only if the code
37 : !! uses threaded external libraries or OpenMP parallelization)
38 : !! ndat = integer specifying how many FFT transforms should be executed for each call to the FFT routine
39 : !! (same meaning as the ndat input variable passed to fourwf)
40 : !! necut = Used if tasks = "bench". Specifies the number of cutoff energies to profile (see also ecut_arth)
41 : !! ecut_arth = Used if tasks = "bench". Used to generate an arithmetic progression of cutoff energies
42 : !! whose starting value is ecut_arth(1) and whose step is ecut_arth(2)
43 : !!
44 : !! &SYSTEM
45 : !! ecut = cutoff energy for wavefunctions (real, Hartree units)
46 : !! rprimd = Direct lattice vectors in Bohr. (3,3) matrix in Fortran column-major order
47 : !! kpoint = real(3) vector specifying the reduced coordinates of the k-point of the wavefunction (used if tasks = "fourwf").
48 : !! The value of the k-point defines the storage scheme (istwfk) of the u(G) coefficients and therefore
49 : !! the FFT algorithm used to perform the transform u(G) <--> u(R) in fourwf.
50 : !! osc_ecut = cutoff energy (Hartree) for the oscillator matrix elements computed in the GW code
51 : !! Corresponds to the input variables (ecuteps, ecutsigx) used in the main code.
52 : !! nsym =Number of symmetry operations (DEFAULT 1)
53 : !! symrel(3,3,nsym) = Symmetry operation in real space used to select
54 : !! the FFT mesh in the routine getng (default: Identity matrix)
55 : !! NOTE that the real tnons is not taken into account anyhow: tnons is set to zero.
56 : !!
57 : !! SOURCE
58 :
59 : #if defined HAVE_CONFIG_H
60 : #include "config.h"
61 : #endif
62 :
63 : #include "abi_common.h"
64 :
65 38 : program fftprof
66 :
67 38 : use defs_basis
68 : use m_xmpi
69 : use m_xomp
70 : use m_errors
71 : use m_abicore
72 : use m_dfti
73 : use m_abi_linalg
74 : #ifdef HAVE_GPU_CUDA
75 : use m_gpu_toolbox
76 : use m_manage_cuda
77 : #endif
78 :
79 : use defs_abitypes, only : MPI_type
80 : use m_build_info, only : abinit_version
81 : use m_fstrings, only : lower
82 : use m_specialmsg, only : specialmsg_getcount, herald
83 : use m_argparse, only : get_arg !, get_arg_list, get_start_step_num
84 : use m_io_tools, only : flush_unit
85 : use m_geometry, only : metric
86 : use m_fftcore, only : get_cache_kb, get_kg, fftalg_isavailable, fftalg_has_mpi, getng, fftcore_set_mixprec
87 : use m_fft, only : fft_use_lib_threads, fftbox_utests, fftu_utests, fftbox_mpi_utests, fftu_mpi_utests, uplan_utests
88 : use m_fftw3, only : fftw3_init_threads
89 : use m_fft_prof, only : fft_test_t, fft_prof_t, fft_tests_free, fftprof_ncalls_per_test, fftprofs_free, &
90 : fftprofs_print, prof_fourdp, prof_fourwf, prof_rhotwg
91 : use m_mpinfo, only : destroy_mpi_enreg, initmpi_seq
92 :
93 : implicit none
94 :
95 : !Arguments -----------------------------------
96 : !scalars
97 : integer,parameter :: MAX_NFFTALGS = 50, MAX_NSYM = 48, wfoptalg = 4
98 : integer,parameter :: paral_kgb0 = 0, me_fft0 = 0, nproc_fft1 = 1, master = 0, np_slk1 = 1, use_slk0 = 0
99 : integer :: ii,fftcache,it,cplex,ntests,option_fourwf,osc_npw, linalg_max_size
100 : integer :: map2sphere,use_padfft,isign,nthreads,comm,nprocs,my_rank
101 : integer :: iset,iall,inplace,nsets,avail,ith,idx,ut_nfft,ut_mgfft
102 : integer :: nfftalgs,alg,fftalg,fftalga,fftalgc,nfailed,ierr,paral_kgb,abimem_level
103 : character(len=24) :: codename
104 : character(len=500) :: header,msg
105 : real(dp),parameter :: boxcutmin2 = two
106 : real(dp) :: ucvol, abimem_limit_mb
107 : logical :: test_fourdp,test_fourwf,test_gw,do_seq_bench,do_seq_utests
108 : logical :: iam_master,do_mpi_utests !,do_mpi_bench,
109 38 : type(MPI_type) :: MPI_enreg
110 : !arrays
111 : integer :: ut_ngfft(18)
112 : #ifdef HAVE_GPU_CUDA
113 : integer :: gpu_devices(12)
114 : #endif
115 : real(dp),parameter :: gamma_point(3) = zero
116 : real(dp) :: gmet(3,3),gprimd(3,3),rmet(3,3)
117 38 : type(FFT_test_t),allocatable :: Ftest(:)
118 38 : type(FFT_prof_t),allocatable :: Ftprof(:)
119 38 : integer,allocatable :: osc_gvec(:,:), fft_setups(:,:),fourwf_params(:,:)
120 : ! ========== INPUT FILE ==============
121 : integer :: ncalls = 10, max_nthreads = 1, ndat = 1, necut = 0, nsym = 1
122 : integer :: mixprec = 0, gpu_option = 0, init_gpu_flavor
123 : character(len=500) :: tasks="all"
124 : integer :: fftalgs(MAX_NFFTALGS) = 0, gpu_options(MAX_NFFTALGS) = 0
125 : integer :: symrel(3,3,MAX_NSYM) = 0
126 : real(dp),parameter :: k0(3) = zero
127 : real(dp) :: ecut = 30, osc_ecut = 3
128 : real(dp) :: ecut_arth(2) = zero, rprimd(3,3)
129 : real(dp) :: kpoint(3) = [0.1,0.2,0.3], tnons(3,MAX_NSYM) = zero
130 : logical :: use_lib_threads = .FALSE.
131 : namelist /CONTROL/ tasks, ncalls, max_nthreads, ndat, fftalgs, gpu_options, &
132 : necut, ecut_arth, use_lib_threads, mixprec
133 : namelist /SYSTEM/ ecut, rprimd, kpoint, osc_ecut, nsym, symrel
134 : ! *************************************************************************
135 :
136 : ! Change communicator for I/O (mandatory!)
137 38 : call abi_io_redirect(new_io_comm=xmpi_world)
138 :
139 38 : call xmpi_init()
140 38 : comm = xmpi_world
141 38 : my_rank = xmpi_comm_rank(comm); nprocs = xmpi_comm_size(comm)
142 38 : iam_master = (my_rank == master)
143 :
144 : ! Initialize memory profiling if it is activated
145 : ! if a full abimem.mocc report is desired, set the argument of abimem_init to "2" instead of "0"
146 : ! note that abimem.mocc files can easily be multiple GB in size so don't use this option normally
147 38 : ABI_CHECK(get_arg("abimem-level", abimem_level, msg, default=0) == 0, msg)
148 38 : ABI_CHECK(get_arg("abimem-limit-mb", abimem_limit_mb, msg, default=20.0_dp) == 0, msg)
149 : #ifdef HAVE_MEM_PROFILING
150 : call abimem_init(abimem_level, limit_mb=abimem_limit_mb)
151 : #endif
152 :
153 38 : if (iam_master) then
154 : ! Print header and read input file.
155 38 : codename='FFTPROF'//REPEAT(' ',17)
156 38 : call herald(codename,abinit_version,std_out)
157 :
158 38 : write(std_out,'(a)')" Tool for profiling and testing the FFT libraries used in ABINIT."
159 38 : write(std_out,'(a)')" Allowed options are: "
160 38 : write(std_out,'(a)')" fourdp --> Test FFT transforms of density and potentials on the full box."
161 38 : write(std_out,'(a)')" fourwf --> Test FFT transforms of wavefunctions using the zero-pad algorithm."
162 38 : write(std_out,'(a)')" gw_fft --> Test the FFT transforms used in the GW code."
163 38 : write(std_out,'(a)')" all --> Test all FFT routines."
164 : !write(std_out,'(a)')" seq-utests --> Units tests for sequential FFTs."
165 : !write(std_out,'(a)')" mpi-utests --> Units tests for MPI FFTs."
166 : !write(std_out,'(a)')" seq-bench --> Benchmark mode for sequential FFTs."
167 : !write(std_out,'(a)')" mpi-bench --> Benchmark mode for MPI FFTs."
168 38 : write(std_out,'(a)')" "
169 :
170 : !Read input file
171 38 : read(std_in, NML=CONTROL)
172 38 : read(std_in, NML=SYSTEM)
173 : !write(std_out, NML=CONTROL)
174 : !write(std_out, NML=SYSTEM)
175 38 : call lower(tasks)
176 : end if
177 :
178 : ! Broadcast variables.
179 38 : if (nprocs > 1) then
180 : ! CONTROL
181 0 : call xmpi_bcast(tasks,master,comm,ierr)
182 0 : call xmpi_bcast(ncalls,master,comm,ierr)
183 0 : call xmpi_bcast(max_nthreads,master,comm,ierr)
184 0 : call xmpi_bcast(ndat,master,comm,ierr)
185 0 : call xmpi_bcast(fftalgs,master,comm,ierr)
186 0 : call xmpi_bcast(gpu_options,master,comm,ierr)
187 0 : call xmpi_bcast(necut,master,comm,ierr)
188 0 : call xmpi_bcast(ecut_arth,master,comm,ierr)
189 0 : call xmpi_bcast(use_lib_threads,master,comm,ierr)
190 0 : call xmpi_bcast(mixprec,master,comm,ierr)
191 : ! SYSTEM
192 0 : call xmpi_bcast(ecut,master,comm,ierr)
193 0 : call xmpi_bcast(rprimd,master,comm,ierr)
194 0 : call xmpi_bcast(kpoint,master,comm,ierr)
195 0 : call xmpi_bcast(osc_ecut,master,comm,ierr)
196 0 : call xmpi_bcast(nsym,master,comm,ierr)
197 0 : call xmpi_bcast(symrel,master,comm,ierr)
198 : end if
199 :
200 : ! Set precision for FFT libs.
201 38 : ii = fftcore_set_mixprec(mixprec)
202 :
203 : ! replace "+" with white spaces
204 282 : do ii=1,LEN_TRIM(tasks)
205 282 : if (tasks(ii:ii) == "+") tasks(ii:ii) = " "
206 : end do
207 : !%call str_replace_chars(tasks,"+"," ")
208 38 : tasks = " "//TRIM(tasks)//""
209 :
210 38 : iall=INDEX (tasks,"all")
211 38 : test_fourdp = (iall>0 .or. INDEX(tasks," fourdp")>0 )
212 38 : test_fourwf = (iall>0 .or. INDEX(tasks," fourwf")>0 )
213 38 : test_gw = (iall>0 .or. INDEX(tasks," gw_fft")>0 )
214 :
215 38 : do_seq_utests = INDEX(tasks," utests") >0
216 38 : do_seq_bench = INDEX(tasks," bench") >0
217 38 : do_mpi_utests = INDEX(tasks," mpi-utests")>0
218 : !do_mpi_bench = INDEX(tasks," mpi-bench")>0
219 :
220 : #ifdef HAVE_FFTW3_THREADS
221 : call fftw3_init_threads()
222 : #endif
223 :
224 : #ifndef HAVE_OPENMP
225 38 : ABI_CHECK(max_nthreads <= 1, "nthreads>1 but OMP support is not enabled!")
226 : #endif
227 38 : if (max_nthreads>1 .and. iam_master) call xomp_show_info(std_out)
228 :
229 38 : call fft_use_lib_threads(use_lib_threads)
230 : !write(std_out,*)"use_lib_threads: ",use_lib_threads
231 :
232 1938 : init_gpu_flavor = maxval(gpu_options)
233 : #if defined HAVE_GPU_CUDA
234 : if (init_gpu_flavor /= ABI_GPU_DISABLED) then
235 : gpu_devices(:)=-1
236 : call setdevice_cuda(gpu_devices, init_gpu_flavor)
237 : ABI_CHECK(init_gpu_flavor /= ABI_GPU_DISABLED, "Cannot find any free GPU device!")
238 : ! Cublas initialization
239 : call gpu_linalg_init()
240 : end if
241 : #endif
242 :
243 : ! linalg initialisation (required by subdiago)
244 38 : linalg_max_size = 1
245 : !call abi_linalg_init(linalg_max_size, RUNL_GSTATE, wfoptalg, paral_kgb0,&
246 : ! init_gpu_flavor, use_slk0, np_slk1, xmpi_comm_self)
247 :
248 38 : if (do_mpi_utests) then
249 : ! Execute unit tests for MPI FFTs and terminate execution.
250 4 : call wrtout(std_out, "=== MPI FFT Unit Tests ===")
251 :
252 : ! List the FFT libraries that will be tested.
253 : ! Goedecker FFTs are always available, other libs are optional.
254 204 : nfftalgs = COUNT(fftalgs /= 0)
255 4 : ABI_CHECK(nfftalgs > 0, "fftalgs must be specified")
256 :
257 4 : nfailed = 0; nthreads = 0
258 12 : do ii=1,nfftalgs
259 8 : fftalg = fftalgs(ii); gpu_option = gpu_options(ii)
260 20 : do paral_kgb=1,1
261 : write(msg,"(5(a,i0))")&
262 8 : "MPI fftu_utests with fftalg = ",fftalg,", paral_kgb = ",paral_kgb," ndat = ",ndat,", nthreads = ",nthreads
263 8 : call wrtout(std_out, msg)
264 16 : nfailed = nfailed + fftu_mpi_utests(fftalg,ecut,rprimd,ndat,nthreads,comm,paral_kgb)
265 : end do
266 : end do
267 :
268 4 : nfailed = 0; nthreads = 0
269 12 : do ii=1,nfftalgs
270 8 : fftalg = fftalgs(ii); gpu_option = gpu_options(ii)
271 28 : do cplex=1,2
272 : write(msg,"(4(a,i0))")&
273 16 : "MPI fftbox_utests with fftalg = ",fftalg,", cplex = ",cplex," ndat = ",ndat,", nthreads = ",nthreads
274 16 : call wrtout(std_out, msg)
275 24 : nfailed = nfailed + fftbox_mpi_utests(fftalg=fftalg,cplex=cplex,ndat=ndat,nthreads=nthreads,comm_fft=comm)
276 : end do
277 : end do
278 :
279 4 : write(msg,'(a,i0)')"Total number of failed tests = ",nfailed
280 4 : call wrtout(std_out, msg)
281 4 : goto 100 ! Jump to xmpi_end
282 : end if
283 :
284 34 : call initmpi_seq(MPI_enreg)
285 34 : call metric(gmet,gprimd,std_out,rmet,rprimd,ucvol)
286 :
287 : ! symmetries (if given) are used for defining the FFT mesh.
288 21250 : if (nsym==1 .and. ALL(symrel==0)) then
289 442 : symrel(:,:,1) = RESHAPE([1,0,0,0,1,0,0,0,1], [3,3])
290 : end if
291 :
292 : ! Set the number of calls for test.
293 34 : ncalls=ABS(ncalls); if (ncalls==0) ncalls=10
294 34 : call fftprof_ncalls_per_test(ncalls)
295 :
296 : ! List the FFT libraries that will be tested.
297 : ! Goedecker FFTs are always available, other libs are optional.
298 1734 : nfftalgs = count(fftalgs /= 0)
299 34 : ABI_CHECK(nfftalgs > 0, "fftalgs must be specified")
300 :
301 34 : ntests = max_nthreads * nfftalgs
302 :
303 : ! First dimension contains [fftalg, fftcache, ndat, nthreads, available, gpu_option]
304 34 : ABI_MALLOC(fft_setups, (6, ntests))
305 :
306 : ! Default Goedecker library.
307 34 : idx=0
308 230 : do alg=1,nfftalgs
309 196 : fftalg = fftalgs(alg); gpu_option = gpu_options(alg)
310 196 : fftalga = fftalg/100; fftalgc = mod(fftalg, 10)
311 196 : avail = merge(1, 0, fftalg_isavailable(fftalg))
312 : !fftcache is machine-dependent.
313 196 : fftcache = get_cache_kb()
314 426 : do ith=1,max_nthreads
315 196 : idx = idx + 1
316 1568 : fft_setups(:,idx) = [fftalg, fftcache, ndat, ith, avail, gpu_option]
317 : end do
318 : end do
319 :
320 : ! Init Ftest objects.
321 944 : ABI_MALLOC(Ftest, (ntests))
322 230 : ABI_MALLOC(Ftprof, (ntests))
323 :
324 230 : do it=1,ntests
325 196 : call Ftest(it)%init(fft_setups(:,it), kpoint, ecut, boxcutmin2, rprimd, nsym, symrel, MPI_enreg)
326 : ! Ftest%results is allocated using nfftot and the consistency btw libs is tested assuming an equal number of FFT-points.
327 784 : if ( ANY(Ftest(it)%ngfft(1:3) /= Ftest(1)%ngfft(1:3)) ) then
328 0 : ABI_ERROR("Consistency check assumes equal FFT meshes. Cannot continue")
329 : end if
330 230 : if (it == 1) then
331 34 : call Ftest(it)%print() !,header)
332 162 : else if (fft_setups(1,it) /= fft_setups(1,it-1)) then
333 162 : call Ftest(it)%print() !,header)
334 : end if
335 : end do
336 :
337 : ! =======================
338 : ! ==== fourdp timing ====
339 : ! =======================
340 34 : if (test_fourdp) then
341 6 : do isign=-1,1,2
342 14 : do cplex=1,2
343 40 : do it=1,ntests
344 40 : call Ftest(it)%time_fourdp(isign, cplex, header, Ftprof(it))
345 : end do
346 8 : call fftprofs_print(Ftprof, header)
347 12 : call fftprofs_free(Ftprof)
348 : end do
349 : end do
350 : end if
351 :
352 : ! =======================
353 : ! ==== fourwf timing ====
354 : ! =======================
355 34 : if (test_fourwf) then
356 : ! possible combinations of (option, cplex) supported in fourwf.
357 : ! (cplex=2 only allowed for option=2, and istwf_k=1)
358 22 : nsets=4; if (Ftest(1)%istwf_k==1) nsets=5
359 22 : ABI_MALLOC(fourwf_params,(2,nsets))
360 66 : fourwf_params(:,1) = [0, 0]
361 66 : fourwf_params(:,2) = [1, 1]
362 66 : fourwf_params(:,3) = [2, 1]
363 66 : fourwf_params(:,4) = [3, 0]
364 30 : if (nsets==5) fourwf_params(:,5) = [2, 2]
365 :
366 114 : do iset=1,nsets
367 92 : option_fourwf = fourwf_params(1,iset)
368 92 : cplex = fourwf_params(2,iset)
369 818 : do it=1,ntests
370 818 : call Ftest(it)%time_fourwf(cplex, option_fourwf, header, Ftprof(it))
371 : end do
372 92 : call fftprofs_print(Ftprof, header)
373 114 : call fftprofs_free(Ftprof)
374 : end do
375 22 : ABI_FREE(fourwf_params)
376 : end if
377 :
378 : ! ==========================
379 : ! ==== Test GW routines ====
380 : ! ==========================
381 : ! These routines are used in the GW part, FFTW3 is expected to
382 : ! be more efficient as the conversion complex(:) <--> real(2,:) is not needed.
383 34 : if (test_gw) then
384 :
385 : ! fourdp timing with complex arrays
386 6 : do isign=-1,1,2
387 14 : do inplace=0,1
388 32 : do it=1,ntests
389 32 : call Ftest(it)%time_fftbox(isign, inplace, header, Ftprof(it))
390 : end do
391 8 : call fftprofs_print(Ftprof, header)
392 12 : call fftprofs_free(Ftprof)
393 : end do
394 : end do
395 :
396 : ! zero padded FFTs with complex arrays
397 6 : do isign=-1,1,2
398 16 : do it=1,ntests
399 16 : call Ftest(it)%time_fftu(isign, header, Ftprof(it))
400 : end do
401 4 : call fftprofs_print(Ftprof, header)
402 6 : call fftprofs_free(Ftprof)
403 : end do
404 :
405 : ! rho_tw_g timing
406 2 : ABI_CHECK(osc_ecut > zero, "osc_ecut <= zero!")
407 :
408 2 : call get_kg(gamma_point,1,osc_ecut,gmet,osc_npw,osc_gvec)
409 : ! TODO should reorder by shells to be consistent with the GW part!
410 : ! Moreover I guess this ordering is more efficient when we have
411 : ! to map the box to the G-sphere!
412 2 : map2sphere=1; !map2sphere=0
413 :
414 6 : do use_padfft=0,1
415 16 : do it=1,ntests
416 16 : call Ftest(it)%time_rhotwg(map2sphere, use_padfft, osc_npw, osc_gvec, header, Ftprof(it))
417 : end do
418 4 : call fftprofs_print(Ftprof, header)
419 6 : call fftprofs_free(Ftprof)
420 : end do
421 :
422 2 : ABI_FREE(osc_gvec)
423 : end if ! test_gw
424 :
425 34 : if (do_seq_utests) then
426 8 : call wrtout(std_out, "=== FFT Unit Tests ===")
427 8 : nfailed = 0
428 16 : do idx=1,ntests
429 : ! fft_setups(:,idx) = [fftalg,fftcache,ndat,ith,avail,gpu_option]
430 8 : fftalg = fft_setups(1, idx)
431 8 : fftcache = fft_setups(2, idx)
432 8 : ndat = fft_setups(3, idx)
433 8 : nthreads = fft_setups(4, idx)
434 : ! Skip the test if library is not available.
435 8 : if (fft_setups(5, idx) == 0) CYCLE
436 8 : gpu_option = fft_setups(6, idx)
437 :
438 8 : write(msg,"(3(a,i0))")"fftbox_utests with fftalg = ",fftalg,", ndat = ",ndat,", nthreads = ",nthreads
439 : !write(msg,"(4(a,i0))")"fftbox_utests with fftalg = ",fftalg,", ndat = ",ndat,", nthreads = ",nthreads, ", gpu_option = ", gpu_option
440 8 : call wrtout(std_out, msg)
441 8 : nfailed = nfailed + fftbox_utests(fftalg, ndat, nthreads, gpu_option)
442 :
443 : ! Initialize ngfft(7:8) here.
444 152 : ut_ngfft = -1
445 8 : ut_ngfft(7) = fftalg
446 8 : ut_ngfft(8) = fftcache
447 :
448 : call getng(boxcutmin2,0,ecut,gmet,k0,me_fft0,ut_mgfft,ut_nfft,ut_ngfft,nproc_fft1,nsym,&
449 8 : paral_kgb0,symrel,tnons, unit=dev_null, gpu_option=gpu_option)
450 :
451 8 : write(msg,"(3(a,i0))")"fftu_utests with fftalg = ",fftalg,", ndat = ",ndat,", nthreads = ",nthreads
452 : !write(msg,"(4(a,i0))")"fftu_utests with fftalg = ",fftalg,", ndat = ",ndat,", nthreads = ",nthreads, ", gpu_option = ", gpu_option
453 8 : call wrtout(std_out, msg)
454 16 : nfailed = nfailed + fftu_utests(ecut, ut_ngfft, rprimd, ndat, nthreads)
455 :
456 : !write(msg,"(4(a,i0))")"uplan_utests with fftalg = ",fftalg,", ndat = ",ndat,", nthreads = ",nthreads, ", gpu_option = ", gpu_option
457 : !call wrtout(std_out, msg)
458 : !nfailed = nfailed + uplan_utests(ecut, ut_ngfft, rprimd, ndat, nthreads, gpu_option)
459 : end do
460 :
461 8 : write(msg,'(a,i0)')"Total number of failed tests = ",nfailed
462 8 : call wrtout(std_out, msg)
463 : end if
464 :
465 : ! Benchmarks for the sequential version.
466 34 : if (do_seq_bench) then
467 0 : call wrtout(std_out, "Entering benchmark mode")
468 0 : write(std_out,*)"ecut_arth",ecut_arth,", necut ",necut
469 :
470 0 : if (INDEX(tasks, "bench_fourdp") > 0) then
471 0 : isign=1; cplex=1
472 0 : call prof_fourdp(fft_setups, isign, cplex, necut, ecut_arth, boxcutmin2, rprimd, nsym, symrel, MPI_enreg)
473 :
474 0 : isign=1; cplex=2
475 0 : call prof_fourdp(fft_setups, isign, cplex, necut, ecut_arth, boxcutmin2, rprimd, nsym, symrel, MPI_enreg)
476 : end if
477 :
478 0 : if (INDEX(tasks, "bench_fourwf") > 0) then
479 0 : cplex=2; option_fourwf=0
480 0 : call prof_fourwf(fft_setups,cplex,option_fourwf,kpoint,necut,ecut_arth,boxcutmin2,rprimd,nsym,symrel,MPI_enreg)
481 :
482 0 : cplex=1; option_fourwf=1
483 0 : call prof_fourwf(fft_setups,cplex,option_fourwf,kpoint,necut,ecut_arth,boxcutmin2,rprimd,nsym,symrel,MPI_enreg)
484 :
485 0 : cplex=1; option_fourwf=2
486 0 : call prof_fourwf(fft_setups,cplex,option_fourwf,kpoint,necut,ecut_arth,boxcutmin2,rprimd,nsym,symrel,MPI_enreg)
487 :
488 0 : cplex=2; option_fourwf=2
489 0 : call prof_fourwf(fft_setups,cplex,option_fourwf,kpoint,necut,ecut_arth,boxcutmin2,rprimd,nsym,symrel,MPI_enreg)
490 :
491 0 : cplex=0; option_fourwf=3
492 0 : call prof_fourwf(fft_setups,cplex,option_fourwf,kpoint,necut,ecut_arth,boxcutmin2,rprimd,nsym,symrel,MPI_enreg)
493 : end if
494 :
495 0 : if (INDEX(tasks, "bench_rhotwg") > 0) then
496 0 : map2sphere = 1; use_padfft = 1
497 : call prof_rhotwg(fft_setups,map2sphere,use_padfft,necut,ecut_arth,osc_ecut,boxcutmin2,&
498 0 : rprimd,nsym,symrel,gmet,MPI_enreg)
499 :
500 0 : map2sphere = 1; use_padfft = 0
501 : call prof_rhotwg(fft_setups,map2sphere,use_padfft,necut,ecut_arth,osc_ecut,boxcutmin2,&
502 0 : rprimd,nsym,symrel,gmet,MPI_enreg)
503 : end if
504 : end if
505 :
506 : !===============================
507 : !=== End of run, free memory ===
508 : !===============================
509 34 : call wrtout(std_out,ch10//" Analysis completed.")
510 :
511 34 : ABI_FREE(fft_setups)
512 34 : call fft_tests_free(Ftest)
513 264 : ABI_FREE(Ftest)
514 34 : call fftprofs_free(Ftprof)
515 264 : ABI_FREE(Ftprof)
516 34 : call destroy_mpi_enreg(MPI_enreg)
517 :
518 : !call abi_linalg_finalize(init_gpu_flavor)
519 :
520 : #if defined HAVE_GPU_CUDA
521 : if (init_gpu_flavor /= ABI_GPU_DISABLED) then
522 : call gpu_linalg_shutdown()
523 : call unsetdevice_cuda(init_gpu_flavor)
524 : end if
525 : #endif
526 :
527 34 : call flush_unit(std_out)
528 34 : call abinit_doctor("__fftprof")
529 38 : 100 call xmpi_end()
530 :
531 34 : end program fftprof
532 : !!***
|
