sparse_multrec Subroutine

private recursive subroutine sparse_multrec(this, left, right, mi, mf, ni, nf, ki, kf, ai, af, a_index, bi, bf, b_index, d)

Performs recursive multiplication

Arguments

Type IntentOptional 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

Source Code

   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