dbcsr_add_anytype_d Subroutine

private 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

Arguments

TypeIntentOptionalAttributesName
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

Contents

Source Code


Source Code

      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