!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright (C) 2000 - 2018  CP2K developers group                                               !
!--------------------------------------------------------------------------------------------------!

! **************************************************************************************************
!> \brief   Routines for basic block transformations.
!> \author  Urban Borstnik
!> \date    2010-02-18
!> \version 0.9
!>
!> <b>Modification history:</b>
!> - 2009-05-12 moved from dbcsr_util
! **************************************************************************************************
MODULE dbcsr_block_operations

   USE acc_devmem,                      ONLY: acc_devmem_allocated,&
                                              acc_devmem_setzero_bytes
   USE dbcsr_data_methods_low,          ONLY: dbcsr_data_exists,&
                                              dbcsr_data_get_size,&
                                              dbcsr_data_get_size_referenced,&
                                              dbcsr_data_get_type,&
                                              dbcsr_data_verify_bounds,&
                                              dbcsr_type_2d_to_1d,&
                                              dbcsr_type_is_2d
   USE dbcsr_ptr_util,                  ONLY: memory_copy
   USE dbcsr_types,                     ONLY: &
        dbcsr_data_obj, dbcsr_datatype_sizeof, dbcsr_scalar_type, dbcsr_type_complex_4, &
        dbcsr_type_complex_4_2d, dbcsr_type_complex_8, dbcsr_type_complex_8_2d, dbcsr_type_real_4, &
        dbcsr_type_real_4_2d, dbcsr_type_real_8, dbcsr_type_real_8_2d
   USE kinds,                           ONLY: dp,&
                                              real_4,&
                                              real_8,&
                                              sp
#include "../../base/base_uses.f90"

!$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num, omp_get_num_threads
   IMPLICIT NONE
   PRIVATE

   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbcsr_block_operations'

   PUBLIC :: dbcsr_block_transpose, dbcsr_block_transpose_aa, dbcsr_data_set
   PUBLIC :: dbcsr_block_copy_aa, dbcsr_block_partial_copy
   PUBLIC :: dbcsr_data_clear
   PUBLIC :: dbcsr_block_scale, dbcsr_block_conjg, dbcsr_block_real_neg

   PUBLIC :: dbcsr_data_copy

   PUBLIC :: block_add

   ! For quick access
   PUBLIC :: block_copy_s, block_copy_d, &
             block_copy_c, block_copy_z

   INTERFACE dbcsr_block_transpose
      MODULE PROCEDURE block_transpose_inplace_s, block_transpose_inplace_d, &
         block_transpose_inplace_c, block_transpose_inplace_z
      MODULE PROCEDURE block_transpose_copy_d, block_transpose_copy_s, &
         block_transpose_copy_z, block_transpose_copy_c
      MODULE PROCEDURE block_transpose_copy_2d1d_d, &
         block_transpose_copy_2d1d_s, &
         block_transpose_copy_2d1d_z, &
         block_transpose_copy_2d1d_c
      MODULE PROCEDURE block_transpose_copy_1d2d_d, &
         block_transpose_copy_1d2d_s, &
         block_transpose_copy_1d2d_z, &
         block_transpose_copy_1d2d_c
      MODULE PROCEDURE dbcsr_block_transpose_aa, dbcsr_block_transpose_a
   END INTERFACE

   INTERFACE dbcsr_block_copy
      MODULE PROCEDURE block_copy_2d1d_s, block_copy_2d1d_d, &
         block_copy_2d1d_c, block_copy_2d1d_z
      MODULE PROCEDURE block_copy_1d2d_s, block_copy_1d2d_d, &
         block_copy_1d2d_c, block_copy_1d2d_z
      MODULE PROCEDURE block_copy_1d1d_s, block_copy_1d1d_d, &
         block_copy_1d1d_c, block_copy_1d1d_z
      MODULE PROCEDURE block_copy_2d2d_s, block_copy_2d2d_d, &
         block_copy_2d2d_c, block_copy_2d2d_z
   END INTERFACE

   INTERFACE dbcsr_data_clear
      MODULE PROCEDURE dbcsr_data_clear_nt
      MODULE PROCEDURE dbcsr_data_clear0
   END INTERFACE

   ! Supports copy between two data areas, or to a data area from a
   ! given explicit array.
   INTERFACE dbcsr_data_set
      MODULE PROCEDURE dbcsr_data_copy_aa, dbcsr_data_set_as, &
         dbcsr_data_set_ad, dbcsr_data_set_ac, dbcsr_data_set_az
   END INTERFACE

   INTERFACE dbcsr_data_copy
      MODULE PROCEDURE dbcsr_data_copy_aa2, dbcsr_data_set_as, &
         dbcsr_data_set_ad, dbcsr_data_set_ac, dbcsr_data_set_az
   END INTERFACE

   INTERFACE block_add
      MODULE PROCEDURE block_add_anytype
      MODULE PROCEDURE block_add_anytype_bounds
      MODULE PROCEDURE block_add_s, block_add_d, block_add_c, block_add_z
   END INTERFACE block_add

   LOGICAL, PARAMETER :: debug_mod = .FALSE.
   LOGICAL, PARAMETER :: careful_mod = .FALSE.

CONTAINS

! **************************************************************************************************
!> \brief Copy data from one data area to another.
!>
!> There are no checks done for correctness!
!> \param[in] dst        destination data area
!> \param[in] src        source data area
!> \param[in] row_size   row size of existing block
!> \param[in] col_size   column size of existing block
!> \param[in] lb         (optional) lower bound for destination (and source if
!>                       not given explicity)
!> \param[in] source_lb  (optional) lower bound of source
!> \param[in] scale      (optional) scale data
!> \param[in] lb2        (optional) lower bound of 2nd dimension for target
!> \param[in] source_lb2 (optional) lower bound of 2nd dimension for source
! **************************************************************************************************
   SUBROUTINE dbcsr_block_transpose_aa(dst, src, &
                                       row_size, col_size, lb, source_lb, scale, lb2, source_lb2)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dst
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: src
      INTEGER, INTENT(IN)                                :: row_size, col_size
      INTEGER, INTENT(IN), OPTIONAL                      :: lb, source_lb
      TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL      :: scale
      INTEGER, INTENT(IN), OPTIONAL                      :: lb2, source_lb2

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_block_transpose_aa', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: data_size, lb2_s, lb2_t, lb_s, lb_t, &
                                                            ub_s, ub_t

