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_s (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_s (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_s (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_s