Emulation of sparse_matrix_types/add_block_node mapped to add_real_matrix_block.... should not be used any longer It adds a block to the dbcsr matrix and returns a rank-2 pointer to the block. Currently it only and always uses the mutable data.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix |
DBCSR matrix |
||
integer, | intent(in) | :: | block_row |
the row the column |
||
integer, | intent(in) | :: | block_col |
the row the column |
||
real(kind=dp), | DIMENSION(:, :), POINTER | :: | block |
the block to put |
SUBROUTINE dbcsr_add_block_node(matrix, block_row, block_col, block)
!! Emulation of sparse_matrix_types/add_block_node mapped
!! to add_real_matrix_block.... should not be used any longer
!! It adds a block to the dbcsr matrix and returns a rank-2 pointer to the
!! block. Currently it only and always uses the mutable data.
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
!! DBCSR matrix
INTEGER, INTENT(IN) :: block_row, block_col
!! the row
!! the column
REAL(KIND=dp), DIMENSION(:, :), POINTER :: block
!! the block to put
INTEGER :: c, ithread, mynode, p, r
LOGICAL :: dbg, existed, is_there, tr
TYPE(dbcsr_distribution_obj) :: dist
! ---------------------------------------------------------------------------
dbg = .FALSE.
ithread = 0
!$ ithread = omp_get_thread_num()
IF (.NOT. ASSOCIATED(matrix%wms)) THEN
CALL dbcsr_work_create(matrix, work_mutable=.TRUE.)
matrix%valid = .FALSE.
END IF
!$ IF (SIZE(matrix%wms) .LT. omp_get_num_threads()) &
!$ DBCSR_ABORT("Too few threads.")
IF (.NOT. dbcsr_wm_use_mutable(matrix%wms(ithread + 1))) &
DBCSR_ABORT("Data loss due to no conversion of appendable to mutable data")
is_there = ASSOCIATED(block)
!r = row ; c = col ; tr = .FALSE.
!CALL dbcsr_get_stored_coordinates (matrix, r, c, tr)
!CALL dbcsr_reserve_block2d (matrix, row, col, block)
!write(*,*) 'add_block_node: block_row',block_row,' block_col',block_col
CALL dbcsr_reserve_block2d(matrix, block_row, block_col, block, &
existed=existed)
!
IF (dbg) THEN
r = block_row; c = block_col; tr = .FALSE.
CALL dbcsr_get_stored_coordinates(matrix, r, c, p)
CALL dbcsr_get_info(matrix, distribution=dist)
CALL dbcsr_distribution_get(dist, mynode=mynode)
IF (p .NE. mynode) &
DBCSR_WARN("Adding non-local element")
END IF
IF (existed) DBCSR_WARN("You should not add existing blocks according to old API.")
IF (.NOT. is_there) block(:, :) = 0.0_dp
END SUBROUTINE dbcsr_add_block_node