dbcsr_mm_multrec_init Subroutine

public subroutine dbcsr_mm_multrec_init(this, left, right, product, keep_sparsity, eps, row_max_epss, block_estimate, right_row_blk_size, m_sizes, n_sizes, nlayers, keep_product_data)

Sets up recursive multiplication

Arguments

Type IntentOptional Attributes Name
type(dbcsr_mm_multrec_type), intent(out) :: this
type(dbcsr_type), intent(in), optional :: left

left DBCSR matrix right DBCSR matrix

type(dbcsr_type), intent(in), optional :: right

left DBCSR matrix right DBCSR matrix

type(dbcsr_type), intent(inout) :: product

resulting DBCSR product matrix

logical, intent(in) :: keep_sparsity

retain the sparsity of the existing product matrix, default is no

real(kind=real_8), intent(in), optional :: eps

on-the-fly filtering epsilon

real(kind=sp), intent(in), DIMENSION(:), TARGET :: row_max_epss
integer, intent(in) :: block_estimate
integer, intent(in), DIMENSION(:) :: right_row_blk_size
integer, intent(in), DIMENSION(:), POINTER :: m_sizes
integer, intent(in), DIMENSION(:), POINTER :: n_sizes
integer, optional :: nlayers
logical, intent(in), optional :: keep_product_data

Perform final reduction on C data, default is yes


Source Code

   SUBROUTINE dbcsr_mm_multrec_init(this, left, right, product, &
                                    keep_sparsity, eps, row_max_epss, block_estimate, right_row_blk_size, &
                                    m_sizes, n_sizes, nlayers, keep_product_data)
      !! Sets up recursive multiplication

      TYPE(dbcsr_mm_multrec_type), INTENT(out)           :: this
      TYPE(dbcsr_type), INTENT(IN), OPTIONAL             :: left, right
         !! left DBCSR matrix
         !! right DBCSR matrix
      TYPE(dbcsr_type), INTENT(INOUT)                    :: product
         !! resulting DBCSR product matrix
      LOGICAL, INTENT(IN)                                :: keep_sparsity
         !! retain the sparsity of the existing product matrix, default is no
      LOGICAL, INTENT(IN), OPTIONAL                      :: keep_product_data
         !! Perform final reduction on C data, default is yes
      REAL(kind=real_8), INTENT(in), OPTIONAL            :: eps
         !! on-the-fly filtering epsilon
      REAL(kind=sp), DIMENSION(:), INTENT(IN), TARGET    :: row_max_epss
      INTEGER, INTENT(IN)                                :: block_estimate
      INTEGER, DIMENSION(:), INTENT(IN)                  :: right_row_blk_size
      INTEGER, DIMENSION(:), INTENT(IN), POINTER         :: m_sizes, n_sizes
      INTEGER, OPTIONAL                                  :: nlayers

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_mm_multrec_init'
      LOGICAL, PARAMETER                                 :: dbg = .FALSE.

      INTEGER                                            :: c_nblkcols_local, c_nblkrows_local, &
                                                            handle, ithread
      INTEGER, DIMENSION(:), POINTER                     :: c_local_cols, c_local_rows

!$    INTEGER, DIMENSION(:), POINTER           :: product_thread_dist

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, handle)

      ithread = 0
!$    ithread = OMP_GET_THREAD_NUM()
      !
      IF (this%initialized) &
         DBCSR_ABORT("multrec already initialized.")

      IF (PRESENT(left) .NEQV. PRESENT(right)) &
         DBCSR_ABORT("Must both left and right provided or not.")

      IF (PRESENT(left) .AND. PRESENT(right)) THEN
         ! Ensures that the index is correctly defined.
         IF (.NOT. left%list_indexing) &
            DBCSR_ABORT("Must use list indexing for this routine.")
         IF (left%bcsc) &
            DBCSR_ABORT("Wrong routine for BCSC matrices.")

         IF (right%bcsc) &
            DBCSR_ABORT("Wrong routine for BCSC matrices.")
         IF (.NOT. right%local_indexing) &
            DBCSR_ABORT("Matrices must have local indexing.")
         IF (.NOT. left%local_indexing) &
            DBCSR_ABORT("Matrices must have local indexing.")
      END IF
      !
      ! Fill result data structure.
      this%keep_sparsity = keep_sparsity
      this%c_has_symmetry = product%symmetry
      this%keep_product_data = .TRUE.
      IF (PRESENT(keep_product_data)) THEN
         this%keep_product_data = keep_product_data
      END IF
      this%use_eps = PRESENT(eps)
      this%original_lastblk = product%wms(ithread + 1)%lastblk
      this%flop = INT(0, int_8)
      this%product_wm => product%wms(ithread + 1)

      IF (PRESENT(eps)) THEN
         this%eps = eps
      ELSE
         this%eps = 0.0_real_8
      END IF
      !
      !
