Performs recursive multiplication
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_mm_multrec_type), | intent(inout) | :: | this | |||
type(dbcsr_type), | intent(in) | :: | left | |||
type(dbcsr_type), | intent(in) | :: | right | |||
integer, | intent(in) | :: | mi | |||
integer, | intent(in) | :: | mf | |||
integer, | intent(in) | :: | ni | |||
integer, | intent(in) | :: | nf | |||
integer, | intent(in) | :: | ki | |||
integer, | intent(in) | :: | kf | |||
integer, | intent(in) | :: | ai | |||
integer, | intent(in) | :: | af | |||
integer, | intent(in), | DIMENSION(3, 1:af) | :: | a_index | ||
integer, | intent(in) | :: | bi | |||
integer, | intent(in) | :: | bf | |||
integer, | intent(in), | DIMENSION(3, 1:bf) | :: | b_index | ||
integer, | intent(in) | :: | d |
RECURSIVE SUBROUTINE sparse_multrec(this, left, right, mi, mf, ni, nf, ki, kf, &
!! Performs recursive multiplication
ai, af, a_index, bi, bf, b_index, &
d)
TYPE(dbcsr_mm_multrec_type), INTENT(INOUT) :: this
TYPE(dbcsr_type), INTENT(IN) :: left, right
INTEGER, INTENT(IN) :: mi, mf, ni, nf, ki, kf, ai, af
INTEGER, DIMENSION(3, 1:af), INTENT(IN) :: a_index
INTEGER, INTENT(IN) :: bi, bf
INTEGER, DIMENSION(3, 1:bf), INTENT(IN) :: b_index
INTEGER, INTENT(IN) :: d
LOGICAL, PARAMETER :: dbg = .FALSE.
INTEGER :: acut, bcut, cut, K, M, N, s1
! ---------------------------------------------------------------------------
IF (dbg) THEN
WRITE (*, '(I7,1X,5(A,2(1X,I7)))') d, " rm", mi, mf, ",", ni, nf, ",", ki, kf, "/", ai, af, ",", bi, bf
END IF
IF (.TRUE.) THEN
IF (af .LT. ai .OR. bf .LT. bi .OR. mf .LT. mi .OR. nf .LT. ni .OR. kf .LT. ki) THEN
IF (dbg) WRITE (*, *) "Empty"
RETURN
END IF
END IF
IF (af - ai + 1 <= dbcsr_cfg%multrec_limit%val .AND. bf - bi + 1 <= dbcsr_cfg%multrec_limit%val) THEN
IF (af - ai + 1 .GT. 0 .AND. bf - bi + 1 .GT. 0) &
CALL dbcsr_mm_csr_multiply(this%csr, left, right, &
mi=mi, mf=mf, ni=ni, nf=nf, ki=ki, kf=kf, &
ai=ai, af=af, &
bi=bi, bf=bf, &
m_sizes=this%m_sizes, n_sizes=this%n_sizes, k_sizes=this%k_sizes, &
c_local_rows=this%c_local_rows, c_local_cols=this%c_local_cols, &
c_has_symmetry=this%c_has_symmetry, keep_sparsity=this%keep_sparsity, &
use_eps=this%use_eps, row_max_epss=this%row_max_epss, &
flop=this%flop, &
a_index=a_index, b_index=b_index, &
a_norms=this%a_norms, b_norms=this%b_norms)
RETURN
END IF
M = mf - mi + 1
N = nf - ni + 1
K = kf - ki + 1
IF (dbg) THEN
WRITE (*, *) 'm,k,n', M, K, N
END IF
IF (M >= MAX(N, K)) cut = 1
IF (K >= MAX(N, M)) cut = 2
IF (N >= MAX(M, K)) cut = 3
SELECT CASE (cut)
CASE (1)
s1 = M/2
acut = find_cut_row(ai, af, a_index, mi + s1 - 1)
CALL sparse_multrec(this, left, right, mi, mi + s1 - 1, ni, nf, ki, kf, &
ai, acut - 1, a_index, bi, bf, b_index, d + 1)
CALL sparse_multrec(this, left, right, mi + s1, mf, ni, nf, ki, kf, &
acut, af, a_index, bi, bf, b_index, d + 1)
CASE (2)
s1 = K/2
acut = find_cut_col(ai, af, a_index, ki + s1 - 1)
IF (dbg) THEN
WRITE (*, *) N, s1, ni + s1 - 1, "/", ai, af, acut
WRITE (*, '(3(I7))') a_index
END IF
bcut = find_cut_row(bi, bf, b_index, ki + s1 - 1)
IF (dbg) THEN
WRITE (*, *) N, s1, ni + s1 - 1, "/", bi, bf, bcut
WRITE (*, '(3(I7))') b_index
END IF
CALL sparse_multrec(this, left, right, mi, mf, ni, nf, ki, ki + s1 - 1, &
ai, acut - 1, a_index, bi, bcut - 1, b_index, d + 1)
CALL sparse_multrec(this, left, right, mi, mf, ni, nf, ki + s1, kf, &
acut, af, a_index, bcut, bf, b_index, d + 1)
CASE (3)
s1 = N/2
bcut = find_cut_col(bi, bf, b_index, ni + s1 - 1)
IF (dbg) THEN
WRITE (*, *) N, s1, ni + s1 - 1, "/", bi, bf, bcut
WRITE (*, '(3(I7))') b_index
END IF
CALL sparse_multrec(this, left, right, mi, mf, ni, ni + s1 - 1, ki, kf, &
ai, af, a_index, bi, bcut - 1, b_index, d + 1)
CALL sparse_multrec(this, left, right, mi, mf, ni + s1, nf, ki, kf, &
ai, af, a_index, bcut, bf, b_index, d + 1)
END SELECT
END SUBROUTINE sparse_multrec