dbcsr_tensor_test.F Source File


Source Code

# 1 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F" 1
!--------------------------------------------------------------------------------------------------!
! Copyright (C) by the DBCSR developers group - All rights reserved                                !
! This file is part of the DBCSR library.                                                          !
!                                                                                                  !
! For information on the license, see the LICENSE file.                                            !
! For further information please visit https://dbcsr.cp2k.org                                      !
! SPDX-License-Identifier: GPL-2.0+                                                                !
!--------------------------------------------------------------------------------------------------!

MODULE dbcsr_tensor_test
   !! General methods for testing DBCSR tensors.

# 1 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor.fypp" 1
# 9 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor.fypp"

# 241 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor.fypp"
# 14 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F" 2
# 15 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
# 16 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

   USE dbcsr_api, ONLY: dbcsr_type_real_8, dbcsr_type_complex_4, dbcsr_type_real_4, dbcsr_type_complex_8
   USE dbcsr_tensor, ONLY: &
      dbcsr_t_copy, dbcsr_t_get_block, dbcsr_t_iterator_type, dbcsr_t_iterator_blocks_left, &
      dbcsr_t_iterator_next_block, dbcsr_t_iterator_start, dbcsr_t_iterator_stop, &
      dbcsr_t_reserve_blocks, dbcsr_t_get_stored_coordinates, dbcsr_t_put_block, &
      dbcsr_t_contract, dbcsr_t_inverse_order
   USE dbcsr_tensor_block, ONLY: block_nd
   USE dbcsr_tensor_types, ONLY: &
      dbcsr_t_create, dbcsr_t_destroy, dbcsr_t_type, dbcsr_t_distribution_type, dbcsr_t_distribution_destroy, &
      dims_tensor, ndims_tensor, dbcsr_t_distribution_new, dbcsr_t_get_data_type, &
      mp_environ_pgrid, dbcsr_t_pgrid_type, dbcsr_t_pgrid_create, dbcsr_t_pgrid_destroy, dbcsr_t_get_info, &
      dbcsr_t_default_distvec
   USE dbcsr_tensor_io, ONLY: &
      dbcsr_t_write_blocks, dbcsr_t_write_block_indices
   USE dbcsr_kinds, ONLY: real_4, real_8, &
                          default_string_length, &
                          int_8
   USE dbcsr_mpiwrap, ONLY: mp_environ, &
                            mp_comm_free, &
                            mp_sum, &
                            mp_comm_type
   USE dbcsr_allocate_wrap, ONLY: allocate_any
   USE dbcsr_tensor_index, ONLY: &
      combine_tensor_index, get_2d_indices_tensor, dbcsr_t_get_mapping_info
   USE dbcsr_tas_test, ONLY: dbcsr_tas_checksum
   USE dbcsr_data_types, ONLY: dbcsr_scalar_type
   USE dbcsr_blas_operations, ONLY: &
      set_larnv_seed
#include "base/dbcsr_base_uses.f90"

   IMPLICIT NONE
   PRIVATE
   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbcsr_tensor_test'

   PUBLIC :: &
      dbcsr_t_setup_test_tensor, &
      dbcsr_t_contract_test, &
      dbcsr_t_test_formats, &
      dbcsr_t_checksum, &
      dbcsr_t_reset_randmat_seed

   INTERFACE dist_sparse_tensor_to_repl_dense_array
# 60 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
# 61 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            MODULE PROCEDURE dist_sparse_tensor_to_repl_dense_2d_array_r_dp
# 61 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            MODULE PROCEDURE dist_sparse_tensor_to_repl_dense_3d_array_r_dp
# 61 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            MODULE PROCEDURE dist_sparse_tensor_to_repl_dense_4d_array_r_dp
# 63 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
# 64 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
   END INTERFACE

   INTEGER, SAVE :: randmat_counter = 0
   INTEGER, PARAMETER, PRIVATE :: rand_seed_init = 12341313

CONTAINS

   FUNCTION dbcsr_t_equal(tensor1, tensor2)
      !! check if two (arbitrarily mapped and distributed) tensors are equal.
      TYPE(dbcsr_t_type), INTENT(INOUT)          :: tensor1, tensor2
      LOGICAL                                    :: dbcsr_t_equal

      INTEGER                                    :: blk
      TYPE(dbcsr_t_type)                         :: tensor2_tmp
      TYPE(dbcsr_t_iterator_type)                :: iter
      TYPE(block_nd)                             :: blk_data1, blk_data2
      INTEGER, DIMENSION(ndims_tensor(tensor1)) :: blk_size, ind_nd
      LOGICAL :: found

      ! create a copy of tensor2 that has exact same data format as tensor1
      CALL dbcsr_t_create(tensor1, tensor2_tmp)

      CALL dbcsr_t_reserve_blocks(tensor1, tensor2_tmp)
      CALL dbcsr_t_copy(tensor2, tensor2_tmp)

      dbcsr_t_equal = .TRUE.

      CALL dbcsr_t_iterator_start(iter, tensor1)

      DO WHILE (dbcsr_t_iterator_blocks_left(iter))
         CALL dbcsr_t_iterator_next_block(iter, ind_nd, blk, blk_size=blk_size)
         CALL dbcsr_t_get_block(tensor1, ind_nd, blk_data1, found)
         DBCSR_ASSERT(found)
         CALL dbcsr_t_get_block(tensor2_tmp, ind_nd, blk_data2, found)
         DBCSR_ASSERT(found)

         IF (.NOT. blocks_equal(blk_data1, blk_data2)) THEN
            dbcsr_t_equal = .FALSE.
         END IF
      END DO

      CALL dbcsr_t_iterator_stop(iter)

      CALL dbcsr_t_destroy(tensor2_tmp)
   END FUNCTION

   PURE FUNCTION blocks_equal(block1, block2)
      !! check if two blocks are equal
      TYPE(block_nd), INTENT(IN) :: block1, block2
      LOGICAL                    :: blocks_equal

      SELECT CASE (block1%data_type)
# 117 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            CASE (dbcsr_type_real_8)
            blocks_equal = MAXVAL(ABS(block1%r_dp%blk - block2%r_dp%blk)) .LT. 1.0E-12_real_8
# 117 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            CASE (dbcsr_type_real_4)
            blocks_equal = MAXVAL(ABS(block1%r_sp%blk - block2%r_sp%blk)) .LT. 1.0E-12_real_4
# 117 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            CASE (dbcsr_type_complex_8)
            blocks_equal = MAXVAL(ABS(block1%c_dp%blk - block2%c_dp%blk)) .LT. 1.0E-12_real_8
# 117 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            CASE (dbcsr_type_complex_4)
            blocks_equal = MAXVAL(ABS(block1%c_sp%blk - block2%c_sp%blk)) .LT. 1.0E-12_real_4