!   ---------------------------------------------------------------------------

      IF (debug_mod) THEN
         IF (.NOT. ASSOCIATED(dst%d) .OR. .NOT. ASSOCIATED(src%d)) &
            CPABORT("Data areas must be setup.")
         IF (dst%d%data_type /= src%d%data_type) &
            CPABORT("Data type must be the same.")
         IF (dst%d%data_type .NE. dbcsr_type_real_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_8_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4_2d) &
            CPWARN("Incorrect data type.")
         IF (PRESENT(scale)) THEN
            IF (dbcsr_type_is_2d(src%d%data_type)) THEN
               IF (scale%data_type /= dbcsr_type_2d_to_1d(src%d%data_type)) &
                  CPABORT("Incompatible data types")
            ELSE
               IF (scale%data_type /= src%d%data_type) &
                  CPABORT("Incompatible data types")
            ENDIF
         ENDIF
      ENDIF
      data_size = row_size*col_size
      lb_t = 1
      IF (PRESENT(lb)) lb_t = lb
      ub_t = lb_t+data_size-1
      IF (PRESENT(source_lb)) THEN
         lb_s = source_lb
         ub_s = source_lb+data_size-1
      ELSE
         lb_s = lb_t
         ub_s = ub_t
      ENDIF
      lb2_t = 1
      IF (PRESENT(lb2)) lb2_t = lb2
      IF (PRESENT(source_lb2)) THEN
         lb2_s = source_lb2
      ELSE
         lb2_s = lb2_t
      ENDIF
      SELECT CASE (src%d%data_type)
      CASE (dbcsr_type_real_8)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_transpose(dst%d%r_dp(lb_t:ub_t), &
                                       src%d%r_dp(lb_s:ub_s)*scale%r_dp, &
                                       row_size, col_size)
         ELSE
            CALL dbcsr_block_transpose(dst%d%r_dp(lb_t:ub_t), &
                                       src%d%r_dp(lb_s:ub_s), &
                                       row_size, col_size)
         ENDIF
      CASE (dbcsr_type_real_4)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_transpose(dst%d%r_sp(lb_t:ub_t), &
                                       src%d%r_sp(lb_s:ub_s)*scale%r_sp, &
                                       row_size, col_size)
         ELSE
            CALL dbcsr_block_transpose(dst%d%r_sp(lb_t:ub_t), &
                                       src%d%r_sp(lb_s:ub_s), &
                                       row_size, col_size)
         ENDIF
      CASE (dbcsr_type_complex_8)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_transpose(dst%d%c_dp(lb_t:ub_t), &
                                       src%d%c_dp(lb_s:ub_s)*scale%c_dp, &
                                       row_size, col_size)
         ELSE
            CALL dbcsr_block_transpose(dst%d%c_dp(lb_t:ub_t), &
                                       src%d%c_dp(lb_s:ub_s), &
                                       row_size, col_size)
         ENDIF
      CASE (dbcsr_type_complex_4)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_transpose(dst%d%c_sp(lb_t:ub_t), &
                                       src%d%c_sp(lb_s:ub_s)*scale%c_sp, &
                                       row_size, col_size)
         ELSE
            CALL dbcsr_block_transpose(dst%d%c_sp(lb_t:ub_t), &
                                       src%d%c_sp(lb_s:ub_s), &
                                       row_size, col_size)
         ENDIF
      CASE (dbcsr_type_real_8_2d)
         IF (PRESENT(scale)) THEN
            dst%d%r2_dp(lb_t:lb_t+col_size-1, lb2_t:lb2_t+row_size-1) = &
               TRANSPOSE( &
               src%d%r2_dp(lb_s:lb_s+row_size-1, lb2_s:lb2_s+col_size-1) &
               *scale%r_dp)
         ELSE
            dst%d%r2_dp(lb_t:lb_t+col_size-1, lb2_t:lb2_t+row_size-1) = &
               TRANSPOSE( &
               src%d%r2_dp(lb_s:lb_s+row_size-1, lb2_s:lb2_s+col_size-1))
         ENDIF
      CASE (dbcsr_type_real_4_2d)
         IF (PRESENT(scale)) THEN
            dst%d%r2_sp(lb_t:lb_t+col_size-1, lb2_t:lb2_t+row_size-1) = &
               TRANSPOSE( &
               src%d%r2_sp(lb_s:lb_s+row_size-1, lb2_s:lb2_s+col_size-1) &
               *scale%r_sp)
         ELSE
            dst%d%r2_sp(lb_t:lb_t+col_size-1, lb2_t:lb2_t+row_size-1) = &
               TRANSPOSE( &
               src%d%r2_sp(lb_s:lb_s+row_size-1, lb2_s:lb2_s+col_size-1))
         ENDIF
      CASE (dbcsr_type_complex_8_2d)
         IF (PRESENT(scale)) THEN
            dst%d%c2_dp(lb_t:lb_t+col_size-1, lb2_t:lb2_t+row_size-1) = &
               TRANSPOSE( &
               src%d%c2_dp(lb_s:lb_s+row_size-1, lb2_s:lb2_s+col_size-1) &
               *scale%c_dp)
         ELSE
            dst%d%c2_dp(lb_t:lb_t+col_size-1, lb2_t:lb2_t+row_size-1) = &
               TRANSPOSE( &
               src%d%c2_dp(lb_s:lb_s+row_size-1, lb2_s:lb2_s+col_size-1))
         ENDIF
      CASE (dbcsr_type_complex_4_2d)
         IF (PRESENT(scale)) THEN
            dst%d%c2_sp(lb_t:lb_t+col_size-1, lb2_t:lb2_t+row_size-1) = &
               TRANSPOSE( &
               src%d%c2_sp(lb_s:lb_s+row_size-1, lb2_s:lb2_s+col_size-1) &
               *scale%c_sp)
         ELSE
            dst%d%c2_sp(lb_t:lb_t+col_size-1, lb2_t:lb2_t+row_size-1) = &
               TRANSPOSE( &
               src%d%c2_sp(lb_s:lb_s+row_size-1, lb2_s:lb2_s+col_size-1))
         ENDIF
      CASE default
         CPABORT("Incorrect data type.")
      END SELECT
   END SUBROUTINE dbcsr_block_transpose_aa

! **************************************************************************************************
!> \brief Copy data from one data area to another.
!>
!> There are no checks done for correctness!
!> \param[in] dst        destination data area
!> \param[in] src        source data area
!> \param[in] row_size   row size of existing block
!> \param[in] col_size   column size of existing block
!> \param[in] lb         (optional) lower bound for destination (and source if
!>                       not given explicity)
!> \param[in] source_lb  (optional) lower bound of source
!> \param[in] scale      (optional) scale data
! **************************************************************************************************
   SUBROUTINE dbcsr_block_copy_aa(dst, src, &
                                  row_size, col_size, lb, source_lb, scale)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dst
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: src
      INTEGER, INTENT(IN)                                :: row_size, col_size
      INTEGER, INTENT(IN), OPTIONAL                      :: lb, source_lb
      TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL      :: scale

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_block_copy_aa', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: data_size, lb_s, lb_t, ub_s, ub_t

!   ---------------------------------------------------------------------------

      IF (debug_mod) THEN
         IF (.NOT. ASSOCIATED(dst%d) .OR. .NOT. ASSOCIATED(src%d)) &
            CPABORT("Data areas must be setup.")
         IF (dst%d%data_type /= src%d%data_type) &
            CPABORT("Data type must be the same.")
         IF (dst%d%data_type .NE. dbcsr_type_real_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4) &
            CPWARN("Incorrect data type.")
         IF (PRESENT(scale)) THEN
            IF (dbcsr_type_is_2d(src%d%data_type)) THEN
               IF (scale%data_type /= dbcsr_type_2d_to_1d(src%d%data_type)) &
                  CPABORT("Incompatible data types")
            ELSE
               IF (scale%data_type /= src%d%data_type) &
                  CPABORT("Incompatible data types")
            ENDIF
         ENDIF
      ENDIF
      data_size = row_size*col_size
      lb_t = 1
      IF (PRESENT(lb)) lb_t = lb
      ub_t = lb_t+data_size-1
      IF (PRESENT(source_lb)) THEN
         lb_s = source_lb
         ub_s = source_lb+data_size-1
      ELSE
         lb_s = lb_t
         ub_s = ub_t
      ENDIF
      SELECT CASE (src%d%data_type)
      CASE (dbcsr_type_real_8)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_copy(dst%d%r_dp(lb_t:ub_t), &
                                  src%d%r_dp(lb_s:ub_s)*scale%r_dp, &
                                  row_size, col_size)
         ELSE
            CALL dbcsr_block_copy(dst%d%r_dp(lb_t:ub_t), &
                                  src%d%r_dp(lb_s:ub_s), &
                                  row_size, col_size)
         ENDIF
      CASE (dbcsr_type_real_4)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_copy(dst%d%r_sp(lb_t:ub_t), &
                                  src%d%r_sp(lb_s:ub_s)*scale%r_sp, &
                                  row_size, col_size)
         ELSE
            CALL dbcsr_block_copy(dst%d%r_sp(lb_t:ub_t), &
                                  src%d%r_sp(lb_s:ub_s), &
                                  row_size, col_size)
         ENDIF
      CASE (dbcsr_type_complex_8)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_copy(dst%d%c_dp(lb_t:ub_t), &
                                  src%d%c_dp(lb_s:ub_s)*scale%c_dp, &
                                  row_size, col_size)
         ELSE
            CALL dbcsr_block_copy(dst%d%c_dp(lb_t:ub_t), &
                                  src%d%c_dp(lb_s:ub_s), &
                                  row_size, col_size)
         ENDIF
      CASE (dbcsr_type_complex_4)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_copy(dst%d%c_sp(lb_t:ub_t), &
                                  src%d%c_sp(lb_s:ub_s)*scale%c_sp, &
                                  row_size, col_size)
         ELSE
            CALL dbcsr_block_copy(dst%d%c_sp(lb_t:ub_t), &
                                  src%d%c_sp(lb_s:ub_s), &
                                  row_size, col_size)
         ENDIF
      CASE default
         CPABORT("Incorrect data type.")
      END SELECT
   END SUBROUTINE dbcsr_block_copy_aa

