(git:0de0cc2)
dbt_unittest.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
8 ! **************************************************************************************************
9 !> \brief Block tensor unit test
10 !> \author Patrick Seewald
11 ! **************************************************************************************************
12 PROGRAM dbt_unittest
13  USE dbcsr_api, ONLY: dbcsr_finalize_lib,&
14  dbcsr_init_lib
15  USE dbm_api, ONLY: dbm_library_finalize,&
18  USE dbt_test, ONLY: dbt_contract_test,&
22  USE dbt_types, ONLY: &
24  dbt_distribution_new, dbt_distribution_type, dbt_get_info, dbt_pgrid_create, &
25  dbt_pgrid_destroy, dbt_pgrid_type, dbt_type, ndims_tensor
26  USE kinds, ONLY: dp
27  USE machine, ONLY: default_output_unit
28  USE message_passing, ONLY: mp_comm_type,&
33 #include "../base/base_uses.f90"
34 
35  IMPLICIT NONE
36 
37  TYPE(mp_comm_type) :: mp_comm
38  INTEGER :: mynode, io_unit
39  INTEGER :: ndims, nblks_alloc, nblks_1, nblks_2, nblks_3, nblks_4, nblks_5, &
40  nblks_alloc_1, nblks_alloc_2, nblks_alloc_3, nblks_alloc_4, nblks_alloc_5
41  INTEGER, DIMENSION(:), ALLOCATABLE :: size_1, size_2, size_3, size_4, size_5, dist1_1, dist1_2, dist1_3, &
42  dist2_1, dist2_2, dist3_1, dist3_2, dist3_3, dist4_1, dist4_2, &
43  dist4_3, dist4_4, dist5_1, dist5_2, dist5_3
44  INTEGER, DIMENSION(:), ALLOCATABLE :: blk_ind_1, blk_ind_2, blk_ind_3, blk_ind_4, blk_ind_1_1, blk_ind_2_1, &
45  blk_ind_3_1, blk_ind_3_2, blk_ind_4_2, blk_ind_1_3, blk_ind_2_3, &
46  blk_ind_4_3, blk_ind_1_4, blk_ind_2_4, blk_ind_4_4, blk_ind_5_4, &
47  blk_ind_3_5, blk_ind_4_5, blk_ind_5_5
48  INTEGER, DIMENSION(:), ALLOCATABLE :: map11, map31, map12, map32, map21, map22
49 
50  LOGICAL, PARAMETER :: verbose = .false.
51  TYPE(dbt_distribution_type) :: dist1, dist2, dist3
52  TYPE(dbt_type) :: tensor_a, tensor_b, tensor_c
53 
54  LOGICAL, PARAMETER :: test_format = .true.
55  LOGICAL, PARAMETER :: test_contraction = .true.
56  INTEGER, DIMENSION(4) :: pdims_4d
57  INTEGER, DIMENSION(3) :: pdims_3d
58  INTEGER, DIMENSION(2) :: pdims_2d
59  TYPE(dbt_pgrid_type) :: pgrid_2d, pgrid_3d, pgrid_4d
60  INTEGER, DIMENSION(:), ALLOCATABLE :: bounds_t
61  INTEGER, DIMENSION(:, :), ALLOCATABLE :: bounds, bounds_1, bounds_2
62 
63  CALL mp_world_init(mp_comm)
64  mynode = mp_comm%mepos
65 
66  ! Select active offload device when available.
67  IF (offload_get_device_count() > 0) THEN
69  END IF
70 
71  ! set standard output parameters
72  io_unit = -1
73  IF (mynode .EQ. 0) io_unit = default_output_unit
74 
75  CALL dbcsr_init_lib(mp_comm%get_handle(), io_unit) ! Needed for DBM_VALIDATE_AGAINST_DBCSR.
76  CALL dbm_library_init()
77 
79 
80  ! Process grid
81 
82  IF (test_format) THEN
83 !--------------------------------------------------------------------------------------------------!
84 ! Test 1: Testing matrix representations of tensor rank 2 !
85 !--------------------------------------------------------------------------------------------------!
86  ndims = 2
87 
88  ! Number of blocks in each dimension
89  nblks_1 = 14
90  nblks_2 = 21
91 
92  ! Block sizes in each dimension
93  ALLOCATE (size_1(nblks_1), size_2(nblks_2))
94 
95  size_1(:) = [3, 5, 1, 23, 2, 3, 1, 6, 3, 8, 2, 3, 5, 1]
96  size_2(:) = [4, 2, 5, 3, 1, 5, 13, 5, 2, 4, 5, 6, 7, 2, 3, 1, 2, 6, 9, 12, 21]
97 
98  ! Number of non-zero blocks
99  nblks_alloc = 12
100  ALLOCATE (blk_ind_1(nblks_alloc), blk_ind_2(nblks_alloc))
101 
102  ! Indices of non-zero blocks (s.t. index of ith block is [blk_ind_1(i), blk_ind_2(i), ...])
103  blk_ind_1(:) = [1, 1, 1, 2, 4, 4, 7, 10, 10, 10, 10, 13] !&
104  blk_ind_2(:) = [1, 3, 11, 15, 4, 17, 21, 6, 9, 13, 19, 7] !&
105 
106  ! Test tensor formats
107  CALL dbt_test_formats(ndims, mp_comm, io_unit, verbose, &
108  blk_size_1=size_1, blk_size_2=size_2, &
109  blk_ind_1=blk_ind_1, blk_ind_2=blk_ind_2)
110 
111  DEALLOCATE (size_1, size_2)
112  DEALLOCATE (blk_ind_1, blk_ind_2)
113 
114 !--------------------------------------------------------------------------------------------------!
115 ! Test 2: Testing matrix representations of tensor rank 3 !
116 !--------------------------------------------------------------------------------------------------!
117  ndims = 3
118 
119  ! Number of blocks in each dimension
120  nblks_1 = 4
121  nblks_2 = 6
122  nblks_3 = 3
123 
124  ! Block sizes in each dimension
125  ALLOCATE (size_1(nblks_1), size_2(nblks_2), size_3(nblks_3))
126 
127  size_1(:) = [3, 1, 5, 2]
128  size_2(:) = [1, 2, 5, 3, 2, 4]
129  size_3(:) = [4, 2, 10]
130 
131  ! Number of non-zero blocks
132  nblks_alloc = 6
133  ALLOCATE (blk_ind_1(nblks_alloc), blk_ind_2(nblks_alloc), blk_ind_3(nblks_alloc))
134 
135  ! Indices of non-zero blocks (s.t. index of ith block is [blk_ind_1(i), blk_ind_2(i), ...])
136  blk_ind_1(:) = [1, 1, 1, 2, 2, 2] !&
137  blk_ind_2(:) = [2, 2, 4, 1, 1, 2] !&
138  blk_ind_3(:) = [1, 3, 3, 2, 3, 2] !&
139 
140  ! Test tensor formats
141  CALL dbt_test_formats(ndims, mp_comm, io_unit, verbose, &
142  blk_size_1=size_1, blk_size_2=size_2, blk_size_3=size_3, &
143  blk_ind_1=blk_ind_1, blk_ind_2=blk_ind_2, blk_ind_3=blk_ind_3)
144 
145  DEALLOCATE (size_1, size_2, size_3)
146  DEALLOCATE (blk_ind_1, blk_ind_2, blk_ind_3)
147 
148 !--------------------------------------------------------------------------------------------------!
149 ! Test 3: Testing matrix representations of tensor rank 4 !
150 !--------------------------------------------------------------------------------------------------!
151  ndims = 4
152 
153  ! Number of blocks in each dimension
154  nblks_1 = 2
155  nblks_2 = 13
156  nblks_3 = 7
157  nblks_4 = 3
158 
159  ! Block sizes in each dimension
160  ALLOCATE (size_1(nblks_1), size_2(nblks_2), size_3(nblks_3), size_4(nblks_4))
161 
162  size_1(:) = [5, 9]
163  size_2(:) = [6, 2, 5, 12, 3, 1, 7, 2, 5, 17, 9, 3, 4]
164  size_3(:) = [2, 7, 3, 8, 5, 15, 1]
165  size_4(:) = [12, 5, 3]
166 
167  ! Number of non-zero blocks
168  nblks_alloc = 19
169  ALLOCATE (blk_ind_1(nblks_alloc), blk_ind_2(nblks_alloc), blk_ind_3(nblks_alloc), blk_ind_4(nblks_alloc))
170 
171  ! Indices of non-zero blocks (s.t. index of ith block is [blk_ind_1(i), blk_ind_2(i), ...])
172  blk_ind_1(:) = [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2] !&
173  blk_ind_2(:) = [2, 2, 3, 4, 7, 7, 10, 11, 11, 12, 12, 1, 1, 3, 5, 6, 6, 9, 12] !&
174  blk_ind_3(:) = [1, 4, 6, 3, 1, 4, 2, 5, 7, 3, 3, 1, 4, 7, 6, 4, 5, 2, 3] !&
175  blk_ind_4(:) = [3, 2, 3, 1, 1, 2, 1, 3, 2, 2, 3, 1, 3, 2, 1, 1, 3, 2, 2] !&
176 
177  ! Test tensor formats
178  CALL dbt_test_formats(ndims, mp_comm, io_unit, verbose, &
179  blk_size_1=size_1, blk_size_2=size_2, blk_size_3=size_3, blk_size_4=size_4, &
180  blk_ind_1=blk_ind_1, blk_ind_2=blk_ind_2, blk_ind_3=blk_ind_3, blk_ind_4=blk_ind_4)
181 
182  DEALLOCATE (size_1, size_2, size_3, size_4)
183  DEALLOCATE (blk_ind_1, blk_ind_2, blk_ind_3, blk_ind_4)
184 
185  END IF
186  IF (test_contraction) THEN
187 
188 !--------------------------------------------------------------------------------------------------!
189 ! Preparations for tensor contraction tests !
190 !--------------------------------------------------------------------------------------------------!
191 
192  nblks_1 = 4
193  nblks_2 = 11
194  nblks_3 = 9
195  nblks_4 = 5
196  nblks_5 = 3
197 
198  ! Block sizes in each dimension
199  ALLOCATE (size_1(nblks_1), size_2(nblks_2), size_3(nblks_3), size_4(nblks_4), size_5(nblks_5))
200 
201  size_1(:) = [3, 9, 12, 1]
202  size_2(:) = [4, 2, 3, 1, 9, 2, 32, 10, 5, 8, 7]
203  size_3(:) = [7, 3, 8, 7, 9, 5, 10, 23, 2]
204  size_4(:) = [8, 1, 4, 13, 6]
205  size_5(:) = [4, 2, 22]
206 
207  nblks_alloc_1 = 32
208  ALLOCATE (blk_ind_1_1(nblks_alloc_1), blk_ind_2_1(nblks_alloc_1), blk_ind_3_1(nblks_alloc_1))
209 
210  blk_ind_1_1(:) = [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & !&
211  1, 2, 2, 2, 2, 2, 2, 2, 3, 3, & !&
212  3, 3, 3, 3, 3, 3, 3, 4, 4, 4, & !&
213  4, 4] !&
214 
215  blk_ind_2_1(:) = [ 3, 5, 5, 5, 6, 6, 7, 8, 10, 11, & !&
216  11, 1, 1, 4, 7, 7, 9, 10 , 2, 2, & !&
217  5, 6, 8, 8, 9, 11, 11, 2 , 4, 5, & !&
218  5, 8] !&
219 
220  blk_ind_3_1(:) = [7, 3, 5, 9, 6, 8, 2, 8, 3, 2, & !&
221  3, 1, 4, 6, 2, 7, 5, 8, 3, 7, & !&
222  1, 4, 3, 7, 8, 5, 8, 9, 6, 1, & !&
223  2, 7] !&
224 
225  nblks_alloc_2 = 12
226  ALLOCATE (blk_ind_3_2(nblks_alloc_2), blk_ind_4_2(nblks_alloc_2))
227 
228  blk_ind_3_2(:) = [1, 1, 2, 2, 2, 4, 4, 5, 5, 6, & !&
229  8, 8] !&
230  blk_ind_4_2(:) = [2, 3, 2, 4, 5, 3, 5, 1, 3, 3, & !&
231  1, 4] !&
232 
233  nblks_alloc_3 = 5
234  ALLOCATE (blk_ind_1_3(nblks_alloc_3), blk_ind_2_3(nblks_alloc_3), blk_ind_4_3(nblks_alloc_3))
235 
236  blk_ind_1_3(:) = [1, 1, 2, 4, 4]
237  blk_ind_2_3(:) = [2, 6, 6, 7, 9]
238  blk_ind_4_3(:) = [1, 3, 4, 4, 5]
239 
240  nblks_alloc_4 = 36
241  ALLOCATE (blk_ind_1_4(nblks_alloc_4))
242  ALLOCATE (blk_ind_2_4(nblks_alloc_4))
243  ALLOCATE (blk_ind_4_4(nblks_alloc_4))
244  ALLOCATE (blk_ind_5_4(nblks_alloc_4))
245 
246  blk_ind_1_4(:) = [ 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, & !&
247  2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & !&
248  3, 3, 3, 3, 3, 3, 3, 3, 3, 3, & !&
249  4, 4, 4, 4, 4, 4] !&
250 
251  blk_ind_2_4(:) = [ 1, 3, 4, 6, 10, 2, 2, 4, 5, 5, & !&
252  6, 6, 6, 7, 7, 9, 9, 9, 10, 11, & !&
253  1, 3, 3, 4, 5, 6, 8, 9, 11, 11, & !&
254  1, 3, 4, 6, 10, 11] !&
255 
256  blk_ind_4_4(:) = [ 3, 5, 2, 3, 2, 3, 5, 1, 1, 4, & !&
257  2, 3, 4, 1, 4, 3, 4, 4, 2, 1, & !&
258  3, 1, 1, 3, 4, 3, 4, 2, 2, 3, & !&
259  1, 1, 3, 2, 5, 5] !&
260 
261  blk_ind_5_4(:) = [ 1, 3, 2, 1, 1, 2, 3, 1, 3, 1, & !&
262  2, 3, 2, 1, 3, 2, 3, 2, 1, 2, & !&
263  3, 1, 2, 3, 2, 2, 2, 3, 1, 2, & !&
264  1, 3, 2, 1, 3, 2] !&
265 
266  nblks_alloc_5 = 8
267 
268  ALLOCATE (blk_ind_3_5(nblks_alloc_5), blk_ind_4_5(nblks_alloc_5), blk_ind_5_5(nblks_alloc_5))
269 
270  blk_ind_3_5(:) = [2, 4, 5, 5, 5, 6, 6, 8]
271  blk_ind_4_5(:) = [3, 2, 1, 1, 3, 2, 4, 5]
272  blk_ind_5_5(:) = [3, 2, 1, 2, 3, 2, 1, 1]
273 
274  pdims_4d(:) = 0; pdims_3d(:) = 0; pdims_2d(:) = 0
275  CALL dbt_pgrid_create(mp_comm, pdims_4d, pgrid_4d)
276  CALL dbt_pgrid_create(mp_comm, pdims_3d, pgrid_3d)
277  CALL dbt_pgrid_create(mp_comm, pdims_2d, pgrid_2d)
278 
279  ALLOCATE (dist1_1(nblks_1))
280  CALL dbt_default_distvec(nblks_1, pdims_3d(1), size_1, dist1_1)
281  ALLOCATE (dist1_2(nblks_2))
282  CALL dbt_default_distvec(nblks_2, pdims_3d(2), size_2, dist1_2)
283  ALLOCATE (dist1_3(nblks_3))
284  CALL dbt_default_distvec(nblks_3, pdims_3d(3), size_3, dist1_3)
285 
286  ALLOCATE (dist2_1(nblks_3))
287  CALL dbt_default_distvec(nblks_3, pdims_2d(1), size_3, dist2_1)
288  ALLOCATE (dist2_2(nblks_4))
289  CALL dbt_default_distvec(nblks_4, pdims_2d(2), size_4, dist2_2)
290 
291  ALLOCATE (dist3_1(nblks_1))
292  CALL dbt_default_distvec(nblks_1, pdims_3d(1), size_1, dist3_1)
293  ALLOCATE (dist3_2(nblks_2))
294  CALL dbt_default_distvec(nblks_2, pdims_3d(2), size_2, dist3_2)
295  ALLOCATE (dist3_3(nblks_4))
296  CALL dbt_default_distvec(nblks_4, pdims_3d(3), size_4, dist3_3)
297 
298  ALLOCATE (dist4_1(nblks_1))
299  CALL dbt_default_distvec(nblks_1, pdims_4d(1), size_1, dist4_1)
300  ALLOCATE (dist4_2(nblks_2))
301  CALL dbt_default_distvec(nblks_2, pdims_4d(2), size_2, dist4_2)
302  ALLOCATE (dist4_3(nblks_4))
303  CALL dbt_default_distvec(nblks_4, pdims_4d(3), size_4, dist4_3)
304  ALLOCATE (dist4_4(nblks_5))
305  CALL dbt_default_distvec(nblks_5, pdims_4d(4), size_5, dist4_4)
306 
307  ALLOCATE (dist5_1(nblks_3))
308  CALL dbt_default_distvec(nblks_3, pdims_3d(1), size_3, dist5_1)
309  ALLOCATE (dist5_2(nblks_4))
310  CALL dbt_default_distvec(nblks_4, pdims_3d(2), size_4, dist5_2)
311  ALLOCATE (dist5_3(nblks_5))
312  CALL dbt_default_distvec(nblks_5, pdims_3d(3), size_5, dist5_3)
313 
314 !--------------------------------------------------------------------------------------------------!
315 ! Test 4: Testing tensor contraction (12|3)x(3|4)=(12|4) !
316 !--------------------------------------------------------------------------------------------------!
317 
318  ALLOCATE (map11(2), map12(1), map21(1), map22(1), map31(2), map32(1))
319  map11(:) = [1, 2]
320  map12(:) = [3]
321  map21(:) = [1]
322  map22(:) = [2]
323  map31(:) = [1, 2]
324  map32(:) = [3]
325 
326  CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
327  CALL dbt_distribution_new(dist2, pgrid_2d, dist2_1, dist2_2)
328  CALL dbt_distribution_new(dist3, pgrid_3d, dist3_1, dist3_2, dist3_3)
329 
330  CALL dbt_create(tensor_a, "(12|3)", dist1, map11, map12, size_1, size_2, size_3)
331  CALL dbt_create(tensor_b, "(3|4)", dist2, map21, map22, size_3, size_4)
332  CALL dbt_create(tensor_c, "(12|4)", dist3, map31, map32, size_1, size_2, size_4)
333 
334  CALL dbt_setup_test_tensor(tensor_a, mp_comm, .false., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
335  CALL dbt_setup_test_tensor(tensor_b, mp_comm, .false., blk_ind_3_2, blk_ind_4_2)
336 
337  CALL dbt_setup_test_tensor(tensor_c, mp_comm, .false., blk_ind_1_3, blk_ind_2_3, blk_ind_4_3)
338 
339  CALL dbt_contract_test(0.9_dp, tensor_a, tensor_b, 0.1_dp, tensor_c, &
340  [3], [2, 1], &
341  [1], [2], &
342  [2, 1], [3], &
343  io_unit, &
344  log_verbose=verbose, &
345  write_int=.true.)
346 
347  DEALLOCATE (map11, map12, map21, map22, map31, map32)
348 
349  CALL dbt_destroy(tensor_a)
350  CALL dbt_destroy(tensor_b)
351  CALL dbt_destroy(tensor_c)
352  CALL dbt_distribution_destroy(dist1)
353  CALL dbt_distribution_destroy(dist2)
354  CALL dbt_distribution_destroy(dist3)
355 
356 !--------------------------------------------------------------------------------------------------!
357 ! Test 5: Testing tensor contraction (2|31)x(4|3)=(24|1) !
358 !--------------------------------------------------------------------------------------------------!
359 
360  ALLOCATE (map11(1), map12(2), map21(1), map22(1), map31(2), map32(1))
361  map11(:) = [2]
362  map12(:) = [3, 1]
363  map21(:) = [2]
364  map22(:) = [1]
365  map31(:) = [2, 3]
366  map32(:) = [1]
367 
368  CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
369  CALL dbt_distribution_new(dist2, pgrid_2d, dist2_1, dist2_2)
370  CALL dbt_distribution_new(dist3, pgrid_3d, dist3_1, dist3_2, dist3_3)
371 
372  CALL dbt_create(tensor_a, "(2|31)", dist1, map11, map12, size_1, size_2, size_3)
373  CALL dbt_create(tensor_b, "(4|3)", dist2, map21, map22, size_3, size_4)
374  CALL dbt_create(tensor_c, "(24|1)", dist3, map31, map32, size_1, size_2, size_4)
375 
376  CALL dbt_setup_test_tensor(tensor_a, mp_comm, .false., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
377  CALL dbt_setup_test_tensor(tensor_b, mp_comm, .false., blk_ind_3_2, blk_ind_4_2)
378  CALL dbt_setup_test_tensor(tensor_c, mp_comm, .false., blk_ind_1_3, blk_ind_2_3, blk_ind_4_3)
379 
380  CALL dbt_contract_test(0.9_dp, tensor_a, tensor_b, 0.1_dp, tensor_c, &
381  [3], [1, 2], &
382  [1], [2], &
383  [1, 2], [3], &
384  io_unit, &
385  log_verbose=verbose, &
386  write_int=.true.)
387 
388  DEALLOCATE (map11, map12, map21, map22, map31, map32)
389 
390  CALL dbt_destroy(tensor_a)
391  CALL dbt_destroy(tensor_b)
392  CALL dbt_destroy(tensor_c)
393  CALL dbt_distribution_destroy(dist1)
394  CALL dbt_distribution_destroy(dist2)
395  CALL dbt_distribution_destroy(dist3)
396 
397 !-------------------------------------------------------------------------------------------------!
398 ! Test 6: Testing tensor contraction (4|3)x(1|32)=(24|1) !
399 !-------------------------------------------------------------------------------------------------!
400 
401  ALLOCATE (map11(1), map12(2), map21(1), map22(1), map31(2), map32(1))
402  map11(:) = [1]
403  map12(:) = [3, 2]
404  map21(:) = [2]
405  map22(:) = [1]
406  map31(:) = [2, 3]
407  map32(:) = [1]
408 
409  CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
410  CALL dbt_distribution_new(dist2, pgrid_2d, dist2_1, dist2_2)
411  CALL dbt_distribution_new(dist3, pgrid_3d, dist3_1, dist3_2, dist3_3)
412 
413  CALL dbt_create(tensor_a, "(1|32)", dist1, map11, map12, size_1, size_2, size_3)
414  CALL dbt_create(tensor_b, "(4|3)", dist2, map21, map22, size_3, size_4)
415  CALL dbt_create(tensor_c, "(24|1)", dist3, map31, map32, size_1, size_2, size_4)
416 
417  CALL dbt_setup_test_tensor(tensor_a, mp_comm, .false., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
418  CALL dbt_setup_test_tensor(tensor_b, mp_comm, .false., blk_ind_3_2, blk_ind_4_2)
419  CALL dbt_setup_test_tensor(tensor_c, mp_comm, .false., blk_ind_1_3, blk_ind_2_3, blk_ind_4_3)
420 
421  ALLOCATE (bounds_t(ndims_tensor(tensor_b)))
422  CALL dbt_get_info(tensor_b, nfull_total=bounds_t)
423 
424  ALLOCATE (bounds(2, 1))
425  bounds(1, 1) = 1
426  bounds(2, 1) = bounds_t(1) - 21
427 
428  CALL dbt_contract_test(0.9_dp, tensor_b, tensor_a, 0.1_dp, tensor_c, &
429  [1], [2], &
430  [3], [1, 2], &
431  [3], [1, 2], &
432  io_unit, &
433  bounds_1=bounds, &
434  log_verbose=verbose, &
435  write_int=.true.)
436 
437  DEALLOCATE (map11, map12, map21, map22, map31, map32, bounds_t, bounds)
438 
439  CALL dbt_destroy(tensor_a)
440  CALL dbt_destroy(tensor_b)
441  CALL dbt_destroy(tensor_c)
442  CALL dbt_distribution_destroy(dist1)
443  CALL dbt_distribution_destroy(dist2)
444  CALL dbt_distribution_destroy(dist3)
445 
446 !-------------------------------------------------------------------------------------------------!
447 ! Test 7: Testing tensor contraction (1|24)x(3|4)=(21|3) !
448 !-------------------------------------------------------------------------------------------------!
449 
450  ALLOCATE (map11(2), map12(1), map21(1), map22(1), map31(1), map32(2))
451  map11(:) = [2, 1]
452  map12(:) = [3]
453  map21(:) = [1]
454  map22(:) = [2]
455  map31(:) = [1]
456  map32(:) = [2, 3]
457 
458  CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
459  CALL dbt_distribution_new(dist2, pgrid_2d, dist2_1, dist2_2)
460  CALL dbt_distribution_new(dist3, pgrid_3d, dist3_1, dist3_2, dist3_3)
461 
462  CALL dbt_create(tensor_a, "(21|3)", dist1, map11, map12, size_1, size_2, size_3)
463  CALL dbt_create(tensor_b, "(3|4)", dist2, map21, map22, size_3, size_4)
464  CALL dbt_create(tensor_c, "(1|24)", dist3, map31, map32, size_1, size_2, size_4)
465 
466  CALL dbt_setup_test_tensor(tensor_a, mp_comm, .false., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
467  CALL dbt_setup_test_tensor(tensor_b, mp_comm, .false., blk_ind_3_2, blk_ind_4_2)
468  CALL dbt_setup_test_tensor(tensor_c, mp_comm, .false., blk_ind_1_3, blk_ind_2_3, blk_ind_4_3)
469 
470  ALLOCATE (bounds_t(ndims_tensor(tensor_c)))
471  CALL dbt_get_info(tensor_c, nfull_total=bounds_t)
472 
473  ALLOCATE (bounds(2, 2))
474  bounds(1, 1) = 4
475  bounds(2, 1) = bounds_t(1)
476  bounds(1, 2) = 13
477  bounds(2, 2) = bounds_t(2) - 10
478  DEALLOCATE (bounds_t)
479 
480  CALL dbt_contract_test(0.2_dp, tensor_c, tensor_b, 0.8_dp, tensor_a, &
481  [3], [1, 2], &
482  [2], [1], &
483  [1, 2], [3], &
484  io_unit, &
485  bounds_2=bounds, &
486  log_verbose=verbose, &
487  write_int=.true.)
488 
489  DEALLOCATE (map11, map12, map21, map22, map31, map32, bounds)
490 
491  CALL dbt_destroy(tensor_a)
492  CALL dbt_destroy(tensor_b)
493  CALL dbt_destroy(tensor_c)
494  CALL dbt_distribution_destroy(dist1)
495  CALL dbt_distribution_destroy(dist2)
496  CALL dbt_distribution_destroy(dist3)
497 
498 !-------------------------------------------------------------------------------------------------!
499 ! Test 8: Testing tensor contraction (12|3)x(12|45)=(3|45)
500 !-------------------------------------------------------------------------------------------------!
501 
502  ALLOCATE (map11(2), map12(1), map21(2), map22(2), map31(1), map32(2))
503  map11(:) = [1, 2]
504  map12(:) = [3]
505  map21(:) = [1, 2]
506  map22(:) = [3, 4]
507  map31(:) = [1]
508  map32(:) = [2, 3]
509 
510  CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
511  CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
512  CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
513 
514  CALL dbt_create(tensor_a, "(12|3)", dist1, map11, map12, size_1, size_2, size_3)
515  CALL dbt_create(tensor_b, "(12|45)", dist2, map21, map22, size_1, size_2, size_4, size_5)
516  CALL dbt_create(tensor_c, "(3|45)", dist3, map31, map32, size_3, size_4, size_5)
517 
518  CALL dbt_setup_test_tensor(tensor_a, mp_comm, .false., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
519  CALL dbt_setup_test_tensor(tensor_b, mp_comm, .false., blk_ind_1_4, blk_ind_2_4, blk_ind_4_4, blk_ind_5_4)
520  CALL dbt_setup_test_tensor(tensor_c, mp_comm, .false., blk_ind_3_5, blk_ind_4_5, blk_ind_5_5)
521 
522  ALLOCATE (bounds_t(ndims_tensor(tensor_a)))
523  CALL dbt_get_info(tensor_a, nfull_total=bounds_t)
524  ALLOCATE (bounds_1(2, 2))
525  bounds_1(1, 1) = 7
526  bounds_1(2, 1) = bounds_t(2) - 17
527  bounds_1(1, 2) = 8
528  bounds_1(2, 2) = bounds_t(1)
529  DEALLOCATE (bounds_t)
530 
531  ALLOCATE (bounds_t(ndims_tensor(tensor_b)))
532  CALL dbt_get_info(tensor_b, nfull_total=bounds_t)
533  ALLOCATE (bounds_2(2, 2))
534  bounds_2(1, 1) = 1
535  bounds_2(2, 1) = bounds_t(3)
536  bounds_2(1, 2) = 1
537  bounds_2(2, 2) = bounds_t(4) - 18
538  DEALLOCATE (bounds_t)
539 
540  CALL dbt_contract_test(0.2_dp, tensor_a, tensor_b, 0.8_dp, tensor_c, &
541  [2, 1], [3], &
542  [2, 1], [3, 4], &
543  [1], [2, 3], &
544  io_unit, &
545  bounds_1=bounds_1, &
546  bounds_3=bounds_2, &
547  log_verbose=verbose, &
548  write_int=.true.)
549 
550  DEALLOCATE (map11, map12, map21, map22, map31, map32, bounds_1, bounds_2)
551 
552  CALL dbt_destroy(tensor_a)
553  CALL dbt_destroy(tensor_b)
554  CALL dbt_destroy(tensor_c)
555  CALL dbt_distribution_destroy(dist1)
556  CALL dbt_distribution_destroy(dist2)
557  CALL dbt_distribution_destroy(dist3)
558 
559 !-------------------------------------------------------------------------------------------------!
560 ! Test 9: Testing tensor contraction (3|21)x(12|45)=(3|45)
561 !-------------------------------------------------------------------------------------------------!
562 
563  ALLOCATE (map11(1), map12(2), map21(2), map22(2), map31(1), map32(2))
564  map11(:) = [3]
565  map12(:) = [2, 1]
566  map21(:) = [1, 2]
567  map22(:) = [3, 4]
568  map31(:) = [1]
569  map32(:) = [2, 3]
570 
571  CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
572  CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
573  CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
574 
575  CALL dbt_create(tensor_a, "(3|21)", dist1, map11, map12, size_1, size_2, size_3)
576  CALL dbt_create(tensor_b, "(12|45)", dist2, map21, map22, size_1, size_2, size_4, size_5)
577  CALL dbt_create(tensor_c, "(3|45)", dist3, map31, map32, size_3, size_4, size_5)
578 
579  CALL dbt_setup_test_tensor(tensor_a, mp_comm, .false., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
580  CALL dbt_setup_test_tensor(tensor_b, mp_comm, .false., blk_ind_1_4, blk_ind_2_4, blk_ind_4_4, blk_ind_5_4)
581  CALL dbt_setup_test_tensor(tensor_c, mp_comm, .false., blk_ind_3_5, blk_ind_4_5, blk_ind_5_5)
582 
583  CALL dbt_contract_test(0.2_dp, tensor_a, tensor_b, 0.8_dp, tensor_c, &
584  [2, 1], [3], &
585  [2, 1], [3, 4], &
586  [1], [2, 3], &
587  io_unit, &
588  log_verbose=verbose, &
589  write_int=.true.)
590 
591  DEALLOCATE (map11, map12, map21, map22, map31, map32)
592 
593  CALL dbt_destroy(tensor_a)
594  CALL dbt_destroy(tensor_b)
595  CALL dbt_destroy(tensor_c)
596  CALL dbt_distribution_destroy(dist1)
597  CALL dbt_distribution_destroy(dist2)
598  CALL dbt_distribution_destroy(dist3)
599 
600 !-------------------------------------------------------------------------------------------------!
601 ! Test 10: Testing tensor contraction (13|2)x(54|21)=(3|45)
602 !-------------------------------------------------------------------------------------------------!
603 
604  ALLOCATE (map11(2), map12(1), map21(2), map22(2), map31(1), map32(2))
605  map11(:) = [1, 3]
606  map12(:) = [2]
607  map21(:) = [4, 3]
608  map22(:) = [2, 1]
609  map31(:) = [1]
610  map32(:) = [2, 3]
611 
612  CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
613  CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
614  CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
615 
616  CALL dbt_create(tensor_a, "(13|2)", dist1, map11, map12, size_1, size_2, size_3)
617  CALL dbt_create(tensor_b, "(54|21)", dist2, map21, map22, size_1, size_2, size_4, size_5)
618  CALL dbt_create(tensor_c, "(3|45)", dist3, map31, map32, size_3, size_4, size_5)
619 
620  CALL dbt_setup_test_tensor(tensor_a, mp_comm, .false., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
621  CALL dbt_setup_test_tensor(tensor_b, mp_comm, .false., blk_ind_1_4, blk_ind_2_4, blk_ind_4_4, blk_ind_5_4)
622  CALL dbt_setup_test_tensor(tensor_c, mp_comm, .false., blk_ind_3_5, blk_ind_4_5, blk_ind_5_5)
623 
624  CALL dbt_contract_test(0.2_dp, tensor_a, tensor_b, 0.8_dp, tensor_c, &
625  [1, 2], [3], &
626  [1, 2], [3, 4], &
627  [1], [2, 3], &
628  io_unit, &
629  log_verbose=verbose, &
630  write_int=.true.)
631 
632  DEALLOCATE (map11, map12, map21, map22, map31, map32)
633 
634  CALL dbt_destroy(tensor_a)
635  CALL dbt_destroy(tensor_b)
636  CALL dbt_destroy(tensor_c)
637  CALL dbt_distribution_destroy(dist1)
638  CALL dbt_distribution_destroy(dist2)
639  CALL dbt_distribution_destroy(dist3)
640 
641 !-------------------------------------------------------------------------------------------------!
642 ! Test 10: Testing tensor contraction (54|21)x(2|31)=(43|5)
643 !-------------------------------------------------------------------------------------------------!
644 
645  ALLOCATE (map11(1), map12(2), map21(2), map22(2), map31(2), map32(1))
646  map11(:) = [2]
647  map12(:) = [3, 1]
648  map21(:) = [4, 3]
649  map22(:) = [2, 1]
650  map31(:) = [2, 1]
651  map32(:) = [3]
652 
653  CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
654  CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
655  CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
656 
657  CALL dbt_create(tensor_a, "(2|31)", dist1, map11, map12, size_1, size_2, size_3)
658  CALL dbt_create(tensor_b, "(54|21)", dist2, map21, map22, size_1, size_2, size_4, size_5)
659  CALL dbt_create(tensor_c, "(43|5)", dist3, map31, map32, size_3, size_4, size_5)
660 
661  CALL dbt_setup_test_tensor(tensor_a, mp_comm, .false., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
662  CALL dbt_setup_test_tensor(tensor_b, mp_comm, .false., blk_ind_1_4, blk_ind_2_4, blk_ind_4_4, blk_ind_5_4)
663  CALL dbt_setup_test_tensor(tensor_c, mp_comm, .false., blk_ind_3_5, blk_ind_4_5, blk_ind_5_5)
664 
665  CALL dbt_contract_test(0.2_dp, tensor_b, tensor_a, 0.8_dp, tensor_c, &
666  [2, 1], [4, 3], &
667  [2, 1], [3], &
668  [3, 2], [1], &
669  io_unit, &
670  log_verbose=verbose, &
671  write_int=.true.)
672 
673  DEALLOCATE (map11, map12, map21, map22, map31, map32)
674 
675  CALL dbt_destroy(tensor_a)
676  CALL dbt_destroy(tensor_b)
677  CALL dbt_destroy(tensor_c)
678  CALL dbt_distribution_destroy(dist1)
679  CALL dbt_distribution_destroy(dist2)
680  CALL dbt_distribution_destroy(dist3)
681 
682 !-------------------------------------------------------------------------------------------------!
683 ! Test 11: Testing tensor contraction (241|5)x(31|2)=(5|43)
684 !-------------------------------------------------------------------------------------------------!
685 
686  ALLOCATE (map11(2), map12(1), map21(3), map22(1), map31(1), map32(2))
687  map11(:) = [3, 1]
688  map12(:) = [2]
689  map21(:) = [2, 3, 1]
690  map22(:) = [4]
691  map31(:) = [3]
692  map32(:) = [2, 1]
693 
694  CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
695  CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
696  CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
697 
698  CALL dbt_create(tensor_a, "(31|2)", dist1, map11, map12, size_1, size_2, size_3)
699  CALL dbt_create(tensor_b, "(241|5)", dist2, map21, map22, size_1, size_2, size_4, size_5)
700  CALL dbt_create(tensor_c, "(5|43)", dist3, map31, map32, size_3, size_4, size_5)
701 
702  CALL dbt_setup_test_tensor(tensor_a, mp_comm, .false., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
703  CALL dbt_setup_test_tensor(tensor_b, mp_comm, .false., blk_ind_1_4, blk_ind_2_4, blk_ind_4_4, blk_ind_5_4)
704  CALL dbt_setup_test_tensor(tensor_c, mp_comm, .false., blk_ind_3_5, blk_ind_4_5, blk_ind_5_5)
705 
706  CALL dbt_contract_test(0.6_dp, tensor_b, tensor_a, 0.4_dp, tensor_c, &
707  [2, 1], [3, 4], &
708  [2, 1], [3], &
709  [2, 3], [1], &
710  io_unit, &
711  log_verbose=verbose, &
712  write_int=.true.)
713 
714  DEALLOCATE (map11, map12, map21, map22, map31, map32)
715 
716  CALL dbt_destroy(tensor_a)
717  CALL dbt_destroy(tensor_b)
718  CALL dbt_destroy(tensor_c)
719  CALL dbt_distribution_destroy(dist1)
720  CALL dbt_distribution_destroy(dist2)
721  CALL dbt_distribution_destroy(dist3)
722 
723 !-------------------------------------------------------------------------------------------------!
724 ! Test 12: Testing tensor contraction (34|5)x(12|3)=(14|25)
725 !-------------------------------------------------------------------------------------------------!
726 
727  ALLOCATE (map11(2), map12(1), map21(2), map22(2), map31(2), map32(1))
728  map11(:) = [1, 2]
729  map12(:) = [3]
730  map21(:) = [1, 3]
731  map22(:) = [2, 4]
732  map31(:) = [1, 2]
733  map32(:) = [3]
734 
735  CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
736  CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
737  CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
738 
739  CALL dbt_create(tensor_a, "(12|3)", dist1, map11, map12, size_1, size_2, size_3)
740  CALL dbt_create(tensor_b, "(14|25)", dist2, map21, map22, size_1, size_2, size_4, size_5)
741  CALL dbt_create(tensor_c, "(34|5)", dist3, map31, map32, size_3, size_4, size_5)
742 
743  CALL dbt_setup_test_tensor(tensor_a, mp_comm, .false., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
744  CALL dbt_setup_test_tensor(tensor_b, mp_comm, .false., blk_ind_1_4, blk_ind_2_4, blk_ind_4_4, blk_ind_5_4)
745  CALL dbt_setup_test_tensor(tensor_c, mp_comm, .false., blk_ind_3_5, blk_ind_4_5, blk_ind_5_5)
746 
747  CALL dbt_contract_test(0.2_dp, tensor_c, tensor_a, 0.8_dp, tensor_b, &
748  [1], [2, 3], &
749  [3], [1, 2], &
750  [3, 4], [1, 2], &
751  io_unit, &
752  log_verbose=verbose, &
753  write_int=.true.)
754 
755  DEALLOCATE (map11, map12, map21, map22, map31, map32)
756 
757  CALL dbt_destroy(tensor_a)
758  CALL dbt_destroy(tensor_b)
759  CALL dbt_destroy(tensor_c)
760  CALL dbt_distribution_destroy(dist1)
761  CALL dbt_distribution_destroy(dist2)
762  CALL dbt_distribution_destroy(dist3)
763 
764 !--------------------------------------------------------------------------------------------------!
765 ! Cleanup for tensor contraction tests !
766 !--------------------------------------------------------------------------------------------------!
767 
768  DEALLOCATE (blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
769  DEALLOCATE (blk_ind_3_2, blk_ind_4_2)
770  DEALLOCATE (blk_ind_1_3, blk_ind_2_3, blk_ind_4_3)
771  DEALLOCATE (blk_ind_1_4, blk_ind_2_4, blk_ind_4_4, blk_ind_5_4)
772  DEALLOCATE (blk_ind_3_5, blk_ind_4_5, blk_ind_5_5)
773  DEALLOCATE (size_1, size_2, size_3, size_4, size_5, dist1_1, dist1_2, dist1_3, &
774  dist2_1, dist2_2, dist3_1, dist3_2, dist3_3, dist4_1, dist4_2, &
775  dist4_3, dist4_4, dist5_1, dist5_2, dist5_3)
776  CALL dbt_pgrid_destroy(pgrid_3d)
777  CALL dbt_pgrid_destroy(pgrid_2d)
778  CALL dbt_pgrid_destroy(pgrid_4d)
779 
780  END IF
781 
782 !--------------------------------------------------------------------------------------------------!
783 ! End tests !
784 !--------------------------------------------------------------------------------------------------!
785 
786  CALL dbm_library_print_stats(mp_comm, io_unit)
787  CALL dbm_library_finalize()
788  CALL dbcsr_finalize_lib() ! Needed for DBM_VALIDATE_AGAINST_DBCSR.
789 
790  ! finalize mpi
791  CALL mp_world_finalize()
792 
793 END PROGRAM
program dbt_unittest
Block tensor unit test.
Definition: dbt_unittest.F:12
Definition: dbm_api.F:8
subroutine, public dbm_library_init()
Initialize DBM library.
Definition: dbm_api.F:1483
subroutine, public dbm_library_finalize()
Finalize DBM library.
Definition: dbm_api.F:1497
subroutine, public dbm_library_print_stats(mpi_comm, output_unit)
Print DBM library statistics.
Definition: dbm_api.F:1513
General methods for testing DBT tensors.
Definition: dbt_test.F:12
subroutine, public dbt_reset_randmat_seed()
Reset the seed used for generating random matrices to default value.
Definition: dbt_test.F:1195
subroutine, public dbt_test_formats(ndims, mp_comm, unit_nr, verbose, blk_size_1, blk_size_2, blk_size_3, blk_size_4, blk_ind_1, blk_ind_2, blk_ind_3, blk_ind_4)
Test equivalence of all tensor formats, using a random distribution.
Definition: dbt_test.F:176
subroutine, public dbt_contract_test(alpha, tensor_1, tensor_2, beta, tensor_3, contract_1, notcontract_1, contract_2, notcontract_2, map_1, map_2, unit_nr, bounds_1, bounds_2, bounds_3, log_verbose, write_int)
test tensor contraction
Definition: dbt_test.F:833
subroutine, public dbt_setup_test_tensor(tensor, mp_comm, enumerate, blk_ind_1, blk_ind_2, blk_ind_3, blk_ind_4)
Allocate and fill test tensor - entries are enumerated by their index s.t. they only depend on global...
Definition: dbt_test.F:476
DBT tensor framework for block-sparse tensor contraction: Types and create/destroy routines.
Definition: dbt_types.F:12
subroutine, public dbt_pgrid_destroy(pgrid, keep_comm)
destroy process grid
Definition: dbt_types.F:905
subroutine, public dbt_distribution_new(dist, pgrid, nd_dist_1, nd_dist_2, nd_dist_3, nd_dist_4)
Create a tensor distribution.
Definition: dbt_types.F:886
subroutine, public dbt_destroy(tensor)
Destroy a tensor.
Definition: dbt_types.F:1410
subroutine, public dbt_get_info(tensor, nblks_total, nfull_total, nblks_local, nfull_local, pdims, my_ploc, blks_local_1, blks_local_2, blks_local_3, blks_local_4, proc_dist_1, proc_dist_2, proc_dist_3, proc_dist_4, blk_size_1, blk_size_2, blk_size_3, blk_size_4, blk_offset_1, blk_offset_2, blk_offset_3, blk_offset_4, distribution, name)
As block_get_info but for tensors.
Definition: dbt_types.F:1656
pure integer function, public ndims_tensor(tensor)
tensor rank
Definition: dbt_types.F:1227
subroutine, public dbt_default_distvec(nblk, nproc, blk_size, dist)
get a load-balanced and randomized distribution along one tensor dimension
Definition: dbt_types.F:1876
subroutine, public dbt_pgrid_create(mp_comm, dims, pgrid, tensor_dims)
Definition: dbt_types.F:1525
subroutine, public dbt_distribution_destroy(dist)
Destroy tensor distribution.
Definition: dbt_types.F:926
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
Machine interface based on Fortran 2003 and POSIX.
Definition: machine.F:17
integer, parameter, public default_output_unit
Definition: machine.F:45
Interface to the message passing library MPI.
subroutine, public mp_world_init(mp_comm)
initializes the system default communicator
subroutine, public mp_world_finalize()
finalizes the system default communicator
Fortran API for the offload package, which is written in C.
Definition: offload_api.F:12
subroutine, public offload_set_chosen_device(device_id)
Selects the chosen device to be used.
Definition: offload_api.F:132
integer function, public offload_get_device_count()
Returns the number of available devices.
Definition: offload_api.F:112