# 120 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
      END SELECT

   END FUNCTION

   PURE FUNCTION factorial(n)
      !! Compute factorial
      INTEGER, INTENT(IN) :: n
      INTEGER             :: k
      INTEGER             :: factorial
      factorial = PRODUCT((/(k, k=1, n)/))
   END FUNCTION

   SUBROUTINE permute(n, p)
      !! Compute all permutations p of (1, 2, ..., n)
      INTEGER, INTENT(IN)                              :: n
      INTEGER                                          :: i, c
      INTEGER, DIMENSION(n)                            :: pp
      INTEGER, DIMENSION(n, factorial(n)), INTENT(OUT) :: p

      pp = [(i, i=1, n)]
      c = 1
      CALL perm(1)
   CONTAINS
      RECURSIVE SUBROUTINE perm(i)
         INTEGER, INTENT(IN) :: i
         INTEGER :: j, t
         IF (i == n) THEN
            p(:, c) = pp(:)
            c = c + 1
         ELSE
            DO j = i, n
               t = pp(i)
               pp(i) = pp(j)
               pp(j) = t
               call perm(i + 1)
               t = pp(i)
               pp(i) = pp(j)
               pp(j) = t
            END DO
         END IF
      END SUBROUTINE
   END SUBROUTINE

   SUBROUTINE dbcsr_t_test_formats(ndims, mp_comm, unit_nr, verbose, &
                                   blk_size_1, blk_size_2, blk_size_3, blk_size_4, &
                                   blk_ind_1, blk_ind_2, blk_ind_3, blk_ind_4)
      !! Test equivalence of all tensor formats, using a random distribution.
      INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: blk_size_1, blk_size_2, blk_size_3, blk_size_4
         !! block sizes along respective dimension
      INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: blk_ind_1, blk_ind_2, blk_ind_3, blk_ind_4
         !! index along respective dimension of non-zero blocks
      INTEGER, INTENT(IN)                         :: ndims
         !! tensor rank
      INTEGER, INTENT(IN)                         :: unit_nr
         !! output unit, needs to be a valid unit number on all mpi ranks
      LOGICAL, INTENT(IN)                         :: verbose
         !! if .TRUE., print all tensor blocks
      TYPE(mp_comm_type), INTENT(IN)              :: mp_comm
      TYPE(dbcsr_t_distribution_type)             :: dist1, dist2
      TYPE(dbcsr_t_type)                          :: tensor1, tensor2
      INTEGER                                     :: isep, iblk
      INTEGER, DIMENSION(:), ALLOCATABLE          :: dist1_1, dist1_2, dist1_3, dist1_4, &
                                                     dist2_1, dist2_2, dist2_3, dist2_4
      INTEGER                                     :: nblks, imap
      INTEGER, DIMENSION(ndims)                   :: pdims, myploc
      LOGICAL                                     :: eql
      INTEGER                                     :: iperm, idist, icount
      INTEGER, DIMENSION(:), ALLOCATABLE          :: map1, map2, map1_ref, map2_ref
      INTEGER, DIMENSION(ndims, factorial(ndims)) :: perm
      INTEGER                                     :: io_unit
      INTEGER                                     :: mynode, numnodes
      TYPE(dbcsr_t_pgrid_type)                    :: comm_nd
      CHARACTER(LEN=default_string_length)        :: tensor_name

      ! Process grid
      pdims(:) = 0
      CALL dbcsr_t_pgrid_create(mp_comm, pdims, comm_nd)
      CALL mp_environ(numnodes, mynode, mp_comm)

      io_unit = 0
      IF (mynode .EQ. 0) io_unit = unit_nr

      CALL permute(ndims, perm)
      CALL allocate_any(map1_ref, source=perm(1:ndims/2, 1))
      CALL allocate_any(map2_ref, source=perm(ndims/2 + 1:ndims, 1))

      IF (io_unit > 0) THEN
         WRITE (io_unit, *)
         WRITE (io_unit, '(A)') repeat("-", 80)
         WRITE (io_unit, '(A,1X,I1)') "Testing matrix representations of tensor rank", ndims
         WRITE (io_unit, '(A)') repeat("-", 80)
         WRITE (io_unit, '(A)') "Block sizes:"

# 214 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            IF (ndims >= 1) THEN
               WRITE (io_unit, '(T4,A,1X,I1,A,1X)', advance='no') 'Dim', 1, ':'
               DO iblk = 1, SIZE(blk_size_1)
                  WRITE (io_unit, '(I2,1X)', advance='no') blk_size_1 (iblk)
               END DO
               WRITE (io_unit, *)
            END IF
# 214 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            IF (ndims >= 2) THEN
               WRITE (io_unit, '(T4,A,1X,I1,A,1X)', advance='no') 'Dim', 2, ':'
               DO iblk = 1, SIZE(blk_size_2)
                  WRITE (io_unit, '(I2,1X)', advance='no') blk_size_2 (iblk)
               END DO
               WRITE (io_unit, *)
            END IF
# 214 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            IF (ndims >= 3) THEN
               WRITE (io_unit, '(T4,A,1X,I1,A,1X)', advance='no') 'Dim', 3, ':'
               DO iblk = 1, SIZE(blk_size_3)
                  WRITE (io_unit, '(I2,1X)', advance='no') blk_size_3 (iblk)
               END DO
               WRITE (io_unit, *)
            END IF
# 214 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            IF (ndims >= 4) THEN
               WRITE (io_unit, '(T4,A,1X,I1,A,1X)', advance='no') 'Dim', 4, ':'
               DO iblk = 1, SIZE(blk_size_4)
                  WRITE (io_unit, '(I2,1X)', advance='no') blk_size_4 (iblk)
               END DO
               WRITE (io_unit, *)
            END IF
# 222 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

         WRITE (io_unit, '(A)') "Non-zero blocks:"
         DO iblk = 1, SIZE(blk_ind_1)
# 226 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims == 2) THEN
                  WRITE (io_unit, '(T4,A, I3, A, 2I3, 1X, A)') &
                     'Block', iblk, ': (', blk_ind_1(iblk), blk_ind_2(iblk), ')'
               END IF
# 226 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims == 3) THEN
                  WRITE (io_unit, '(T4,A, I3, A, 3I3, 1X, A)') &
                     'Block', iblk, ': (', blk_ind_1(iblk), blk_ind_2(iblk), blk_ind_3(iblk), ')'
               END IF
# 226 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims == 4) THEN
                  WRITE (io_unit, '(T4,A, I3, A, 4I3, 1X, A)') &
                     'Block', iblk, ': (', blk_ind_1(iblk), blk_ind_2(iblk), blk_ind_3(iblk), blk_ind_4(iblk), ')'
               END IF
# 231 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         END DO

         WRITE (io_unit, *)
         WRITE (io_unit, '(A,1X)', advance='no') "Reference map:"
         WRITE (io_unit, '(A1,1X)', advance='no') "("
         DO imap = 1, SIZE(map1_ref)
            WRITE (io_unit, '(I1,1X)', advance='no') map1_ref(imap)
         END DO
         WRITE (io_unit, '(A1,1X)', advance='no') "|"
         DO imap = 1, SIZE(map2_ref)
            WRITE (io_unit, '(I1,1X)', advance='no') map2_ref(imap)
         END DO
         WRITE (io_unit, '(A1)') ")"

      END IF

      icount = 0
      DO iperm = 1, factorial(ndims)
         DO isep = 1, ndims - 1
            icount = icount + 1

            CALL allocate_any(map1, source=perm(1:isep, iperm))
            CALL allocate_any(map2, source=perm(isep + 1:ndims, iperm))

            CALL mp_environ(numnodes, mynode, mp_comm)
            CALL mp_environ_pgrid(comm_nd, pdims, myploc)

# 259 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (1 <= ndims) THEN
                  nblks = SIZE(blk_size_1)
                  ALLOCATE (dist1_1 (nblks))
                  ALLOCATE (dist2_1 (nblks))
                  CALL dbcsr_t_default_distvec(nblks, pdims(1), blk_size_1, dist1_1)
                  CALL dbcsr_t_default_distvec(nblks, pdims(1), blk_size_1, dist2_1)
               END IF
# 259 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (2 <= ndims) THEN
                  nblks = SIZE(blk_size_2)
                  ALLOCATE (dist1_2 (nblks))
                  ALLOCATE (dist2_2 (nblks))
                  CALL dbcsr_t_default_distvec(nblks, pdims(2), blk_size_2, dist1_2)
                  CALL dbcsr_t_default_distvec(nblks, pdims(2), blk_size_2, dist2_2)
               END IF
# 259 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (3 <= ndims) THEN
                  nblks = SIZE(blk_size_3)
                  ALLOCATE (dist1_3 (nblks))
                  ALLOCATE (dist2_3 (nblks))
                  CALL dbcsr_t_default_distvec(nblks, pdims(3), blk_size_3, dist1_3)
                  CALL dbcsr_t_default_distvec(nblks, pdims(3), blk_size_3, dist2_3)
               END IF
# 259 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (4 <= ndims) THEN
                  nblks = SIZE(blk_size_4)
                  ALLOCATE (dist1_4 (nblks))
                  ALLOCATE (dist2_4 (nblks))
                  CALL dbcsr_t_default_distvec(nblks, pdims(4), blk_size_4, dist1_4)
                  CALL dbcsr_t_default_distvec(nblks, pdims(4), blk_size_4, dist2_4)
               END IF