!$    NULLIFY (product_thread_dist)
!$    IF (.NOT. dbcsr_distribution_has_threads(product%dist)) &
!$       DBCSR_ABORT("Missing thread distribution.")
!$    product_thread_dist => array_data( &
!$                           dbcsr_distribution_thread_dist(product%dist))
      !
      ! Find out the C/A rows and C/B columns and sizes.
      c_nblkrows_local = product%nblkrows_local
      c_local_rows => array_data(product%local_rows)
      c_nblkcols_local = product%nblkcols_local
      c_local_cols => array_data(product%local_cols)
      this%c_local_rows => c_local_rows
      this%c_local_cols => c_local_cols
      IF (dbg) WRITE (*, *) "setting up for product", product%name
      IF (careful_mod) THEN
         IF (.NOT. array_equality(dbcsr_distribution_local_rows_obj(product%dist), &
                                  product%local_rows)) THEN
            WRITE (*, *) "row dist", dbcsr_distribution_row_dist(product%dist)
            WRITE (*, *) "dist local rows", dbcsr_distribution_local_rows(product%dist)
            WRITE (*, *) " mat local rows", array_data(product%local_rows)
            DBCSR_ABORT("Array mismatch.")
         END IF
         IF (.NOT. array_equality(dbcsr_distribution_local_cols_obj(product%dist), &
                                  product%local_cols)) THEN
            WRITE (*, *) "col dist", dbcsr_distribution_col_dist(product%dist)
            WRITE (*, *) "dist local cols", dbcsr_distribution_local_cols(product%dist)
            WRITE (*, *) " mat local cols", array_data(product%local_cols)
            DBCSR_ABORT("Array mismatch.")
         END IF
         IF (SIZE(c_local_rows) /= c_nblkrows_local) &
            DBCSR_ABORT("Row count mismatch.")
         IF (SIZE(c_local_cols) /= c_nblkcols_local) &
            DBCSR_ABORT("Column count mismatch.")
      END IF
      !
      ! And the k epsilons
      IF ((PRESENT(left) .AND. PRESENT(right)) .OR. .NOT. this%use_eps) THEN
         ALLOCATE (this%row_max_epss(c_nblkrows_local))
         this%new_row_max_epss = .TRUE.
      END IF
      IF (this%use_eps) THEN
         IF (PRESENT(left) .AND. PRESENT(right)) THEN
            CALL local_filter_sp(row_max_epss, c_nblkrows_local, c_local_rows, &
                                 this%row_max_epss)
         ELSE
            this%row_max_epss => row_max_epss
         END IF
      ELSE
         this%row_max_epss(:) = -HUGE(0.0_sp)
      END IF
      !
      this%m_sizes => m_sizes
      this%n_sizes => n_sizes
      this%m_global_sizes => array_data(product%row_blk_size)
      this%n_global_sizes => array_data(product%col_blk_size)
      NULLIFY (this%k_locals)
      NULLIFY (this%k_sizes)

      !TODO: should we move this up?
      CALL dbcsr_mm_csr_init(this%csr, &
                             left=left, right=right, product=product, &
                             m_sizes=this%m_sizes, n_sizes=this%n_sizes, &
                             block_estimate=block_estimate, &
                             right_row_blk_size=right_row_blk_size, &
                             nlayers=nlayers, &
                             keep_product_data=this%keep_product_data)

      this%initialized = .TRUE.
      CALL timestop(handle)
   END SUBROUTINE dbcsr_mm_multrec_init