! **************************************************************************************************
!> \brief Scale a data area.
!>
!> There are no checks done for correctness!
!> \param dst ...
!> \param[in] scale      (optional) scale data
!> \param[in] row_size   row size of existing block
!> \param[in] col_size   column size of existing block
!> \param[in] lb         (optional) lower bound for destination (and source if
!>                       not given explicity)
!> \param[in] lb2        (optional) lower bound of 2nd dimension for target
!> \par History
!> - 2010-09 [??] Copied from block_transpose?
!> - 2010-09-20 [UB] Swaps/corrects row/column definitions for 2-D bounds
! **************************************************************************************************
   SUBROUTINE dbcsr_block_scale(dst, scale, &
                                row_size, col_size, lb, lb2)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dst
      TYPE(dbcsr_scalar_type), INTENT(IN)                :: scale
      INTEGER, INTENT(IN)                                :: row_size, col_size
      INTEGER, INTENT(IN), OPTIONAL                      :: lb, lb2

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_block_scale', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: data_size, handle, lb2_t, lb_t, ub_t

!   ---------------------------------------------------------------------------

      IF (careful_mod) CALL timeset(routineN, handle)
      IF (debug_mod) THEN
         IF (.NOT. ASSOCIATED(dst%d)) &
            CPABORT("Data area must be setup.")
         IF (dst%d%data_type .NE. dbcsr_type_real_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_8_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4_2d) &
            CPWARN("Incorrect data type.")
      ENDIF
      IF (scale%data_type /= dbcsr_type_2d_to_1d(dst%d%data_type)) &
         CPABORT("Incompatible data types")

      data_size = row_size*col_size
      lb_t = 1
      IF (PRESENT(lb)) lb_t = lb
      ub_t = lb_t+data_size-1
      lb2_t = 1
      IF (PRESENT(lb2)) lb2_t = lb2
      SELECT CASE (dst%d%data_type)
      CASE (dbcsr_type_real_8)
         dst%d%r_dp(lb_t:ub_t) = dst%d%r_dp(lb_t:ub_t)*scale%r_dp
      CASE (dbcsr_type_real_4)
         dst%d%r_sp(lb_t:ub_t) = dst%d%r_sp(lb_t:ub_t)*scale%r_sp
      CASE (dbcsr_type_complex_8)
         dst%d%c_dp(lb_t:ub_t) = dst%d%c_dp(lb_t:ub_t)*scale%c_dp
      CASE (dbcsr_type_complex_4)
         dst%d%c_sp(lb_t:ub_t) = dst%d%c_sp(lb_t:ub_t)*scale%c_sp
      CASE (dbcsr_type_real_8_2d)
         dst%d%r2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            dst%d%r2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1)*scale%r_dp
      CASE (dbcsr_type_real_4_2d)
         dst%d%r2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            dst%d%r2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1)*scale%r_sp
      CASE (dbcsr_type_complex_8_2d)
         dst%d%c2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            dst%d%c2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1)*scale%c_dp
      CASE (dbcsr_type_complex_4_2d)
         dst%d%c2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            dst%d%c2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1)*scale%c_sp
      CASE default
         CPABORT("Incorrect data type.")
      END SELECT
      IF (careful_mod) CALL timestop(handle)
   END SUBROUTINE dbcsr_block_scale

! **************************************************************************************************
!> \brief Negates the real part of a block
!>
!> There are no checks done for correctness!
!> \param dst ...
!> \param[in] row_size   row size of existing block
!> \param[in] col_size   column size of existing block
!> \param[in] lb         (optional) lower bound for destination (and source if
!>                       not given explicity)
!> \param[in] lb2        (optional) lower bound of 2nd dimension for target
!> \par History
!> - 2010-09 [??] Copied from block_transpose?
!> - 2010-09-20 [UB] Swaps/corrects row/column definitions for 2-D bounds
! **************************************************************************************************
   SUBROUTINE dbcsr_block_real_neg(dst, &
                                   row_size, col_size, lb, lb2)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dst
      INTEGER, INTENT(IN)                                :: row_size, col_size
      INTEGER, INTENT(IN), OPTIONAL                      :: lb, lb2

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_block_real_neg', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: data_size, handle, lb2_t, lb_t, ub_t

!   ---------------------------------------------------------------------------

      IF (careful_mod) CALL timeset(routineN, handle)
      IF (debug_mod) THEN
         IF (.NOT. ASSOCIATED(dst%d)) &
            CPABORT("Data area must be setup.")
         IF (dst%d%data_type .NE. dbcsr_type_real_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_8_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4_2d) &
            CPWARN("Incorrect data type.")
      ENDIF

      data_size = row_size*col_size
      lb_t = 1
      IF (PRESENT(lb)) lb_t = lb
      ub_t = lb_t+data_size-1
      lb2_t = 1
      IF (PRESENT(lb2)) lb2_t = lb2
      SELECT CASE (dst%d%data_type)
      CASE (dbcsr_type_real_8)
         dst%d%r_dp(lb_t:ub_t) = -dst%d%r_dp(lb_t:ub_t)
      CASE (dbcsr_type_real_4)
         dst%d%r_sp(lb_t:ub_t) = -dst%d%r_sp(lb_t:ub_t)
      CASE (dbcsr_type_complex_8)
         dst%d%c_dp(lb_t:ub_t) = CMPLX( &
                                 -REAL(dst%d%c_dp(lb_t:ub_t), KIND=real_8), &
                                 AIMAG(dst%d%c_dp(lb_t:ub_t)), &
                                 KIND=real_8)
      CASE (dbcsr_type_complex_4)
         dst%d%c_sp(lb_t:ub_t) = CMPLX( &
                                 -REAL(dst%d%c_sp(lb_t:ub_t), KIND=real_4), &
                                 AIMAG(dst%d%c_sp(lb_t:ub_t)), &
                                 KIND=real_4)
      CASE (dbcsr_type_real_8_2d)
         dst%d%r2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            -dst%d%r2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1)
      CASE (dbcsr_type_real_4_2d)
         dst%d%r2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            -dst%d%r2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1)
      CASE (dbcsr_type_complex_8_2d)
         dst%d%c2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            CMPLX( &
            -REAL(dst%d%c2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1), KIND=real_8), &
            AIMAG(dst%d%c2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1)), &
            KIND=real_8)
      CASE (dbcsr_type_complex_4_2d)
         dst%d%c2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            CMPLX( &
            -REAL(dst%d%c2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1), KIND=real_4), &
            AIMAG(dst%d%c2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1)), &
            KIND=real_4)
      CASE default
         CPABORT("Incorrect data type.")
      END SELECT
      IF (careful_mod) CALL timestop(handle)
   END SUBROUTINE dbcsr_block_real_neg

! **************************************************************************************************
!> \brief Conjugate a data area.
!>
!> There are no checks done for correctness!
!> \param dst ...
!> \param[in] row_size   row size of existing block
!> \param[in] col_size   column size of existing block
!> \param[in] lb         (optional) lower bound for destination (and source if
!>                       not given explicity)
!> \param[in] lb2        (optional) lower bound of 2nd dimension for target
!> \par History
!> - 2010-09 [??] Copied from block_transpose?
!> - 2010-09-20 [UB] Swaps/corrects row/column definitions for 2-D bounds
! **************************************************************************************************
   SUBROUTINE dbcsr_block_conjg(dst, &
                                row_size, col_size, lb, lb2)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dst
      INTEGER, INTENT(IN)                                :: row_size, col_size
      INTEGER, INTENT(IN), OPTIONAL                      :: lb, lb2

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_block_conjg', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: data_size, handle, lb2_t, lb_t, ub_t