# 267 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

            WRITE (tensor_name, '(A,1X,I3,1X)') "Test", icount

            IF (io_unit > 0) THEN
               WRITE (io_unit, *)
               WRITE (io_unit, '(A,A,1X)', advance='no') TRIM(tensor_name), ':'
               WRITE (io_unit, '(A1,1X)', advance='no') "("
               DO imap = 1, SIZE(map1)
                  WRITE (io_unit, '(I1,1X)', advance='no') map1(imap)
               END DO
               WRITE (io_unit, '(A1,1X)', advance='no') "|"
               DO imap = 1, SIZE(map2)
                  WRITE (io_unit, '(I1,1X)', advance='no') map2(imap)
               END DO
               WRITE (io_unit, '(A1)') ")"

               WRITE (io_unit, '(T4,A)') "Reference distribution:"
# 285 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  IF (1 <= ndims) THEN
                     WRITE (io_unit, '(T7,A,1X)', advance='no') "Dist vec 1:"
                     DO idist = 1, SIZE(dist2_1)
                        WRITE (io_unit, '(I2,1X)', advance='no') dist2_1 (idist)
                     END DO
                     WRITE (io_unit, *)
                  END IF
# 285 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  IF (2 <= ndims) THEN
                     WRITE (io_unit, '(T7,A,1X)', advance='no') "Dist vec 2:"
                     DO idist = 1, SIZE(dist2_2)
                        WRITE (io_unit, '(I2,1X)', advance='no') dist2_2 (idist)
                     END DO
                     WRITE (io_unit, *)
                  END IF
# 285 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  IF (3 <= ndims) THEN
                     WRITE (io_unit, '(T7,A,1X)', advance='no') "Dist vec 3:"
                     DO idist = 1, SIZE(dist2_3)
                        WRITE (io_unit, '(I2,1X)', advance='no') dist2_3 (idist)
                     END DO
                     WRITE (io_unit, *)
                  END IF
# 285 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  IF (4 <= ndims) THEN
                     WRITE (io_unit, '(T7,A,1X)', advance='no') "Dist vec 4:"
                     DO idist = 1, SIZE(dist2_4)
                        WRITE (io_unit, '(I2,1X)', advance='no') dist2_4 (idist)
                     END DO
                     WRITE (io_unit, *)
                  END IF
# 293 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

               WRITE (io_unit, '(T4,A)') "Test distribution:"
# 296 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  IF (1 <= ndims) THEN
                     WRITE (io_unit, '(T7,A,1X)', advance='no') "Dist vec 1:"
                     DO idist = 1, SIZE(dist2_1)
                        WRITE (io_unit, '(I2,1X)', advance='no') dist1_1 (idist)
                     END DO
                     WRITE (io_unit, *)
                  END IF
# 296 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  IF (2 <= ndims) THEN
                     WRITE (io_unit, '(T7,A,1X)', advance='no') "Dist vec 2:"
                     DO idist = 1, SIZE(dist2_2)
                        WRITE (io_unit, '(I2,1X)', advance='no') dist1_2 (idist)
                     END DO
                     WRITE (io_unit, *)
                  END IF
# 296 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  IF (3 <= ndims) THEN
                     WRITE (io_unit, '(T7,A,1X)', advance='no') "Dist vec 3:"
                     DO idist = 1, SIZE(dist2_3)
                        WRITE (io_unit, '(I2,1X)', advance='no') dist1_3 (idist)
                     END DO
                     WRITE (io_unit, *)
                  END IF
# 296 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  IF (4 <= ndims) THEN
                     WRITE (io_unit, '(T7,A,1X)', advance='no') "Dist vec 4:"
                     DO idist = 1, SIZE(dist2_4)
                        WRITE (io_unit, '(I2,1X)', advance='no') dist1_4 (idist)
                     END DO
                     WRITE (io_unit, *)
                  END IF
# 304 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            END IF

# 307 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims == 2) THEN
                  CALL dbcsr_t_distribution_new(dist2, comm_nd, dist2_1, dist2_2)
                  CALL dbcsr_t_create(tensor2, "Ref", dist2, map1_ref, map2_ref, &
                                      dbcsr_type_real_8, blk_size_1, blk_size_2)
                  CALL dbcsr_t_setup_test_tensor(tensor2, comm_nd%mp_comm_2d, .TRUE., blk_ind_1, blk_ind_2)
               END IF
# 307 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims == 3) THEN
                  CALL dbcsr_t_distribution_new(dist2, comm_nd, dist2_1, dist2_2, dist2_3)
                  CALL dbcsr_t_create(tensor2, "Ref", dist2, map1_ref, map2_ref, &
                                      dbcsr_type_real_8, blk_size_1, blk_size_2, blk_size_3)
                  CALL dbcsr_t_setup_test_tensor(tensor2, comm_nd%mp_comm_2d, .TRUE., blk_ind_1, blk_ind_2, blk_ind_3)
               END IF
# 307 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims == 4) THEN
                  CALL dbcsr_t_distribution_new(dist2, comm_nd, dist2_1, dist2_2, dist2_3, dist2_4)
                  CALL dbcsr_t_create(tensor2, "Ref", dist2, map1_ref, map2_ref, &
                                      dbcsr_type_real_8, blk_size_1, blk_size_2, blk_size_3, blk_size_4)
                  CALL dbcsr_t_setup_test_tensor(tensor2, comm_nd%mp_comm_2d, .TRUE., blk_ind_1, blk_ind_2, blk_ind_3, blk_ind_4)
               END IF
# 314 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

            IF (verbose) CALL dbcsr_t_write_blocks(tensor2, io_unit, unit_nr)

# 318 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims == 2) THEN
                  CALL dbcsr_t_distribution_new(dist1, comm_nd, dist1_1, dist1_2)
                  CALL dbcsr_t_create(tensor1, tensor_name, dist1, map1, map2, &
                                      dbcsr_type_real_8, blk_size_1, blk_size_2)
                  CALL dbcsr_t_setup_test_tensor(tensor1, comm_nd%mp_comm_2d, .TRUE., blk_ind_1, blk_ind_2)
               END IF
# 318 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims == 3) THEN
                  CALL dbcsr_t_distribution_new(dist1, comm_nd, dist1_1, dist1_2, dist1_3)
                  CALL dbcsr_t_create(tensor1, tensor_name, dist1, map1, map2, &
                                      dbcsr_type_real_8, blk_size_1, blk_size_2, blk_size_3)
                  CALL dbcsr_t_setup_test_tensor(tensor1, comm_nd%mp_comm_2d, .TRUE., blk_ind_1, blk_ind_2, blk_ind_3)
               END IF
# 318 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims == 4) THEN
                  CALL dbcsr_t_distribution_new(dist1, comm_nd, dist1_1, dist1_2, dist1_3, dist1_4)
                  CALL dbcsr_t_create(tensor1, tensor_name, dist1, map1, map2, &
                                      dbcsr_type_real_8, blk_size_1, blk_size_2, blk_size_3, blk_size_4)
                  CALL dbcsr_t_setup_test_tensor(tensor1, comm_nd%mp_comm_2d, .TRUE., blk_ind_1, blk_ind_2, blk_ind_3, blk_ind_4)
               END IF
# 325 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

            IF (verbose) CALL dbcsr_t_write_blocks(tensor1, io_unit, unit_nr)

            eql = dbcsr_t_equal(tensor1, tensor2)

            IF (.NOT. eql) THEN
               IF (io_unit > 0) WRITE (io_unit, '(A,1X,A)') TRIM(tensor_name), 'Test failed!'
               DBCSR_ABORT('')
            ELSE
               IF (io_unit > 0) WRITE (io_unit, '(A,1X,A)') TRIM(tensor_name), 'Test passed!'
            END IF
            DEALLOCATE (map1, map2)

            CALL dbcsr_t_destroy(tensor1)
            CALL dbcsr_t_distribution_destroy(dist1)

            CALL dbcsr_t_destroy(tensor2)
            CALL dbcsr_t_distribution_destroy(dist2)

