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