dbcsr_addto_index_array Subroutine

public subroutine dbcsr_addto_index_array(matrix, slot, DATA, reservation, extra)

Adds data to the index. Increases the index size when necessary.

Arguments

TypeIntentOptionalAttributesName
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


Contents


Source Code

   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