# 345 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (1 <= ndims) THEN
                  DEALLOCATE (dist1_1, dist2_1)
               END IF
# 345 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (2 <= ndims) THEN
                  DEALLOCATE (dist1_2, dist2_2)
               END IF
# 345 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (3 <= ndims) THEN
                  DEALLOCATE (dist1_3, dist2_3)
               END IF
# 345 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (4 <= ndims) THEN
                  DEALLOCATE (dist1_4, dist2_4)
               END IF
# 349 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

         END DO
      END DO
      CALL dbcsr_t_pgrid_destroy(comm_nd)
   END SUBROUTINE

   SUBROUTINE dbcsr_t_setup_test_tensor(tensor, mp_comm, enumerate, blk_ind_1, blk_ind_2, blk_ind_3, blk_ind_4)
      !! Allocate and fill test tensor - entries are enumerated by their index s.t. they only depend
      !! on global properties of the tensor but not on distribution, matrix representation, etc.
      TYPE(dbcsr_t_type), INTENT(INOUT)                  :: tensor
      TYPE(mp_comm_type), INTENT(IN)                                :: mp_comm
         !! communicator
      LOGICAL, INTENT(IN)                                :: enumerate
      INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL        :: blk_ind_1, blk_ind_2, blk_ind_3, blk_ind_4
         !! index along respective dimension of non-zero blocks
      INTEGER                                            :: blk, numnodes, mynode

      INTEGER                                            :: i, ib, my_nblks_alloc, nblks_alloc, proc, nze
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: my_blk_ind_1, my_blk_ind_2, my_blk_ind_3, my_blk_ind_4
      INTEGER, DIMENSION(ndims_tensor(tensor))          :: blk_index, blk_offset, blk_size, &
                                                           tensor_dims
      INTEGER, DIMENSION(:, :), ALLOCATABLE               :: ind_nd
# 372 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         REAL(KIND=real_8), ALLOCATABLE, &
            DIMENSION(:,:)                :: blk_values_2
# 372 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         REAL(KIND=real_8), ALLOCATABLE, &
            DIMENSION(:,:,:)                :: blk_values_3
# 372 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         REAL(KIND=real_8), ALLOCATABLE, &
            DIMENSION(:,:,:,:)                :: blk_values_4
# 375 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
      TYPE(dbcsr_t_iterator_type)                        :: iterator
      INTEGER, DIMENSION(4)                              :: iseed
      INTEGER, DIMENSION(2)                              :: blk_index_2d, nblks_2d

      nblks_alloc = SIZE(blk_ind_1)
      CALL mp_environ(numnodes, mynode, mp_comm)

      IF (.NOT. enumerate) THEN
         DBCSR_ASSERT(randmat_counter .NE. 0)

         randmat_counter = randmat_counter + 1
      END IF

      ALLOCATE (ind_nd(nblks_alloc, ndims_tensor(tensor)))
      my_nblks_alloc = 0
      DO ib = 1, nblks_alloc
# 392 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            IF (ndims_tensor(tensor) == 2) THEN
               ind_nd(ib, :) = [blk_ind_1(ib), blk_ind_2(ib)]
            END IF
# 392 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            IF (ndims_tensor(tensor) == 3) THEN
               ind_nd(ib, :) = [blk_ind_1(ib), blk_ind_2(ib), blk_ind_3(ib)]
            END IF
# 392 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            IF (ndims_tensor(tensor) == 4) THEN
               ind_nd(ib, :) = [blk_ind_1(ib), blk_ind_2(ib), blk_ind_3(ib), blk_ind_4(ib)]
            END IF
# 396 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         CALL dbcsr_t_get_stored_coordinates(tensor, ind_nd(ib, :), proc)
         IF (proc == mynode) THEN
            my_nblks_alloc = my_nblks_alloc + 1
         END IF
      END DO

# 403 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         IF (ndims_tensor(tensor) >= 1) THEN
            ALLOCATE (my_blk_ind_1 (my_nblks_alloc))
         END IF
# 403 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         IF (ndims_tensor(tensor) >= 2) THEN
            ALLOCATE (my_blk_ind_2 (my_nblks_alloc))
         END IF
# 403 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         IF (ndims_tensor(tensor) >= 3) THEN
            ALLOCATE (my_blk_ind_3 (my_nblks_alloc))
         END IF
# 403 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         IF (ndims_tensor(tensor) >= 4) THEN
            ALLOCATE (my_blk_ind_4 (my_nblks_alloc))
         END IF
# 407 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

      i = 0
      DO ib = 1, nblks_alloc
         CALL dbcsr_t_get_stored_coordinates(tensor, ind_nd(ib, :), proc)
         IF (proc == mynode) THEN
            i = i + 1
# 414 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims_tensor(tensor) >= 1) THEN
                  my_blk_ind_1 (i) = blk_ind_1 (ib)
               END IF
# 414 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims_tensor(tensor) >= 2) THEN
                  my_blk_ind_2 (i) = blk_ind_2 (ib)
               END IF
# 414 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims_tensor(tensor) >= 3) THEN
                  my_blk_ind_3 (i) = blk_ind_3 (ib)
               END IF
# 414 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               IF (ndims_tensor(tensor) >= 4) THEN
                  my_blk_ind_4 (i) = blk_ind_4 (ib)
               END IF
# 418 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         END IF
      END DO

# 422 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         IF (ndims_tensor(tensor) == 2) THEN
            CALL dbcsr_t_reserve_blocks(tensor, my_blk_ind_1, my_blk_ind_2)
         END IF
# 422 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         IF (ndims_tensor(tensor) == 3) THEN
            CALL dbcsr_t_reserve_blocks(tensor, my_blk_ind_1, my_blk_ind_2, my_blk_ind_3)
         END IF
# 422 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         IF (ndims_tensor(tensor) == 4) THEN
            CALL dbcsr_t_reserve_blocks(tensor, my_blk_ind_1, my_blk_ind_2, my_blk_ind_3, my_blk_ind_4)
         END IF
# 426 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

      CALL dbcsr_t_iterator_start(iterator, tensor)
      DO WHILE (dbcsr_t_iterator_blocks_left(iterator))
         CALL dbcsr_t_iterator_next_block(iterator, blk_index, blk, blk_size=blk_size, blk_offset=blk_offset)

         IF (.NOT. enumerate) THEN
            blk_index_2d = INT(get_2d_indices_tensor(tensor%nd_index_blk, blk_index))
            CALL dbcsr_t_get_mapping_info(tensor%nd_index_blk, dims_2d=nblks_2d)
            CALL set_larnv_seed(blk_index_2d(1), nblks_2d(1), blk_index_2d(2), nblks_2d(2), randmat_counter, iseed)
            nze = PRODUCT(blk_size)
         END IF

# 439 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            IF (ndims_tensor(tensor) == 2) THEN
               CALL allocate_any(blk_values_2, shape_spec=blk_size)
               CALL dims_tensor(tensor, tensor_dims)
               IF (enumerate) THEN
                  CALL enumerate_block_elements(blk_size, blk_offset, tensor_dims, blk_2=blk_values_2)
               ELSE
                  CALL dlarnv(1, iseed, nze, blk_values_2)
               END IF
               CALL dbcsr_t_put_block(tensor, blk_index, blk_size, blk_values_2)
               DEALLOCATE (blk_values_2)
            END IF
# 439 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            IF (ndims_tensor(tensor) == 3) THEN
               CALL allocate_any(blk_values_3, shape_spec=blk_size)
               CALL dims_tensor(tensor, tensor_dims)
               IF (enumerate) THEN
                  CALL enumerate_block_elements(blk_size, blk_offset, tensor_dims, blk_3=blk_values_3)
               ELSE
                  CALL dlarnv(1, iseed, nze, blk_values_3)
               END IF
               CALL dbcsr_t_put_block(tensor, blk_index, blk_size, blk_values_3)
               DEALLOCATE (blk_values_3)
            END IF