!   ---------------------------------------------------------------------------

      IF (careful_mod) CALL timeset(routineN, handle)
      IF (debug_mod) THEN
         IF (.NOT. ASSOCIATED(dst%d)) &
            CPABORT("Data area must be setup.")
         IF (dst%d%data_type .NE. dbcsr_type_real_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_8_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4_2d) &
            CPWARN("Incorrect data type.")
      ENDIF

      data_size = row_size*col_size
      lb_t = 1
      IF (PRESENT(lb)) lb_t = lb
      ub_t = lb_t+data_size-1
      lb2_t = 1
      IF (PRESENT(lb2)) lb2_t = lb2
      SELECT CASE (dst%d%data_type)
      CASE (dbcsr_type_real_8)
         dst%d%r_dp(lb_t:ub_t) = dst%d%r_dp(lb_t:ub_t)
      CASE (dbcsr_type_real_4)
         dst%d%r_sp(lb_t:ub_t) = dst%d%r_sp(lb_t:ub_t)
      CASE (dbcsr_type_complex_8)
         dst%d%c_dp(lb_t:ub_t) = CONJG(dst%d%c_dp(lb_t:ub_t))
      CASE (dbcsr_type_complex_4)
         dst%d%c_sp(lb_t:ub_t) = CONJG(dst%d%c_sp(lb_t:ub_t))
      CASE (dbcsr_type_real_8_2d)
         dst%d%r2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            dst%d%r2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1)
      CASE (dbcsr_type_real_4_2d)
         dst%d%r2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            dst%d%r2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1)
      CASE (dbcsr_type_complex_8_2d)
         dst%d%c2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            CONJG(dst%d%c2_dp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1))
      CASE (dbcsr_type_complex_4_2d)
         dst%d%c2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1) = &
            CONJG(dst%d%c2_sp(lb_t:lb_t+row_size-1, lb2_t:lb2_t+col_size-1))
      CASE default
         CPABORT("Incorrect data type.")
      END SELECT
      IF (careful_mod) CALL timestop(handle)
   END SUBROUTINE dbcsr_block_conjg

! **************************************************************************************************
!> \brief In-place transpose of encapsulated data
!>
!> There are no checks done for correctness!
!> \param[in] area       encapsulated data area
!> \param[in] row_size   number of rows in existing block
!> \param[in] col_size   number of columns in existing block
! **************************************************************************************************
   SUBROUTINE dbcsr_block_transpose_a(area, row_size, col_size)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: area
      INTEGER, INTENT(IN)                                :: row_size, col_size

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_block_transpose_a', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: handle

!   ---------------------------------------------------------------------------

      IF (careful_mod) &
         CALL timeset(routineN, handle)
      SELECT CASE (area%d%data_type)
      CASE (dbcsr_type_real_8)
         CALL dbcsr_block_transpose(area%d%r_dp, &
                                    row_size, col_size)
      CASE (dbcsr_type_real_4)
         CALL dbcsr_block_transpose(area%d%r_sp, &
                                    row_size, col_size)
      CASE (dbcsr_type_complex_8)
         CALL dbcsr_block_transpose(area%d%c_dp, &
                                    row_size, col_size)
      CASE (dbcsr_type_complex_4)
         CALL dbcsr_block_transpose(area%d%c_sp, &
                                    row_size, col_size)
      CASE default
         CPABORT("Invalid data type")
      END SELECT
      IF (careful_mod) &
         CALL timestop(handle)
   END SUBROUTINE dbcsr_block_transpose_a

! **************************************************************************************************
!> \brief Copy data from one data area to another.
!>
!> There are no checks done for correctness!
!> \param[in] dst        destination data area
!> \param[in] lb         lower bound for destination (and source if
!>                       not given explicity)
!> \param[in] data_size  number of elements to copy
!> \param[in] src        source data area
!> \param[in] source_lb  (optional) lower bound of source
!> \param[in] scale      (optional) scale by this factor
!> \param[in] lb2        (optional) 2nd dimension lower bound
!> \param[in] data_size2 (optional) 2nd dimension data size
!> \param[in] source_lb2 (optional) 2nd dimension lower bound for source
! **************************************************************************************************
   SUBROUTINE dbcsr_data_copy_aa(dst, lb, data_size, src, source_lb, scale, &
                                 lb2, data_size2, source_lb2)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dst
      INTEGER, INTENT(IN)                                :: lb, data_size
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: src
      INTEGER, INTENT(IN), OPTIONAL                      :: source_lb
      TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL      :: scale
      INTEGER, INTENT(IN), OPTIONAL                      :: lb2, data_size2, source_lb2

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_data_copy_aa', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: lb2_s, lb_s, ub, ub2, ub2_s, ub_s

