LCOV - code coverage report
Current view: top level - src/dbt - dbt_unittest.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:e7e05ae) Lines: 418 421 99.3 %
Date: 2024-04-18 06:59:28 Functions: 2 2 100.0 %

          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 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             :       nblks_1 = 14
      90             :       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 1.15