# 439 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            IF (ndims_tensor(tensor) == 4) THEN
               CALL allocate_any(blk_values_4, shape_spec=blk_size)
               CALL dims_tensor(tensor, tensor_dims)
               IF (enumerate) THEN
                  CALL enumerate_block_elements(blk_size, blk_offset, tensor_dims, blk_4=blk_values_4)
               ELSE
                  CALL dlarnv(1, iseed, nze, blk_values_4)
               END IF
               CALL dbcsr_t_put_block(tensor, blk_index, blk_size, blk_values_4)
               DEALLOCATE (blk_values_4)
            END IF
# 451 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
      END DO
      CALL dbcsr_t_iterator_stop(iterator)

   END SUBROUTINE

   SUBROUTINE enumerate_block_elements(blk_size, blk_offset, tensor_size, blk_2, blk_3, blk_4)
      !! Enumerate tensor entries in block
      !! \blk_2 block values for 2 dimensions
      !! \blk_3 block values for 3 dimensions

      INTEGER, DIMENSION(:), INTENT(IN)                  :: blk_size, blk_offset, tensor_size
         !! size of block
         !! block offset (indices of first element)
         !! global tensor sizes
# 466 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         REAL(KIND=real_8), DIMENSION(:,:), &
            OPTIONAL, INTENT(OUT)                           :: blk_2
# 466 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         REAL(KIND=real_8), DIMENSION(:,:,:), &
            OPTIONAL, INTENT(OUT)                           :: blk_3
# 466 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         REAL(KIND=real_8), DIMENSION(:,:,:,:), &
            OPTIONAL, INTENT(OUT)                           :: blk_4
# 469 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
      INTEGER                                            :: ndim
      INTEGER, DIMENSION(SIZE(blk_size))                 :: arr_ind, tens_ind
      INTEGER                                            :: i_1, i_2, i_3, i_4

      ndim = SIZE(tensor_size)

# 476 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         IF (ndim == 2) THEN
# 478 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               DO i_2 = 1, blk_size(2)
# 478 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               DO i_1 = 1, blk_size(1)
# 480 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  arr_ind(:) = [i_1, i_2]
                  tens_ind(:) = arr_ind(:) + blk_offset(:) - 1
                  blk_2 (arr_ind(1), arr_ind(2)) = combine_tensor_index(tens_ind, tensor_size)
# 484 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     END DO
# 484 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     END DO
# 486 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               END IF
# 476 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         IF (ndim == 3) THEN
# 478 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               DO i_3 = 1, blk_size(3)
# 478 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               DO i_2 = 1, blk_size(2)
# 478 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               DO i_1 = 1, blk_size(1)
# 480 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  arr_ind(:) = [i_1, i_2, i_3]
                  tens_ind(:) = arr_ind(:) + blk_offset(:) - 1
                  blk_3 (arr_ind(1), arr_ind(2), arr_ind(3)) = combine_tensor_index(tens_ind, tensor_size)
# 484 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     END DO
# 484 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     END DO
# 484 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     END DO
# 486 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               END IF
# 476 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
         IF (ndim == 4) THEN
# 478 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               DO i_4 = 1, blk_size(4)
# 478 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               DO i_3 = 1, blk_size(3)
# 478 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               DO i_2 = 1, blk_size(2)
# 478 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               DO i_1 = 1, blk_size(1)
# 480 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  arr_ind(:) = [i_1, i_2, i_3, i_4]
                  tens_ind(:) = arr_ind(:) + blk_offset(:) - 1
                  blk_4 (arr_ind(1), arr_ind(2), arr_ind(3), arr_ind(4)) = combine_tensor_index(tens_ind, tensor_size)
# 484 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     END DO
# 484 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     END DO
# 484 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     END DO
# 484 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     END DO
# 486 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               END IF
# 488 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

         END SUBROUTINE

# 492 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
# 493 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               SUBROUTINE dist_sparse_tensor_to_repl_dense_2d_array_r_dp (tensor, array)
      !! Transform a distributed sparse tensor to a replicated dense array. This is only useful for
      !! testing tensor contraction by matrix multiplication of dense arrays.

                  TYPE(dbcsr_t_type), INTENT(INOUT)                          :: tensor
                  REAL(kind=real_8), ALLOCATABLE, DIMENSION(:,:), &
                     INTENT(OUT)                                             :: array
                  REAL(kind=real_8), ALLOCATABLE, DIMENSION(:,:)   :: block
                  INTEGER, DIMENSION(ndims_tensor(tensor))                  :: dims_nd, ind_nd, blk_size, blk_offset
                  TYPE(dbcsr_t_iterator_type)                                     :: iterator
                  INTEGER                                                    :: blk, idim
                  INTEGER, DIMENSION(ndims_tensor(tensor))                  :: blk_start, blk_end
                  LOGICAL                                                    :: found

                  DBCSR_ASSERT(ndims_tensor(tensor) .EQ. 2)
                  CALL dbcsr_t_get_info(tensor, nfull_total=dims_nd)
                  CALL allocate_any(array, shape_spec=dims_nd)
                  array(:,:) = 0.0_real_8

                  CALL dbcsr_t_iterator_start(iterator, tensor)
                  DO WHILE (dbcsr_t_iterator_blocks_left(iterator))
                     CALL dbcsr_t_iterator_next_block(iterator, ind_nd, blk, blk_size=blk_size, blk_offset=blk_offset)
                     CALL dbcsr_t_get_block(tensor, ind_nd, block, found)
                     DBCSR_ASSERT(found)

                     DO idim = 1, ndims_tensor(tensor)
                        blk_start(idim) = blk_offset(idim)
                        blk_end(idim) = blk_offset(idim) + blk_size(idim) - 1
                     END DO
                     array(blk_start(1):blk_end(1), blk_start(2):blk_end(2)) = &
                        block(:,:)

                     DEALLOCATE (block)
                  END DO
                  CALL dbcsr_t_iterator_stop(iterator)
                  CALL mp_sum(array, tensor%pgrid%mp_comm_2d)

               END SUBROUTINE
# 493 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               SUBROUTINE dist_sparse_tensor_to_repl_dense_3d_array_r_dp (tensor, array)
      !! Transform a distributed sparse tensor to a replicated dense array. This is only useful for
      !! testing tensor contraction by matrix multiplication of dense arrays.

                  TYPE(dbcsr_t_type), INTENT(INOUT)                          :: tensor
                  REAL(kind=real_8), ALLOCATABLE, DIMENSION(:,:,:), &
                     INTENT(OUT)                                             :: array
                  REAL(kind=real_8), ALLOCATABLE, DIMENSION(:,:,:)   :: block
                  INTEGER, DIMENSION(ndims_tensor(tensor))                  :: dims_nd, ind_nd, blk_size, blk_offset
                  TYPE(dbcsr_t_iterator_type)                                     :: iterator
                  INTEGER                                                    :: blk, idim
                  INTEGER, DIMENSION(ndims_tensor(tensor))                  :: blk_start, blk_end
                  LOGICAL                                                    :: found

                  DBCSR_ASSERT(ndims_tensor(tensor) .EQ. 3)
                  CALL dbcsr_t_get_info(tensor, nfull_total=dims_nd)
                  CALL allocate_any(array, shape_spec=dims_nd)
                  array(:,:,:) = 0.0_real_8

                  CALL dbcsr_t_iterator_start(iterator, tensor)
                  DO WHILE (dbcsr_t_iterator_blocks_left(iterator))
                     CALL dbcsr_t_iterator_next_block(iterator, ind_nd, blk, blk_size=blk_size, blk_offset=blk_offset)
                     CALL dbcsr_t_get_block(tensor, ind_nd, block, found)
                     DBCSR_ASSERT(found)

                     DO idim = 1, ndims_tensor(tensor)
                        blk_start(idim) = blk_offset(idim)
                        blk_end(idim) = blk_offset(idim) + blk_size(idim) - 1
                     END DO
                     array(blk_start(1):blk_end(1), blk_start(2):blk_end(2), blk_start(3):blk_end(3)) = &
                        block(:,:,:)

                     DEALLOCATE (block)
                  END DO
                  CALL dbcsr_t_iterator_stop(iterator)
                  CALL mp_sum(array, tensor%pgrid%mp_comm_2d)

               END SUBROUTINE
