Adds data to the index. Increases the index size when necessary.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix |
bcsr matrix |
||
integer, | intent(in) | :: | slot |
which index array to add (e.g., dbcsr_slot_row_blk_sizes) |
||
integer, | intent(in), | optional, | DIMENSION(:) | :: | DATA |
array holding the index data to add to the index array |
integer, | intent(in), | optional | :: | reservation |
only reserve space for subsequent array reserve extra space for later additions |
|
integer, | intent(in), | optional | :: | extra |
only reserve space for subsequent array reserve extra space for later additions |
SUBROUTINE dbcsr_addto_index_array(matrix, slot, DATA, reservation, extra)
!! Adds data to the index. Increases the index size when necessary.
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
!! bcsr matrix
INTEGER, INTENT(IN) :: slot
!! which index array to add (e.g., dbcsr_slot_row_blk_sizes)
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: DATA
!! array holding the index data to add to the index array
INTEGER, INTENT(IN), OPTIONAL :: reservation, extra
!! only reserve space for subsequent array
!! reserve extra space for later additions
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_addto_index_array', &
routineP = moduleN//':'//routineN
INTEGER :: deplus, space, ub, ub_new
! ---------------------------------------------------------------------------
IF (debug_mod) THEN
IF (.NOT. ASSOCIATED(matrix%index)) &
DBCSR_ABORT("Index must be preallocated.")
IF (UBOUND(matrix%index, 1) < dbcsr_num_slots) &
DBCSR_ABORT("Actual index size less than declared size")
IF (.NOT. PRESENT(DATA) .AND. .NOT. PRESENT(reservation)) &
DBCSR_ABORT('Either an array or its size must be specified.')
WRITE (*, *) routineP//' index', matrix%index(:dbcsr_num_slots)
END IF
IF (PRESENT(reservation)) THEN
space = reservation
ELSE
space = SIZE(DATA)
END IF
IF (PRESENT(extra)) THEN
deplus = extra
ELSE
deplus = 0
END IF
ub = UBOUND(matrix%index, 1)
! The data area was not defined or the new area is greater than the old:
IF (matrix%index(slot) .EQ. 0 .OR. &
space .GT. matrix%index(slot + 1) - matrix%index(slot) + 1) THEN
IF (debug_mod) WRITE (*, *) routineP//' Slot', slot, 'not filled, adding at', &
matrix%index(dbcsr_slot_size) + 1, 'sized', space
matrix%index(slot) = matrix%index(dbcsr_slot_size) + 1
matrix%index(slot + 1) = matrix%index(slot) + space - 1
matrix%index(dbcsr_slot_size) = matrix%index(slot + 1)
END IF
! Shorten an index entry.
IF (space .LT. matrix%index(slot + 1) - matrix%index(slot) + 1) THEN
IF (debug_mod) WRITE (*, *) routineP//' Shortening index'
matrix%index(slot + 1) = matrix%index(slot) + space - 1
CALL dbcsr_repoint_index(matrix, slot)
END IF
ub_new = matrix%index(slot + 1) + deplus
IF (debug_mod) WRITE (*, *) routineP//' need', space, 'at', matrix%index(slot), &
'to', matrix%index(slot + 1), '(', ub_new, ')', 'have', ub
IF (ub_new .GT. ub) THEN
IF (debug_mod) WRITE (*, *) routineP//' Reallocating index to ubound', ub_new
!CALL reallocate(matrix%index, 1, ub_new)
CALL ensure_array_size(matrix%index, lb=1, ub=ub_new, &
factor=default_resize_factor, &
nocopy=.FALSE., &
memory_type=matrix%index_memory_type)
CALL dbcsr_repoint_index(matrix)
END IF
IF (debug_mod) WRITE (*, *) routineP//' Adding slot', slot, 'at', &
matrix%index(slot), 'sized', space
CALL dbcsr_repoint_index(matrix, slot)
IF (PRESENT(DATA)) &
matrix%index(matrix%index(slot):matrix%index(slot + 1)) = DATA(:)
END SUBROUTINE dbcsr_addto_index_array