Branch data 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 : : !!***
|