!   ---------------------------------------------------------------------------

      IF (debug_mod) THEN
         IF (.NOT. ASSOCIATED(dst%d) .OR. .NOT. ASSOCIATED(src%d)) &
            CPABORT("Data areas must be setup.")
         IF (dst%d%data_type .NE. src%d%data_type) &
            CPABORT("Data type must be the same.")
      ENDIF
      IF (PRESENT(scale) .AND. careful_mod) THEN
         IF (dbcsr_type_is_2d(src%d%data_type)) THEN
            IF (scale%data_type .NE. dbcsr_type_2d_to_1d(src%d%data_type)) &
               CPABORT("Incomptable data types")
         ELSE
            IF (scale%data_type .NE. src%d%data_type) &
               CPABORT("Incomptable data types")
         ENDIF
      ENDIF
      ub = lb+data_size-1
      IF (PRESENT(source_lb)) THEN
         lb_s = source_lb
         ub_s = source_lb+data_size-1
      ELSE
         lb_s = lb
         ub_s = ub
      ENDIF
      IF (careful_mod) THEN
         IF (dbcsr_type_is_2d(src%d%data_type) .AND. .NOT. PRESENT(lb2)) &
            CPABORT("Must specify lb2 for 2-D data area")
         IF (dbcsr_type_is_2d(src%d%data_type) .AND. .NOT. PRESENT(data_size2)) &
            CPABORT("Must specify data_size2 for 2-D data area")
      ENDIF
      IF (PRESENT(lb2)) THEN
         IF (careful_mod) THEN
            IF (.NOT. dbcsr_type_is_2d(src%d%data_type)) &
               CPWARN("Should not specify lb2 for 1-D data")
         ENDIF
         ub2 = lb2+data_size2-1
         IF (PRESENT(source_lb2)) THEN
            lb2_s = source_lb2
            ub2_s = source_lb2+data_size2-1
         ELSE
            lb2_s = lb2
            ub2_s = ub2
         ENDIF
         !write(*,*)routineN//" lb,ub2D <- S",lb2, ub2, lb2_s, ub2_s
      ENDIF
      SELECT CASE (src%d%data_type)
      CASE (dbcsr_type_real_4)
         IF (debug_mod) THEN
            IF (.NOT. ASSOCIATED(dst%d%r_sp)) &
               CPABORT("associated(dst%d%r_sp)")
            IF (.NOT. ASSOCIATED(src%d%r_sp)) &
               CPABORT("associated(src%d%r_sp)")
            IF (lb < LBOUND(dst%d%r_sp, 1)) &
               CPABORT("lb dst%d%r_sp")
            IF (ub > UBOUND(dst%d%r_sp, 1)) &
               CPABORT("ub dst%d%r_sp")
            IF (lb_s < LBOUND(src%d%r_sp, 1)) &
               CPABORT("lb src%d%r_sp")
            IF (ub_s > UBOUND(src%d%r_sp, 1)) &
               CPABORT("ub src%d%r_sp")
         ENDIF
         IF (PRESENT(scale)) THEN
            dst%d%r_sp(lb:ub) = scale%r_sp*src%d%r_sp(lb_s:ub_s)
         ELSE
            dst%d%r_sp(lb:ub) = src%d%r_sp(lb_s:ub_s)
         ENDIF
      CASE (dbcsr_type_real_8)
         IF (debug_mod) THEN
            IF (.NOT. ASSOCIATED(dst%d%r_dp)) &
               CPABORT("associated(dst%d%r_dp)")
            IF (.NOT. ASSOCIATED(src%d%r_dp)) &
               CPABORT("associated(src%d%r_dp)")
            IF (lb < LBOUND(dst%d%r_dp, 1)) &
               CPABORT("lb dst%d%r_dp")
            IF (ub > UBOUND(dst%d%r_dp, 1)) &
               CPABORT("ub dst%d%r_dp")
            IF (lb_s < LBOUND(src%d%r_dp, 1)) &
               CPABORT("lb src%d%r_dp")
            IF (ub_s > UBOUND(src%d%r_dp, 1)) &
               CPABORT("ub src%d%r_dp")
         ENDIF
         IF (PRESENT(scale)) THEN
            dst%d%r_dp(lb:ub) = scale%r_dp*src%d%r_dp(lb_s:ub_s)
         ELSE
            dst%d%r_dp(lb:ub) = src%d%r_dp(lb_s:ub_s)
         ENDIF
      CASE (dbcsr_type_complex_4)
         IF (debug_mod) THEN
            IF (.NOT. ASSOCIATED(dst%d%c_sp)) &
               CPABORT("associated(dst%d%c_sp)")
            IF (.NOT. ASSOCIATED(src%d%c_sp)) &
               CPABORT("associated(src%d%c_sp)")
            IF (lb < LBOUND(dst%d%c_sp, 1)) &
               CPABORT("lb dst%d%c_sp")
            IF (ub > UBOUND(dst%d%c_sp, 1)) &
               CPABORT("ub dst%d%c_sp")
            IF (lb_s < LBOUND(src%d%c_sp, 1)) &
               CPABORT("lb src%d%c_sp")
            IF (ub_s > UBOUND(src%d%c_sp, 1)) &
               CPABORT("ub src%d%c_sp")
         ENDIF
         IF (PRESENT(scale)) THEN
            dst%d%c_sp(lb:ub) = scale%c_sp*src%d%c_sp(lb_s:ub_s)
         ELSE
            dst%d%c_sp(lb:ub) = src%d%c_sp(lb_s:ub_s)
         ENDIF
      CASE (dbcsr_type_complex_8)
         IF (debug_mod) THEN
            IF (.NOT. ASSOCIATED(dst%d%c_dp)) &
               CPABORT("associated(dst%d%c_dp)")
            IF (.NOT. ASSOCIATED(src%d%c_dp)) &
               CPABORT("associated(src%d%c_dp)")
            IF (lb < LBOUND(dst%d%c_dp, 1)) &
               CPABORT("lb dst%d%c_dp")
            IF (ub > UBOUND(dst%d%c_dp, 1)) &
               CPABORT("ub dst%d%c_dp")
            IF (lb_s < LBOUND(src%d%c_dp, 1)) &
               CPABORT("lb src%d%c_dp")
            IF (ub_s > UBOUND(src%d%c_dp, 1)) &
               CPABORT("ub src%d%c_dp")
         ENDIF
         IF (PRESENT(scale)) THEN
            dst%d%c_dp(lb:ub) = scale%c_dp*src%d%c_dp(lb_s:ub_s)
         ELSE
            dst%d%c_dp(lb:ub) = src%d%c_dp(lb_s:ub_s)
         ENDIF
      CASE (dbcsr_type_real_4_2d)
         IF (PRESENT(scale)) THEN
            dst%d%r2_sp(lb:ub, lb2:ub2) = &
               scale%r_sp*src%d%r2_sp(lb_s:ub_s, lb2_s:ub2_s)
         ELSE
            dst%d%r2_sp(lb:ub, lb2:ub2) = src%d%r2_sp(lb_s:ub_s, lb2_s:ub2_s)
         ENDIF
      CASE (dbcsr_type_real_8_2d)
         IF (PRESENT(scale)) THEN
            dst%d%r2_dp(lb:ub, lb2:ub2) = &
               scale%r_dp*src%d%r2_dp(lb_s:ub_s, lb2_s:ub2_s)
         ELSE
            dst%d%r2_dp(lb:ub, lb2:ub2) = src%d%r2_dp(lb_s:ub_s, lb2_s:ub2_s)
         ENDIF
      CASE (dbcsr_type_complex_4_2d)
         IF (PRESENT(scale)) THEN
            dst%d%c2_sp(lb:ub, lb2:ub2) = &
               scale%c_sp*src%d%c2_sp(lb_s:ub_s, lb2_s:ub2_s)
         ELSE
            dst%d%c2_sp(lb:ub, lb2:ub2) = src%d%c2_sp(lb_s:ub_s, lb2_s:ub2_s)
         ENDIF
      CASE (dbcsr_type_complex_8_2d)
         IF (PRESENT(scale)) THEN
            dst%d%c2_dp(lb:ub, lb2:ub2) = &
               scale%c_dp*src%d%c2_dp(lb_s:ub_s, lb2_s:ub2_s)
         ELSE
            dst%d%c2_dp(lb:ub, lb2:ub2) = src%d%c2_dp(lb_s:ub_s, lb2_s:ub2_s)
         ENDIF
      CASE default
         CPABORT("Invalid data type")
      END SELECT
   END SUBROUTINE dbcsr_data_copy_aa

