nestedfn5.f90 2.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697
  1. ! { dg-do run }
  2. interface
  3. subroutine bar (q)
  4. integer :: q(19:)
  5. end subroutine
  6. end interface
  7. integer :: q(7:15)
  8. q(:) = 5
  9. call bar (q)
  10. end
  11. subroutine bar (q)
  12. use iso_c_binding, only: c_ptr, c_loc, c_int
  13. integer :: a, b, c, d(2:3,4:5), q(19:), h, k, m, n, o, p
  14. integer(c_int), target :: e(64)
  15. type (c_ptr) :: f, g(64)
  16. logical :: l
  17. a = 1
  18. b = 2
  19. c = 3
  20. d = 4
  21. l = .false.
  22. f = c_loc (e)
  23. call foo
  24. contains
  25. subroutine foo
  26. use iso_c_binding, only: c_sizeof
  27. !$omp simd linear(a:2) linear(b:1)
  28. do a = 1, 20, 2
  29. b = b + 1
  30. end do
  31. !$omp end simd
  32. if (a /= 21 .or. b /= 12) call abort
  33. !$omp simd aligned(f : c_sizeof (e(1)))
  34. do b = 1, 64
  35. g(b) = f
  36. end do
  37. !$omp end simd
  38. !$omp parallel
  39. !$omp single
  40. !$omp taskgroup
  41. !$omp task depend(out : a, d(2:2,4:5))
  42. a = a + 1
  43. d(2:2,4:5) = d(2:2,4:5) + 1
  44. !$omp end task
  45. !$omp task depend(in : a, d(2:2,4:5))
  46. if (a /= 22) call abort
  47. if (any (d(2:2,4:5) /= 5)) call abort
  48. !$omp end task
  49. !$omp end taskgroup
  50. !$omp end single
  51. !$omp end parallel
  52. b = 10
  53. !$omp target data map (tofrom: a, d(2:3,4:4), q) map (from: l)
  54. !$omp target map (tofrom: b, d(2:3,4:4))
  55. l = .false.
  56. if (a /= 22 .or. any (q /= 5)) l = .true.
  57. if (lbound (q, 1) /= 19 .or. ubound (q, 1) /= 27) l = .true.
  58. if (d(2,4) /= 5 .or. d(3,4) /= 4) l = .true.
  59. l = l .or. (b /= 10)
  60. a = 6
  61. b = 11
  62. q = 8
  63. d(2:3,4:4) = 9
  64. !$omp end target
  65. !$omp target update from (a, q, d(2:3,4:4), l)
  66. if (a /= 6 .or. l .or. b /= 11 .or. any (q /= 8)) call abort
  67. if (any (d(2:3,4:4) /= 9) .or. d(2,5) /= 5 .or. d(3,5) /= 4) call abort
  68. a = 12
  69. b = 13
  70. q = 14
  71. d = 15
  72. !$omp target update to (a, q, d(2:3,4:4))
  73. !$omp target map (tofrom: b, d(2:3,4:4))
  74. if (a /= 12 .or. b /= 13 .or. any (q /= 14)) l = .true.
  75. l = l .or. any (d(2:3,4:4) /= 15)
  76. !$omp end target
  77. a = 0
  78. b = 1
  79. c = 100
  80. h = 8
  81. m = 0
  82. n = 64
  83. o = 16
  84. if (l) call abort
  85. !$omp target teams distribute parallel do simd if (.not.l) device(a) &
  86. !$omp & num_teams(b) dist_schedule(static, c) num_threads (h) &
  87. !$omp & reduction (+: m) safelen (n) schedule(static, o)
  88. do p = 1, 64
  89. m = m + 1
  90. end do
  91. !$omp end target teams distribute parallel do simd
  92. if (m /= 64) call abort
  93. !$omp end target data
  94. end subroutine foo
  95. end subroutine bar