# 493 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               SUBROUTINE dist_sparse_tensor_to_repl_dense_4d_array_r_dp (tensor, array)
      !! Transform a distributed sparse tensor to a replicated dense array. This is only useful for
      !! testing tensor contraction by matrix multiplication of dense arrays.

                  TYPE(dbcsr_t_type), INTENT(INOUT)                          :: tensor
                  REAL(kind=real_8), ALLOCATABLE, DIMENSION(:,:,:,:), &
                     INTENT(OUT)                                             :: array
                  REAL(kind=real_8), ALLOCATABLE, DIMENSION(:,:,:,:)   :: block
                  INTEGER, DIMENSION(ndims_tensor(tensor))                  :: dims_nd, ind_nd, blk_size, blk_offset
                  TYPE(dbcsr_t_iterator_type)                                     :: iterator
                  INTEGER                                                    :: blk, idim
                  INTEGER, DIMENSION(ndims_tensor(tensor))                  :: blk_start, blk_end
                  LOGICAL                                                    :: found

                  DBCSR_ASSERT(ndims_tensor(tensor) .EQ. 4)
                  CALL dbcsr_t_get_info(tensor, nfull_total=dims_nd)
                  CALL allocate_any(array, shape_spec=dims_nd)
                  array(:,:,:,:) = 0.0_real_8

                  CALL dbcsr_t_iterator_start(iterator, tensor)
                  DO WHILE (dbcsr_t_iterator_blocks_left(iterator))
                     CALL dbcsr_t_iterator_next_block(iterator, ind_nd, blk, blk_size=blk_size, blk_offset=blk_offset)
                     CALL dbcsr_t_get_block(tensor, ind_nd, block, found)
                     DBCSR_ASSERT(found)

                     DO idim = 1, ndims_tensor(tensor)
                        blk_start(idim) = blk_offset(idim)
                        blk_end(idim) = blk_offset(idim) + blk_size(idim) - 1
                     END DO
                     array(blk_start(1):blk_end(1), blk_start(2):blk_end(2), blk_start(3):blk_end(3), blk_start(4):blk_end(4)) = &
                        block(:,:,:,:)

                     DEALLOCATE (block)
                  END DO
                  CALL dbcsr_t_iterator_stop(iterator)
                  CALL mp_sum(array, tensor%pgrid%mp_comm_2d)

               END SUBROUTINE
# 532 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
# 533 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

         SUBROUTINE dbcsr_t_contract_test(alpha, tensor_1, tensor_2, beta, tensor_3, &
                                          contract_1, notcontract_1, &
                                          contract_2, notcontract_2, &
                                          map_1, map_2, &
                                          unit_nr, &
                                          bounds_1, bounds_2, bounds_3, &
                                          log_verbose, write_int)
      !! test tensor contraction
      !! @note for testing/debugging, simply replace a call to dbcsr_t_contract with a call to this routine
      !! @endnote

            TYPE(dbcsr_scalar_type), INTENT(IN) :: alpha
            TYPE(dbcsr_t_type), INTENT(INOUT)    :: tensor_1, tensor_2, tensor_3
            TYPE(dbcsr_scalar_type), INTENT(IN) :: beta
            INTEGER, DIMENSION(:), INTENT(IN)    :: contract_1, contract_2, &
                                                    notcontract_1, notcontract_2, &
                                                    map_1, map_2
            INTEGER, INTENT(IN)                  :: unit_nr
            INTEGER, DIMENSION(2, SIZE(contract_1)), &
               OPTIONAL                          :: bounds_1
            INTEGER, DIMENSION(2, SIZE(notcontract_1)), &
               OPTIONAL                          :: bounds_2
            INTEGER, DIMENSION(2, SIZE(notcontract_2)), &
               OPTIONAL                          :: bounds_3
            LOGICAL, INTENT(IN), OPTIONAL        :: log_verbose
            LOGICAL, INTENT(IN), OPTIONAL        :: write_int
            INTEGER                              :: io_unit, mynode, numnodes
            INTEGER, DIMENSION(:), ALLOCATABLE   :: size_1, size_2, size_3, &
                                                    order_t1, order_t2, order_t3
            INTEGER, DIMENSION(2, ndims_tensor(tensor_1)) :: bounds_t1
            INTEGER, DIMENSION(2, ndims_tensor(tensor_2)) :: bounds_t2
            TYPE(mp_comm_type)                   :: mp_comm

# 568 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               REAL(KIND=real_8), ALLOCATABLE, &
                  DIMENSION(:,:) :: array_1_2d, &
                                                      array_2_2d, &
                                                      array_3_2d, &
                                                      array_1_2d_full, &
                                                      array_2_2d_full, &
                                                      array_3_0_2d, &
                                                      array_1_rs2d, &
                                                      array_2_rs2d, &
                                                      array_3_rs2d, &
                                                      array_3_0_rs2d
# 568 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               REAL(KIND=real_8), ALLOCATABLE, &
                  DIMENSION(:,:,:) :: array_1_3d, &
                                                      array_2_3d, &
                                                      array_3_3d, &
                                                      array_1_3d_full, &
                                                      array_2_3d_full, &
                                                      array_3_0_3d, &
                                                      array_1_rs3d, &
                                                      array_2_rs3d, &
                                                      array_3_rs3d, &
                                                      array_3_0_rs3d
# 568 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               REAL(KIND=real_8), ALLOCATABLE, &
                  DIMENSION(:,:,:,:) :: array_1_4d, &
                                                      array_2_4d, &
                                                      array_3_4d, &
                                                      array_1_4d_full, &
                                                      array_2_4d_full, &
                                                      array_3_0_4d, &
                                                      array_1_rs4d, &
                                                      array_2_rs4d, &
                                                      array_3_rs4d, &
                                                      array_3_0_rs4d
# 580 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            REAL(KIND=real_8), ALLOCATABLE, &
               DIMENSION(:, :)                   :: array_1_mm, &
                                                    array_2_mm, &
                                                    array_3_mm, &
                                                    array_3_test_mm
            LOGICAL                             :: eql, notzero
            LOGICAL, PARAMETER                  :: debug = .FALSE.
            REAL(KIND=real_8)                   :: cs_1, cs_2, cs_3, eql_diff
            LOGICAL                             :: do_crop_1, do_crop_2

            mp_comm = tensor_1%pgrid%mp_comm_2d
            CALL mp_environ(numnodes, mynode, mp_comm)
            io_unit = -1
            IF (mynode .EQ. 0) io_unit = unit_nr

            cs_1 = dbcsr_t_checksum(tensor_1)
            cs_2 = dbcsr_t_checksum(tensor_2)
            cs_3 = dbcsr_t_checksum(tensor_3)

            IF (io_unit > 0) THEN
               WRITE (io_unit, *)
               WRITE (io_unit, '(A)') repeat("-", 80)
               WRITE (io_unit, '(A,1X,A,1X,A,1X,A,1X,A,1X,A)') "Testing tensor contraction", &
                  TRIM(tensor_1%name), "x", TRIM(tensor_2%name), "=", TRIM(tensor_3%name)
               WRITE (io_unit, '(A)') repeat("-", 80)
            END IF

            IF (debug) THEN
               IF (io_unit > 0) THEN
                  WRITE (io_unit, "(A, E9.2)") "checksum ", TRIM(tensor_1%name), cs_1
                  WRITE (io_unit, "(A, E9.2)") "checksum ", TRIM(tensor_2%name), cs_2
                  WRITE (io_unit, "(A, E9.2)") "checksum ", TRIM(tensor_3%name), cs_3
               END IF
            END IF

            IF (debug) THEN
               CALL dbcsr_t_write_block_indices(tensor_1, io_unit, unit_nr)
               CALL dbcsr_t_write_blocks(tensor_1, io_unit, unit_nr, write_int)
            END IF

            SELECT CASE (ndims_tensor(tensor_3))
