Sets up recursive multiplication
Type | Intent | Optional | 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 |
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