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