Determines whether most blocks are stored transposed in normally.
Note
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