Determines whether most blocks are stored transposed in normally.
Tries to be quick and not necessarily accurate.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in), | DIMENSION(:) | :: | blk_p |
Pointers to blocks |
PURE FUNCTION mostly_non_transposed(blk_p)
!! Determines whether most blocks are stored transposed in normally.
!! @note Tries to be quick and not necessarily accurate.
INTEGER, DIMENSION(:), INTENT(IN) :: blk_p
!! Pointers to blocks
LOGICAL :: mostly_non_transposed
INTEGER :: n, str, sntr
INTEGER, PARAMETER :: allcheck_cutoff = 8
n = SIZE(blk_p)
IF (n .EQ. 0) THEN
mostly_non_transposed = .TRUE.
RETURN
END IF
str = 0
sntr = 0
CALL check_range(blk_p, 1, allcheck_cutoff, sntr, str)
IF (n .GT. 4*allcheck_cutoff) THEN
CALL check_range(blk_p, (n - allcheck_cutoff)/2, (n + allcheck_cutoff)/2, &
sntr, str)
CALL check_range(blk_p, n - allcheck_cutoff, n, sntr, str)
END IF
IF (str .EQ. 0) THEN
mostly_non_transposed = .TRUE.
RETURN
ELSE
! Bias towards .TRUE.
mostly_non_transposed = ((2*str)/(1 + str + sntr)) .EQ. 0
END IF
RETURN
CONTAINS
PURE SUBROUTINE check_range(blk_p, lb, ub, sntr, str)
INTEGER, DIMENSION(:), INTENT(IN) :: blk_p
INTEGER, INTENT(IN) :: lb, ub
INTEGER, INTENT(INOUT) :: sntr, str
INTEGER :: b1, b2
b1 = MAX(1, lb)
b2 = MIN(SIZE(blk_p), ub)
sntr = sntr + COUNT(blk_p(b1:b2) .GT. 0)
str = str + COUNT(blk_p(b1:b2) .LT. 0)
END SUBROUTINE check_range
END FUNCTION mostly_non_transposed