1! { dg-do run } 2! { dg-require-effective-target fortran_large_int } 3! Program to test the eoshift intrinsic for kind=16_k integers 4! 5program intrinsic_eoshift 6 integer, parameter :: k=16 7 integer(kind=k), dimension(3_k, 3_k) :: a 8 integer(kind=k), dimension(3_k, 3_k, 2_k) :: b 9 integer(kind=k), dimension(3_k) :: bo, sh 10 11 ! Scalar shift and scalar bound. 12 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 13 a = eoshift (a, 1_k, 99_k, 1_k) 14 if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 5_k, 6_k, 99_k, 8_k, 9_k, 99_k/), (/3_k, 3_k/)))) & 15 call abort 16 17 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 18 a = eoshift (a, 9999_k, 99_k, 1_k) 19 if (any (a .ne. 99_k)) call abort 20 21 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 22 a = eoshift (a, -2_k, dim = 2_k) 23 if (any (a .ne. reshape ((/0_k, 0_k, 0_k, 0_k, 0_k, 0_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) & 24 call abort 25 26 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 27 a = eoshift (a, -9999_k, 99_k, 1_k) 28 if (any (a .ne. 99_k)) call abort 29 30 ! Array shift and scalar bound. 31 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 32 a = eoshift (a, (/1_k, 0_k, -1_k/), 99_k, 1_k) 33 if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 4_k, 5_k, 6_k, 99_k, 7_k, 8_k/), (/3_k, 3_k/)))) & 34 call abort 35 36 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 37 a = eoshift (a, (/9999_k, 0_k, -9999_k/), 99_k, 1_k) 38 if (any (a .ne. reshape ((/99_k, 99_k, 99_k, 4_k, 5_k, 6_k, 99_k, 99_k, 99_k/), (/3_k, 3_k/)))) & 39 call abort 40 41 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 42 a = eoshift (a, (/2_k, -2_k, 0_k/), dim = 2_k) 43 if (any (a .ne. reshape ((/7_k, 0_k, 3_k, 0_k, 0_k, 6_k, 0_k, 2_k, 9_k/), (/3_k, 3_k/)))) & 44 call abort 45 46 ! Scalar shift and array bound. 47 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 48 a = eoshift (a, 1_k, (/99_k, -1_k, 42_k/), 1_k) 49 if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 5_k, 6_k, -1_k, 8_k, 9_k, 42_k/), (/3_k, 3_k/)))) & 50 call abort 51 52 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 53 a = eoshift (a, 9999_k, (/99_k, -1_k, 42_k/), 1_k) 54 if (any (a .ne. reshape ((/99_k, 99_k, 99_k, -1_k, -1_k, -1_k, 42_k, 42_k, 42_k/), & 55 (/3_k, 3_k/)))) call abort 56 57 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 58 a = eoshift (a, -9999_k, (/99_k, -1_k, 42_k/), 1_k) 59 if (any (a .ne. reshape ((/99_k, 99_k, 99_k, -1_k, -1_k, -1_k, 42_k, 42_k, 42_k/), & 60 (/3_k, 3_k/)))) call abort 61 62 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 63 a = eoshift (a, -2_k, (/99_k, -1_k, 42_k/), 2_k) 64 if (any (a .ne. reshape ((/99_k, -1_k, 42_k, 99_k, -1_k, 42_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) & 65 call abort 66 67 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 68 bo = (/99_k, -1_k, 42_k/) 69 a = eoshift (a, -2_k, bo, 2_k) 70 if (any (a .ne. reshape ((/99_k, -1_k, 42_k, 99_k, -1_k, 42_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) & 71 call abort 72 73 ! Array shift and array bound. 74 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 75 a = eoshift (a, (/1_k, 0_k, -1_k/), (/99_k, -1_k, 42_k/), 1_k) 76 if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 4_k, 5_k, 6_k, 42_k, 7_k, 8_k/), (/3_k, 3_k/)))) & 77 call abort 78 79 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 80 a = eoshift (a, (/2_k, -2_k, 0_k/), (/99_k, -1_k, 42_k/), 2_k) 81 if (any (a .ne. reshape ((/7_k, -1_k, 3_k, 99_k, -1_k, 6_k, 99_k, 2_k, 9_k/), (/3_k, 3_k/)))) & 82 call abort 83 84 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 85 sh = (/ 3_k, -1_k, -3_k /) 86 bo = (/-999_k, -99_k, -9_k /) 87 a = eoshift(a, shift=sh, boundary=bo) 88 if (any (a .ne. reshape ((/ -999_k, -999_k, -999_k, -99_k, 4_k, 5_k, -9_k, -9_k, -9_k /), & 89 shape(a)))) call abort 90 91 a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 92 a = eoshift (a, (/9999_k, -9999_k, 0_k/), (/99_k, -1_k, 42_k/), 2_k) 93 if (any (a .ne. reshape ((/99_k, -1_k, 3_k, 99_k, -1_k, 6_k, 99_k, -1_k, 9_k/), (/3_k, 3_k/)))) & 94 call abort 95 96 ! Test arrays > rank 2 97 b(:, :, 1_k) = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 98 b(:, :, 2_k) = 10_k + reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)) 99 b = eoshift (b, 1_k, 99_k, 1_k) 100 if (any (b(:, :, 1_k) .ne. reshape ((/2_k, 3_k, 99_k, 5_k, 6_k, 99_k, 8_k, 9_k, 99_k/), (/3_k, 3_k/)))) & 101 call abort 102 if (any (b(:, :, 2_k) .ne. reshape ((/12_k, 13_k, 99_k, 15_k, 16_k, 99_k, 18_k, 19_k, 99_k/), (/3_k, 3_k/)))) & 103 call abort 104 105 ! TODO: Test array sections 106end program 107