dbcsr_scale_anytype Subroutine

   SUBROUTINE dbcsr_scale_anytype(matrix_a, alpha_scalar, limits)
      !! Scales a DBCSR matrix by alpha
      !!
      !! Limits
      !! A 4-tuple describing (first_row, last_row, first_column, last_column). Set
      !! to 0 to avoid limiting.

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix_a
         !! DBCSR matrix
      TYPE(dbcsr_scalar_type), INTENT(IN)                :: alpha_scalar
         !! a scalar
      INTEGER, DIMENSION(4), INTENT(IN), OPTIONAL        :: limits
         !! Scale only a subbox

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_scale_anytype'
      INTEGER, PARAMETER                                 :: first_col_i = 3, first_row_i = 1, &
                                                            last_col_i = 4, last_row_i = 2

      INTEGER :: a_col, a_col_size, a_row, a_row_size, col_offset, handle, row_offset, &
                 scale_col_offset, scale_col_size, scale_row_offset, scale_row_size
      INTEGER, DIMENSION(4)                              :: my_limits
      LOGICAL                                            :: do_scale, has_limits, tr
      TYPE(dbcsr_data_obj)                               :: data_any
      TYPE(dbcsr_iterator)                               :: iter
      TYPE(dbcsr_scalar_type)                            :: one

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

      CALL timeset(routineN, handle)

      ! Limits are only honored if the argument is present and any are
      ! non-zero.
      IF (PRESENT(limits)) THEN
         has_limits = ANY(limits(:) .NE. 0)
      ELSE
         has_limits = .FALSE.
      END IF
      my_limits(first_row_i) = 1
      my_limits(last_row_i) = dbcsr_nfullrows_total(matrix_a)
      my_limits(first_col_i) = 1
      my_limits(last_col_i) = dbcsr_nfullcols_total(matrix_a)
      IF (has_limits) THEN
         IF (limits(last_col_i) .NE. 0) THEN
            IF (debug_mod .AND. (limits(last_col_i) < 0 .OR. limits(last_col_i) > dbcsr_nfullcols_total(matrix_a))) &
               DBCSR_ABORT("Specified last column is out of bounds.")
            my_limits(last_col_i) = limits(last_col_i)
         END IF
         IF (limits(first_col_i) .NE. 0) THEN
            IF (debug_mod .AND. (limits(first_col_i) < 0 .OR. limits(first_col_i) > dbcsr_nfullcols_total(matrix_a))) &
               DBCSR_ABORT("Specified first column is out of bounds.")
            my_limits(first_col_i) = limits(first_col_i)
         END IF
         IF (limits(last_row_i) .NE. 0) THEN
            IF (debug_mod .AND. (limits(last_row_i) < 0 .OR. limits(last_row_i) > dbcsr_nfullrows_total(matrix_a))) &
               DBCSR_ABORT("Specified last row is out of bounds.")
            my_limits(last_row_i) = limits(last_row_i)
         END IF
         IF (limits(first_row_i) .NE. 0) THEN
            IF (debug_mod .AND. (limits(first_row_i) < 0 .OR. limits(first_row_i) > dbcsr_nfullrows_total(matrix_a))) &
               DBCSR_ABORT("Specified first row is out of bounds.")
            my_limits(first_row_i) = limits(first_row_i)
         END IF
      END IF
      !
      ! quick return if possible
      one = dbcsr_scalar_one(dbcsr_scalar_get_type(alpha_scalar))
      do_scale = .NOT. dbcsr_scalar_are_equal(alpha_scalar, one)
      !
      ! let's go
      IF (do_scale) THEN
!$OMP        PARALLEL DEFAULT (NONE) &
!$OMP                 PRIVATE (iter, data_any) &
!$OMP                 PRIVATE (a_row, a_col, tr, a_row_size, a_col_size, &
!$OMP                          row_offset, col_offset) &
!$OMP                 PRIVATE (scale_row_size, scale_col_size,&
!$OMP                          scale_row_offset, scale_col_offset) &
!$OMP                 SHARED (matrix_a, my_limits,alpha_scalar)
         CALL dbcsr_data_init(data_any)
         CALL dbcsr_data_new(data_any, dbcsr_type_1d_to_2d(dbcsr_get_data_type(matrix_a)))
         CALL dbcsr_iterator_start(iter, matrix_a, read_only=.FALSE., &
                                   contiguous_pointers=.FALSE., dynamic=.TRUE., &
                                   dynamic_byrows=.TRUE., shared=.TRUE.)
         iterations: DO WHILE (dbcsr_iterator_blocks_left(iter))
            CALL dbcsr_iterator_next_block(iter, a_row, a_col, data_any, tr, &
                                           row_size=a_row_size, col_size=a_col_size, &
                                           row_offset=row_offset, col_offset=col_offset)
            IF (a_row_size .GT. 0 .AND. a_col_size .GT. 0) THEN
               CALL frame_block_limit(a_row_size, row_offset, &
                                      my_limits(first_row_i), my_limits(last_row_i), &
                                      scale_row_size, scale_row_offset)
               CALL frame_block_limit(a_col_size, col_offset, &
                                      my_limits(first_col_i), my_limits(last_col_i), &
                                      scale_col_size, scale_col_offset)
               IF (tr) THEN
                  CALL swap(scale_row_size, scale_col_size)
                  CALL swap(scale_row_offset, scale_col_offset)
               END IF
               CALL dbcsr_block_scale(data_any, scale=alpha_scalar, &
                                      row_size=scale_row_size, col_size=scale_col_size, &
                                      lb=scale_row_offset, lb2=scale_col_offset)
            END IF
         END DO iterations
         CALL dbcsr_iterator_stop(iter)
         CALL dbcsr_data_clear_pointer(data_any)
         CALL dbcsr_data_release(data_any)
!$OMP        END PARALLEL
      END IF
      CALL timestop(handle)
   END SUBROUTINE dbcsr_scale_anytype