LCOV - code coverage report
Current view: top level - src/dbt - dbt_unittest.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 99.3 % 423 420
Test Date: 2025-07-25 12:55:17 Functions: 100.0 % 2 2

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 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
        

Generated by: LCOV version 2.0-1