--- /dev/null
+! { dg-do compile }
+! { dg-additional-options "-O -fdump-tree-original" }
+! { dg-final { scan-tree-dump-not "gfortran_\[sm\]?minloc" "original" } }
+! { dg-final { scan-tree-dump-not "gfortran_\[sm\]?maxloc" "original" } }
+!
+! PR fortran/90608
+! Check that all MINLOC and MAXLOC calls are inlined with optimizations by default.
+
+subroutine check_maxloc_without_mask
+ implicit none
+ integer, parameter :: data5(*) = (/ 1, 7, 2, 7, 0 /)
+ integer, parameter :: data64(*) = (/ 2, 5, 4, 6, 0, 9, 3, 5, &
+ 4, 4, 1, 7, 3, 2, 1, 2, &
+ 5, 4, 6, 0, 9, 3, 5, 4, &
+ 4, 1, 7, 3, 2, 1, 2, 5, &
+ 4, 6, 0, 9, 3, 5, 4, 4, &
+ 1, 7, 3, 2, 1, 2, 5, 4, &
+ 6, 0, 9, 3, 5, 4, 4, 1, &
+ 7, 3, 2, 1, 2, 5, 4, 6 /)
+ call check_int_const_shape_rank_1
+ call check_int_const_shape_rank_3
+ call check_int_const_shape_empty_4
+ call check_int_alloc_rank_1
+ call check_int_alloc_rank_3
+ call check_real_const_shape_rank_1
+ call check_real_const_shape_rank_3
+ call check_real_const_shape_empty_4
+ call check_real_alloc_rank_1
+ call check_real_alloc_rank_3
+contains
+ subroutine check_int_const_shape_rank_1()
+ integer :: a(5)
+ integer, allocatable :: m(:)
+ a = data5
+ m = maxloc(a)
+ if (size(m, dim=1) /= 1) stop 11
+ if (any(m /= (/ 2 /))) stop 12
+ end subroutine
+ subroutine check_int_const_shape_rank_3()
+ integer :: a(4,4,4)
+ integer, allocatable :: m(:)
+ a = reshape(data64, shape(a))
+ m = maxloc(a)
+ if (size(m, dim=1) /= 3) stop 21
+ if (any(m /= (/ 2, 2, 1 /))) stop 22
+ end subroutine
+ subroutine check_int_const_shape_empty_4()
+ integer :: a(9,3,0,7)
+ integer, allocatable :: m(:)
+ a = reshape((/ integer:: /), shape(a))
+ m = maxloc(a)
+ if (size(m, dim=1) /= 4) stop 31
+ if (any(m /= (/ 0, 0, 0, 0 /))) stop 32
+ end subroutine
+ subroutine check_int_alloc_rank_1()
+ integer, allocatable :: a(:)
+ integer, allocatable :: m(:)
+ allocate(a(5))
+ a(:) = data5
+ m = maxloc(a)
+ if (size(m, dim=1) /= 1) stop 41
+ if (any(m /= (/ 2 /))) stop 42
+ end subroutine
+ subroutine check_int_alloc_rank_3()
+ integer, allocatable :: a(:,:,:)
+ integer, allocatable :: m(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape(data64, shape(a))
+ m = maxloc(a)
+ if (size(m, dim=1) /= 3) stop 51
+ if (any(m /= (/ 2, 2, 1 /))) stop 52
+ end subroutine
+ subroutine check_real_const_shape_rank_1()
+ real :: a(5)
+ integer, allocatable :: m(:)
+ a = (/ real:: data5 /)
+ m = maxloc(a)
+ if (size(m, dim=1) /= 1) stop 71
+ if (any(m /= (/ 2 /))) stop 72
+ end subroutine
+ subroutine check_real_const_shape_rank_3()
+ real :: a(4,4,4)
+ integer, allocatable :: m(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ m = maxloc(a)
+ if (size(m, dim=1) /= 3) stop 81
+ if (any(m /= (/ 2, 2, 1 /))) stop 82
+ end subroutine
+ subroutine check_real_const_shape_empty_4()
+ real :: a(9,3,0,7)
+ integer, allocatable :: m(:)
+ a = reshape((/ real:: /), shape(a))
+ m = maxloc(a)
+ if (size(m, dim=1) /= 4) stop 91
+ if (any(m /= (/ 0, 0, 0, 0 /))) stop 92
+ end subroutine
+ subroutine check_real_alloc_rank_1()
+ real, allocatable :: a(:)
+ integer, allocatable :: m(:)
+ allocate(a(5))
+ a(:) = (/ real:: data5 /)
+ m = maxloc(a)
+ if (size(m, dim=1) /= 1) stop 111
+ if (any(m /= (/ 2 /))) stop 112
+ end subroutine
+ subroutine check_real_alloc_rank_3()
+ real, allocatable :: a(:,:,:)
+ integer, allocatable :: m(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape((/ real:: data64 /), shape(a))
+ m = maxloc(a)
+ if (size(m, dim=1) /= 3) stop 121
+ if (any(m /= (/ 2, 2, 1 /))) stop 122
+ end subroutine
+end subroutine check_maxloc_without_mask
+subroutine check_minloc_without_mask
+ implicit none
+ integer, parameter :: data5(*) = (/ 8, 2, 7, 2, 9 /)
+ integer, parameter :: data64(*) = (/ 7, 4, 5, 3, 9, 0, 6, 4, &
+ 5, 5, 8, 2, 6, 7, 8, 7, &
+ 4, 5, 3, 9, 0, 6, 4, 5, &
+ 5, 8, 2, 6, 7, 8, 7, 4, &
+ 5, 3, 9, 0, 6, 4, 5, 5, &
+ 8, 2, 6, 7, 8, 7, 4, 5, &
+ 3, 9, 0, 6, 4, 5, 5, 8, &
+ 2, 6, 7, 8, 7, 4, 5, 3 /)
+ call check_int_const_shape_rank_1
+ call check_int_const_shape_rank_3
+ call check_int_const_shape_empty_4
+ call check_int_alloc_rank_1
+ call check_int_alloc_rank_3
+ call check_real_const_shape_rank_1
+ call check_real_const_shape_rank_3
+ call check_real_const_shape_empty_4
+ call check_real_alloc_rank_1
+ call check_real_alloc_rank_3
+contains
+ subroutine check_int_const_shape_rank_1()
+ integer :: a(5)
+ integer, allocatable :: m(:)
+ a = data5
+ m = minloc(a)
+ if (size(m, dim=1) /= 1) stop 11
+ if (any(m /= (/ 2 /))) stop 12
+ end subroutine
+ subroutine check_int_const_shape_rank_3()
+ integer :: a(4,4,4)
+ integer, allocatable :: m(:)
+ a = reshape(data64, shape(a))
+ m = minloc(a)
+ if (size(m, dim=1) /= 3) stop 21
+ if (any(m /= (/ 2, 2, 1 /))) stop 22
+ end subroutine
+ subroutine check_int_const_shape_empty_4()
+ integer :: a(9,3,0,7)
+ integer, allocatable :: m(:)
+ a = reshape((/ integer:: /), shape(a))
+ m = minloc(a)
+ if (size(m, dim=1) /= 4) stop 31
+ if (any(m /= (/ 0, 0, 0, 0 /))) stop 32
+ end subroutine
+ subroutine check_int_alloc_rank_1()
+ integer, allocatable :: a(:)
+ integer, allocatable :: m(:)
+ allocate(a(5))
+ a(:) = data5
+ m = minloc(a)
+ if (size(m, dim=1) /= 1) stop 41
+ if (any(m /= (/ 2 /))) stop 42
+ end subroutine
+ subroutine check_int_alloc_rank_3()
+ integer, allocatable :: a(:,:,:)
+ integer, allocatable :: m(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape(data64, shape(a))
+ m = minloc(a)
+ if (size(m, dim=1) /= 3) stop 51
+ if (any(m /= (/ 2, 2, 1 /))) stop 52
+ end subroutine
+ subroutine check_real_const_shape_rank_1()
+ real :: a(5)
+ integer, allocatable :: m(:)
+ a = (/ real:: data5 /)
+ m = minloc(a)
+ if (size(m, dim=1) /= 1) stop 71
+ if (any(m /= (/ 2 /))) stop 72
+ end subroutine
+ subroutine check_real_const_shape_rank_3()
+ real :: a(4,4,4)
+ integer, allocatable :: m(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ m = minloc(a)
+ if (size(m, dim=1) /= 3) stop 81
+ if (any(m /= (/ 2, 2, 1 /))) stop 82
+ end subroutine
+ subroutine check_real_const_shape_empty_4()
+ real :: a(9,3,0,7)
+ integer, allocatable :: m(:)
+ a = reshape((/ real:: /), shape(a))
+ m = minloc(a)
+ if (size(m, dim=1) /= 4) stop 91
+ if (any(m /= (/ 0, 0, 0, 0 /))) stop 92
+ end subroutine
+ subroutine check_real_alloc_rank_1()
+ real, allocatable :: a(:)
+ integer, allocatable :: m(:)
+ allocate(a(5))
+ a(:) = (/ real:: data5 /)
+ m = minloc(a)
+ if (size(m, dim=1) /= 1) stop 111
+ if (any(m /= (/ 2 /))) stop 112
+ end subroutine
+ subroutine check_real_alloc_rank_3()
+ real, allocatable :: a(:,:,:)
+ integer, allocatable :: m(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape((/ real:: data64 /), shape(a))
+ m = minloc(a)
+ if (size(m, dim=1) /= 3) stop 121
+ if (any(m /= (/ 2, 2, 1 /))) stop 122
+ end subroutine
+end subroutine check_minloc_without_mask
+subroutine check_maxloc_with_mask
+ implicit none
+ integer, parameter :: data10(*) = (/ 7, 4, 7, 6, 6, 4, 6, 3, 9, 8 /)
+ logical, parameter :: mask10(*) = (/ .false., .true., .false., &
+ .false., .true., .true., &
+ .true. , .true., .false., &
+ .false. /)
+ integer, parameter :: data64(*) = (/ 2, 5, 4, 6, 0, 9, 3, 5, &
+ 4, 4, 1, 7, 3, 2, 1, 2, &
+ 5, 4, 6, 0, 9, 3, 5, 4, &
+ 4, 1, 7, 3, 2, 1, 2, 5, &
+ 4, 6, 0, 9, 3, 5, 4, 4, &
+ 1, 7, 3, 2, 1, 2, 5, 4, &
+ 6, 0, 9, 3, 5, 4, 4, 1, &
+ 7, 3, 2, 1, 2, 5, 4, 6 /)
+ logical, parameter :: mask64(*) = (/ .true. , .false., .false., .false., &
+ .true. , .false., .true. , .false., &
+ .false., .true. , .true. , .false., &
+ .true. , .true. , .true. , .true. , &
+ .false., .true. , .false., .true. , &
+ .false., .true. , .false., .true. , &
+ .true. , .false., .false., .true. , &
+ .true. , .true. , .true. , .false., &
+ .false., .false., .true. , .false., &
+ .true. , .false., .true. , .true. , &
+ .true. , .false., .true. , .true. , &
+ .false., .true. , .false., .true. , &
+ .false., .true. , .false., .false., &
+ .false., .true. , .true. , .true. , &
+ .false., .true. , .false., .true. , &
+ .true. , .false., .false., .false. /)
+ call check_int_const_shape_rank_1
+ call check_int_const_shape_rank_3
+ call check_int_const_shape_rank_3_true_mask
+ call check_int_const_shape_rank_3_false_mask
+ call check_int_const_shape_rank_3_optional_mask_present
+ call check_int_const_shape_rank_3_optional_mask_absent
+ call check_int_const_shape_empty_4
+ call check_int_alloc_rank_1
+ call check_int_alloc_rank_3
+ call check_int_alloc_rank_3_true_mask
+ call check_int_alloc_rank_3_false_mask
+ call check_real_const_shape_rank_1
+ call check_real_const_shape_rank_3
+ call check_real_const_shape_rank_3_true_mask
+ call check_real_const_shape_rank_3_false_mask
+ call check_real_const_shape_rank_3_optional_mask_present
+ call check_real_const_shape_rank_3_optional_mask_absent
+ call check_real_const_shape_empty_4
+ call check_real_alloc_rank_1
+ call check_real_alloc_rank_3
+ call check_real_alloc_rank_3_true_mask
+ call check_real_alloc_rank_3_false_mask
+contains
+ subroutine check_int_const_shape_rank_1()
+ integer :: a(10)
+ logical :: m(10)
+ integer, allocatable :: r(:)
+ a = data10
+ m = mask10
+ r = maxloc(a, mask = m)
+ if (size(r, dim = 1) /= 1) stop 11
+ if (any(r /= (/ 5 /))) stop 12
+ end subroutine
+ subroutine check_int_const_shape_rank_3()
+ integer :: a(4,4,4)
+ logical :: m(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape(data64, shape(a))
+ m = reshape(mask64, shape(m))
+ r = maxloc(a, mask = m)
+ if (size(r, dim = 1) /= 3) stop 21
+ if (any(r /= (/ 2, 3, 1 /))) stop 22
+ end subroutine
+ subroutine check_int_const_shape_rank_3_true_mask()
+ integer :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape(data64, shape(a))
+ r = maxloc(a, mask = .true.)
+ if (size(r, dim = 1) /= 3) stop 31
+ if (any(r /= (/ 2, 2, 1 /))) stop 32
+ end subroutine
+ subroutine check_int_const_shape_rank_3_false_mask()
+ integer :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape(data64, shape(a))
+ r = maxloc(a, mask = .false.)
+ if (size(r, dim = 1) /= 3) stop 41
+ if (any(r /= (/ 0, 0, 0 /))) stop 42
+ end subroutine
+ subroutine call_maxloc_int(r, a, m)
+ integer :: a(:,:,:)
+ logical, optional :: m(:,:,:)
+ integer, allocatable :: r(:)
+ r = maxloc(a, mask = m)
+ end subroutine
+ subroutine check_int_const_shape_rank_3_optional_mask_present()
+ integer :: a(4,4,4)
+ logical :: m(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape(data64, shape(a))
+ m = reshape(mask64, shape(m))
+ call call_maxloc_int(r, a, m)
+ if (size(r, dim = 1) /= 3) stop 51
+ if (any(r /= (/ 2, 3, 1 /))) stop 52
+ end subroutine
+ subroutine check_int_const_shape_rank_3_optional_mask_absent()
+ integer :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape(data64, shape(a))
+ call call_maxloc_int(r, a)
+ if (size(r, dim = 1) /= 3) stop 61
+ if (any(r /= (/ 2, 2, 1 /))) stop 62
+ end subroutine
+ subroutine check_int_const_shape_empty_4()
+ integer :: a(9,3,0,7)
+ logical :: m(9,3,0,7)
+ integer, allocatable :: r(:)
+ a = reshape((/ integer:: /), shape(a))
+ m = reshape((/ logical:: /), shape(m))
+ r = maxloc(a, mask = m)
+ if (size(r, dim = 1) /= 4) stop 71
+ if (any(r /= (/ 0, 0, 0, 0 /))) stop 72
+ end subroutine
+ subroutine check_int_alloc_rank_1()
+ integer, allocatable :: a(:)
+ logical, allocatable :: m(:)
+ integer, allocatable :: r(:)
+ allocate(a(10), m(10))
+ a(:) = data10
+ m(:) = mask10
+ r = maxloc(a, mask = m)
+ if (size(r, dim = 1) /= 1) stop 81
+ if (any(r /= (/ 5 /))) stop 82
+ end subroutine
+ subroutine check_int_alloc_rank_3()
+ integer, allocatable :: a(:,:,:)
+ logical, allocatable :: m(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4), m(4,4,4))
+ a(:,:,:) = reshape(data64, shape(a))
+ m(:,:,:) = reshape(mask64, shape(m))
+ r = maxloc(a, mask = m)
+ if (size(r, dim = 1) /= 3) stop 91
+ if (any(r /= (/ 2, 3, 1 /))) stop 92
+ end subroutine
+ subroutine check_int_alloc_rank_3_true_mask()
+ integer, allocatable :: a(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape(data64, shape(a))
+ r = maxloc(a, mask = .true.)
+ if (size(r, dim = 1) /= 3) stop 101
+ if (any(r /= (/ 2, 2, 1 /))) stop 102
+ end subroutine
+ subroutine check_int_alloc_rank_3_false_mask()
+ integer, allocatable :: a(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape(data64, shape(a))
+ r = maxloc(a, mask = .false.)
+ if (size(r, dim = 1) /= 3) stop 111
+ if (any(r /= (/ 0, 0, 0 /))) stop 112
+ end subroutine
+ subroutine check_real_const_shape_rank_1()
+ real :: a(10)
+ logical :: m(10)
+ integer, allocatable :: r(:)
+ a = (/ real:: data10 /)
+ m = mask10
+ r = maxloc(a, mask = m)
+ if (size(r, dim = 1) /= 1) stop 131
+ if (any(r /= (/ 5 /))) stop 132
+ end subroutine
+ subroutine check_real_const_shape_rank_3()
+ real :: a(4,4,4)
+ logical :: m(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ m = reshape(mask64, shape(m))
+ r = maxloc(a, mask = m)
+ if (size(r, dim = 1) /= 3) stop 141
+ if (any(r /= (/ 2, 3, 1 /))) stop 142
+ end subroutine
+ subroutine check_real_const_shape_rank_3_true_mask()
+ real :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ r = maxloc(a, mask = .true.)
+ if (size(r, dim = 1) /= 3) stop 151
+ if (any(r /= (/ 2, 2, 1 /))) stop 152
+ end subroutine
+ subroutine check_real_const_shape_rank_3_false_mask()
+ real :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ r = maxloc(a, mask = .false.)
+ if (size(r, dim = 1) /= 3) stop 161
+ if (any(r /= (/ 0, 0, 0 /))) stop 162
+ end subroutine
+ subroutine call_maxloc_real(r, a, m)
+ real :: a(:,:,:)
+ logical, optional :: m(:,:,:)
+ integer, allocatable :: r(:)
+ r = maxloc(a, mask = m)
+ end subroutine
+ subroutine check_real_const_shape_rank_3_optional_mask_present()
+ real :: a(4,4,4)
+ logical :: m(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ m = reshape(mask64, shape(m))
+ call call_maxloc_real(r, a, m)
+ if (size(r, dim = 1) /= 3) stop 171
+ if (any(r /= (/ 2, 3, 1 /))) stop 172
+ end subroutine
+ subroutine check_real_const_shape_rank_3_optional_mask_absent()
+ real :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ call call_maxloc_real(r, a)
+ if (size(r, dim = 1) /= 3) stop 181
+ if (any(r /= (/ 2, 2, 1 /))) stop 182
+ end subroutine
+ subroutine check_real_const_shape_empty_4()
+ real :: a(9,3,0,7)
+ logical :: m(9,3,0,7)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: /), shape(a))
+ m = reshape((/ logical:: /), shape(m))
+ r = maxloc(a, mask = m)
+ if (size(r, dim = 1) /= 4) stop 191
+ if (any(r /= (/ 0, 0, 0, 0 /))) stop 192
+ end subroutine
+ subroutine check_real_alloc_rank_1()
+ real, allocatable :: a(:)
+ logical, allocatable :: m(:)
+ integer, allocatable :: r(:)
+ allocate(a(10), m(10))
+ a(:) = (/ real:: data10 /)
+ m(:) = mask10
+ r = maxloc(a, mask = m)
+ if (size(r, dim = 1) /= 1) stop 201
+ if (any(r /= (/ 5 /))) stop 202
+ end subroutine
+ subroutine check_real_alloc_rank_3()
+ real, allocatable :: a(:,:,:)
+ logical, allocatable :: m(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4), m(4,4,4))
+ a(:,:,:) = reshape((/ real:: data64 /), shape(a))
+ m(:,:,:) = reshape(mask64, shape(m))
+ r = maxloc(a, mask = m)
+ if (size(r, dim = 1) /= 3) stop 211
+ if (any(r /= (/ 2, 3, 1 /))) stop 212
+ end subroutine
+ subroutine check_real_alloc_rank_3_true_mask()
+ real, allocatable :: a(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape((/ real:: data64 /), shape(a))
+ r = maxloc(a, mask = .true.)
+ if (size(r, dim = 1) /= 3) stop 221
+ if (any(r /= (/ 2, 2, 1 /))) stop 222
+ end subroutine
+ subroutine check_real_alloc_rank_3_false_mask()
+ real, allocatable :: a(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape((/ real:: data64 /), shape(a))
+ r = maxloc(a, mask = .false.)
+ if (size(r, dim = 1) /= 3) stop 231
+ if (any(r /= (/ 0, 0, 0 /))) stop 232
+ end subroutine
+end subroutine check_maxloc_with_mask
+subroutine check_minloc_with_mask
+ implicit none
+ integer, parameter :: data10(*) = (/ 2, 5, 2, 3, 3, 5, 3, 6, 0, 1 /)
+ logical, parameter :: mask10(*) = (/ .false., .true., .false., &
+ .false., .true., .true., &
+ .true. , .true., .false., &
+ .false. /)
+ integer, parameter :: data64(*) = (/ 7, 4, 5, 3, 9, 0, 6, 4, &
+ 5, 5, 8, 2, 6, 7, 8, 7, &
+ 4, 5, 3, 9, 0, 6, 4, 5, &
+ 5, 8, 2, 6, 7, 8, 7, 4, &
+ 5, 3, 9, 0, 6, 4, 5, 5, &
+ 8, 2, 6, 7, 8, 7, 4, 5, &
+ 3, 9, 0, 6, 4, 5, 5, 8, &
+ 2, 6, 7, 8, 7, 4, 5, 3 /)
+ logical, parameter :: mask64(*) = (/ .true. , .false., .false., .false., &
+ .true. , .false., .true. , .false., &
+ .false., .true. , .true. , .false., &
+ .true. , .true. , .true. , .true. , &
+ .false., .true. , .false., .true. , &
+ .false., .true. , .false., .true. , &
+ .true. , .false., .false., .true. , &
+ .true. , .true. , .true. , .false., &
+ .false., .false., .true. , .false., &
+ .true. , .false., .true. , .true. , &
+ .true. , .false., .true. , .true. , &
+ .false., .true. , .false., .true. , &
+ .false., .true. , .false., .false., &
+ .false., .true. , .true. , .true. , &
+ .false., .true. , .false., .true. , &
+ .true. , .false., .false., .false. /)
+ call check_int_const_shape_rank_1
+ call check_int_const_shape_rank_3
+ call check_int_const_shape_rank_3_true_mask
+ call check_int_const_shape_rank_3_false_mask
+ call check_int_const_shape_rank_3_optional_mask_present
+ call check_int_const_shape_rank_3_optional_mask_absent
+ call check_int_const_shape_empty_4
+ call check_int_alloc_rank_1
+ call check_int_alloc_rank_3
+ call check_int_alloc_rank_3_true_mask
+ call check_int_alloc_rank_3_false_mask
+ call check_real_const_shape_rank_1
+ call check_real_const_shape_rank_3
+ call check_real_const_shape_rank_3_true_mask
+ call check_real_const_shape_rank_3_false_mask
+ call check_real_const_shape_rank_3_optional_mask_present
+ call check_real_const_shape_rank_3_optional_mask_absent
+ call check_real_const_shape_empty_4
+ call check_real_alloc_rank_1
+ call check_real_alloc_rank_3
+ call check_real_alloc_rank_3_true_mask
+ call check_real_alloc_rank_3_false_mask
+contains
+ subroutine check_int_const_shape_rank_1()
+ integer :: a(10)
+ logical :: m(10)
+ integer, allocatable :: r(:)
+ a = data10
+ m = mask10
+ r = minloc(a, mask = m)
+ if (size(r, dim = 1) /= 1) stop 11
+ if (any(r /= (/ 5 /))) stop 12
+ end subroutine
+ subroutine check_int_const_shape_rank_3()
+ integer :: a(4,4,4)
+ logical :: m(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape(data64, shape(a))
+ m = reshape(mask64, shape(m))
+ r = minloc(a, mask = m)
+ if (size(r, dim = 1) /= 3) stop 21
+ if (any(r /= (/ 2, 3, 1 /))) stop 22
+ end subroutine
+ subroutine check_int_const_shape_rank_3_true_mask()
+ integer :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape(data64, shape(a))
+ r = minloc(a, mask = .true.)
+ if (size(r, dim = 1) /= 3) stop 31
+ if (any(r /= (/ 2, 2, 1 /))) stop 32
+ end subroutine
+ subroutine check_int_const_shape_rank_3_false_mask()
+ integer :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape(data64, shape(a))
+ r = minloc(a, mask = .false.)
+ if (size(r, dim = 1) /= 3) stop 41
+ if (any(r /= (/ 0, 0, 0 /))) stop 42
+ end subroutine
+ subroutine call_minloc_int(r, a, m)
+ integer :: a(:,:,:)
+ logical, optional :: m(:,:,:)
+ integer, allocatable :: r(:)
+ r = minloc(a, mask = m)
+ end subroutine
+ subroutine check_int_const_shape_rank_3_optional_mask_present()
+ integer :: a(4,4,4)
+ logical :: m(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape(data64, shape(a))
+ m = reshape(mask64, shape(m))
+ call call_minloc_int(r, a, m)
+ if (size(r, dim = 1) /= 3) stop 51
+ if (any(r /= (/ 2, 3, 1 /))) stop 52
+ end subroutine
+ subroutine check_int_const_shape_rank_3_optional_mask_absent()
+ integer :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape(data64, shape(a))
+ call call_minloc_int(r, a)
+ if (size(r, dim = 1) /= 3) stop 61
+ if (any(r /= (/ 2, 2, 1 /))) stop 62
+ end subroutine
+ subroutine check_int_const_shape_empty_4()
+ integer :: a(9,3,0,7)
+ logical :: m(9,3,0,7)
+ integer, allocatable :: r(:)
+ a = reshape((/ integer:: /), shape(a))
+ m = reshape((/ logical:: /), shape(m))
+ r = minloc(a, mask = m)
+ if (size(r, dim = 1) /= 4) stop 71
+ if (any(r /= (/ 0, 0, 0, 0 /))) stop 72
+ end subroutine
+ subroutine check_int_alloc_rank_1()
+ integer, allocatable :: a(:)
+ logical, allocatable :: m(:)
+ integer, allocatable :: r(:)
+ allocate(a(10), m(10))
+ a(:) = data10
+ m(:) = mask10
+ r = minloc(a, mask = m)
+ if (size(r, dim = 1) /= 1) stop 81
+ if (any(r /= (/ 5 /))) stop 82
+ end subroutine
+ subroutine check_int_alloc_rank_3()
+ integer, allocatable :: a(:,:,:)
+ logical, allocatable :: m(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4), m(4,4,4))
+ a(:,:,:) = reshape(data64, shape(a))
+ m(:,:,:) = reshape(mask64, shape(m))
+ r = minloc(a, mask = m)
+ if (size(r, dim = 1) /= 3) stop 91
+ if (any(r /= (/ 2, 3, 1 /))) stop 92
+ end subroutine
+ subroutine check_int_alloc_rank_3_true_mask()
+ integer, allocatable :: a(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape(data64, shape(a))
+ r = minloc(a, mask = .true.)
+ if (size(r, dim = 1) /= 3) stop 101
+ if (any(r /= (/ 2, 2, 1 /))) stop 102
+ end subroutine
+ subroutine check_int_alloc_rank_3_false_mask()
+ integer, allocatable :: a(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape(data64, shape(a))
+ r = minloc(a, mask = .false.)
+ if (size(r, dim = 1) /= 3) stop 111
+ if (any(r /= (/ 0, 0, 0 /))) stop 112
+ end subroutine
+ subroutine check_real_const_shape_rank_1()
+ real :: a(10)
+ logical :: m(10)
+ integer, allocatable :: r(:)
+ a = (/ real:: data10 /)
+ m = mask10
+ r = minloc(a, mask = m)
+ if (size(r, dim = 1) /= 1) stop 131
+ if (any(r /= (/ 5 /))) stop 132
+ end subroutine
+ subroutine check_real_const_shape_rank_3()
+ real :: a(4,4,4)
+ logical :: m(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ m = reshape(mask64, shape(m))
+ r = minloc(a, mask = m)
+ if (size(r, dim = 1) /= 3) stop 141
+ if (any(r /= (/ 2, 3, 1 /))) stop 142
+ end subroutine
+ subroutine check_real_const_shape_rank_3_true_mask()
+ real :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ r = minloc(a, mask = .true.)
+ if (size(r, dim = 1) /= 3) stop 151
+ if (any(r /= (/ 2, 2, 1 /))) stop 152
+ end subroutine
+ subroutine check_real_const_shape_rank_3_false_mask()
+ real :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ r = minloc(a, mask = .false.)
+ if (size(r, dim = 1) /= 3) stop 161
+ if (any(r /= (/ 0, 0, 0 /))) stop 162
+ end subroutine
+ subroutine call_minloc_real(r, a, m)
+ real :: a(:,:,:)
+ logical, optional :: m(:,:,:)
+ integer, allocatable :: r(:)
+ r = minloc(a, mask = m)
+ end subroutine
+ subroutine check_real_const_shape_rank_3_optional_mask_present()
+ real :: a(4,4,4)
+ logical :: m(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ m = reshape(mask64, shape(m))
+ call call_minloc_real(r, a, m)
+ if (size(r, dim = 1) /= 3) stop 171
+ if (any(r /= (/ 2, 3, 1 /))) stop 172
+ end subroutine
+ subroutine check_real_const_shape_rank_3_optional_mask_absent()
+ real :: a(4,4,4)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: data64 /), shape(a))
+ call call_minloc_real(r, a)
+ if (size(r, dim = 1) /= 3) stop 181
+ if (any(r /= (/ 2, 2, 1 /))) stop 182
+ end subroutine
+ subroutine check_real_const_shape_empty_4()
+ real :: a(9,3,0,7)
+ logical :: m(9,3,0,7)
+ integer, allocatable :: r(:)
+ a = reshape((/ real:: /), shape(a))
+ m = reshape((/ logical:: /), shape(m))
+ r = minloc(a, mask = m)
+ if (size(r, dim = 1) /= 4) stop 191
+ if (any(r /= (/ 0, 0, 0, 0 /))) stop 192
+ end subroutine
+ subroutine check_real_alloc_rank_1()
+ real, allocatable :: a(:)
+ logical, allocatable :: m(:)
+ integer, allocatable :: r(:)
+ allocate(a(10), m(10))
+ a(:) = (/ real:: data10 /)
+ m(:) = mask10
+ r = minloc(a, mask = m)
+ if (size(r, dim = 1) /= 1) stop 201
+ if (any(r /= (/ 5 /))) stop 202
+ end subroutine
+ subroutine check_real_alloc_rank_3()
+ real, allocatable :: a(:,:,:)
+ logical, allocatable :: m(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4), m(4,4,4))
+ a(:,:,:) = reshape((/ real:: data64 /), shape(a))
+ m(:,:,:) = reshape(mask64, shape(m))
+ r = minloc(a, mask = m)
+ if (size(r, dim = 1) /= 3) stop 211
+ if (any(r /= (/ 2, 3, 1 /))) stop 212
+ end subroutine
+ subroutine check_real_alloc_rank_3_true_mask()
+ real, allocatable :: a(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape((/ real:: data64 /), shape(a))
+ r = minloc(a, mask = .true.)
+ if (size(r, dim = 1) /= 3) stop 221
+ if (any(r /= (/ 2, 2, 1 /))) stop 222
+ end subroutine
+ subroutine check_real_alloc_rank_3_false_mask()
+ real, allocatable :: a(:,:,:)
+ integer, allocatable :: r(:)
+ allocate(a(4,4,4))
+ a(:,:,:) = reshape((/ real:: data64 /), shape(a))
+ r = minloc(a, mask = .false.)
+ if (size(r, dim = 1) /= 3) stop 231
+ if (any(r /= (/ 0, 0, 0 /))) stop 232
+ end subroutine
+end subroutine check_minloc_with_mask