mostly_non_transposed Function

private pure function mostly_non_transposed(blk_p)

Determines whether most blocks are stored transposed in normally.

Arguments

TypeIntentOptionalAttributesName
integer, intent(in), DIMENSION(:):: blk_p

Pointers to blocks

Return Value logical


Contents

Source Code


Source Code

   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