|
| 1 | +! SPDX-Identifier: MIT |
| 2 | + |
| 3 | +!> Module for index manipulation and general array handling |
| 4 | +!> |
| 5 | +!> The specification of this module is available [here](../page/specs/stdlib_array.html). |
| 6 | +module stdlib_array |
| 7 | + implicit none |
| 8 | + private |
| 9 | + |
| 10 | + public :: trueloc, falseloc |
| 11 | + |
| 12 | +contains |
| 13 | + |
| 14 | + !> Version: experimental |
| 15 | + !> |
| 16 | + !> Return the positions of the true elements in array. |
| 17 | + !> [Specification](../page/specs/stdlib_array.html#trueloc) |
| 18 | + pure function trueloc(array, lbound) result(loc) |
| 19 | + !> Mask of logicals |
| 20 | + logical, intent(in) :: array(:) |
| 21 | + !> Lower bound of array to index |
| 22 | + integer, intent(in), optional :: lbound |
| 23 | + !> Locations of true elements |
| 24 | + integer :: loc(count(array)) |
| 25 | + |
| 26 | + call logicalloc(loc, array, .true., lbound) |
| 27 | + end function trueloc |
| 28 | + |
| 29 | + !> Version: experimental |
| 30 | + !> |
| 31 | + !> Return the positions of the false elements in array. |
| 32 | + !> [Specification](../page/specs/stdlib_array.html#falseloc) |
| 33 | + pure function falseloc(array, lbound) result(loc) |
| 34 | + !> Mask of logicals |
| 35 | + logical, intent(in) :: array(:) |
| 36 | + !> Lower bound of array to index |
| 37 | + integer, intent(in), optional :: lbound |
| 38 | + !> Locations of false elements |
| 39 | + integer :: loc(count(.not.array)) |
| 40 | + |
| 41 | + call logicalloc(loc, array, .false., lbound) |
| 42 | + end function falseloc |
| 43 | + |
| 44 | + !> Return the positions of the truthy elements in array |
| 45 | + pure subroutine logicalloc(loc, array, truth, lbound) |
| 46 | + !> Locations of truthy elements |
| 47 | + integer, intent(out) :: loc(:) |
| 48 | + !> Mask of logicals |
| 49 | + logical, intent(in) :: array(:) |
| 50 | + !> Truthy value |
| 51 | + logical, intent(in) :: truth |
| 52 | + !> Lower bound of array to index |
| 53 | + integer, intent(in), optional :: lbound |
| 54 | + integer :: i, pos, offset |
| 55 | + |
| 56 | + offset = 0 |
| 57 | + if (present(lbound)) offset = lbound - 1 |
| 58 | + |
| 59 | + i = 0 |
| 60 | + do pos = 1, size(array) |
| 61 | + if (array(pos).eqv.truth) then |
| 62 | + i = i + 1 |
| 63 | + loc(i) = pos + offset |
| 64 | + end if |
| 65 | + end do |
| 66 | + end subroutine logicalloc |
| 67 | + |
| 68 | +end module stdlib_array |
0 commit comments