Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Performance tests for basic tasks like matrix multiplies, copy, fft.
10 : !> \par History
11 : !> 30-Nov-2000 (JGH) added input
12 : !> 02-Jan-2001 (JGH) Parallel FFT
13 : !> 28-Feb-2002 (JGH) Clebsch-Gordon Coefficients
14 : !> 06-Jun-2003 (JGH) Real space grid test
15 : !> Eigensolver test (29.08.05,MK)
16 : !> \author JGH 6-NOV-2000
17 : ! **************************************************************************************************
18 : MODULE library_tests
19 :
20 : USE ai_coulomb_test, ONLY: eri_test
21 : USE cell_methods, ONLY: cell_create,&
22 : init_cell
23 : USE cell_types, ONLY: cell_release,&
24 : cell_type
25 : USE cg_test, ONLY: clebsch_gordon_test
26 : USE cp_blacs_env, ONLY: cp_blacs_env_create,&
27 : cp_blacs_env_release,&
28 : cp_blacs_env_type
29 : USE cp_dbcsr_api, ONLY: dbcsr_reset_randmat_seed,&
30 : dbcsr_run_tests
31 : USE cp_eri_mme_interface, ONLY: cp_eri_mme_perf_acc_test
32 : USE cp_files, ONLY: close_file,&
33 : open_file
34 : USE cp_fm_basic_linalg, ONLY: cp_fm_gemm
35 : USE cp_fm_diag, ONLY: cp_fm_syevd,&
36 : cp_fm_syevx
37 : USE cp_fm_struct, ONLY: cp_fm_struct_create,&
38 : cp_fm_struct_get,&
39 : cp_fm_struct_release,&
40 : cp_fm_struct_type
41 : USE cp_fm_types, ONLY: cp_fm_create,&
42 : cp_fm_pilaenv,&
43 : cp_fm_release,&
44 : cp_fm_set_all,&
45 : cp_fm_set_submatrix,&
46 : cp_fm_to_fm,&
47 : cp_fm_type
48 : USE cp_log_handling, ONLY: cp_get_default_logger,&
49 : cp_logger_type
50 : USE cp_output_handling, ONLY: cp_print_key_finished_output,&
51 : cp_print_key_unit_nr
52 : USE cp_realspace_grid_init, ONLY: init_input_type
53 : USE dbm_tests, ONLY: dbm_run_tests
54 : USE fft_tools, ONLY: BWFFT,&
55 : FFT_RADIX_CLOSEST,&
56 : FWFFT,&
57 : fft3d,&
58 : fft_radix_operations,&
59 : finalize_fft,&
60 : init_fft
61 : USE global_types, ONLY: global_environment_type
62 : USE input_constants, ONLY: do_diag_syevd,&
63 : do_diag_syevx,&
64 : do_mat_random,&
65 : do_mat_read,&
66 : do_pwgrid_ns_fullspace,&
67 : do_pwgrid_ns_halfspace,&
68 : do_pwgrid_spherical
69 : USE input_section_types, ONLY: section_vals_get,&
70 : section_vals_get_subs_vals,&
71 : section_vals_type,&
72 : section_vals_val_get
73 : USE kinds, ONLY: dp
74 : USE machine, ONLY: m_flush,&
75 : m_walltime
76 : USE mathconstants, ONLY: gaussi
77 : USE message_passing, ONLY: mp_para_env_type
78 : USE minimax_exp, ONLY: validate_exp_minimax
79 : USE mp2_grids, ONLY: test_least_square_ft
80 : USE mp_perf_test, ONLY: mpi_perf_test
81 : USE parallel_gemm_api, ONLY: parallel_gemm
82 : USE parallel_rng_types, ONLY: UNIFORM,&
83 : rng_stream_type
84 : USE pw_grid_types, ONLY: FULLSPACE,&
85 : HALFSPACE,&
86 : pw_grid_type
87 : USE pw_grids, ONLY: pw_grid_create,&
88 : pw_grid_release
89 : USE pw_methods, ONLY: pw_transfer,&
90 : pw_zero
91 : USE pw_types, ONLY: pw_c1d_gs_type,&
92 : pw_c3d_rs_type,&
93 : pw_r3d_rs_type
94 : USE realspace_grid_types, ONLY: &
95 : realspace_grid_desc_type, realspace_grid_input_type, realspace_grid_type, rs_grid_create, &
96 : rs_grid_create_descriptor, rs_grid_print, rs_grid_release, rs_grid_release_descriptor, &
97 : rs_grid_zero, transfer_pw2rs, transfer_rs2pw
98 : USE shg_integrals_test, ONLY: shg_integrals_perf_acc_test
99 : #include "./base/base_uses.f90"
100 :
101 : IMPLICIT NONE
102 :
103 : PRIVATE
104 : PUBLIC :: lib_test
105 :
106 : INTEGER :: runtest(100)
107 : REAL(KIND=dp) :: max_memory
108 : REAL(KIND=dp), PARAMETER :: threshold = 1.0E-8_dp
109 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'library_tests'
110 :
111 : CONTAINS
112 :
113 : ! **************************************************************************************************
114 : !> \brief Master routine for tests
115 : !> \param root_section ...
116 : !> \param para_env ...
117 : !> \param globenv ...
118 : !> \par History
119 : !> none
120 : !> \author JGH 6-NOV-2000
121 : ! **************************************************************************************************
122 720 : SUBROUTINE lib_test(root_section, para_env, globenv)
123 :
124 : TYPE(section_vals_type), POINTER :: root_section
125 : TYPE(mp_para_env_type), POINTER :: para_env
126 : TYPE(global_environment_type), POINTER :: globenv
127 :
128 : CHARACTER(LEN=*), PARAMETER :: routineN = 'lib_test'
129 :
130 : INTEGER :: handle, iw
131 : LOGICAL :: explicit
132 : TYPE(cp_logger_type), POINTER :: logger
133 : TYPE(section_vals_type), POINTER :: cp_dbcsr_test_section, cp_fm_gemm_test_section, &
134 : dbm_test_section, eigensolver_section, eri_mme_test_section, pw_transfer_section, &
135 : rs_pw_transfer_section, shg_integrals_test_section
136 :
137 80 : CALL timeset(routineN, handle)
138 :
139 80 : logger => cp_get_default_logger()
140 80 : iw = cp_print_key_unit_nr(logger, root_section, "TEST%PROGRAM_RUN_INFO", extension=".log")
141 :
142 80 : IF (iw > 0) THEN
143 40 : WRITE (iw, '(T2,79("*"))')
144 40 : WRITE (iw, '(A,T31,A,T80,A)') ' *', ' PERFORMANCE TESTS ', '*'
145 40 : WRITE (iw, '(T2,79("*"))')
146 : END IF
147 : !
148 80 : CALL test_input(root_section, para_env)
149 : !
150 80 : IF (runtest(1) /= 0) CALL copy_test(para_env, iw)
151 : !
152 80 : IF (runtest(2) /= 0) CALL matmul_test(para_env, test_matmul=.TRUE., test_dgemm=.FALSE., iw=iw)
153 80 : IF (runtest(5) /= 0) CALL matmul_test(para_env, test_matmul=.FALSE., test_dgemm=.TRUE., iw=iw)
154 : !
155 80 : IF (runtest(3) /= 0) CALL fft_test(para_env, iw, globenv%fftw_plan_type, &
156 2 : globenv%fftw_wisdom_file_name)
157 : !
158 80 : IF (runtest(4) /= 0) CALL eri_test(iw)
159 : !
160 80 : IF (runtest(6) /= 0) CALL clebsch_gordon_test()
161 : !
162 : ! runtest 7 has been deleted and can be recycled
163 : !
164 80 : IF (runtest(8) /= 0) CALL mpi_perf_test(para_env, runtest(8), iw)
165 : !
166 80 : IF (runtest(10) /= 0) CALL validate_exp_minimax(runtest(10), iw)
167 : !
168 80 : IF (runtest(11) /= 0) CALL test_least_square_ft(runtest(11), iw)
169 : !
170 :
171 80 : rs_pw_transfer_section => section_vals_get_subs_vals(root_section, "TEST%RS_PW_TRANSFER")
172 80 : CALL section_vals_get(rs_pw_transfer_section, explicit=explicit)
173 80 : IF (explicit) THEN
174 2 : CALL rs_pw_transfer_test(para_env, iw, globenv, rs_pw_transfer_section)
175 : END IF
176 :
177 80 : pw_transfer_section => section_vals_get_subs_vals(root_section, "TEST%PW_TRANSFER")
178 80 : CALL section_vals_get(pw_transfer_section, explicit=explicit)
179 80 : IF (explicit) THEN
180 10 : CALL pw_fft_test(para_env, iw, globenv, pw_transfer_section)
181 : END IF
182 :
183 80 : cp_fm_gemm_test_section => section_vals_get_subs_vals(root_section, "TEST%CP_FM_GEMM")
184 80 : CALL section_vals_get(cp_fm_gemm_test_section, explicit=explicit)
185 80 : IF (explicit) THEN
186 4 : CALL cp_fm_gemm_test(para_env, iw, cp_fm_gemm_test_section)
187 : END IF
188 :
189 80 : eigensolver_section => section_vals_get_subs_vals(root_section, "TEST%EIGENSOLVER")
190 80 : CALL section_vals_get(eigensolver_section, explicit=explicit)
191 80 : IF (explicit) THEN
192 2 : CALL eigensolver_test(para_env, iw, eigensolver_section)
193 : END IF
194 :
195 80 : eri_mme_test_section => section_vals_get_subs_vals(root_section, "TEST%ERI_MME_TEST")
196 80 : CALL section_vals_get(eri_mme_test_section, explicit=explicit)
197 80 : IF (explicit) THEN
198 8 : CALL cp_eri_mme_perf_acc_test(para_env, iw, eri_mme_test_section)
199 : END IF
200 :
201 80 : shg_integrals_test_section => section_vals_get_subs_vals(root_section, "TEST%SHG_INTEGRALS_TEST")
202 80 : CALL section_vals_get(shg_integrals_test_section, explicit=explicit)
203 80 : IF (explicit) THEN
204 4 : CALL shg_integrals_perf_acc_test(iw, shg_integrals_test_section)
205 : END IF
206 :
207 : ! DBCSR tests
208 80 : cp_dbcsr_test_section => section_vals_get_subs_vals(root_section, "TEST%CP_DBCSR")
209 80 : CALL section_vals_get(cp_dbcsr_test_section, explicit=explicit)
210 80 : IF (explicit) THEN
211 32 : CALL cp_dbcsr_tests(para_env, iw, cp_dbcsr_test_section)
212 : END IF
213 :
214 : ! DBM tests
215 80 : dbm_test_section => section_vals_get_subs_vals(root_section, "TEST%DBM")
216 80 : CALL section_vals_get(dbm_test_section, explicit=explicit)
217 80 : IF (explicit) THEN
218 14 : CALL run_dbm_tests(para_env, iw, dbm_test_section)
219 : END IF
220 :
221 80 : CALL cp_print_key_finished_output(iw, logger, root_section, "TEST%PROGRAM_RUN_INFO")
222 :
223 80 : CALL timestop(handle)
224 :
225 80 : END SUBROUTINE lib_test
226 :
227 : ! **************************************************************************************************
228 : !> \brief Reads input section &TEST ... &END
229 : !> \param root_section ...
230 : !> \param para_env ...
231 : !> \author JGH 30-NOV-2000
232 : !> \note
233 : !> I---------------------------------------------------------------------------I
234 : !> I SECTION: &TEST ... &END I
235 : !> I I
236 : !> I MEMORY max_memory I
237 : !> I COPY n I
238 : !> I MATMUL n I
239 : !> I FFT n I
240 : !> I ERI n I
241 : !> I PW_FFT n I
242 : !> I Clebsch-Gordon n I
243 : !> I RS_GRIDS n I
244 : !> I MPI n I
245 : !> I RNG n -> Parallel random number generator I
246 : !> I---------------------------------------------------------------------------I
247 : ! **************************************************************************************************
248 160 : SUBROUTINE test_input(root_section, para_env)
249 : TYPE(section_vals_type), POINTER :: root_section
250 : TYPE(mp_para_env_type), POINTER :: para_env
251 :
252 : TYPE(section_vals_type), POINTER :: test_section
253 :
254 : !
255 : !..defaults
256 : ! using this style is not recommended, introduce sections instead (see e.g. cp_fm_gemm)
257 :
258 80 : runtest = 0
259 80 : test_section => section_vals_get_subs_vals(root_section, "TEST")
260 80 : CALL section_vals_val_get(test_section, "MEMORY", r_val=max_memory)
261 80 : CALL section_vals_val_get(test_section, 'COPY', i_val=runtest(1))
262 80 : CALL section_vals_val_get(test_section, 'MATMUL', i_val=runtest(2))
263 80 : CALL section_vals_val_get(test_section, 'DGEMM', i_val=runtest(5))
264 80 : CALL section_vals_val_get(test_section, 'FFT', i_val=runtest(3))
265 80 : CALL section_vals_val_get(test_section, 'ERI', i_val=runtest(4))
266 80 : CALL section_vals_val_get(test_section, 'CLEBSCH_GORDON', i_val=runtest(6))
267 80 : CALL section_vals_val_get(test_section, 'MPI', i_val=runtest(8))
268 80 : CALL section_vals_val_get(test_section, 'MINIMAX', i_val=runtest(10))
269 80 : CALL section_vals_val_get(test_section, 'LEAST_SQ_FT', i_val=runtest(11))
270 :
271 80 : CALL para_env%sync()
272 80 : END SUBROUTINE test_input
273 :
274 : ! **************************************************************************************************
275 : !> \brief Tests the performance to copy two vectors.
276 : !> \param para_env ...
277 : !> \param iw ...
278 : !> \par History
279 : !> none
280 : !> \author JGH 6-NOV-2000
281 : !> \note
282 : !> The results of these tests allow to determine the size of the cache
283 : !> of the CPU. This can be used to optimize the performance of the
284 : !> FFTSG library.
285 : ! **************************************************************************************************
286 2 : SUBROUTINE copy_test(para_env, iw)
287 : TYPE(mp_para_env_type), POINTER :: para_env
288 : INTEGER :: iw
289 :
290 : INTEGER :: i, j, len, ntim, siz
291 : REAL(KIND=dp) :: perf, t, tend, tstart
292 2 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: ca, cb
293 :
294 : ! test for copy --> Cache size
295 :
296 2 : siz = ABS(runtest(1))
297 2 : IF (para_env%is_source()) WRITE (iw, '(//,A,/)') " Test of copy ( F95 ) "
298 34 : DO i = 6, 24
299 34 : len = 2**i
300 34 : IF (8.0_dp*REAL(len, KIND=dp) > max_memory*0.5_dp) EXIT
301 96 : ALLOCATE (ca(len))
302 64 : ALLOCATE (cb(len))
303 :
304 32 : CALL RANDOM_NUMBER(ca)
305 32 : ntim = NINT(1.e7_dp/REAL(len, KIND=dp))
306 32 : ntim = MAX(ntim, 1)
307 32 : ntim = MIN(ntim, siz*10000)
308 :
309 32 : tstart = m_walltime()
310 512524 : DO j = 1, ntim
311 315058412 : cb(:) = ca(:)
312 512524 : ca(1) = REAL(j, KIND=dp)
313 : END DO
314 32 : tend = m_walltime()
315 32 : t = tend - tstart + threshold
316 32 : IF (t > 0.0_dp) THEN
317 32 : perf = REAL(ntim, KIND=dp)*REAL(len, KIND=dp)*1.e-6_dp/t
318 : ELSE
319 0 : perf = 0.0_dp
320 : END IF
321 :
322 32 : IF (para_env%is_source()) THEN
323 16 : WRITE (iw, '(A,i2,i10,A,T59,F14.4,A)') " Copy test: Size = 2^", i, &
324 32 : len/1024, " Kwords", perf, " Mcopy/s"
325 : END IF
326 :
327 32 : DEALLOCATE (ca)
328 34 : DEALLOCATE (cb)
329 : END DO
330 2 : CALL para_env%sync()
331 2 : END SUBROUTINE copy_test
332 :
333 : ! **************************************************************************************************
334 : !> \brief Tests the performance of different kinds of matrix matrix multiply
335 : !> kernels for the BLAS and F95 intrinsic matmul.
336 : !> \param para_env ...
337 : !> \param test_matmul ...
338 : !> \param test_dgemm ...
339 : !> \param iw ...
340 : !> \par History
341 : !> none
342 : !> \author JGH 6-NOV-2000
343 : ! **************************************************************************************************
344 2 : SUBROUTINE matmul_test(para_env, test_matmul, test_dgemm, iw)
345 : TYPE(mp_para_env_type), POINTER :: para_env
346 : LOGICAL :: test_matmul, test_dgemm
347 : INTEGER :: iw
348 :
349 : INTEGER :: i, j, len, ntim, siz
350 : REAL(KIND=dp) :: perf, t, tend, tstart, xdum
351 2 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: ma, mb, mc
352 :
353 : ! test for matrix multpies
354 :
355 2 : IF (test_matmul) THEN
356 2 : siz = ABS(runtest(2))
357 2 : IF (para_env%is_source()) WRITE (iw, '(//,A,/)') " Test of matmul ( F95 ) "
358 2 : DO i = 5, siz, 2
359 4 : len = 2**i + 1
360 4 : IF (8.0_dp*REAL(len*len, KIND=dp) > max_memory*0.3_dp) EXIT
361 16 : ALLOCATE (ma(len, len))
362 12 : ALLOCATE (mb(len, len))
363 12 : ALLOCATE (mc(len, len))
364 4 : mc = 0.0_dp
365 :
366 4 : CALL RANDOM_NUMBER(xdum)
367 35788 : ma = xdum
368 4 : CALL RANDOM_NUMBER(xdum)
369 35788 : mb = xdum
370 4 : ntim = NINT(1.e8_dp/(2.0_dp*REAL(len, KIND=dp)**3))
371 4 : ntim = MAX(ntim, 1)
372 4 : ntim = MIN(ntim, siz*200)
373 4 : tstart = m_walltime()
374 2832 : DO j = 1, ntim
375 2828 : mc(:, :) = MATMUL(ma, mb)
376 2832 : ma(1, 1) = REAL(j, KIND=dp)
377 : END DO
378 4 : tend = m_walltime()
379 4 : t = tend - tstart + threshold
380 4 : perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t
381 4 : IF (para_env%is_source()) THEN
382 : WRITE (iw, '(A,i6,T59,F14.4,A)') &
383 2 : " Matrix multiply test: c = a * b Size = ", len, perf, " Mflop/s"
384 : END IF
385 4 : tstart = m_walltime()
386 2832 : DO j = 1, ntim
387 3895652 : mc(:, :) = mc + MATMUL(ma, mb)
388 2832 : ma(1, 1) = REAL(j, KIND=dp)
389 : END DO
390 4 : tend = m_walltime()
391 4 : t = tend - tstart + threshold
392 4 : IF (t > 0.0_dp) THEN
393 4 : perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t
394 : ELSE
395 0 : perf = 0.0_dp
396 : END IF
397 :
398 4 : IF (para_env%is_source()) THEN
399 : WRITE (iw, '(A,i6,T59,F14.4,A)') &
400 2 : " Matrix multiply test: a = a * b Size = ", len, perf, " Mflop/s"
401 : END IF
402 :
403 4 : tstart = m_walltime()
404 2832 : DO j = 1, ntim
405 3895652 : mc(:, :) = mc + MATMUL(ma, TRANSPOSE(mb))
406 2832 : ma(1, 1) = REAL(j, KIND=dp)
407 : END DO
408 4 : tend = m_walltime()
409 4 : t = tend - tstart + threshold
410 4 : IF (t > 0.0_dp) THEN
411 4 : perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t
412 : ELSE
413 0 : perf = 0.0_dp
414 : END IF
415 :
416 4 : IF (para_env%is_source()) THEN
417 : WRITE (iw, '(A,i6,T59,F14.4,A)') &
418 2 : " Matrix multiply test: c = a * b(T) Size = ", len, perf, " Mflop/s"
419 : END IF
420 :
421 4 : tstart = m_walltime()
422 2832 : DO j = 1, ntim
423 3895652 : mc(:, :) = mc + MATMUL(TRANSPOSE(ma), mb)
424 2832 : ma(1, 1) = REAL(j, KIND=dp)
425 : END DO
426 4 : tend = m_walltime()
427 4 : t = tend - tstart + threshold
428 4 : IF (t > 0.0_dp) THEN
429 4 : perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t
430 : ELSE
431 0 : perf = 0.0_dp
432 : END IF
433 :
434 4 : IF (para_env%is_source()) THEN
435 : WRITE (iw, '(A,i6,T59,F14.4,A)') &
436 2 : " Matrix multiply test: c = a(T) * b Size = ", len, perf, " Mflop/s"
437 : END IF
438 :
439 4 : DEALLOCATE (ma)
440 4 : DEALLOCATE (mb)
441 4 : DEALLOCATE (mc)
442 : END DO
443 : END IF
444 :
445 : ! test for matrix multpies
446 2 : IF (test_dgemm) THEN
447 0 : siz = ABS(runtest(5))
448 0 : IF (para_env%is_source()) WRITE (iw, '(//,A,/)') " Test of matmul ( BLAS ) "
449 0 : DO i = 5, siz, 2
450 0 : len = 2**i + 1
451 0 : IF (8.0_dp*REAL(len*len, KIND=dp) > max_memory*0.3_dp) EXIT
452 0 : ALLOCATE (ma(len, len))
453 0 : ALLOCATE (mb(len, len))
454 0 : ALLOCATE (mc(len, len))
455 0 : mc = 0.0_dp
456 :
457 0 : CALL RANDOM_NUMBER(xdum)
458 0 : ma = xdum
459 0 : CALL RANDOM_NUMBER(xdum)
460 0 : mb = xdum
461 0 : ntim = NINT(1.e8_dp/(2.0_dp*REAL(len, KIND=dp)**3))
462 0 : ntim = MAX(ntim, 1)
463 0 : ntim = MIN(ntim, 1000)
464 :
465 0 : tstart = m_walltime()
466 0 : DO j = 1, ntim
467 0 : CALL dgemm("N", "N", len, len, len, 1.0_dp, ma, len, mb, len, 1.0_dp, mc, len)
468 : END DO
469 0 : tend = m_walltime()
470 0 : t = tend - tstart + threshold
471 0 : IF (t > 0.0_dp) THEN
472 0 : perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t
473 : ELSE
474 0 : perf = 0.0_dp
475 : END IF
476 :
477 0 : IF (para_env%is_source()) THEN
478 : WRITE (iw, '(A,i6,T59,F14.4,A)') &
479 0 : " Matrix multiply test: c = a * b Size = ", len, perf, " Mflop/s"
480 : END IF
481 :
482 0 : tstart = m_walltime()
483 0 : DO j = 1, ntim
484 0 : CALL dgemm("N", "N", len, len, len, 1.0_dp, ma, len, mb, len, 1.0_dp, mc, len)
485 : END DO
486 0 : tend = m_walltime()
487 0 : t = tend - tstart + threshold
488 0 : IF (t > 0.0_dp) THEN
489 0 : perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t
490 : ELSE
491 0 : perf = 0.0_dp
492 : END IF
493 :
494 0 : IF (para_env%is_source()) THEN
495 : WRITE (iw, '(A,i6,T59,F14.4,A)') &
496 0 : " Matrix multiply test: a = a * b Size = ", len, perf, " Mflop/s"
497 : END IF
498 :
499 0 : tstart = m_walltime()
500 0 : DO j = 1, ntim
501 0 : CALL dgemm("N", "T", len, len, len, 1.0_dp, ma, len, mb, len, 1.0_dp, mc, len)
502 : END DO
503 0 : tend = m_walltime()
504 0 : t = tend - tstart + threshold
505 0 : IF (t > 0.0_dp) THEN
506 0 : perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t
507 : ELSE
508 0 : perf = 0.0_dp
509 : END IF
510 :
511 0 : IF (para_env%is_source()) THEN
512 : WRITE (iw, '(A,i6,T59,F14.4,A)') &
513 0 : " Matrix multiply test: c = a * b(T) Size = ", len, perf, " Mflop/s"
514 : END IF
515 :
516 0 : tstart = m_walltime()
517 0 : DO j = 1, ntim
518 0 : CALL dgemm("T", "N", len, len, len, 1.0_dp, ma, len, mb, len, 1.0_dp, mc, len)
519 : END DO
520 0 : tend = m_walltime()
521 0 : t = tend - tstart + threshold
522 0 : IF (t > 0.0_dp) THEN
523 0 : perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t
524 : ELSE
525 0 : perf = 0.0_dp
526 : END IF
527 :
528 0 : IF (para_env%is_source()) THEN
529 : WRITE (iw, '(A,i6,T59,F14.4,A)') &
530 0 : " Matrix multiply test: c = a(T) * b Size = ", len, perf, " Mflop/s"
531 : END IF
532 :
533 0 : DEALLOCATE (ma)
534 0 : DEALLOCATE (mb)
535 0 : DEALLOCATE (mc)
536 : END DO
537 : END IF
538 :
539 2 : CALL para_env%sync()
540 :
541 2 : END SUBROUTINE matmul_test
542 :
543 : ! **************************************************************************************************
544 : !> \brief Tests the performance of all available FFT libraries for 3D FFTs
545 : !> \param para_env ...
546 : !> \param iw ...
547 : !> \param fftw_plan_type ...
548 : !> \param wisdom_file where FFTW3 should look to save/load wisdom
549 : !> \par History
550 : !> none
551 : !> \author JGH 6-NOV-2000
552 : ! **************************************************************************************************
553 2 : SUBROUTINE fft_test(para_env, iw, fftw_plan_type, wisdom_file)
554 :
555 : TYPE(mp_para_env_type), POINTER :: para_env
556 : INTEGER :: iw, fftw_plan_type
557 : CHARACTER(LEN=*), INTENT(IN) :: wisdom_file
558 :
559 : INTEGER, PARAMETER :: ndate(3) = [12, 48, 96]
560 :
561 : INTEGER :: iall, it, j, len, n(3), ntim, radix_in, &
562 : radix_out, siz, stat
563 : COMPLEX(KIND=dp), DIMENSION(4, 4, 4) :: zz
564 2 : COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: ca, cb, cc
565 : CHARACTER(LEN=7) :: method
566 : REAL(KIND=dp) :: flops, perf, scale, t, tdiff, tend, &
567 : tstart
568 2 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: ra
569 :
570 : ! test for 3d FFT
571 :
572 2 : IF (para_env%is_source()) WRITE (iw, '(//,A,/)') " Test of 3D-FFT "
573 2 : siz = ABS(runtest(3))
574 :
575 8 : DO iall = 1, 100
576 : SELECT CASE (iall)
577 : CASE DEFAULT
578 2 : EXIT
579 : CASE (1)
580 : CALL init_fft("FFTSG", alltoall=.FALSE., fftsg_sizes=.TRUE., wisdom_file=wisdom_file, &
581 2 : pool_limit=10, plan_style=fftw_plan_type)
582 2 : method = "FFTSG "
583 : CASE (2)
584 2 : CYCLE
585 : CASE (3)
586 : CALL init_fft("FFTW3", alltoall=.FALSE., fftsg_sizes=.TRUE., wisdom_file=wisdom_file, &
587 2 : pool_limit=10, plan_style=fftw_plan_type)
588 10 : method = "FFTW3 "
589 : END SELECT
590 16 : n = 4
591 4 : zz = 0.0_dp
592 4 : CALL fft3d(FWFFT, n, zz, status=stat)
593 4 : IF (stat == 0) THEN
594 16 : DO it = 1, 3
595 12 : radix_in = ndate(it)
596 12 : CALL fft_radix_operations(radix_in, radix_out, FFT_RADIX_CLOSEST)
597 12 : len = radix_out
598 48 : n = len
599 12 : IF (16.0_dp*REAL(len*len*len, KIND=dp) > max_memory*0.5_dp) EXIT
600 60 : ALLOCATE (ra(len, len, len))
601 60 : ALLOCATE (ca(len, len, len))
602 12 : CALL RANDOM_NUMBER(ra)
603 4035516 : ca(:, :, :) = ra
604 12 : CALL RANDOM_NUMBER(ra)
605 4035516 : ca(:, :, :) = ca + gaussi*ra
606 12 : flops = REAL(len**3, KIND=dp)*15.0_dp*LOG(REAL(len, KIND=dp))
607 12 : ntim = NINT(siz*1.e7_dp/flops)
608 12 : ntim = MAX(ntim, 1)
609 12 : ntim = MIN(ntim, 200)
610 12 : scale = 1.0_dp/REAL(len**3, KIND=dp)
611 12 : tstart = m_walltime()
612 884 : DO j = 1, ntim
613 872 : CALL fft3d(FWFFT, n, ca)
614 884 : CALL fft3d(BWFFT, n, ca)
615 : END DO
616 12 : tend = m_walltime()
617 12 : t = tend - tstart + threshold
618 12 : IF (t > 0.0_dp) THEN
619 12 : perf = REAL(ntim, KIND=dp)*2.0_dp*flops*1.e-6_dp/t
620 : ELSE
621 0 : perf = 0.0_dp
622 : END IF
623 :
624 12 : IF (para_env%is_source()) THEN
625 : WRITE (iw, '(T2,A,A,i6,T59,F14.4,A)') &
626 6 : ADJUSTR(method), " test (in-place) Size = ", len, perf, " Mflop/s"
627 : END IF
628 12 : DEALLOCATE (ca)
629 16 : DEALLOCATE (ra)
630 : END DO
631 4 : IF (para_env%is_source()) WRITE (iw, *)
632 : ! test if input data is preserved
633 4 : len = 24
634 16 : n = len
635 4 : ALLOCATE (ra(len, len, len))
636 4 : ALLOCATE (ca(len, len, len))
637 4 : ALLOCATE (cb(len, len, len))
638 4 : ALLOCATE (cc(len, len, len))
639 4 : CALL RANDOM_NUMBER(ra)
640 57700 : ca(:, :, :) = ra
641 4 : CALL RANDOM_NUMBER(ra)
642 57700 : ca(:, :, :) = ca + gaussi*ra
643 57700 : cc(:, :, :) = ca
644 4 : CALL fft3d(FWFFT, n, ca, cb)
645 57700 : tdiff = MAXVAL(ABS(ca - cc))
646 4 : IF (tdiff > 1.0E-12_dp) THEN
647 0 : IF (para_env%is_source()) THEN
648 0 : WRITE (iw, '(T2,A,A,A)') ADJUSTR(method), " FWFFT ", &
649 0 : " Input array is changed in out-of-place FFT !"
650 : END IF
651 : ELSE
652 4 : IF (para_env%is_source()) THEN
653 2 : WRITE (iw, '(T2,A,A,A)') ADJUSTR(method), " FWFFT ", &
654 4 : " Input array is not changed in out-of-place FFT !"
655 : END IF
656 : END IF
657 57700 : ca(:, :, :) = cc
658 4 : CALL fft3d(BWFFT, n, ca, cb)
659 57700 : tdiff = MAXVAL(ABS(ca - cc))
660 4 : IF (tdiff > 1.0E-12_dp) THEN
661 0 : IF (para_env%is_source()) THEN
662 0 : WRITE (iw, '(T2,A,A,A)') ADJUSTR(method), " BWFFT ", &
663 0 : " Input array is changed in out-of-place FFT !"
664 : END IF
665 : ELSE
666 4 : IF (para_env%is_source()) THEN
667 2 : WRITE (iw, '(T2,A,A,A)') ADJUSTR(method), " BWFFT ", &
668 4 : " Input array is not changed in out-of-place FFT !"
669 : END IF
670 : END IF
671 4 : IF (para_env%is_source()) WRITE (iw, *)
672 :
673 4 : DEALLOCATE (ra)
674 4 : DEALLOCATE (ca)
675 4 : DEALLOCATE (cb)
676 4 : DEALLOCATE (cc)
677 : END IF
678 4 : CALL finalize_fft(para_env, wisdom_file=wisdom_file)
679 : END DO
680 :
681 2 : END SUBROUTINE fft_test
682 :
683 : ! **************************************************************************************************
684 : !> \brief test rs_pw_transfer performance
685 : !> \param para_env ...
686 : !> \param iw ...
687 : !> \param globenv ...
688 : !> \param rs_pw_transfer_section ...
689 : !> \author Joost VandeVondele
690 : !> 9.2008 Randomise rs grid [Iain Bethune]
691 : !> (c) The Numerical Algorithms Group (NAG) Ltd, 2008 on behalf of the HECToR project
692 : ! **************************************************************************************************
693 2 : SUBROUTINE rs_pw_transfer_test(para_env, iw, globenv, rs_pw_transfer_section)
694 :
695 : TYPE(mp_para_env_type), POINTER :: para_env
696 : INTEGER :: iw
697 : TYPE(global_environment_type), POINTER :: globenv
698 : TYPE(section_vals_type), POINTER :: rs_pw_transfer_section
699 :
700 : CHARACTER(LEN=*), PARAMETER :: routineN = 'rs_pw_transfer_test'
701 :
702 : INTEGER :: halo_size, handle, i_loop, n_loop, ns_max
703 : INTEGER, DIMENSION(3) :: no, np
704 2 : INTEGER, DIMENSION(:), POINTER :: i_vals
705 : LOGICAL :: do_rs2pw
706 : REAL(KIND=dp) :: tend, tstart
707 : TYPE(cell_type), POINTER :: box
708 : TYPE(pw_grid_type), POINTER :: grid
709 : TYPE(pw_r3d_rs_type) :: ca
710 : TYPE(realspace_grid_desc_type), POINTER :: rs_desc
711 : TYPE(realspace_grid_input_type) :: input_settings
712 32 : TYPE(realspace_grid_type) :: rs_grid
713 : TYPE(section_vals_type), POINTER :: rs_grid_section
714 :
715 2 : CALL timeset(routineN, handle)
716 :
717 : !..set fft lib
718 : CALL init_fft(globenv%default_fft_library, alltoall=.FALSE., fftsg_sizes=.TRUE., &
719 : pool_limit=globenv%fft_pool_scratch_limit, &
720 : wisdom_file=globenv%fftw_wisdom_file_name, &
721 2 : plan_style=globenv%fftw_plan_type)
722 :
723 : ! .. set cell (should otherwise be irrelevant)
724 2 : NULLIFY (box)
725 2 : CALL cell_create(box)
726 : box%hmat = RESHAPE([20.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 20.0_dp, 0.0_dp, &
727 26 : 0.0_dp, 0.0_dp, 20.0_dp], [3, 3])
728 2 : CALL init_cell(box)
729 :
730 : ! .. grid type and pw_grid
731 2 : NULLIFY (grid)
732 2 : CALL section_vals_val_get(rs_pw_transfer_section, "GRID", i_vals=i_vals)
733 8 : np = i_vals
734 2 : CALL pw_grid_create(grid, para_env, box%hmat, grid_span=FULLSPACE, npts=np, fft_usage=.TRUE., iounit=iw)
735 8 : no = grid%npts
736 :
737 2 : CALL ca%create(grid)
738 2 : CALL pw_zero(ca)
739 :
740 : ! .. rs input setting type
741 2 : CALL section_vals_val_get(rs_pw_transfer_section, "HALO_SIZE", i_val=halo_size)
742 2 : rs_grid_section => section_vals_get_subs_vals(rs_pw_transfer_section, "RS_GRID")
743 2 : ns_max = 2*halo_size + 1
744 2 : CALL init_input_type(input_settings, ns_max, rs_grid_section, 1, [-1, -1, -1])
745 :
746 : ! .. rs type
747 2 : NULLIFY (rs_desc)
748 2 : CALL rs_grid_create_descriptor(rs_desc, pw_grid=grid, input_settings=input_settings)
749 2 : CALL rs_grid_create(rs_grid, rs_desc)
750 2 : CALL rs_grid_print(rs_grid, iw)
751 2 : CALL rs_grid_zero(rs_grid)
752 :
753 : ! Put random values on the grid, so summation check will pick up errors
754 2 : CALL RANDOM_NUMBER(rs_grid%r)
755 :
756 2 : CALL section_vals_val_get(rs_pw_transfer_section, "N_loop", i_val=N_loop)
757 2 : CALL section_vals_val_get(rs_pw_transfer_section, "RS2PW", l_val=do_rs2pw)
758 :
759 : ! go for the real loops, sync to get max timings
760 2 : IF (para_env%is_source()) THEN
761 1 : WRITE (iw, '(T2,A)') ""
762 1 : WRITE (iw, '(T2,A)') "Timing rs_pw_transfer routine"
763 1 : WRITE (iw, '(T2,A)') ""
764 1 : WRITE (iw, '(T2,A)') "iteration time[s]"
765 : END IF
766 8 : DO i_loop = 1, N_loop
767 6 : CALL para_env%sync()
768 6 : tstart = m_walltime()
769 6 : IF (do_rs2pw) THEN
770 6 : CALL transfer_rs2pw(rs_grid, ca)
771 : ELSE
772 0 : CALL transfer_pw2rs(rs_grid, ca)
773 : END IF
774 6 : CALL para_env%sync()
775 6 : tend = m_walltime()
776 8 : IF (para_env%is_source()) THEN
777 3 : WRITE (iw, '(T2,I9,1X,F12.6)') i_loop, tend - tstart
778 : END IF
779 : END DO
780 :
781 : !cleanup
782 2 : CALL rs_grid_release(rs_grid)
783 2 : CALL rs_grid_release_descriptor(rs_desc)
784 2 : CALL ca%release()
785 2 : CALL pw_grid_release(grid)
786 2 : CALL cell_release(box)
787 2 : CALL finalize_fft(para_env, wisdom_file=globenv%fftw_wisdom_file_name)
788 :
789 2 : CALL timestop(handle)
790 :
791 10 : END SUBROUTINE rs_pw_transfer_test
792 :
793 : ! **************************************************************************************************
794 : !> \brief Tests the performance of PW calls to FFT routines
795 : !> \param para_env ...
796 : !> \param iw ...
797 : !> \param globenv ...
798 : !> \param pw_transfer_section ...
799 : !> \par History
800 : !> JGH 6-Feb-2001 : Test and performance code
801 : !> Made input sensitive [Joost VandeVondele]
802 : !> \author JGH 1-JAN-2001
803 : ! **************************************************************************************************
804 10 : SUBROUTINE pw_fft_test(para_env, iw, globenv, pw_transfer_section)
805 :
806 : TYPE(mp_para_env_type), POINTER :: para_env
807 : INTEGER :: iw
808 : TYPE(global_environment_type), POINTER :: globenv
809 : TYPE(section_vals_type), POINTER :: pw_transfer_section
810 :
811 : REAL(KIND=dp), PARAMETER :: toler = 1.e-11_dp
812 :
813 : INTEGER :: blocked_id, grid_span, i_layout, i_rep, &
814 : ig, ip, itmp, n_loop, n_rep, nn, p, q
815 10 : INTEGER, ALLOCATABLE, DIMENSION(:, :) :: layouts
816 : INTEGER, DIMENSION(2) :: distribution_layout
817 : INTEGER, DIMENSION(3) :: no, np
818 10 : INTEGER, DIMENSION(:), POINTER :: i_vals
819 : LOGICAL :: debug, is_fullspace, odd, &
820 : pw_grid_layout_all, spherical
821 : REAL(KIND=dp) :: em, et, flops, gsq, perf, t, t_max, &
822 : t_min, tend, tstart
823 10 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: t_end, t_start
824 : TYPE(cell_type), POINTER :: box
825 : TYPE(pw_c1d_gs_type) :: ca, cc
826 : TYPE(pw_c3d_rs_type) :: cb
827 : TYPE(pw_grid_type), POINTER :: grid
828 :
829 : !..set fft lib
830 :
831 : CALL init_fft(globenv%default_fft_library, alltoall=.FALSE., fftsg_sizes=.TRUE., &
832 : pool_limit=globenv%fft_pool_scratch_limit, &
833 : wisdom_file=globenv%fftw_wisdom_file_name, &
834 10 : plan_style=globenv%fftw_plan_type)
835 :
836 : !..the unit cell (should not really matter, the number of grid points do)
837 10 : NULLIFY (box, grid)
838 10 : CALL cell_create(box)
839 : box%hmat = RESHAPE([10.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 8.0_dp, 0.0_dp, &
840 130 : 0.0_dp, 0.0_dp, 7.0_dp], [3, 3])
841 10 : CALL init_cell(box)
842 :
843 10 : CALL section_vals_get(pw_transfer_section, n_repetition=n_rep)
844 70 : DO i_rep = 1, n_rep
845 :
846 : ! how often should we do the transfer
847 60 : CALL section_vals_val_get(pw_transfer_section, "N_loop", i_rep_section=i_rep, i_val=N_loop)
848 180 : ALLOCATE (t_start(N_loop))
849 120 : ALLOCATE (t_end(N_loop))
850 :
851 : ! setup of the grids
852 60 : CALL section_vals_val_get(pw_transfer_section, "GRID", i_rep_section=i_rep, i_vals=i_vals)
853 240 : np = i_vals
854 :
855 60 : CALL section_vals_val_get(pw_transfer_section, "PW_GRID_BLOCKED", i_rep_section=i_rep, i_val=blocked_id)
856 60 : CALL section_vals_val_get(pw_transfer_section, "DEBUG", i_rep_section=i_rep, l_val=debug)
857 :
858 : CALL section_vals_val_get(pw_transfer_section, "PW_GRID_LAYOUT_ALL", i_rep_section=i_rep, &
859 60 : l_val=pw_grid_layout_all)
860 :
861 : ! prepare to loop over all or a specific layout
862 60 : IF (pw_grid_layout_all) THEN
863 : ! count layouts that fit
864 8 : itmp = 0
865 : ! start from 2, (/1,para_env%num_pe/) is not supported
866 16 : DO p = 2, para_env%num_pe
867 8 : q = para_env%num_pe/p
868 16 : IF (p*q == para_env%num_pe) THEN
869 8 : itmp = itmp + 1
870 : END IF
871 : END DO
872 : ! build list
873 24 : ALLOCATE (layouts(2, itmp))
874 8 : itmp = 0
875 16 : DO p = 2, para_env%num_pe
876 8 : q = para_env%num_pe/p
877 16 : IF (p*q == para_env%num_pe) THEN
878 8 : itmp = itmp + 1
879 24 : layouts(:, itmp) = [p, q]
880 : END IF
881 : END DO
882 : ELSE
883 52 : CALL section_vals_val_get(pw_transfer_section, "PW_GRID_LAYOUT", i_rep_section=i_rep, i_vals=i_vals)
884 52 : ALLOCATE (layouts(2, 1))
885 156 : layouts(:, 1) = i_vals
886 : END IF
887 :
888 120 : DO i_layout = 1, SIZE(layouts, 2)
889 :
890 180 : distribution_layout = layouts(:, i_layout)
891 :
892 60 : CALL section_vals_val_get(pw_transfer_section, "PW_GRID", i_rep_section=i_rep, i_val=itmp)
893 :
894 : ! from cp_control_utils
895 16 : SELECT CASE (itmp)
896 : CASE (do_pwgrid_spherical)
897 16 : spherical = .TRUE.
898 16 : is_fullspace = .FALSE.
899 : CASE (do_pwgrid_ns_fullspace)
900 28 : spherical = .FALSE.
901 28 : is_fullspace = .TRUE.
902 : CASE (do_pwgrid_ns_halfspace)
903 16 : spherical = .FALSE.
904 60 : is_fullspace = .FALSE.
905 : END SELECT
906 :
907 : ! from pw_env_methods
908 60 : IF (spherical) THEN
909 16 : grid_span = HALFSPACE
910 16 : spherical = .TRUE.
911 16 : odd = .TRUE.
912 44 : ELSE IF (is_fullspace) THEN
913 28 : grid_span = FULLSPACE
914 28 : spherical = .FALSE.
915 28 : odd = .FALSE.
916 : ELSE
917 16 : grid_span = HALFSPACE
918 16 : spherical = .FALSE.
919 16 : odd = .TRUE.
920 : END IF
921 :
922 : ! actual setup
923 : CALL pw_grid_create(grid, para_env, box%hmat, grid_span=grid_span, odd=odd, spherical=spherical, &
924 : blocked=blocked_id, npts=np, fft_usage=.TRUE., &
925 60 : rs_dims=distribution_layout, iounit=iw)
926 :
927 60 : IF (iw > 0) CALL m_flush(iw)
928 :
929 : ! note that the number of grid points might be different from what the user requested (fft-able needed)
930 240 : no = grid%npts
931 :
932 60 : CALL ca%create(grid)
933 60 : CALL cb%create(grid)
934 60 : CALL cc%create(grid)
935 :
936 : ! initialize data
937 60 : CALL pw_zero(ca)
938 60 : CALL pw_zero(cb)
939 60 : CALL pw_zero(cc)
940 60 : nn = SIZE(ca%array)
941 142042 : DO ig = 1, nn
942 141982 : gsq = grid%gsq(ig)
943 142042 : ca%array(ig) = EXP(-gsq)
944 : END DO
945 :
946 420 : flops = PRODUCT(no)*30.0_dp*LOG(REAL(MAXVAL(no), KIND=dp))
947 60 : tstart = m_walltime()
948 596 : DO ip = 1, n_loop
949 536 : CALL para_env%sync()
950 536 : t_start(ip) = m_walltime()
951 536 : CALL pw_transfer(ca, cb, debug)
952 536 : CALL pw_transfer(cb, cc, debug)
953 536 : CALL para_env%sync()
954 596 : t_end(ip) = m_walltime()
955 : END DO
956 60 : tend = m_walltime()
957 60 : t = tend - tstart + threshold
958 60 : IF (t > 0.0_dp) THEN
959 60 : perf = REAL(n_loop, KIND=dp)*2.0_dp*flops*1.e-6_dp/t
960 : ELSE
961 0 : perf = 0.0_dp
962 : END IF
963 :
964 142042 : em = MAXVAL(ABS(ca%array(:) - cc%array(:)))
965 60 : CALL para_env%max(em)
966 142042 : et = SUM(ABS(ca%array(:) - cc%array(:)))
967 60 : CALL para_env%sum(et)
968 596 : t_min = MINVAL(t_end - t_start)
969 596 : t_max = MAXVAL(t_end - t_start)
970 :
971 60 : IF (para_env%is_source()) THEN
972 30 : WRITE (iw, *)
973 30 : WRITE (iw, '(A,T67,E14.6)') " Parallel FFT Tests: Maximal Error ", em
974 30 : WRITE (iw, '(A,T67,E14.6)') " Parallel FFT Tests: Total Error ", et
975 : WRITE (iw, '(A,T67,F14.0)') &
976 30 : " Parallel FFT Tests: Performance [Mflops] ", perf
977 30 : WRITE (iw, '(A,T67,F14.6)') " Best time : ", t_min
978 30 : WRITE (iw, '(A,T67,F14.6)') " Worst time: ", t_max
979 30 : IF (iw > 0) CALL m_flush(iw)
980 : END IF
981 :
982 : ! need debugging ???
983 60 : IF (em > toler .OR. et > toler) THEN
984 0 : CPWARN("The FFT results are not accurate ... starting debug pw_transfer")
985 0 : CALL pw_transfer(ca, cb, .TRUE.)
986 0 : CALL pw_transfer(cb, cc, .TRUE.)
987 : END IF
988 :
989 : ! done with these grids
990 60 : CALL ca%release()
991 60 : CALL cb%release()
992 60 : CALL cc%release()
993 180 : CALL pw_grid_release(grid)
994 :
995 : END DO
996 :
997 : ! local arrays
998 60 : DEALLOCATE (layouts)
999 60 : DEALLOCATE (t_start)
1000 190 : DEALLOCATE (t_end)
1001 :
1002 : END DO
1003 :
1004 : ! cleanup
1005 10 : CALL cell_release(box)
1006 10 : CALL finalize_fft(para_env, wisdom_file=globenv%fftw_wisdom_file_name)
1007 :
1008 20 : END SUBROUTINE pw_fft_test
1009 :
1010 : ! **************************************************************************************************
1011 : !> \brief Tests the eigensolver library routines
1012 : !> \param para_env ...
1013 : !> \param iw ...
1014 : !> \param eigensolver_section ...
1015 : !> \par History
1016 : !> JGH 6-Feb-2001 : Test and performance code
1017 : !> \author JGH 1-JAN-2001
1018 : ! **************************************************************************************************
1019 2 : SUBROUTINE eigensolver_test(para_env, iw, eigensolver_section)
1020 :
1021 : TYPE(mp_para_env_type), POINTER :: para_env
1022 : INTEGER :: iw
1023 : TYPE(section_vals_type), POINTER :: eigensolver_section
1024 :
1025 : INTEGER :: diag_method, i, i_loop, i_rep, &
1026 : init_method, j, n, n_loop, n_rep, &
1027 : neig, unit_number
1028 : REAL(KIND=dp) :: t1, t2
1029 2 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues
1030 2 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: buffer
1031 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
1032 : TYPE(cp_fm_struct_type), POINTER :: fmstruct
1033 : TYPE(cp_fm_type) :: eigenvectors, matrix, work
1034 2 : TYPE(rng_stream_type), ALLOCATABLE :: rng_stream
1035 :
1036 2 : IF (iw > 0) THEN
1037 1 : WRITE (UNIT=iw, FMT="(/,/,T2,A,/)") "EIGENSOLVER TEST"
1038 : END IF
1039 :
1040 : ! create blacs env corresponding to para_env
1041 2 : NULLIFY (blacs_env)
1042 : CALL cp_blacs_env_create(blacs_env=blacs_env, &
1043 2 : para_env=para_env)
1044 :
1045 : ! loop over all tests
1046 2 : CALL section_vals_get(eigensolver_section, n_repetition=n_rep)
1047 10 : DO i_rep = 1, n_rep
1048 :
1049 : ! parse section
1050 8 : CALL section_vals_val_get(eigensolver_section, "N", i_rep_section=i_rep, i_val=n)
1051 8 : CALL section_vals_val_get(eigensolver_section, "EIGENVALUES", i_rep_section=i_rep, i_val=neig)
1052 8 : CALL section_vals_val_get(eigensolver_section, "DIAG_METHOD", i_rep_section=i_rep, i_val=diag_method)
1053 8 : CALL section_vals_val_get(eigensolver_section, "INIT_METHOD", i_rep_section=i_rep, i_val=init_method)
1054 8 : CALL section_vals_val_get(eigensolver_section, "N_loop", i_rep_section=i_rep, i_val=n_loop)
1055 :
1056 : ! proper number of eigs
1057 8 : IF (neig < 0) neig = n
1058 8 : neig = MIN(neig, n)
1059 :
1060 : ! report
1061 8 : IF (iw > 0) THEN
1062 4 : WRITE (iw, *) "Matrix size", n
1063 4 : WRITE (iw, *) "Number of eigenvalues", neig
1064 4 : WRITE (iw, *) "Timing loops", n_loop
1065 2 : SELECT CASE (diag_method)
1066 : CASE (do_diag_syevd)
1067 2 : WRITE (iw, *) "Diag using syevd"
1068 : CASE (do_diag_syevx)
1069 4 : WRITE (iw, *) "Diag using syevx"
1070 : CASE DEFAULT
1071 : ! stop
1072 : END SELECT
1073 :
1074 4 : SELECT CASE (init_method)
1075 : CASE (do_mat_random)
1076 4 : WRITE (iw, *) "using random matrix"
1077 : CASE (do_mat_read)
1078 4 : WRITE (iw, *) "reading from file"
1079 : CASE DEFAULT
1080 : ! stop
1081 : END SELECT
1082 : END IF
1083 :
1084 : ! create matrix struct type
1085 8 : NULLIFY (fmstruct)
1086 : CALL cp_fm_struct_create(fmstruct=fmstruct, &
1087 : para_env=para_env, &
1088 : context=blacs_env, &
1089 : nrow_global=n, &
1090 8 : ncol_global=n)
1091 :
1092 : ! create all needed matrices, and buffers for the eigenvalues
1093 : CALL cp_fm_create(matrix=matrix, &
1094 : matrix_struct=fmstruct, &
1095 8 : name="MATRIX")
1096 8 : CALL cp_fm_set_all(matrix, 0.0_dp)
1097 :
1098 : CALL cp_fm_create(matrix=eigenvectors, &
1099 : matrix_struct=fmstruct, &
1100 8 : name="EIGENVECTORS")
1101 8 : CALL cp_fm_set_all(eigenvectors, 0.0_dp)
1102 :
1103 : CALL cp_fm_create(matrix=work, &
1104 : matrix_struct=fmstruct, &
1105 8 : name="WORK")
1106 8 : CALL cp_fm_set_all(matrix, 0.0_dp)
1107 :
1108 24 : ALLOCATE (eigenvalues(n))
1109 8 : eigenvalues = 0.0_dp
1110 16 : ALLOCATE (buffer(1, n))
1111 :
1112 : ! generate initial matrix, either by reading a file, or using random numbers
1113 8 : IF (para_env%is_source()) THEN
1114 4 : SELECT CASE (init_method)
1115 : CASE (do_mat_random)
1116 : rng_stream = rng_stream_type( &
1117 : name="rng_stream", &
1118 : distribution_type=UNIFORM, &
1119 4 : extended_precision=.TRUE.)
1120 : CASE (do_mat_read)
1121 : CALL open_file(file_name="MATRIX", &
1122 : file_action="READ", &
1123 : file_form="FORMATTED", &
1124 : file_status="OLD", &
1125 4 : unit_number=unit_number)
1126 : END SELECT
1127 : END IF
1128 :
1129 100 : DO i = 1, n
1130 92 : IF (para_env%is_source()) THEN
1131 : SELECT CASE (init_method)
1132 : CASE (do_mat_random)
1133 347 : DO j = i, n
1134 347 : buffer(1, j) = rng_stream%next() - 0.5_dp
1135 : END DO
1136 : !MK activate/modify for a diagonal dominant symmetric matrix:
1137 : !MK buffer(1,i) = 10.0_dp*buffer(1,i)
1138 : CASE (do_mat_read)
1139 46 : READ (UNIT=unit_number, FMT=*) buffer(1, 1:n)
1140 : END SELECT
1141 : END IF
1142 92 : CALL para_env%bcast(buffer)
1143 8 : SELECT CASE (init_method)
1144 : CASE (do_mat_random)
1145 : CALL cp_fm_set_submatrix(fm=matrix, &
1146 : new_values=buffer, &
1147 : start_row=i, &
1148 : start_col=i, &
1149 : n_rows=1, &
1150 : n_cols=n - i + 1, &
1151 : alpha=1.0_dp, &
1152 : beta=0.0_dp, &
1153 92 : transpose=.FALSE.)
1154 : CALL cp_fm_set_submatrix(fm=matrix, &
1155 : new_values=buffer, &
1156 : start_row=i, &
1157 : start_col=i, &
1158 : n_rows=n - i + 1, &
1159 : n_cols=1, &
1160 : alpha=1.0_dp, &
1161 : beta=0.0_dp, &
1162 92 : transpose=.TRUE.)
1163 : CASE (do_mat_read)
1164 : CALL cp_fm_set_submatrix(fm=matrix, &
1165 : new_values=buffer, &
1166 : start_row=i, &
1167 : start_col=1, &
1168 : n_rows=1, &
1169 : n_cols=n, &
1170 : alpha=1.0_dp, &
1171 : beta=0.0_dp, &
1172 92 : transpose=.FALSE.)
1173 : END SELECT
1174 : END DO
1175 :
1176 8 : DEALLOCATE (buffer)
1177 :
1178 8 : IF (para_env%is_source()) THEN
1179 0 : SELECT CASE (init_method)
1180 : CASE (do_mat_read)
1181 4 : CALL close_file(unit_number=unit_number)
1182 : END SELECT
1183 : END IF
1184 :
1185 88 : DO i_loop = 1, n_loop
1186 80 : eigenvalues = 0.0_dp
1187 80 : CALL cp_fm_set_all(eigenvectors, 0.0_dp)
1188 : CALL cp_fm_to_fm(source=matrix, &
1189 80 : destination=work)
1190 :
1191 : ! DONE, now testing
1192 80 : t1 = m_walltime()
1193 40 : SELECT CASE (diag_method)
1194 : CASE (do_diag_syevd)
1195 : CALL cp_fm_syevd(matrix=work, &
1196 : eigenvectors=eigenvectors, &
1197 40 : eigenvalues=eigenvalues)
1198 : CASE (do_diag_syevx)
1199 : CALL cp_fm_syevx(matrix=work, &
1200 : eigenvectors=eigenvectors, &
1201 : eigenvalues=eigenvalues, &
1202 : neig=neig, &
1203 80 : work_syevx=1.0_dp)
1204 : END SELECT
1205 80 : t2 = m_walltime()
1206 88 : IF (iw > 0) WRITE (iw, *) "Timing for loop ", i_loop, " : ", t2 - t1
1207 : END DO
1208 :
1209 8 : IF (iw > 0) THEN
1210 4 : WRITE (iw, *) "Eigenvalues: "
1211 4 : WRITE (UNIT=iw, FMT="(T3,5F14.6)") eigenvalues(1:neig)
1212 42 : WRITE (UNIT=iw, FMT="(T3,A4,F16.6)") "Sum:", SUM(eigenvalues(1:neig))
1213 4 : WRITE (iw, *) ""
1214 : END IF
1215 :
1216 : ! Clean up
1217 8 : DEALLOCATE (eigenvalues)
1218 8 : CALL cp_fm_release(matrix=work)
1219 8 : CALL cp_fm_release(matrix=eigenvectors)
1220 8 : CALL cp_fm_release(matrix=matrix)
1221 42 : CALL cp_fm_struct_release(fmstruct=fmstruct)
1222 :
1223 : END DO
1224 :
1225 2 : CALL cp_blacs_env_release(blacs_env=blacs_env)
1226 :
1227 4 : END SUBROUTINE eigensolver_test
1228 :
1229 : ! **************************************************************************************************
1230 : !> \brief Tests the parallel matrix multiply
1231 : !> \param para_env ...
1232 : !> \param iw ...
1233 : !> \param cp_fm_gemm_test_section ...
1234 : ! **************************************************************************************************
1235 4 : SUBROUTINE cp_fm_gemm_test(para_env, iw, cp_fm_gemm_test_section)
1236 :
1237 : TYPE(mp_para_env_type), POINTER :: para_env
1238 : INTEGER :: iw
1239 : TYPE(section_vals_type), POINTER :: cp_fm_gemm_test_section
1240 :
1241 : CHARACTER(LEN=1) :: transa, transb
1242 : INTEGER :: i_loop, i_rep, k, m, n, N_loop, n_rep, ncol_block, ncol_block_actual, &
1243 : ncol_global, np, nrow_block, nrow_block_actual, nrow_global
1244 4 : INTEGER, DIMENSION(:), POINTER :: grid_2d
1245 : LOGICAL :: force_blocksize, row_major, transa_p, &
1246 : transb_p
1247 : REAL(KIND=dp) :: t1, t2, t3, t4
1248 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
1249 : TYPE(cp_fm_struct_type), POINTER :: fmstruct_a, fmstruct_b, fmstruct_c
1250 : TYPE(cp_fm_type) :: matrix_a, matrix_b, matrix_c
1251 :
1252 4 : CALL section_vals_get(cp_fm_gemm_test_section, n_repetition=n_rep)
1253 24 : DO i_rep = 1, n_rep
1254 :
1255 : ! how often should we do the multiply
1256 20 : CALL section_vals_val_get(cp_fm_gemm_test_section, "N_loop", i_rep_section=i_rep, i_val=N_loop)
1257 :
1258 : ! matrices def.
1259 20 : CALL section_vals_val_get(cp_fm_gemm_test_section, "K", i_rep_section=i_rep, i_val=k)
1260 20 : CALL section_vals_val_get(cp_fm_gemm_test_section, "N", i_rep_section=i_rep, i_val=n)
1261 20 : CALL section_vals_val_get(cp_fm_gemm_test_section, "M", i_rep_section=i_rep, i_val=m)
1262 20 : CALL section_vals_val_get(cp_fm_gemm_test_section, "transa", i_rep_section=i_rep, l_val=transa_p)
1263 20 : CALL section_vals_val_get(cp_fm_gemm_test_section, "transb", i_rep_section=i_rep, l_val=transb_p)
1264 20 : CALL section_vals_val_get(cp_fm_gemm_test_section, "nrow_block", i_rep_section=i_rep, i_val=nrow_block)
1265 20 : CALL section_vals_val_get(cp_fm_gemm_test_section, "ncol_block", i_rep_section=i_rep, i_val=ncol_block)
1266 20 : CALL section_vals_val_get(cp_fm_gemm_test_section, "ROW_MAJOR", i_rep_section=i_rep, l_val=row_major)
1267 20 : CALL section_vals_val_get(cp_fm_gemm_test_section, "GRID_2D", i_rep_section=i_rep, i_vals=grid_2d)
1268 20 : CALL section_vals_val_get(cp_fm_gemm_test_section, "FORCE_BLOCKSIZE", i_rep_section=i_rep, l_val=force_blocksize)
1269 20 : transa = "N"
1270 20 : transb = "N"
1271 20 : IF (transa_p) transa = "T"
1272 20 : IF (transb_p) transb = "T"
1273 :
1274 20 : IF (iw > 0) THEN
1275 10 : WRITE (iw, '(T2,A)') "----------- TESTING PARALLEL MATRIX MULTIPLY -------------"
1276 10 : WRITE (iw, '(T2,A)', ADVANCE="NO") "C = "
1277 10 : IF (transa_p) THEN
1278 2 : WRITE (iw, '(A)', ADVANCE="NO") "TRANSPOSE(A) x"
1279 : ELSE
1280 8 : WRITE (iw, '(A)', ADVANCE="NO") "A x "
1281 : END IF
1282 10 : IF (transb_p) THEN
1283 2 : WRITE (iw, '(A)') "TRANSPOSE(B) "
1284 : ELSE
1285 8 : WRITE (iw, '(A)') "B "
1286 : END IF
1287 10 : WRITE (iw, '(T2,A,T50,I5,A,I5)') 'requested block size', nrow_block, ' by ', ncol_block
1288 10 : WRITE (iw, '(T2,A,T50,I5)') 'number of repetitions of cp_fm_gemm ', n_loop
1289 10 : WRITE (iw, '(T2,A,T50,L5)') 'Row Major', row_major
1290 30 : WRITE (iw, '(T2,A,T50,2I7)') 'GRID_2D ', grid_2d
1291 10 : WRITE (iw, '(T2,A,T50,L5)') 'Force blocksize ', force_blocksize
1292 : ! check the return value of pilaenv, too small values limit the performance (assuming pdgemm is the vanilla variant)
1293 10 : np = cp_fm_pilaenv(0, 'D')
1294 10 : IF (np > 0) THEN
1295 10 : WRITE (iw, '(T2,A,T50,I5)') 'PILAENV blocksize', np
1296 : END IF
1297 : END IF
1298 :
1299 20 : NULLIFY (blacs_env)
1300 : CALL cp_blacs_env_create(blacs_env=blacs_env, &
1301 : para_env=para_env, &
1302 : row_major=row_major, &
1303 20 : grid_2d=grid_2d)
1304 :
1305 20 : NULLIFY (fmstruct_a)
1306 20 : IF (transa_p) THEN
1307 4 : nrow_global = m; ncol_global = k
1308 : ELSE
1309 16 : nrow_global = k; ncol_global = m
1310 : END IF
1311 : CALL cp_fm_struct_create(fmstruct=fmstruct_a, para_env=para_env, context=blacs_env, &
1312 : nrow_global=nrow_global, ncol_global=ncol_global, &
1313 20 : nrow_block=nrow_block, ncol_block=ncol_block, force_block=force_blocksize)
1314 20 : CALL cp_fm_struct_get(fmstruct_a, nrow_block=nrow_block_actual, ncol_block=ncol_block_actual)
1315 30 : IF (iw > 0) WRITE (iw, '(T2,A,I9,A,I9,A,I5,A,I5)') 'matrix A ', nrow_global, " by ", ncol_global, &
1316 20 : ' using blocks of ', nrow_block_actual, ' by ', ncol_block_actual
1317 :
1318 20 : IF (transb_p) THEN
1319 4 : nrow_global = n; ncol_global = m
1320 : ELSE
1321 16 : nrow_global = m; ncol_global = n
1322 : END IF
1323 20 : NULLIFY (fmstruct_b)
1324 : CALL cp_fm_struct_create(fmstruct=fmstruct_b, para_env=para_env, context=blacs_env, &
1325 : nrow_global=nrow_global, ncol_global=ncol_global, &
1326 20 : nrow_block=nrow_block, ncol_block=ncol_block, force_block=force_blocksize)
1327 20 : CALL cp_fm_struct_get(fmstruct_b, nrow_block=nrow_block_actual, ncol_block=ncol_block_actual)
1328 30 : IF (iw > 0) WRITE (iw, '(T2,A,I9,A,I9,A,I5,A,I5)') 'matrix B ', nrow_global, " by ", ncol_global, &
1329 20 : ' using blocks of ', nrow_block_actual, ' by ', ncol_block_actual
1330 :
1331 20 : NULLIFY (fmstruct_c)
1332 20 : nrow_global = k
1333 20 : ncol_global = n
1334 : CALL cp_fm_struct_create(fmstruct=fmstruct_c, para_env=para_env, context=blacs_env, &
1335 : nrow_global=nrow_global, ncol_global=ncol_global, &
1336 20 : nrow_block=nrow_block, ncol_block=ncol_block, force_block=force_blocksize)
1337 20 : CALL cp_fm_struct_get(fmstruct_c, nrow_block=nrow_block_actual, ncol_block=ncol_block_actual)
1338 30 : IF (iw > 0) WRITE (iw, '(T2,A,I9,A,I9,A,I5,A,I5)') 'matrix C ', nrow_global, " by ", ncol_global, &
1339 20 : ' using blocks of ', nrow_block_actual, ' by ', ncol_block_actual
1340 :
1341 20 : CALL cp_fm_create(matrix=matrix_a, matrix_struct=fmstruct_a, name="MATRIX A")
1342 20 : CALL cp_fm_create(matrix=matrix_b, matrix_struct=fmstruct_b, name="MATRIX B")
1343 20 : CALL cp_fm_create(matrix=matrix_c, matrix_struct=fmstruct_c, name="MATRIX C")
1344 :
1345 20 : CALL RANDOM_NUMBER(matrix_a%local_data)
1346 20 : CALL RANDOM_NUMBER(matrix_b%local_data)
1347 20 : CALL RANDOM_NUMBER(matrix_c%local_data)
1348 :
1349 20 : IF (iw > 0) CALL m_flush(iw)
1350 :
1351 20 : t1 = m_walltime()
1352 932 : DO i_loop = 1, N_loop
1353 912 : t3 = m_walltime()
1354 912 : CALL parallel_gemm(transa, transb, k, n, m, 1.0_dp, matrix_a, matrix_b, 0.0_dp, matrix_c)
1355 912 : t4 = m_walltime()
1356 932 : IF (iw > 0) THEN
1357 456 : WRITE (iw, '(T2,A,T50,F12.6)') "cp_fm_gemm timing: ", (t4 - t3)
1358 456 : CALL m_flush(iw)
1359 : END IF
1360 : END DO
1361 20 : t2 = m_walltime()
1362 :
1363 20 : IF (iw > 0) THEN
1364 10 : WRITE (iw, '(T2,A,T50,F12.6)') "average cp_fm_gemm timing: ", (t2 - t1)/N_loop
1365 10 : IF (t2 > t1) THEN
1366 10 : WRITE (iw, '(T2,A,T50,F12.6)') "cp_fm_gemm Gflops per MPI task: ", &
1367 20 : 2*REAL(m, kind=dp)*REAL(n, kind=dp)*REAL(k, kind=dp)*N_loop/MAX(0.001_dp, t2 - t1)/1.0E9_dp/para_env%num_pe
1368 : END IF
1369 : END IF
1370 :
1371 20 : CALL cp_fm_release(matrix=matrix_a)
1372 20 : CALL cp_fm_release(matrix=matrix_b)
1373 20 : CALL cp_fm_release(matrix=matrix_c)
1374 20 : CALL cp_fm_struct_release(fmstruct=fmstruct_a)
1375 20 : CALL cp_fm_struct_release(fmstruct=fmstruct_b)
1376 20 : CALL cp_fm_struct_release(fmstruct=fmstruct_c)
1377 144 : CALL cp_blacs_env_release(blacs_env=blacs_env)
1378 :
1379 : END DO
1380 :
1381 4 : END SUBROUTINE cp_fm_gemm_test
1382 :
1383 : ! **************************************************************************************************
1384 : !> \brief Tests the DBCSR interface.
1385 : !> \param para_env ...
1386 : !> \param iw ...
1387 : !> \param input_section ...
1388 : ! **************************************************************************************************
1389 32 : SUBROUTINE cp_dbcsr_tests(para_env, iw, input_section)
1390 :
1391 : TYPE(mp_para_env_type), POINTER :: para_env
1392 : INTEGER :: iw
1393 : TYPE(section_vals_type), POINTER :: input_section
1394 :
1395 : CHARACTER, DIMENSION(3) :: types
1396 : INTEGER :: data_type, i_rep, k, m, n, N_loop, &
1397 : n_rep, test_type
1398 32 : INTEGER, DIMENSION(:), POINTER :: bs_k, bs_m, bs_n, nproc
1399 : LOGICAL :: always_checksum, retain_sparsity, &
1400 : transa_p, transb_p
1401 : REAL(KIND=dp) :: alpha, beta, filter_eps, s_a, s_b, s_c
1402 :
1403 : ! ---------------------------------------------------------------------------
1404 :
1405 32 : NULLIFY (bs_m, bs_n, bs_k)
1406 32 : CALL section_vals_get(input_section, n_repetition=n_rep)
1407 32 : CALL dbcsr_reset_randmat_seed()
1408 78 : DO i_rep = 1, n_rep
1409 : ! how often should we do the multiply
1410 46 : CALL section_vals_val_get(input_section, "N_loop", i_rep_section=i_rep, i_val=N_loop)
1411 :
1412 : ! matrices def.
1413 46 : CALL section_vals_val_get(input_section, "TEST_TYPE", i_rep_section=i_rep, i_val=test_type)
1414 46 : CALL section_vals_val_get(input_section, "DATA_TYPE", i_rep_section=i_rep, i_val=data_type)
1415 46 : CALL section_vals_val_get(input_section, "K", i_rep_section=i_rep, i_val=k)
1416 46 : CALL section_vals_val_get(input_section, "N", i_rep_section=i_rep, i_val=n)
1417 46 : CALL section_vals_val_get(input_section, "M", i_rep_section=i_rep, i_val=m)
1418 46 : CALL section_vals_val_get(input_section, "transa", i_rep_section=i_rep, l_val=transa_p)
1419 46 : CALL section_vals_val_get(input_section, "transb", i_rep_section=i_rep, l_val=transb_p)
1420 : CALL section_vals_val_get(input_section, "bs_m", i_rep_section=i_rep, &
1421 46 : i_vals=bs_m)
1422 : CALL section_vals_val_get(input_section, "bs_n", i_rep_section=i_rep, &
1423 46 : i_vals=bs_n)
1424 : CALL section_vals_val_get(input_section, "bs_k", i_rep_section=i_rep, &
1425 46 : i_vals=bs_k)
1426 46 : CALL section_vals_val_get(input_section, "keepsparse", i_rep_section=i_rep, l_val=retain_sparsity)
1427 46 : CALL section_vals_val_get(input_section, "asparsity", i_rep_section=i_rep, r_val=s_a)
1428 46 : CALL section_vals_val_get(input_section, "bsparsity", i_rep_section=i_rep, r_val=s_b)
1429 46 : CALL section_vals_val_get(input_section, "csparsity", i_rep_section=i_rep, r_val=s_c)
1430 46 : CALL section_vals_val_get(input_section, "alpha", i_rep_section=i_rep, r_val=alpha)
1431 46 : CALL section_vals_val_get(input_section, "beta", i_rep_section=i_rep, r_val=beta)
1432 : CALL section_vals_val_get(input_section, "nproc", i_rep_section=i_rep, &
1433 46 : i_vals=nproc)
1434 : CALL section_vals_val_get(input_section, "atype", i_rep_section=i_rep, &
1435 46 : c_val=types(1))
1436 : CALL section_vals_val_get(input_section, "btype", i_rep_section=i_rep, &
1437 46 : c_val=types(2))
1438 : CALL section_vals_val_get(input_section, "ctype", i_rep_section=i_rep, &
1439 46 : c_val=types(3))
1440 : CALL section_vals_val_get(input_section, "filter_eps", &
1441 46 : i_rep_section=i_rep, r_val=filter_eps)
1442 46 : CALL section_vals_val_get(input_section, "ALWAYS_CHECKSUM", i_rep_section=i_rep, l_val=always_checksum)
1443 :
1444 : CALL dbcsr_run_tests(para_env%get_handle(), iw, nproc, &
1445 : [m, n, k], &
1446 : [transa_p, transb_p], &
1447 : bs_m, bs_n, bs_k, &
1448 : [s_a, s_b, s_c], &
1449 : alpha, beta, &
1450 : data_type=data_type, &
1451 : test_type=test_type, &
1452 : n_loops=n_loop, eps=filter_eps, retain_sparsity=retain_sparsity, &
1453 538 : always_checksum=always_checksum)
1454 : END DO
1455 32 : END SUBROUTINE cp_dbcsr_tests
1456 :
1457 : ! **************************************************************************************************
1458 : !> \brief Tests the DBM library.
1459 : !> \param para_env ...
1460 : !> \param iw ...
1461 : !> \param input_section ...
1462 : ! **************************************************************************************************
1463 14 : SUBROUTINE run_dbm_tests(para_env, iw, input_section)
1464 :
1465 : TYPE(mp_para_env_type), POINTER :: para_env
1466 : INTEGER :: iw
1467 : TYPE(section_vals_type), POINTER :: input_section
1468 :
1469 : INTEGER :: i_rep, k, m, n, N_loop, n_rep
1470 14 : INTEGER, DIMENSION(:), POINTER :: bs_k, bs_m, bs_n
1471 : LOGICAL :: always_checksum, retain_sparsity, &
1472 : transa_p, transb_p
1473 : REAL(KIND=dp) :: alpha, beta, filter_eps, s_a, s_b, s_c
1474 :
1475 : ! ---------------------------------------------------------------------------
1476 :
1477 14 : NULLIFY (bs_m, bs_n, bs_k)
1478 14 : CALL section_vals_get(input_section, n_repetition=n_rep)
1479 14 : CALL dbcsr_reset_randmat_seed()
1480 28 : DO i_rep = 1, n_rep
1481 14 : CALL section_vals_val_get(input_section, "N_loop", i_rep_section=i_rep, i_val=N_loop)
1482 14 : CALL section_vals_val_get(input_section, "K", i_rep_section=i_rep, i_val=k)
1483 14 : CALL section_vals_val_get(input_section, "N", i_rep_section=i_rep, i_val=n)
1484 14 : CALL section_vals_val_get(input_section, "M", i_rep_section=i_rep, i_val=m)
1485 14 : CALL section_vals_val_get(input_section, "transa", i_rep_section=i_rep, l_val=transa_p)
1486 14 : CALL section_vals_val_get(input_section, "transb", i_rep_section=i_rep, l_val=transb_p)
1487 14 : CALL section_vals_val_get(input_section, "bs_m", i_rep_section=i_rep, i_vals=bs_m)
1488 14 : CALL section_vals_val_get(input_section, "bs_n", i_rep_section=i_rep, i_vals=bs_n)
1489 14 : CALL section_vals_val_get(input_section, "bs_k", i_rep_section=i_rep, i_vals=bs_k)
1490 14 : CALL section_vals_val_get(input_section, "keepsparse", i_rep_section=i_rep, l_val=retain_sparsity)
1491 14 : CALL section_vals_val_get(input_section, "asparsity", i_rep_section=i_rep, r_val=s_a)
1492 14 : CALL section_vals_val_get(input_section, "bsparsity", i_rep_section=i_rep, r_val=s_b)
1493 14 : CALL section_vals_val_get(input_section, "csparsity", i_rep_section=i_rep, r_val=s_c)
1494 14 : CALL section_vals_val_get(input_section, "alpha", i_rep_section=i_rep, r_val=alpha)
1495 14 : CALL section_vals_val_get(input_section, "beta", i_rep_section=i_rep, r_val=beta)
1496 14 : CALL section_vals_val_get(input_section, "filter_eps", i_rep_section=i_rep, r_val=filter_eps)
1497 14 : CALL section_vals_val_get(input_section, "ALWAYS_CHECKSUM", i_rep_section=i_rep, l_val=always_checksum)
1498 :
1499 : CALL dbm_run_tests(mp_group=para_env, &
1500 : io_unit=iw, &
1501 : matrix_sizes=[m, n, k], &
1502 : trs=[transa_p, transb_p], &
1503 : bs_m=bs_m, &
1504 : bs_n=bs_n, &
1505 : bs_k=bs_k, &
1506 : sparsities=[s_a, s_b, s_c], &
1507 : alpha=alpha, &
1508 : beta=beta, &
1509 : n_loops=n_loop, &
1510 : eps=filter_eps, &
1511 : retain_sparsity=retain_sparsity, &
1512 154 : always_checksum=always_checksum)
1513 : END DO
1514 14 : END SUBROUTINE run_dbm_tests
1515 :
1516 8484 : END MODULE library_tests
|