# 622 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  CASE (2)
                  CALL dist_sparse_tensor_to_repl_dense_array(tensor_3, array_3_0_2d)
# 622 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  CASE (3)
                  CALL dist_sparse_tensor_to_repl_dense_array(tensor_3, array_3_0_3d)
# 622 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  CASE (4)
                  CALL dist_sparse_tensor_to_repl_dense_array(tensor_3, array_3_0_4d)
# 625 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
            END SELECT

            CALL dbcsr_t_contract(alpha, tensor_1, tensor_2, beta, tensor_3, &
                                  contract_1, notcontract_1, &
                                  contract_2, notcontract_2, &
                                  map_1, map_2, &
                                  bounds_1=bounds_1, bounds_2=bounds_2, bounds_3=bounds_3, &
                                  filter_eps=1.0E-12_real_8, &
                                  unit_nr=io_unit, log_verbose=log_verbose)

            cs_3 = dbcsr_t_checksum(tensor_3)

            IF (debug) THEN
               IF (io_unit > 0) THEN
                  WRITE (io_unit, "(A, E9.2)") "checksum ", TRIM(tensor_3%name), cs_3
               END IF
            END IF

            do_crop_1 = .FALSE.; do_crop_2 = .FALSE.!; do_crop_3 = .FALSE.

            ! crop tensor as first step
            bounds_t1(1, :) = 1
            CALL dbcsr_t_get_info(tensor_1, nfull_total=bounds_t1(2, :))

            bounds_t2(1, :) = 1
            CALL dbcsr_t_get_info(tensor_2, nfull_total=bounds_t2(2, :))

            IF (PRESENT(bounds_1)) THEN
               bounds_t1(:, contract_1) = bounds_1
               do_crop_1 = .TRUE.
               bounds_t2(:, contract_2) = bounds_1
               do_crop_2 = .TRUE.
            END IF

            IF (PRESENT(bounds_2)) THEN
               bounds_t1(:, notcontract_1) = bounds_2
               do_crop_1 = .TRUE.
            END IF

            IF (PRESENT(bounds_3)) THEN
               bounds_t2(:, notcontract_2) = bounds_3
               do_crop_2 = .TRUE.
            END IF

            ! Convert tensors to simple multidimensional arrays
# 671 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               SELECT CASE (ndims_tensor(tensor_1))
# 673 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (2)
# 675 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CALL dist_sparse_tensor_to_repl_dense_array(tensor_1, array_1_2d_full)
                        CALL allocate_any(array_1_2d, shape_spec=SHAPE(array_1_2d_full))
                        array_1_2d = 0.0_real_8
         array_1_2d(bounds_t1(1, 1):bounds_t1(2, 1), bounds_t1(1, 2):bounds_t1(2, 2)) = &
         array_1_2d_full(bounds_t1(1, 1):bounds_t1(2, 1), bounds_t1(1, 2):bounds_t1(2, 2))
# 683 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

# 673 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (3)
# 675 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CALL dist_sparse_tensor_to_repl_dense_array(tensor_1, array_1_3d_full)
                        CALL allocate_any(array_1_3d, shape_spec=SHAPE(array_1_3d_full))
                        array_1_3d = 0.0_real_8
         array_1_3d(bounds_t1(1, 1):bounds_t1(2, 1), bounds_t1(1, 2):bounds_t1(2, 2), bounds_t1(1, 3):bounds_t1(2, 3)) = &
         array_1_3d_full(bounds_t1(1, 1):bounds_t1(2, 1), bounds_t1(1, 2):bounds_t1(2, 2), bounds_t1(1, 3):bounds_t1(2, 3))
# 683 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

# 673 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (4)
# 675 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CALL dist_sparse_tensor_to_repl_dense_array(tensor_1, array_1_4d_full)
                        CALL allocate_any(array_1_4d, shape_spec=SHAPE(array_1_4d_full))
                        array_1_4d = 0.0_real_8
         array_1_4d(bounds_t1(1, 1):bounds_t1(2, 1), bounds_t1(1, 2):bounds_t1(2, 2), bounds_t1(1, 3):bounds_t1(2, 3),&
# 678 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
             & bounds_t1(1, 4):bounds_t1(2, 4)) = &
         array_1_4d_full(bounds_t1(1, 1):bounds_t1(2, 1), bounds_t1(1, 2):bounds_t1(2, 2), bounds_t1(1, 3):bounds_t1(2, 3),&
# 679 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
             & bounds_t1(1, 4):bounds_t1(2, 4))
# 683 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

# 685 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               END SELECT
# 671 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               SELECT CASE (ndims_tensor(tensor_2))
# 673 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (2)
# 675 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CALL dist_sparse_tensor_to_repl_dense_array(tensor_2, array_2_2d_full)
                        CALL allocate_any(array_2_2d, shape_spec=SHAPE(array_2_2d_full))
                        array_2_2d = 0.0_real_8
         array_2_2d(bounds_t2(1, 1):bounds_t2(2, 1), bounds_t2(1, 2):bounds_t2(2, 2)) = &
         array_2_2d_full(bounds_t2(1, 1):bounds_t2(2, 1), bounds_t2(1, 2):bounds_t2(2, 2))
# 683 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

# 673 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (3)
# 675 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CALL dist_sparse_tensor_to_repl_dense_array(tensor_2, array_2_3d_full)
                        CALL allocate_any(array_2_3d, shape_spec=SHAPE(array_2_3d_full))
                        array_2_3d = 0.0_real_8
         array_2_3d(bounds_t2(1, 1):bounds_t2(2, 1), bounds_t2(1, 2):bounds_t2(2, 2), bounds_t2(1, 3):bounds_t2(2, 3)) = &
         array_2_3d_full(bounds_t2(1, 1):bounds_t2(2, 1), bounds_t2(1, 2):bounds_t2(2, 2), bounds_t2(1, 3):bounds_t2(2, 3))
# 683 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

# 673 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (4)
# 675 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CALL dist_sparse_tensor_to_repl_dense_array(tensor_2, array_2_4d_full)
                        CALL allocate_any(array_2_4d, shape_spec=SHAPE(array_2_4d_full))
                        array_2_4d = 0.0_real_8
         array_2_4d(bounds_t2(1, 1):bounds_t2(2, 1), bounds_t2(1, 2):bounds_t2(2, 2), bounds_t2(1, 3):bounds_t2(2, 3),&
# 678 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
             & bounds_t2(1, 4):bounds_t2(2, 4)) = &
         array_2_4d_full(bounds_t2(1, 1):bounds_t2(2, 1), bounds_t2(1, 2):bounds_t2(2, 2), bounds_t2(1, 3):bounds_t2(2, 3),&
# 679 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
             & bounds_t2(1, 4):bounds_t2(2, 4))
# 683 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

# 685 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               END SELECT
# 671 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               SELECT CASE (ndims_tensor(tensor_3))
# 673 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (2)
# 681 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CALL dist_sparse_tensor_to_repl_dense_array(tensor_3, array_3_2d)
# 683 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

# 673 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (3)
# 681 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CALL dist_sparse_tensor_to_repl_dense_array(tensor_3, array_3_3d)
# 683 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

# 673 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (4)
# 681 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CALL dist_sparse_tensor_to_repl_dense_array(tensor_3, array_3_4d)
# 683 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

# 685 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               END SELECT
# 687 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

            ! Get array sizes

# 691 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               SELECT CASE (ndims_tensor(tensor_1))
# 693 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (2)
                     CALL allocate_any(size_1, source=SHAPE(array_1_2d))

# 693 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (3)
                     CALL allocate_any(size_1, source=SHAPE(array_1_3d))

# 693 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (4)
                     CALL allocate_any(size_1, source=SHAPE(array_1_4d))

# 697 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               END SELECT
# 691 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               SELECT CASE (ndims_tensor(tensor_2))
# 693 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (2)
                     CALL allocate_any(size_2, source=SHAPE(array_2_2d))

# 693 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (3)
                     CALL allocate_any(size_2, source=SHAPE(array_2_3d))

