Low level function to sum two matrices (matrix_a = matrix_a + beta*matrix_b
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix_a |
DBCSR matrix |
||
type(dbcsr_type), | intent(in) | :: | matrix_b |
DBCSR matrix |
||
type(dbcsr_iterator), | intent(inout) | :: | iter | |||
integer, | intent(in) | :: | iw | |||
logical, | intent(in) | :: | do_scale | |||
type(dbcsr_scalar_type), | intent(in) | :: | my_beta_scalar | |||
integer(kind=int_8), | intent(inout) | :: | my_flop |
SUBROUTINE dbcsr_add_anytype_d (matrix_a, matrix_b, iter, iw, do_scale, &
my_beta_scalar, my_flop)
!! Low level function to sum two matrices (matrix_a = matrix_a + beta*matrix_b
TYPE(dbcsr_type), INTENT(INOUT) :: matrix_a
!! DBCSR matrix
TYPE(dbcsr_type), INTENT(IN) :: matrix_b
!! DBCSR matrix
TYPE(dbcsr_iterator), INTENT(INOUT) :: iter
INTEGER, INTENT(IN) :: iw
LOGICAL, INTENT(IN) :: do_scale
TYPE(dbcsr_scalar_type), INTENT(IN) :: my_beta_scalar
INTEGER(KIND=int_8), INTENT(INOUT) :: my_flop
INTEGER :: row, col, row_size, col_size, &
nze, tot_nze, blk, &
lb_a, first_lb_a, lb_a_val, &
lb_b, first_lb_b
INTEGER, DIMENSION(2) :: lb_row_blk
LOGICAL :: was_found, found, tr
! some start values
lb_row_blk(:) = 0
first_lb_a = matrix_a%wms(iw)%datasize + 1
first_lb_b = 0
tot_nze = 0
!
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row, col, blk, tr, lb_b, row_size, col_size)
nze = row_size*col_size
IF (nze .LE. 0) CYCLE
IF (lb_row_blk(1) .LT. row) THEN
lb_row_blk(1) = row
lb_row_blk(2) = matrix_a%row_p(row) + 1
END IF
! get b-block index
lb_b = ABS(lb_b)
CALL dbcsr_find_column(col, lb_row_blk(2), matrix_a%row_p(row + 1), matrix_a%col_i, matrix_a%blk_p, blk, found)
lb_row_blk(2) = blk + 1
! get index of a-block lb_a whether found (from matrix_a) or not (from workspace array)
IF (found) THEN
my_flop = my_flop + nze*2
lb_a = ABS(matrix_a%blk_p(blk))
ELSE
lb_a = matrix_a%wms(iw)%datasize + 1
lb_a_val = lb_a
IF (tr) lb_a_val = -lb_a
matrix_a%wms(iw)%lastblk = matrix_a%wms(iw)%lastblk + 1
matrix_a%wms(iw)%row_i(matrix_a%wms(iw)%lastblk) = row
matrix_a%wms(iw)%col_i(matrix_a%wms(iw)%lastblk) = col
matrix_a%wms(iw)%blk_p(matrix_a%wms(iw)%lastblk) = lb_a_val
matrix_a%wms(iw)%datasize = matrix_a%wms(iw)%datasize + nze
END IF
! at the first iteration we skip this and go directly to initialization after
IF (first_lb_b .NE. 0) THEN
! if found status is the same as before then probably we are in contiguous blocks
IF ((found .EQV. was_found) .AND. &
(first_lb_b + tot_nze .EQ. lb_b) .AND. &
(first_lb_a + tot_nze) .EQ. lb_a) THEN
tot_nze = tot_nze + nze
CYCLE
END IF
! save block chunk
CALL dbcsr_update_contiguous_blocks_d (matrix_a, matrix_b, first_lb_a, first_lb_b, tot_nze, &
do_scale, my_beta_scalar, was_found, iw)
END IF
!
first_lb_a = lb_a
first_lb_b = lb_b
tot_nze = nze
was_found = found
END DO
! save the last block or chunk of blocks
IF (first_lb_b .NE. 0) THEN
call dbcsr_update_contiguous_blocks_d (matrix_a, matrix_b, first_lb_a, first_lb_b, tot_nze, &
do_scale, my_beta_scalar, was_found, iw)
END IF
END SUBROUTINE dbcsr_add_anytype_d