ensure_array_size_d Subroutine

      SUBROUTINE ensure_array_size_d (array, array_resize, lb, ub, factor, &
                                                  nocopy, memory_type, zero_pad)
     !! Ensures that an array is appropriately large.

         REAL(kind=real_8), DIMENSION(:), POINTER, CONTIGUOUS     :: array
        !! array to verify and possibly resize
         REAL(kind=real_8), DIMENSION(:), POINTER, OPTIONAL       :: array_resize
         INTEGER, INTENT(IN), OPTIONAL                  :: lb
        !! desired array lower bound
         INTEGER, INTENT(IN)                            :: ub
        !! desired array upper bound
         REAL(KIND=dp), INTENT(IN), OPTIONAL            :: factor
        !! factor by which to exaggerate enlargements
         LOGICAL, INTENT(IN), OPTIONAL                  :: nocopy, zero_pad
        !! copy array on enlargement; default is to copy
        !! zero new allocations; default is to write nothing
         TYPE(dbcsr_memtype_type), INTENT(IN), OPTIONAL :: memory_type
        !! use special memory

         CHARACTER(len=*), PARAMETER :: routineN = 'ensure_array_size_d', &
                                        routineP = moduleN//':'//routineN

         INTEGER                                  :: lb_new, lb_orig, &
                                                     ub_new, ub_orig, old_size, &
                                                     size_increase
         TYPE(dbcsr_memtype_type)                 :: mem_type
         LOGICAL                                  :: dbg, docopy, &
                                                     pad
         REAL(kind=real_8), DIMENSION(:), POINTER, CONTIGUOUS    :: newarray

!   ---------------------------------------------------------------------------
         !CALL timeset(routineN, error_handler)
         dbg = .FALSE.

         IF (PRESENT(array_resize)) NULLIFY (array_resize)

         IF (PRESENT(nocopy)) THEN
            docopy = .NOT. nocopy
         ELSE
            docopy = .TRUE.
         END IF
         IF (PRESENT(memory_type)) THEN
            mem_type = memory_type
         ELSE
            mem_type = dbcsr_memtype_default
         END IF
         lb_new = 1
         IF (PRESENT(lb)) lb_new = lb
         pad = .FALSE.
         IF (PRESENT(zero_pad)) pad = zero_pad
         ! Creates a new array if it doesn't yet exist.
         IF (.NOT. ASSOCIATED(array)) THEN
            IF (lb_new /= 1) &
               DBCSR_ABORT("Arrays must start at 1")
            CALL mem_alloc_d (array, ub, mem_type=mem_type)
            IF (pad .AND. ub .GT. 0) CALL mem_zero_d (array, ub)
            !CALL timestop(error_handler)
            RETURN
         END IF
         lb_orig = LBOUND(array, 1)
         ub_orig = UBOUND(array, 1)
         old_size = ub_orig - lb_orig + 1
         ! The existing array is big enough.
         IF (lb_orig .LE. lb_new .AND. ub_orig .GE. ub) THEN
            !CALL timestop(error_handler)
            RETURN
         END IF
         ! A reallocation must be performed
         IF (dbg) WRITE (*, *) routineP//' Current bounds are', lb_orig, ':', ub_orig, &
            '; special?' !,mem_type
         !CALL timeset(routineN,timing_handle)
         IF (lb_orig .GT. lb_new) THEN
            IF (PRESENT(factor)) THEN
               size_increase = lb_orig - lb_new
               size_increase = MAX(NINT(size_increase*factor), &
                                   NINT(old_size*(factor - 1)), 0)
               lb_new = MIN(lb_orig, lb_new - size_increase)
            ELSE
               lb_new = lb_orig
            END IF
         END IF
         IF (ub_orig .LT. ub) THEN
            IF (PRESENT(factor)) THEN
               size_increase = ub - ub_orig
               size_increase = MAX(NINT(size_increase*factor), &
                                   NINT(old_size*(factor - 1)), 0)
               ub_new = MAX(ub_orig, ub + size_increase)
            ELSE
               ub_new = ub
            END IF
         ELSE
            ub_new = ub
         END IF
         IF (dbg) WRITE (*, *) routineP//' Resizing to bounds', lb_new, ':', ub_new
         !
         ! Deallocates the old array if it's not needed to copy the old data.
         IF (.NOT. docopy) THEN
            IF (PRESENT(array_resize)) THEN
               array_resize => array
               NULLIFY (array)
            ELSE
               CALL mem_dealloc_d (array, mem_type=mem_type)
            END IF
         END IF
         !
         ! Allocates the new array
         IF (lb_new /= 1) &
            DBCSR_ABORT("Arrays must start at 1")
         CALL mem_alloc_d (newarray, ub_new - lb_new + 1, mem_type)
         !
         ! Now copy and/or zero pad.
         IF (docopy) THEN
            IF (dbg .AND. (lb_new .GT. lb_orig .OR. ub_new .LT. ub_orig)) &
               DBCSR_ABORT("Old extent exceeds the new one.")
            IF (ub_orig - lb_orig + 1 .gt. 0) THEN
               !newarray(lb_orig:ub_orig) = array(lb_orig:ub_orig)
               CALL mem_copy_d (newarray(lb_orig:ub_orig), &
                                            array(lb_orig:ub_orig), ub_orig - lb_orig + 1)
            END IF
            IF (pad) THEN
               !newarray(lb_new:lb_orig-1) = 0
               CALL mem_zero_d (newarray(lb_new:lb_orig - 1), (lb_orig - 1) - lb_new + 1)
               !newarray(ub_orig+1:ub_new) = 0
               CALL mem_zero_d (newarray(ub_orig + 1:ub_new), ub_new - (ub_orig + 1) + 1)
            END IF
            IF (PRESENT(array_resize)) THEN
               array_resize => array
               NULLIFY (array)
            ELSE
               CALL mem_dealloc_d (array, mem_type=mem_type)
            END IF
         ELSEIF (pad) THEN
            !newarray(:) = 0.0_real_8
            CALL mem_zero_d (newarray, SIZE(newarray))
         END IF
         array => newarray
         IF (dbg) WRITE (*, *) routineP//' New array size', SIZE(array)
         !CALL timestop(error_handler)
      END SUBROUTINE ensure_array_size_d