# 693 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (4)
                     CALL allocate_any(size_2, source=SHAPE(array_2_4d))

# 697 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               END SELECT
# 691 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               SELECT CASE (ndims_tensor(tensor_3))
# 693 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (2)
                     CALL allocate_any(size_3, source=SHAPE(array_3_2d))

# 693 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (3)
                     CALL allocate_any(size_3, source=SHAPE(array_3_3d))

# 693 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (4)
                     CALL allocate_any(size_3, source=SHAPE(array_3_4d))

# 697 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               END SELECT
# 699 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

# 701 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               ALLOCATE (order_t1 (ndims_tensor(tensor_1)))
# 701 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               ALLOCATE (order_t2 (ndims_tensor(tensor_2)))
# 701 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               ALLOCATE (order_t3 (ndims_tensor(tensor_3)))
# 703 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

            ASSOCIATE (map_t1_1 => notcontract_1, map_t1_2 => contract_1, &
                       map_t2_1 => notcontract_2, map_t2_2 => contract_2, &
                       map_t3_1 => map_1, map_t3_2 => map_2)

# 709 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  order_t1 (:) = dbcsr_t_inverse_order([map_t1_1, map_t1_2])

                  SELECT CASE (ndims_tensor(tensor_1))
# 713 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CASE (2)
                        CALL allocate_any(array_1_rs2d, source=array_1_2d, order=order_t1)
                        CALL allocate_any(array_1_mm, sizes_2d(size_1, map_t1_1, map_t1_2))
                        array_1_mm(:, :) = RESHAPE(array_1_rs2d, SHAPE(array_1_mm))
# 713 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CASE (3)
                        CALL allocate_any(array_1_rs3d, source=array_1_3d, order=order_t1)
                        CALL allocate_any(array_1_mm, sizes_2d(size_1, map_t1_1, map_t1_2))
                        array_1_mm(:, :) = RESHAPE(array_1_rs3d, SHAPE(array_1_mm))
# 713 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CASE (4)
                        CALL allocate_any(array_1_rs4d, source=array_1_4d, order=order_t1)
                        CALL allocate_any(array_1_mm, sizes_2d(size_1, map_t1_1, map_t1_2))
                        array_1_mm(:, :) = RESHAPE(array_1_rs4d, SHAPE(array_1_mm))
# 718 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  END SELECT
# 709 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  order_t2 (:) = dbcsr_t_inverse_order([map_t2_1, map_t2_2])

                  SELECT CASE (ndims_tensor(tensor_2))
# 713 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CASE (2)
                        CALL allocate_any(array_2_rs2d, source=array_2_2d, order=order_t2)
                        CALL allocate_any(array_2_mm, sizes_2d(size_2, map_t2_1, map_t2_2))
                        array_2_mm(:, :) = RESHAPE(array_2_rs2d, SHAPE(array_2_mm))
# 713 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CASE (3)
                        CALL allocate_any(array_2_rs3d, source=array_2_3d, order=order_t2)
                        CALL allocate_any(array_2_mm, sizes_2d(size_2, map_t2_1, map_t2_2))
                        array_2_mm(:, :) = RESHAPE(array_2_rs3d, SHAPE(array_2_mm))
# 713 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CASE (4)
                        CALL allocate_any(array_2_rs4d, source=array_2_4d, order=order_t2)
                        CALL allocate_any(array_2_mm, sizes_2d(size_2, map_t2_1, map_t2_2))
                        array_2_mm(:, :) = RESHAPE(array_2_rs4d, SHAPE(array_2_mm))
# 718 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  END SELECT
# 709 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  order_t3 (:) = dbcsr_t_inverse_order([map_t3_1, map_t3_2])

                  SELECT CASE (ndims_tensor(tensor_3))
# 713 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CASE (2)
                        CALL allocate_any(array_3_rs2d, source=array_3_2d, order=order_t3)
                        CALL allocate_any(array_3_mm, sizes_2d(size_3, map_t3_1, map_t3_2))
                        array_3_mm(:, :) = RESHAPE(array_3_rs2d, SHAPE(array_3_mm))
# 713 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CASE (3)
                        CALL allocate_any(array_3_rs3d, source=array_3_3d, order=order_t3)
                        CALL allocate_any(array_3_mm, sizes_2d(size_3, map_t3_1, map_t3_2))
                        array_3_mm(:, :) = RESHAPE(array_3_rs3d, SHAPE(array_3_mm))
# 713 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                        CASE (4)
                        CALL allocate_any(array_3_rs4d, source=array_3_4d, order=order_t3)
                        CALL allocate_any(array_3_mm, sizes_2d(size_3, map_t3_1, map_t3_2))
                        array_3_mm(:, :) = RESHAPE(array_3_rs4d, SHAPE(array_3_mm))
# 718 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                  END SELECT
# 720 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"

               SELECT CASE (ndims_tensor(tensor_3))
# 723 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (2)
                     CALL allocate_any(array_3_0_rs2d, source=array_3_0_2d, order=order_t3)
                     CALL allocate_any(array_3_test_mm, sizes_2d(size_3, map_t3_1, map_t3_2))
                     array_3_test_mm(:, :) = RESHAPE(array_3_0_rs2d, SHAPE(array_3_mm))
# 723 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (3)
                     CALL allocate_any(array_3_0_rs3d, source=array_3_0_3d, order=order_t3)
                     CALL allocate_any(array_3_test_mm, sizes_2d(size_3, map_t3_1, map_t3_2))
                     array_3_test_mm(:, :) = RESHAPE(array_3_0_rs3d, SHAPE(array_3_mm))
# 723 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
                     CASE (4)
                     CALL allocate_any(array_3_0_rs4d, source=array_3_0_4d, order=order_t3)
                     CALL allocate_any(array_3_test_mm, sizes_2d(size_3, map_t3_1, map_t3_2))
                     array_3_test_mm(:, :) = RESHAPE(array_3_0_rs4d, SHAPE(array_3_mm))
# 728 "/__w/dbcsr/dbcsr/src/tensors/dbcsr_tensor_test.F"
               END SELECT

               array_3_test_mm(:, :) = beta%r_dp*array_3_test_mm(:, :) + alpha%r_dp*MATMUL(array_1_mm, transpose(array_2_mm))

            END ASSOCIATE

            eql_diff = MAXVAL(ABS(array_3_test_mm(:, :) - array_3_mm(:, :)))
            notzero = MAXVAL(ABS(array_3_test_mm(:, :))) .GT. 1.0E-12_real_8

            eql = eql_diff .LT. 1.0E-11_real_8

            IF (.NOT. eql .OR. .NOT. notzero) THEN
               IF (io_unit > 0) WRITE (io_unit, *) 'Test failed!', eql_diff
               DBCSR_ABORT('')
            ELSE
               IF (io_unit > 0) WRITE (io_unit, *) 'Test passed!', eql_diff
            END IF

         END SUBROUTINE

         FUNCTION sizes_2d(nd_sizes, map1, map2)
      !! mapped sizes in 2d
            INTEGER, DIMENSION(:), INTENT(IN) :: nd_sizes, map1, map2
            INTEGER, DIMENSION(2)             :: sizes_2d
            sizes_2d(1) = PRODUCT(nd_sizes(map1))
            sizes_2d(2) = PRODUCT(nd_sizes(map2))
         END FUNCTION

         FUNCTION dbcsr_t_checksum(tensor, local, pos)
      !! checksum of a tensor consistent with dbcsr_checksum
            TYPE(dbcsr_t_type), INTENT(IN) :: tensor
            REAL(KIND=real_8) :: dbcsr_t_checksum
            LOGICAL, INTENT(IN), OPTIONAL     :: local, pos
            dbcsr_t_checksum = dbcsr_tas_checksum(tensor%matrix_rep, local, pos)
         END FUNCTION

         SUBROUTINE dbcsr_t_reset_randmat_seed()
      !! Reset the seed used for generating random matrices to default value
            randmat_counter = rand_seed_init
         END SUBROUTINE

      END MODULE