Line data Source code
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 2 : PROGRAM dbt_unittest
13 2 : USE cp_dbcsr_api, ONLY: dbcsr_finalize_lib,&
14 : dbcsr_init_lib
15 : USE dbm_api, ONLY: dbm_library_finalize,&
16 : dbm_library_init,&
17 : dbm_library_print_stats
18 : USE dbt_test, ONLY: dbt_contract_test,&
19 : dbt_reset_randmat_seed,&
20 : dbt_setup_test_tensor,&
21 : dbt_test_formats
22 : USE dbt_types, ONLY: &
23 : dbt_create, dbt_default_distvec, dbt_destroy, dbt_distribution_destroy, &
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,&
29 : mp_world_finalize,&
30 : mp_world_init
31 : USE offload_api, ONLY: offload_get_device_count,&
32 : offload_set_chosen_device
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 4 : INTEGER, DIMENSION(:), ALLOCATABLE :: size_1, size_2, size_3, size_4, size_5, dist1_1, dist1_2, dist1_3, &
42 4 : dist2_1, dist2_2, dist3_1, dist3_2, dist3_3, dist4_1, dist4_2, &
43 2 : dist4_3, dist4_4, dist5_1, dist5_2, dist5_3
44 2 : INTEGER, DIMENSION(:), ALLOCATABLE :: blk_ind_1, blk_ind_2, blk_ind_3, blk_ind_4, blk_ind_1_1, blk_ind_2_1, &
45 2 : blk_ind_3_1, blk_ind_3_2, blk_ind_4_2, blk_ind_1_3, blk_ind_2_3, &
46 2 : blk_ind_4_3, blk_ind_1_4, blk_ind_2_4, blk_ind_4_4, blk_ind_5_4, &
47 2 : blk_ind_3_5, blk_ind_4_5, blk_ind_5_5
48 2 : INTEGER, DIMENSION(:), ALLOCATABLE :: map11, map31, map12, map32, map21, map22
49 :
50 : LOGICAL, PARAMETER :: verbose = .FALSE.
51 38 : TYPE(dbt_distribution_type) :: dist1, dist2, dist3
52 38 : 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 14 : TYPE(dbt_pgrid_type) :: pgrid_2d, pgrid_3d, pgrid_4d
60 2 : INTEGER, DIMENSION(:), ALLOCATABLE :: bounds_t
61 2 : INTEGER, DIMENSION(:, :), ALLOCATABLE :: bounds, bounds_1, bounds_2
62 :
63 2 : CALL mp_world_init(mp_comm)
64 2 : mynode = mp_comm%mepos
65 :
66 : ! Select active offload device when available.
67 2 : IF (offload_get_device_count() > 0) THEN
68 0 : CALL offload_set_chosen_device(MOD(mynode, offload_get_device_count()))
69 : END IF
70 :
71 : ! set standard output parameters
72 2 : io_unit = -1
73 2 : IF (mynode .EQ. 0) io_unit = default_output_unit
74 :
75 2 : CALL dbcsr_init_lib(mp_comm%get_handle(), io_unit) ! Needed for DBM_VALIDATE_AGAINST_DBCSR.
76 2 : CALL dbm_library_init()
77 :
78 2 : CALL dbt_reset_randmat_seed()
79 :
80 : ! Process grid
81 :
82 : IF (test_format) THEN
83 : !--------------------------------------------------------------------------------------------------!
84 : ! Test 1: Testing matrix representations of tensor rank 2 !
85 : !--------------------------------------------------------------------------------------------------!
86 2 : ndims = 2
87 :
88 : ! Number of blocks in each dimension
89 2 : nblks_1 = 14
90 2 : nblks_2 = 21
91 :
92 : ! Block sizes in each dimension
93 2 : ALLOCATE (size_1(nblks_1), size_2(nblks_2))
94 :
95 30 : size_1(:) = [3, 5, 1, 23, 2, 3, 1, 6, 3, 8, 2, 3, 5, 1]
96 44 : 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 2 : nblks_alloc = 12
100 2 : 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 26 : blk_ind_1(:) = [1, 1, 1, 2, 4, 4, 7, 10, 10, 10, 10, 13] !&
104 26 : 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 2 : blk_ind_1=blk_ind_1, blk_ind_2=blk_ind_2)
110 :
111 2 : DEALLOCATE (size_1, size_2)
112 2 : DEALLOCATE (blk_ind_1, blk_ind_2)
113 :
114 : !--------------------------------------------------------------------------------------------------!
115 : ! Test 2: Testing matrix representations of tensor rank 3 !
116 : !--------------------------------------------------------------------------------------------------!
117 2 : 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 2 : ALLOCATE (size_1(nblks_1), size_2(nblks_2), size_3(nblks_3))
126 :
127 10 : size_1(:) = [3, 1, 5, 2]
128 14 : size_2(:) = [1, 2, 5, 3, 2, 4]
129 8 : size_3(:) = [4, 2, 10]
130 :
131 : ! Number of non-zero blocks
132 2 : nblks_alloc = 6
133 2 : 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 14 : blk_ind_1(:) = [1, 1, 1, 2, 2, 2] !&
137 14 : blk_ind_2(:) = [2, 2, 4, 1, 1, 2] !&
138 14 : 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 2 : blk_ind_1=blk_ind_1, blk_ind_2=blk_ind_2, blk_ind_3=blk_ind_3)
144 :
145 2 : DEALLOCATE (size_1, size_2, size_3)
146 2 : DEALLOCATE (blk_ind_1, blk_ind_2, blk_ind_3)
147 :
148 : !--------------------------------------------------------------------------------------------------!
149 : ! Test 3: Testing matrix representations of tensor rank 4 !
150 : !--------------------------------------------------------------------------------------------------!
151 2 : 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 2 : ALLOCATE (size_1(nblks_1), size_2(nblks_2), size_3(nblks_3), size_4(nblks_4))
161 :
162 6 : size_1(:) = [5, 9]
163 28 : size_2(:) = [6, 2, 5, 12, 3, 1, 7, 2, 5, 17, 9, 3, 4]
164 16 : size_3(:) = [2, 7, 3, 8, 5, 15, 1]
165 8 : size_4(:) = [12, 5, 3]
166 :
167 : ! Number of non-zero blocks
168 2 : nblks_alloc = 19
169 2 : 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 40 : blk_ind_1(:) = [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2] !&
173 40 : blk_ind_2(:) = [2, 2, 3, 4, 7, 7, 10, 11, 11, 12, 12, 1, 1, 3, 5, 6, 6, 9, 12] !&
174 40 : blk_ind_3(:) = [1, 4, 6, 3, 1, 4, 2, 5, 7, 3, 3, 1, 4, 7, 6, 4, 5, 2, 3] !&
175 40 : 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 2 : 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 2 : DEALLOCATE (size_1, size_2, size_3, size_4)
183 2 : 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 2 : nblks_1 = 4
193 2 : nblks_2 = 11
194 2 : nblks_3 = 9
195 2 : nblks_4 = 5
196 2 : nblks_5 = 3
197 :
198 : ! Block sizes in each dimension
199 2 : ALLOCATE (size_1(nblks_1), size_2(nblks_2), size_3(nblks_3), size_4(nblks_4), size_5(nblks_5))
200 :
201 10 : size_1(:) = [3, 9, 12, 1]
202 24 : size_2(:) = [4, 2, 3, 1, 9, 2, 32, 10, 5, 8, 7]
203 20 : size_3(:) = [7, 3, 8, 7, 9, 5, 10, 23, 2]
204 12 : size_4(:) = [8, 1, 4, 13, 6]
205 8 : size_5(:) = [4, 2, 22]
206 :
207 2 : nblks_alloc_1 = 32
208 2 : 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 66 : 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 66 : 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 66 : 2, 7] !&
224 :
225 2 : nblks_alloc_2 = 12
226 2 : 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 26 : 8, 8] !&
230 : blk_ind_4_2(:) = [2, 3, 2, 4, 5, 3, 5, 1, 3, 3, & !&
231 26 : 1, 4] !&
232 :
233 2 : nblks_alloc_3 = 5
234 2 : ALLOCATE (blk_ind_1_3(nblks_alloc_3), blk_ind_2_3(nblks_alloc_3), blk_ind_4_3(nblks_alloc_3))
235 :
236 12 : blk_ind_1_3(:) = [1, 1, 2, 4, 4]
237 12 : blk_ind_2_3(:) = [2, 6, 6, 7, 9]
238 12 : blk_ind_4_3(:) = [1, 3, 4, 4, 5]
239 :
240 2 : nblks_alloc_4 = 36
241 2 : ALLOCATE (blk_ind_1_4(nblks_alloc_4))
242 2 : ALLOCATE (blk_ind_2_4(nblks_alloc_4))
243 2 : ALLOCATE (blk_ind_4_4(nblks_alloc_4))
244 2 : 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 74 : 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 74 : 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 74 : 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 74 : 1, 3, 2, 1, 3, 2] !&
265 :
266 2 : nblks_alloc_5 = 8
267 :
268 2 : ALLOCATE (blk_ind_3_5(nblks_alloc_5), blk_ind_4_5(nblks_alloc_5), blk_ind_5_5(nblks_alloc_5))
269 :
270 18 : blk_ind_3_5(:) = [2, 4, 5, 5, 5, 6, 6, 8]
271 18 : blk_ind_4_5(:) = [3, 2, 1, 1, 3, 2, 4, 5]
272 18 : blk_ind_5_5(:) = [3, 2, 1, 2, 3, 2, 1, 1]
273 :
274 2 : pdims_4d(:) = 0; pdims_3d(:) = 0; pdims_2d(:) = 0
275 2 : CALL dbt_pgrid_create(mp_comm, pdims_4d, pgrid_4d)
276 2 : CALL dbt_pgrid_create(mp_comm, pdims_3d, pgrid_3d)
277 2 : CALL dbt_pgrid_create(mp_comm, pdims_2d, pgrid_2d)
278 :
279 2 : ALLOCATE (dist1_1(nblks_1))
280 2 : CALL dbt_default_distvec(nblks_1, pdims_3d(1), size_1, dist1_1)
281 2 : ALLOCATE (dist1_2(nblks_2))
282 2 : CALL dbt_default_distvec(nblks_2, pdims_3d(2), size_2, dist1_2)
283 2 : ALLOCATE (dist1_3(nblks_3))
284 2 : CALL dbt_default_distvec(nblks_3, pdims_3d(3), size_3, dist1_3)
285 :
286 2 : ALLOCATE (dist2_1(nblks_3))
287 2 : CALL dbt_default_distvec(nblks_3, pdims_2d(1), size_3, dist2_1)
288 2 : ALLOCATE (dist2_2(nblks_4))
289 2 : CALL dbt_default_distvec(nblks_4, pdims_2d(2), size_4, dist2_2)
290 :
291 2 : ALLOCATE (dist3_1(nblks_1))
292 2 : CALL dbt_default_distvec(nblks_1, pdims_3d(1), size_1, dist3_1)
293 2 : ALLOCATE (dist3_2(nblks_2))
294 2 : CALL dbt_default_distvec(nblks_2, pdims_3d(2), size_2, dist3_2)
295 2 : ALLOCATE (dist3_3(nblks_4))
296 2 : CALL dbt_default_distvec(nblks_4, pdims_3d(3), size_4, dist3_3)
297 :
298 2 : ALLOCATE (dist4_1(nblks_1))
299 2 : CALL dbt_default_distvec(nblks_1, pdims_4d(1), size_1, dist4_1)
300 2 : ALLOCATE (dist4_2(nblks_2))
301 2 : CALL dbt_default_distvec(nblks_2, pdims_4d(2), size_2, dist4_2)
302 2 : ALLOCATE (dist4_3(nblks_4))
303 2 : CALL dbt_default_distvec(nblks_4, pdims_4d(3), size_4, dist4_3)
304 2 : ALLOCATE (dist4_4(nblks_5))
305 2 : CALL dbt_default_distvec(nblks_5, pdims_4d(4), size_5, dist4_4)
306 :
307 2 : ALLOCATE (dist5_1(nblks_3))
308 2 : CALL dbt_default_distvec(nblks_3, pdims_3d(1), size_3, dist5_1)
309 2 : ALLOCATE (dist5_2(nblks_4))
310 2 : CALL dbt_default_distvec(nblks_4, pdims_3d(2), size_4, dist5_2)
311 2 : ALLOCATE (dist5_3(nblks_5))
312 2 : 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 2 : ALLOCATE (map11(2), map12(1), map21(1), map22(1), map31(2), map32(1))
319 6 : map11(:) = [1, 2]
320 4 : map12(:) = [3]
321 4 : map21(:) = [1]
322 4 : map22(:) = [2]
323 6 : map31(:) = [1, 2]
324 4 : map32(:) = [3]
325 :
326 2 : CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
327 2 : CALL dbt_distribution_new(dist2, pgrid_2d, dist2_1, dist2_2)
328 2 : CALL dbt_distribution_new(dist3, pgrid_3d, dist3_1, dist3_2, dist3_3)
329 :
330 2 : CALL dbt_create(tensor_A, "(12|3)", dist1, map11, map12, size_1, size_2, size_3)
331 2 : CALL dbt_create(tensor_B, "(3|4)", dist2, map21, map22, size_3, size_4)
332 2 : CALL dbt_create(tensor_C, "(12|4)", dist3, map31, map32, size_1, size_2, size_4)
333 :
334 2 : CALL dbt_setup_test_tensor(tensor_A, mp_comm, .FALSE., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
335 2 : CALL dbt_setup_test_tensor(tensor_B, mp_comm, .FALSE., blk_ind_3_2, blk_ind_4_2)
336 :
337 2 : 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 2 : write_int=.TRUE.)
346 :
347 2 : DEALLOCATE (map11, map12, map21, map22, map31, map32)
348 :
349 2 : CALL dbt_destroy(tensor_A)
350 2 : CALL dbt_destroy(tensor_B)
351 2 : CALL dbt_destroy(tensor_C)
352 2 : CALL dbt_distribution_destroy(dist1)
353 2 : CALL dbt_distribution_destroy(dist2)
354 2 : CALL dbt_distribution_destroy(dist3)
355 :
356 : !--------------------------------------------------------------------------------------------------!
357 : ! Test 5: Testing tensor contraction (2|31)x(4|3)=(24|1) !
358 : !--------------------------------------------------------------------------------------------------!
359 :
360 2 : ALLOCATE (map11(1), map12(2), map21(1), map22(1), map31(2), map32(1))
361 4 : map11(:) = [2]
362 6 : map12(:) = [3, 1]
363 4 : map21(:) = [2]
364 4 : map22(:) = [1]
365 6 : map31(:) = [2, 3]
366 4 : map32(:) = [1]
367 :
368 2 : CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
369 2 : CALL dbt_distribution_new(dist2, pgrid_2d, dist2_1, dist2_2)
370 2 : CALL dbt_distribution_new(dist3, pgrid_3d, dist3_1, dist3_2, dist3_3)
371 :
372 2 : CALL dbt_create(tensor_A, "(2|31)", dist1, map11, map12, size_1, size_2, size_3)
373 2 : CALL dbt_create(tensor_B, "(4|3)", dist2, map21, map22, size_3, size_4)
374 2 : CALL dbt_create(tensor_C, "(24|1)", dist3, map31, map32, size_1, size_2, size_4)
375 :
376 2 : CALL dbt_setup_test_tensor(tensor_A, mp_comm, .FALSE., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
377 2 : CALL dbt_setup_test_tensor(tensor_B, mp_comm, .FALSE., blk_ind_3_2, blk_ind_4_2)
378 2 : 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 2 : write_int=.TRUE.)
387 :
388 2 : DEALLOCATE (map11, map12, map21, map22, map31, map32)
389 :
390 2 : CALL dbt_destroy(tensor_A)
391 2 : CALL dbt_destroy(tensor_B)
392 2 : CALL dbt_destroy(tensor_C)
393 2 : CALL dbt_distribution_destroy(dist1)
394 2 : CALL dbt_distribution_destroy(dist2)
395 2 : CALL dbt_distribution_destroy(dist3)
396 :
397 : !-------------------------------------------------------------------------------------------------!
398 : ! Test 6: Testing tensor contraction (4|3)x(1|32)=(24|1) !
399 : !-------------------------------------------------------------------------------------------------!
400 :
401 2 : ALLOCATE (map11(1), map12(2), map21(1), map22(1), map31(2), map32(1))
402 4 : map11(:) = [1]
403 6 : map12(:) = [3, 2]
404 4 : map21(:) = [2]
405 4 : map22(:) = [1]
406 6 : map31(:) = [2, 3]
407 4 : map32(:) = [1]
408 :
409 2 : CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
410 2 : CALL dbt_distribution_new(dist2, pgrid_2d, dist2_1, dist2_2)
411 2 : CALL dbt_distribution_new(dist3, pgrid_3d, dist3_1, dist3_2, dist3_3)
412 :
413 2 : CALL dbt_create(tensor_A, "(1|32)", dist1, map11, map12, size_1, size_2, size_3)
414 2 : CALL dbt_create(tensor_B, "(4|3)", dist2, map21, map22, size_3, size_4)
415 2 : CALL dbt_create(tensor_C, "(24|1)", dist3, map31, map32, size_1, size_2, size_4)
416 :
417 2 : CALL dbt_setup_test_tensor(tensor_A, mp_comm, .FALSE., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
418 2 : CALL dbt_setup_test_tensor(tensor_B, mp_comm, .FALSE., blk_ind_3_2, blk_ind_4_2)
419 2 : CALL dbt_setup_test_tensor(tensor_C, mp_comm, .FALSE., blk_ind_1_3, blk_ind_2_3, blk_ind_4_3)
420 :
421 6 : ALLOCATE (bounds_t(ndims_tensor(tensor_B)))
422 2 : CALL dbt_get_info(tensor_B, nfull_total=bounds_t)
423 :
424 2 : ALLOCATE (bounds(2, 1))
425 2 : bounds(1, 1) = 1
426 2 : 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 2 : write_int=.TRUE.)
436 :
437 2 : DEALLOCATE (map11, map12, map21, map22, map31, map32, bounds_t, bounds)
438 :
439 2 : CALL dbt_destroy(tensor_A)
440 2 : CALL dbt_destroy(tensor_B)
441 2 : CALL dbt_destroy(tensor_C)
442 2 : CALL dbt_distribution_destroy(dist1)
443 2 : CALL dbt_distribution_destroy(dist2)
444 2 : CALL dbt_distribution_destroy(dist3)
445 :
446 : !-------------------------------------------------------------------------------------------------!
447 : ! Test 7: Testing tensor contraction (1|24)x(3|4)=(21|3) !
448 : !-------------------------------------------------------------------------------------------------!
449 :
450 2 : ALLOCATE (map11(2), map12(1), map21(1), map22(1), map31(1), map32(2))
451 6 : map11(:) = [2, 1]
452 4 : map12(:) = [3]
453 4 : map21(:) = [1]
454 4 : map22(:) = [2]
455 4 : map31(:) = [1]
456 6 : map32(:) = [2, 3]
457 :
458 2 : CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
459 2 : CALL dbt_distribution_new(dist2, pgrid_2d, dist2_1, dist2_2)
460 2 : CALL dbt_distribution_new(dist3, pgrid_3d, dist3_1, dist3_2, dist3_3)
461 :
462 2 : CALL dbt_create(tensor_A, "(21|3)", dist1, map11, map12, size_1, size_2, size_3)
463 2 : CALL dbt_create(tensor_B, "(3|4)", dist2, map21, map22, size_3, size_4)
464 2 : CALL dbt_create(tensor_C, "(1|24)", dist3, map31, map32, size_1, size_2, size_4)
465 :
466 2 : CALL dbt_setup_test_tensor(tensor_A, mp_comm, .FALSE., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
467 2 : CALL dbt_setup_test_tensor(tensor_B, mp_comm, .FALSE., blk_ind_3_2, blk_ind_4_2)
468 2 : CALL dbt_setup_test_tensor(tensor_C, mp_comm, .FALSE., blk_ind_1_3, blk_ind_2_3, blk_ind_4_3)
469 :
470 6 : ALLOCATE (bounds_t(ndims_tensor(tensor_C)))
471 2 : CALL dbt_get_info(tensor_C, nfull_total=bounds_t)
472 :
473 2 : ALLOCATE (bounds(2, 2))
474 2 : bounds(1, 1) = 4
475 2 : bounds(2, 1) = bounds_t(1)
476 2 : bounds(1, 2) = 13
477 2 : bounds(2, 2) = bounds_t(2) - 10
478 2 : 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 2 : write_int=.TRUE.)
488 :
489 2 : DEALLOCATE (map11, map12, map21, map22, map31, map32, bounds)
490 :
491 2 : CALL dbt_destroy(tensor_A)
492 2 : CALL dbt_destroy(tensor_B)
493 2 : CALL dbt_destroy(tensor_C)
494 2 : CALL dbt_distribution_destroy(dist1)
495 2 : CALL dbt_distribution_destroy(dist2)
496 2 : CALL dbt_distribution_destroy(dist3)
497 :
498 : !-------------------------------------------------------------------------------------------------!
499 : ! Test 8: Testing tensor contraction (12|3)x(12|45)=(3|45)
500 : !-------------------------------------------------------------------------------------------------!
501 :
502 2 : ALLOCATE (map11(2), map12(1), map21(2), map22(2), map31(1), map32(2))
503 6 : map11(:) = [1, 2]
504 4 : map12(:) = [3]
505 6 : map21(:) = [1, 2]
506 6 : map22(:) = [3, 4]
507 4 : map31(:) = [1]
508 6 : map32(:) = [2, 3]
509 :
510 2 : CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
511 2 : CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
512 2 : CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
513 :
514 2 : CALL dbt_create(tensor_A, "(12|3)", dist1, map11, map12, size_1, size_2, size_3)
515 2 : CALL dbt_create(tensor_B, "(12|45)", dist2, map21, map22, size_1, size_2, size_4, size_5)
516 2 : CALL dbt_create(tensor_C, "(3|45)", dist3, map31, map32, size_3, size_4, size_5)
517 :
518 2 : CALL dbt_setup_test_tensor(tensor_A, mp_comm, .FALSE., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
519 2 : 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 2 : CALL dbt_setup_test_tensor(tensor_C, mp_comm, .FALSE., blk_ind_3_5, blk_ind_4_5, blk_ind_5_5)
521 :
522 6 : ALLOCATE (bounds_t(ndims_tensor(tensor_A)))
523 2 : CALL dbt_get_info(tensor_A, nfull_total=bounds_t)
524 2 : ALLOCATE (bounds_1(2, 2))
525 2 : bounds_1(1, 1) = 7
526 2 : bounds_1(2, 1) = bounds_t(2) - 17
527 2 : bounds_1(1, 2) = 8
528 2 : bounds_1(2, 2) = bounds_t(1)
529 2 : DEALLOCATE (bounds_t)
530 :
531 6 : ALLOCATE (bounds_t(ndims_tensor(tensor_B)))
532 2 : CALL dbt_get_info(tensor_B, nfull_total=bounds_t)
533 2 : ALLOCATE (bounds_2(2, 2))
534 2 : bounds_2(1, 1) = 1
535 2 : bounds_2(2, 1) = bounds_t(3)
536 2 : bounds_2(1, 2) = 1
537 2 : bounds_2(2, 2) = bounds_t(4) - 18
538 2 : 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 2 : write_int=.TRUE.)
549 :
550 2 : DEALLOCATE (map11, map12, map21, map22, map31, map32, bounds_1, bounds_2)
551 :
552 2 : CALL dbt_destroy(tensor_A)
553 2 : CALL dbt_destroy(tensor_B)
554 2 : CALL dbt_destroy(tensor_C)
555 2 : CALL dbt_distribution_destroy(dist1)
556 2 : CALL dbt_distribution_destroy(dist2)
557 2 : CALL dbt_distribution_destroy(dist3)
558 :
559 : !-------------------------------------------------------------------------------------------------!
560 : ! Test 9: Testing tensor contraction (3|21)x(12|45)=(3|45)
561 : !-------------------------------------------------------------------------------------------------!
562 :
563 2 : ALLOCATE (map11(1), map12(2), map21(2), map22(2), map31(1), map32(2))
564 4 : map11(:) = [3]
565 6 : map12(:) = [2, 1]
566 6 : map21(:) = [1, 2]
567 6 : map22(:) = [3, 4]
568 4 : map31(:) = [1]
569 6 : map32(:) = [2, 3]
570 :
571 2 : CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
572 2 : CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
573 2 : CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
574 :
575 2 : CALL dbt_create(tensor_A, "(3|21)", dist1, map11, map12, size_1, size_2, size_3)
576 2 : CALL dbt_create(tensor_B, "(12|45)", dist2, map21, map22, size_1, size_2, size_4, size_5)
577 2 : CALL dbt_create(tensor_C, "(3|45)", dist3, map31, map32, size_3, size_4, size_5)
578 :
579 2 : CALL dbt_setup_test_tensor(tensor_A, mp_comm, .FALSE., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
580 2 : 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 2 : 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 2 : write_int=.TRUE.)
590 :
591 2 : DEALLOCATE (map11, map12, map21, map22, map31, map32)
592 :
593 2 : CALL dbt_destroy(tensor_A)
594 2 : CALL dbt_destroy(tensor_B)
595 2 : CALL dbt_destroy(tensor_C)
596 2 : CALL dbt_distribution_destroy(dist1)
597 2 : CALL dbt_distribution_destroy(dist2)
598 2 : CALL dbt_distribution_destroy(dist3)
599 :
600 : !-------------------------------------------------------------------------------------------------!
601 : ! Test 10: Testing tensor contraction (13|2)x(54|21)=(3|45)
602 : !-------------------------------------------------------------------------------------------------!
603 :
604 2 : ALLOCATE (map11(2), map12(1), map21(2), map22(2), map31(1), map32(2))
605 6 : map11(:) = [1, 3]
606 4 : map12(:) = [2]
607 6 : map21(:) = [4, 3]
608 6 : map22(:) = [2, 1]
609 4 : map31(:) = [1]
610 6 : map32(:) = [2, 3]
611 :
612 2 : CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
613 2 : CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
614 2 : CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
615 :
616 2 : CALL dbt_create(tensor_A, "(13|2)", dist1, map11, map12, size_1, size_2, size_3)
617 2 : CALL dbt_create(tensor_B, "(54|21)", dist2, map21, map22, size_1, size_2, size_4, size_5)
618 2 : CALL dbt_create(tensor_C, "(3|45)", dist3, map31, map32, size_3, size_4, size_5)
619 :
620 2 : CALL dbt_setup_test_tensor(tensor_A, mp_comm, .FALSE., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
621 2 : 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 2 : 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 2 : write_int=.TRUE.)
631 :
632 2 : DEALLOCATE (map11, map12, map21, map22, map31, map32)
633 :
634 2 : CALL dbt_destroy(tensor_A)
635 2 : CALL dbt_destroy(tensor_B)
636 2 : CALL dbt_destroy(tensor_C)
637 2 : CALL dbt_distribution_destroy(dist1)
638 2 : CALL dbt_distribution_destroy(dist2)
639 2 : CALL dbt_distribution_destroy(dist3)
640 :
641 : !-------------------------------------------------------------------------------------------------!
642 : ! Test 10: Testing tensor contraction (54|21)x(2|31)=(43|5)
643 : !-------------------------------------------------------------------------------------------------!
644 :
645 2 : ALLOCATE (map11(1), map12(2), map21(2), map22(2), map31(2), map32(1))
646 4 : map11(:) = [2]
647 6 : map12(:) = [3, 1]
648 6 : map21(:) = [4, 3]
649 6 : map22(:) = [2, 1]
650 6 : map31(:) = [2, 1]
651 4 : map32(:) = [3]
652 :
653 2 : CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
654 2 : CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
655 2 : CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
656 :
657 2 : CALL dbt_create(tensor_A, "(2|31)", dist1, map11, map12, size_1, size_2, size_3)
658 2 : CALL dbt_create(tensor_B, "(54|21)", dist2, map21, map22, size_1, size_2, size_4, size_5)
659 2 : CALL dbt_create(tensor_C, "(43|5)", dist3, map31, map32, size_3, size_4, size_5)
660 :
661 2 : CALL dbt_setup_test_tensor(tensor_A, mp_comm, .FALSE., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
662 2 : 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 2 : 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 2 : write_int=.TRUE.)
672 :
673 2 : DEALLOCATE (map11, map12, map21, map22, map31, map32)
674 :
675 2 : CALL dbt_destroy(tensor_A)
676 2 : CALL dbt_destroy(tensor_B)
677 2 : CALL dbt_destroy(tensor_C)
678 2 : CALL dbt_distribution_destroy(dist1)
679 2 : CALL dbt_distribution_destroy(dist2)
680 2 : CALL dbt_distribution_destroy(dist3)
681 :
682 : !-------------------------------------------------------------------------------------------------!
683 : ! Test 11: Testing tensor contraction (241|5)x(31|2)=(5|43)
684 : !-------------------------------------------------------------------------------------------------!
685 :
686 2 : ALLOCATE (map11(2), map12(1), map21(3), map22(1), map31(1), map32(2))
687 6 : map11(:) = [3, 1]
688 4 : map12(:) = [2]
689 8 : map21(:) = [2, 3, 1]
690 4 : map22(:) = [4]
691 4 : map31(:) = [3]
692 6 : map32(:) = [2, 1]
693 :
694 2 : CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
695 2 : CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
696 2 : CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
697 :
698 2 : CALL dbt_create(tensor_A, "(31|2)", dist1, map11, map12, size_1, size_2, size_3)
699 2 : CALL dbt_create(tensor_B, "(241|5)", dist2, map21, map22, size_1, size_2, size_4, size_5)
700 2 : CALL dbt_create(tensor_C, "(5|43)", dist3, map31, map32, size_3, size_4, size_5)
701 :
702 2 : CALL dbt_setup_test_tensor(tensor_A, mp_comm, .FALSE., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
703 2 : 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 2 : 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 2 : write_int=.TRUE.)
713 :
714 2 : DEALLOCATE (map11, map12, map21, map22, map31, map32)
715 :
716 2 : CALL dbt_destroy(tensor_A)
717 2 : CALL dbt_destroy(tensor_B)
718 2 : CALL dbt_destroy(tensor_C)
719 2 : CALL dbt_distribution_destroy(dist1)
720 2 : CALL dbt_distribution_destroy(dist2)
721 2 : CALL dbt_distribution_destroy(dist3)
722 :
723 : !-------------------------------------------------------------------------------------------------!
724 : ! Test 12: Testing tensor contraction (34|5)x(12|3)=(14|25)
725 : !-------------------------------------------------------------------------------------------------!
726 :
727 2 : ALLOCATE (map11(2), map12(1), map21(2), map22(2), map31(2), map32(1))
728 6 : map11(:) = [1, 2]
729 4 : map12(:) = [3]
730 6 : map21(:) = [1, 3]
731 6 : map22(:) = [2, 4]
732 6 : map31(:) = [1, 2]
733 4 : map32(:) = [3]
734 :
735 2 : CALL dbt_distribution_new(dist1, pgrid_3d, dist1_1, dist1_2, dist1_3)
736 2 : CALL dbt_distribution_new(dist2, pgrid_4d, dist4_1, dist4_2, dist4_3, dist4_4)
737 2 : CALL dbt_distribution_new(dist3, pgrid_3d, dist5_1, dist5_2, dist5_3)
738 :
739 2 : CALL dbt_create(tensor_A, "(12|3)", dist1, map11, map12, size_1, size_2, size_3)
740 2 : CALL dbt_create(tensor_B, "(14|25)", dist2, map21, map22, size_1, size_2, size_4, size_5)
741 2 : CALL dbt_create(tensor_C, "(34|5)", dist3, map31, map32, size_3, size_4, size_5)
742 :
743 2 : CALL dbt_setup_test_tensor(tensor_A, mp_comm, .FALSE., blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
744 2 : 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 2 : 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 2 : write_int=.TRUE.)
754 :
755 2 : DEALLOCATE (map11, map12, map21, map22, map31, map32)
756 :
757 2 : CALL dbt_destroy(tensor_A)
758 2 : CALL dbt_destroy(tensor_B)
759 2 : CALL dbt_destroy(tensor_C)
760 2 : CALL dbt_distribution_destroy(dist1)
761 2 : CALL dbt_distribution_destroy(dist2)
762 2 : CALL dbt_distribution_destroy(dist3)
763 :
764 : !--------------------------------------------------------------------------------------------------!
765 : ! Cleanup for tensor contraction tests !
766 : !--------------------------------------------------------------------------------------------------!
767 :
768 2 : DEALLOCATE (blk_ind_1_1, blk_ind_2_1, blk_ind_3_1)
769 2 : DEALLOCATE (blk_ind_3_2, blk_ind_4_2)
770 2 : DEALLOCATE (blk_ind_1_3, blk_ind_2_3, blk_ind_4_3)
771 2 : DEALLOCATE (blk_ind_1_4, blk_ind_2_4, blk_ind_4_4, blk_ind_5_4)
772 2 : DEALLOCATE (blk_ind_3_5, blk_ind_4_5, blk_ind_5_5)
773 0 : DEALLOCATE (size_1, size_2, size_3, size_4, size_5, dist1_1, dist1_2, dist1_3, &
774 0 : dist2_1, dist2_2, dist3_1, dist3_2, dist3_3, dist4_1, dist4_2, &
775 2 : dist4_3, dist4_4, dist5_1, dist5_2, dist5_3)
776 2 : CALL dbt_pgrid_destroy(pgrid_3d)
777 2 : CALL dbt_pgrid_destroy(pgrid_2d)
778 2 : CALL dbt_pgrid_destroy(pgrid_4d)
779 :
780 : END IF
781 :
782 : !--------------------------------------------------------------------------------------------------!
783 : ! End tests !
784 : !--------------------------------------------------------------------------------------------------!
785 :
786 2 : CALL dbm_library_print_stats(mp_comm, io_unit)
787 2 : CALL dbm_library_finalize()
788 2 : CALL dbcsr_finalize_lib() ! Needed for DBM_VALIDATE_AGAINST_DBCSR.
789 :
790 : ! finalize mpi
791 2 : CALL mp_world_finalize()
792 :
793 2 : END PROGRAM
|