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