! **************************************************************************************************
!> \brief Copy data from one data area to another, the most basic form.
!>
!> There are no checks done for correctness!
!> \param[in,out] dst    destination data area
!> \param[in] dst_lb     lower bounds for destination
!> \param[in] dst_sizes  sizes for destination
!> \param[in] src        source data area
!> \param[in] src_lb     lower bounds for source
!> \param[in] src_sizes  sizes for source
! **************************************************************************************************
   SUBROUTINE dbcsr_data_copy_aa2(dst, dst_lb, dst_sizes, &
                                  src, src_lb, src_sizes)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dst
      INTEGER, DIMENSION(:), INTENT(IN)                  :: dst_lb, dst_sizes
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: src
      INTEGER, DIMENSION(:), INTENT(IN)                  :: src_lb, src_sizes

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_data_copy_aa2', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: dst_d, dst_dt, handle, src_d, src_dt
      INTEGER, DIMENSION(2)                              :: dst_ub, src_ub

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, handle)
      !
      src_dt = dbcsr_data_get_type(src)
      dst_dt = dbcsr_data_get_type(dst)
      IF (dbcsr_type_is_2d(src_dt)) THEN
         src_d = 2
      ELSE
         src_d = 1
      ENDIF
      IF (dbcsr_type_is_2d(dst_dt)) THEN
         dst_d = 2
      ELSE
         dst_d = 1
      ENDIF
      src_ub(1:src_d) = src_lb(1:src_d)+src_sizes(1:src_d)-1
      dst_ub(1:dst_d) = dst_lb(1:dst_d)+dst_sizes(1:dst_d)-1
      IF (careful_mod) THEN
         IF (.NOT. dbcsr_data_exists(dst)) &
            CPABORT("Invalid target data area")
         IF (.NOT. dbcsr_data_exists(src)) &
            CPABORT("Invalid source data area")
         IF (dbcsr_type_2d_to_1d(src_dt) /= dbcsr_type_2d_to_1d(dst_dt)) &
            CPABORT("Data types must be comptable: ")
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            IF (SIZE(dst_lb) /= 2) &
               CPABORT("size must be 2 for 2-d dst_lb")
            IF (SIZE(dst_sizes) /= 2) &
               CPABORT("size must be 2 for 2-d dst_sizes")
         ELSE
            IF (SIZE(dst_lb) /= 1) &
               CPABORT("size must be 1 for 1-d dst_lb")
            IF (SIZE(dst_sizes) /= 1) &
               CPABORT("size must be 1 for 1-d dst_sizes")
         ENDIF
         IF (dbcsr_type_is_2d(src_dt)) THEN
            IF (SIZE(src_lb) /= 2) &
               CPABORT("size must be 2 for 2-d src_lb")
            IF (SIZE(src_sizes) /= 2) &
               CPABORT("size must be 2 for 2-d src_sizes")
         ELSE
            IF (SIZE(src_lb) /= 1) &
               CPABORT("size must be 1 for 1-d src_lb")
            IF (SIZE(src_sizes) /= 1) &
               CPABORT("size must be 1 for 1-d src_sizes")
         ENDIF
         IF (debug_mod) THEN
            CALL dbcsr_data_verify_bounds(dst, dst_lb(1:dst_d), dst_ub(1:dst_d))
            CALL dbcsr_data_verify_bounds(src, src_lb(1:src_d), src_ub(1:src_d))
         ENDIF
      ENDIF
      !
      SELECT CASE (src_dt)
      CASE (dbcsr_type_real_4)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%r2_sp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%r_sp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ELSE
            CALL dbcsr_block_copy(dst%d%r_sp(dst_lb(1):dst_ub(1)), &
                                  src%d%r_sp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ENDIF
      CASE (dbcsr_type_real_8)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%r2_dp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%r_dp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ELSE
            CALL dbcsr_block_copy(dst%d%r_dp(dst_lb(1):dst_ub(1)), &
                                  src%d%r_dp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ENDIF
      CASE (dbcsr_type_complex_4)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%c2_sp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%c_sp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ELSE
            CALL dbcsr_block_copy(dst%d%c_sp(dst_lb(1):dst_ub(1)), &
                                  src%d%c_sp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ENDIF
      CASE (dbcsr_type_complex_8)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%c2_dp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%c_dp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ELSE
            CALL dbcsr_block_copy(dst%d%c_dp(dst_lb(1):dst_ub(1)), &
                                  src%d%c_dp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ENDIF
      CASE (dbcsr_type_real_4_2d)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%r2_sp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%r2_sp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ELSE
            CALL dbcsr_block_copy(dst%d%r_sp(dst_lb(1):dst_ub(1)), &
                                  src%d%r2_sp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ENDIF
      CASE (dbcsr_type_real_8_2d)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%r2_dp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%r2_dp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ELSE
            CALL dbcsr_block_copy(dst%d%r_dp(dst_lb(1):dst_ub(1)), &
                                  src%d%r2_dp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ENDIF
      CASE (dbcsr_type_complex_4_2d)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%c2_sp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%c2_sp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ELSE
            CALL dbcsr_block_copy(dst%d%c_sp(dst_lb(1):dst_ub(1)), &
                                  src%d%c2_sp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ENDIF
      CASE (dbcsr_type_complex_8_2d)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%c2_dp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%c2_dp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ELSE
            CALL dbcsr_block_copy(dst%d%c_dp(dst_lb(1):dst_ub(1)), &
                                  src%d%c2_dp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ENDIF
      CASE default
         CPABORT("Invalid data type")
      END SELECT
      CALL timestop(handle)
   END SUBROUTINE dbcsr_data_copy_aa2

! **************************************************************************************************
!> \brief Clears a data area, possibly transposed.
!> \param area ...
!> \param lb ...
!> \param ub ...
!> \param value ...
!> \param lb2 ...
!> \param ub2 ...
!> \param tr ...
! **************************************************************************************************
   SUBROUTINE dbcsr_data_clear_nt(area, lb, ub, value, lb2, ub2, tr)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: area
      INTEGER, INTENT(IN), OPTIONAL                      :: lb, ub
      TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL      :: value
      INTEGER, INTENT(IN), OPTIONAL                      :: lb2, ub2
      LOGICAL, INTENT(in)                                :: tr

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_data_clear_nt', &
         routineP = moduleN//':'//routineN

!   ---------------------------------------------------------------------------

      IF (tr) THEN
         CALL dbcsr_data_clear0(area, lb=lb2, ub=ub2, value=value, lb2=lb, ub2=ub)
      ELSE
         CALL dbcsr_data_clear0(area, lb=lb, ub=ub, value=value, lb2=lb2, ub2=ub2)
      ENDIF
   END SUBROUTINE dbcsr_data_clear_nt

! **************************************************************************************************
!> \brief Clears a data area
!> \param[in,out] area   area with encapsulated data
!> \param[in] lb (optional) lower bound for clearing
!> \param[in] ub (optional) lower bound for clearing
!> \param[in] value      (optional) value to use for clearing
!> \param[in] lb2 (optional) upper bound for clearing
!> \param[in] ub2 (optional) upper bound for clearing
! **************************************************************************************************
   SUBROUTINE dbcsr_data_clear0(area, lb, ub, value, lb2, ub2)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: area
      INTEGER, INTENT(IN), OPTIONAL                      :: lb, ub
      TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL      :: value
      INTEGER, INTENT(IN), OPTIONAL                      :: lb2, ub2

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_data_clear0', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: l, l2, s, u, u2

!   ---------------------------------------------------------------------------
! CALL timeset(routineN, handle)

      IF (.NOT. ASSOCIATED(area%d)) &
         CPABORT("Data area must be setup.")
      IF (PRESENT(value)) THEN
         IF (area%d%data_type .NE. value%data_type) &
            CPABORT("Incompatible data types")
      ENDIF

      SELECT CASE (area%d%data_type)
      CASE (dbcsr_type_real_4)
         l = LBOUND(area%d%r_sp, 1)
         u = UBOUND(area%d%r_sp, 1)
         IF (PRESENT(lb)) THEN
            IF (lb < l) CPABORT("lower bound too low")
            l = lb
         ENDIF
         IF (PRESENT(ub)) THEN
            IF (ub > u) CPABORT("upper bound too high")
            u = ub
         ENDIF
         IF (PRESENT(value)) THEN
            area%d%r_sp(l:u) = value%r_sp
         ELSE
            area%d%r_sp(l:u) = 0.0_real_4
         ENDIF
      CASE (dbcsr_type_real_8)
         l = LBOUND(area%d%r_dp, 1)
         u = UBOUND(area%d%r_dp, 1)
         IF (PRESENT(lb)) THEN
            IF (lb < l) CPABORT("lower bound too low")
            l = lb
         ENDIF
         IF (PRESENT(ub)) THEN
            IF (ub > u) CPABORT("upper bound too high")
            u = ub
         ENDIF
         IF (PRESENT(value)) THEN
            area%d%r_dp(l:u) = value%r_dp
         ELSE
            area%d%r_dp(l:u) = 0.0_real_8
         ENDIF
      CASE (dbcsr_type_complex_4)
         l = LBOUND(area%d%c_sp, 1)
         u = UBOUND(area%d%c_sp, 1)
         IF (PRESENT(lb)) THEN
            IF (lb < l) CPABORT("lower bound too low")
            l = lb
         ENDIF
         IF (PRESENT(ub)) THEN
            IF (ub > u) CPABORT("upper bound too high")
            u = ub
         ENDIF
         IF (PRESENT(value)) THEN
            area%d%c_sp(l:u) = value%c_sp
         ELSE
            area%d%c_sp(l:u) = CMPLX(0.0, 0.0, real_4)
         ENDIF
      CASE (dbcsr_type_complex_8)
         l = LBOUND(area%d%c_dp, 1)
         u = UBOUND(area%d%c_dp, 1)
         IF (PRESENT(lb)) THEN
            IF (lb < l) CPABORT("lower bound too low")
            l = lb
         ENDIF
         IF (PRESENT(ub)) THEN
            IF (ub > u) CPABORT("upper bound too high")
            u = ub
         ENDIF
         IF (PRESENT(value)) THEN
            area%d%c_dp(l:u) = value%c_dp
         ELSE
            area%d%c_dp(l:u) = CMPLX(0.0, 0.0, real_8)
         ENDIF
      CASE (dbcsr_type_real_4_2d)
         l = LBOUND(area%d%r2_sp, 1)
         u = UBOUND(area%d%r2_sp, 1)
         l2 = LBOUND(area%d%r2_sp, 2)
         u2 = UBOUND(area%d%r2_sp, 2)
         IF (PRESENT(lb)) THEN
            IF (lb < l) CPABORT("lower bound too low")
            l = lb
         ENDIF
         IF (PRESENT(ub)) THEN
            IF (ub > u) CPABORT("upper bound too high")
            u = ub
         ENDIF
         IF (PRESENT(lb2)) THEN
            IF (lb2 < l2) CPABORT("lower2 bound too low")
            l2 = lb2
         ENDIF
         IF (PRESENT(ub2)) THEN
            IF (ub2 > u2) CPABORT("upper2 bound too high")
            u2 = ub2
         ENDIF
         IF (PRESENT(value)) THEN
            area%d%r2_sp(l:u, l2:u2) = value%r_sp
         ELSE
            area%d%r2_sp(l:u, l2:u2) = 0.0_real_4
         ENDIF
      CASE (dbcsr_type_real_8_2d)
         l = LBOUND(area%d%r2_dp, 1)
         u = UBOUND(area%d%r2_dp, 1)
         l2 = LBOUND(area%d%r2_dp, 2)
         u2 = UBOUND(area%d%r2_dp, 2)
         IF (PRESENT(lb)) THEN
            IF (lb < l) CPABORT("lower bound too low")
            l = lb
         ENDIF
         IF (PRESENT(ub)) THEN
            IF (ub > u) CPABORT("upper bound too high")
            u = ub
         ENDIF
         IF (PRESENT(lb2)) THEN
            IF (lb2 < l2) CPABORT("lower2 bound too low")
            l2 = lb2
         ENDIF
         IF (PRESENT(ub2)) THEN
            IF (ub2 > u2) CPABORT("upper2 bound too high")
            u2 = ub2
         ENDIF
         IF (PRESENT(value)) THEN
            area%d%r2_dp(l:u, l2:u2) = value%r_dp
         ELSE
            area%d%r2_dp(l:u, l2:u2) = 0.0_real_8
         ENDIF
      CASE (dbcsr_type_complex_4_2d)
         l = LBOUND(area%d%c2_sp, 1)
         u = UBOUND(area%d%c2_sp, 1)
         l2 = LBOUND(area%d%c2_sp, 2)
         u2 = UBOUND(area%d%c2_sp, 2)
         IF (PRESENT(lb)) THEN
            IF (lb < l) CPABORT("lower bound too low")
            l = lb
         ENDIF
         IF (PRESENT(ub)) THEN
            IF (ub > u) CPABORT("upper bound too high")
            u = ub
         ENDIF
         IF (PRESENT(lb2)) THEN
            IF (lb2 < l2) CPABORT("lower2 bound too low")
            l2 = lb2
         ENDIF
         IF (PRESENT(ub2)) THEN
            IF (ub2 > u2) CPABORT("upper2 bound too high")
            u2 = ub2
         ENDIF
         IF (PRESENT(value)) THEN
            area%d%c2_sp(l:u, l2:u2) = value%c_sp
         ELSE
            area%d%c2_sp(l:u, l2:u2) = CMPLX(0.0, 0.0, real_4)
         ENDIF
      CASE (dbcsr_type_complex_8_2d)
         l = LBOUND(area%d%c2_dp, 1)
         u = UBOUND(area%d%c2_dp, 1)
         l2 = LBOUND(area%d%c2_dp, 2)
         u2 = UBOUND(area%d%c2_dp, 2)
         IF (PRESENT(lb)) THEN
            IF (lb < l) CPABORT("lower bound too low")
            l = lb
         ENDIF
         IF (PRESENT(ub)) THEN
            IF (ub > u) CPABORT("upper bound too high")
            u = ub
         ENDIF
         IF (PRESENT(lb2)) THEN
            IF (lb2 < l2) CPABORT("lower2 bound too low")
            l2 = lb2
         ENDIF
         IF (PRESENT(ub2)) THEN
            IF (ub2 > u2) CPABORT("upper2 bound too high")
            u2 = ub2
         ENDIF
         IF (PRESENT(value)) THEN
            area%d%c2_dp(l:u, l2:u2) = value%c_dp
         ELSE
            area%d%c2_dp(l:u, l2:u2) = CMPLX(0.0, 0.0, real_8)
         ENDIF
      CASE default
         CPABORT("Invalid or unsupported data type.")
      END SELECT

      IF (acc_devmem_allocated(area%d%acc_devmem)) THEN
         IF (PRESENT(value)) &
            CPABORT("dbcsr_data_clear0 with value not implemented for acc_devmem")
         s = dbcsr_datatype_sizeof(area%d%data_type)
         CALL acc_devmem_setzero_bytes(area%d%acc_devmem, s*l, s*u, area%d%memory_type%acc_stream)
      END IF

      ! CALL timestop(handle)

   END SUBROUTINE dbcsr_data_clear0

! **************************************************************************************************
!> \brief Copies a block subset
!> \param[in,out] dst  target data area
!> \param[in] dst_rs   target block row size (logical)
!> \param[in] dst_cs   target block column size (logical)
!> \param[in] dst_tr   whether target block is transposed
!> \param[in] src      source data area
!> \param[in] src_rs   source block row size (logical)
!> \param[in] src_cs   source block column size (logical)
!> \param[in] src_tr   whether source block is transposed
!> \param[in] dst_r_lb   first row in target
!> \param[in] dst_c_lb   first column in target
!> \param[in] src_r_lb   first_row in source
!> \param[in] src_c_lb   first column in target
!> \param[in] nrow       number of rows to copy
!> \param[in] ncol       number of columns to copy
!> \param[in] dst_offset offset in target
!> \param[in] src_offset offset in source
! **************************************************************************************************
   SUBROUTINE dbcsr_block_partial_copy(dst, dst_rs, dst_cs, dst_tr, &
                                       src, src_rs, src_cs, src_tr, &
                                       dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                       dst_offset, src_offset)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dst
      INTEGER, INTENT(IN)                                :: dst_rs, dst_cs
      LOGICAL                                            :: dst_tr
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: src
      INTEGER, INTENT(IN)                                :: src_rs, src_cs
      LOGICAL                                            :: src_tr
      INTEGER, INTENT(IN)                                :: dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, &
                                                            nrow, ncol
      INTEGER, INTENT(IN), OPTIONAL                      :: dst_offset, src_offset

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_block_partial_copy', &
         routineP = moduleN//':'//routineN
      LOGICAL, PARAMETER                                 :: verification = careful_mod

      INTEGER                                            :: dst_o, src_o
      LOGICAL                                            :: src_is_2d

!   ---------------------------------------------------------------------------

      IF (careful_mod) THEN
         IF (dbcsr_type_2d_to_1d(dbcsr_data_get_type(dst)) /= dbcsr_type_2d_to_1d(dbcsr_data_get_type(src))) &
            CPABORT("Incompatible data types.")
      ENDIF
      dst_o = 0; src_o = 0
      IF (PRESENT(dst_offset)) dst_o = dst_offset
      IF (PRESENT(src_offset)) src_o = src_offset
      IF (verification) THEN
         IF (dst_r_lb+nrow-1 > dst_rs) &
            CPABORT("Incompatible dst row sizes")
         IF (dst_c_lb+ncol-1 > dst_cs) &
            CPABORT("Incompatible dst col sizes")
         IF (src_r_lb+nrow-1 > src_rs) &
            CPABORT("Incompatible src row sizes")
         IF (src_c_lb+ncol-1 > src_cs) &
            CPABORT("Incompatible src col sizes")
      ENDIF
      !
      src_is_2d = dbcsr_type_is_2d(dbcsr_data_get_type(src))
      SELECT CASE (dbcsr_data_get_type (dst))
      CASE (dbcsr_type_real_4)
         IF (src_is_2d) THEN
            CALL block_partial_copy_1d2d_s(dst%d%r_sp, dst_rs, dst_cs, dst_tr, &
                                           src%d%r2_sp, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                           dst_offset=dst_o)
         ELSE
            CALL block_partial_copy_s(dst%d%r_sp, dst_rs, dst_cs, dst_tr, &
                                      src%d%r_sp, src_rs, src_cs, src_tr, &
                                      dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                      dst_offset=dst_o, src_offset=src_o)
         ENDIF
      CASE (dbcsr_type_real_8)
         IF (src_is_2d) THEN
            CALL block_partial_copy_1d2d_d(dst%d%r_dp, dst_rs, dst_cs, dst_tr, &
                                           src%d%r2_dp, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                           dst_offset=dst_o)
         ELSE
            CALL block_partial_copy_d(dst%d%r_dp, dst_rs, dst_cs, dst_tr, &
                                      src%d%r_dp, src_rs, src_cs, src_tr, &
                                      dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                      dst_offset=dst_o, src_offset=src_o)
         ENDIF
      CASE (dbcsr_type_complex_4)
         IF (src_is_2d) THEN
            CALL block_partial_copy_1d2d_c(dst%d%c_sp, dst_rs, dst_cs, dst_tr, &
                                           src%d%c2_sp, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                           dst_offset=dst_o)
         ELSE
            CALL block_partial_copy_c(dst%d%c_sp, dst_rs, dst_cs, dst_tr, &
                                      src%d%c_sp, src_rs, src_cs, src_tr, &
                                      dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                      dst_offset=dst_o, src_offset=src_o)
         ENDIF
      CASE (dbcsr_type_complex_8)
         IF (src_is_2d) THEN
            CALL block_partial_copy_1d2d_z(dst%d%c_dp, dst_rs, dst_cs, dst_tr, &
                                           src%d%c2_dp, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                           dst_offset=dst_o)
         ELSE
            CALL block_partial_copy_z(dst%d%c_dp, dst_rs, dst_cs, dst_tr, &
                                      src%d%c_dp, src_rs, src_cs, src_tr, &
                                      dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                      dst_offset=dst_o, src_offset=src_o)
         ENDIF
      CASE (dbcsr_type_real_4_2d)
         IF (src_is_2d) THEN
            CALL block_partial_copy_2d2d_s(dst%d%r2_sp, dst_tr, &
                                           src%d%r2_sp, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol)
         ELSE
            CALL block_partial_copy_2d1d_s(dst%d%r2_sp, dst_tr, &
                                           src%d%r_sp, src_rs, src_cs, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                           src_offset=src_o)
         ENDIF
      CASE (dbcsr_type_real_8_2d)
         IF (src_is_2d) THEN
            CALL block_partial_copy_2d2d_d(dst%d%r2_dp, dst_tr, &
                                           src%d%r2_dp, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol)
         ELSE
            CALL block_partial_copy_2d1d_d(dst%d%r2_dp, dst_tr, &
                                           src%d%r_dp, src_rs, src_cs, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                           src_offset=src_o)
         ENDIF
      CASE (dbcsr_type_complex_4_2d)
         IF (src_is_2d) THEN
            CALL block_partial_copy_2d2d_c(dst%d%c2_sp, dst_tr, &
                                           src%d%c2_sp, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol)
         ELSE
            CALL block_partial_copy_2d1d_c(dst%d%c2_sp, dst_tr, &
                                           src%d%c_sp, src_rs, src_cs, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                           src_offset=src_o)
         ENDIF
      CASE (dbcsr_type_complex_8_2d)
         IF (src_is_2d) THEN
            CALL block_partial_copy_2d2d_z(dst%d%c2_dp, dst_tr, &
                                           src%d%c2_dp, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol)
         ELSE
            CALL block_partial_copy_2d1d_z(dst%d%c2_dp, dst_tr, &
                                           src%d%c_dp, src_rs, src_cs, src_tr, &
                                           dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                           src_offset=src_o)
         ENDIF
      CASE default
         CPABORT("Invalid data type.")
      END SELECT
   END SUBROUTINE dbcsr_block_partial_copy

! **************************************************************************************************
!> \brief Adds two blocks
!> \param[in,out] block_a      Block to add to
!> \param[in] block_b          Block to add to block_a
!> \param len ...
! **************************************************************************************************
   SUBROUTINE block_add_anytype(block_a, block_b, len)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: block_a
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: block_b
      INTEGER, INTENT(IN), OPTIONAL                      :: len

      CHARACTER(len=*), PARAMETER :: routineN = 'block_add_anytype', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: n

!   ---------------------------------------------------------------------------

      IF (careful_mod) THEN
         IF (dbcsr_data_get_type(block_a) /= dbcsr_data_get_type(block_a)) &
            CPABORT("Mismatched data types.")
      ENDIF
      IF (PRESENT(len)) THEN
         n = len
         IF (dbcsr_data_get_size(block_b) < n) &
            CPABORT("Block B too small.")
      ELSE
         n = dbcsr_data_get_size_referenced(block_b)
      ENDIF
      IF (dbcsr_data_get_size(block_a) < n) &
         CPABORT("Block A too small.")
      SELECT CASE (dbcsr_data_get_type (block_a))
      CASE (dbcsr_type_real_4)
         CALL block_add_s(block_a%d%r_sp, block_b%d%r_sp, n)
      CASE (dbcsr_type_real_8)
         CALL block_add_d(block_a%d%r_dp, block_b%d%r_dp, n)
      CASE (dbcsr_type_complex_4)
         CALL block_add_c(block_a%d%c_sp, block_b%d%c_sp, n)
      CASE (dbcsr_type_complex_8)
         CALL block_add_z(block_a%d%c_dp, block_b%d%c_dp, n)
      CASE (dbcsr_type_real_4_2d)
         CALL block_add_s(block_a%d%r2_sp, block_b%d%r2_sp, n)
      CASE (dbcsr_type_real_8_2d)
         CALL block_add_d(block_a%d%r2_dp, block_b%d%r2_dp, n)
      CASE (dbcsr_type_complex_4_2d)
         CALL block_add_c(block_a%d%c2_sp, block_b%d%c2_sp, n)
      CASE (dbcsr_type_complex_8_2d)
         CALL block_add_z(block_a%d%c2_dp, block_b%d%c2_dp, n)
      CASE default
         CPABORT("Invalid data type!")
      END SELECT
   END SUBROUTINE block_add_anytype

! **************************************************************************************************
!> \brief Adds two blocks
!> \param[in,out] block_a      Block to add to
!> \param[in] block_b          Block to add to block_a
!> \param lb_a ...
!> \param lb_b ...
!> \param len ...
! **************************************************************************************************
   SUBROUTINE block_add_anytype_bounds(block_a, block_b, lb_a, lb_b, len)
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: block_a
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: block_b
      INTEGER, INTENT(IN)                                :: lb_a, lb_b, len

      CHARACTER(len=*), PARAMETER :: routineN = 'block_add_anytype_bounds', &
         routineP = moduleN//':'//routineN

!   ---------------------------------------------------------------------------

      IF (careful_mod) THEN
         IF (dbcsr_data_get_type(block_a) /= dbcsr_data_get_type(block_a)) &
            CPABORT("Mismatched data types.")
      ENDIF
      IF (dbcsr_data_get_size(block_b) < lb_b+len-1) &
         CPABORT("Block B too small.")
      IF (dbcsr_data_get_size(block_a) < lb_a+len-1) &
         CPABORT("Block A too small.")
      SELECT CASE (dbcsr_data_get_type (block_a))
      CASE (dbcsr_type_real_4)
         CALL block_add_s(block_a%d%r_sp(lb_a:), block_b%d%r_sp(lb_b:), len)
      CASE (dbcsr_type_real_8)
         CALL block_add_d(block_a%d%r_dp(lb_a:), block_b%d%r_dp(lb_b:), len)
      CASE (dbcsr_type_complex_4)
         CALL block_add_c(block_a%d%c_sp(lb_a:), block_b%d%c_sp(lb_b:), len)
      CASE (dbcsr_type_complex_8)
         CALL block_add_z(block_a%d%c_dp(lb_a:), block_b%d%c_dp(lb_b:), len)
      CASE default
         CPABORT("Invalid data type!")
      END SELECT
   END SUBROUTINE block_add_anytype_bounds

#:include "dbcsr_block_operations.f90"

END MODULE dbcsr_block_operations
