udr1.f90 1.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152
  1. ! { dg-do run }
  2. module udr1
  3. type dt
  4. integer :: x = 7
  5. integer :: y = 9
  6. end type
  7. end module udr1
  8. use udr1, only : dt
  9. !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in)
  10. integer :: i, j
  11. !$omp declare reduction (bar : integer : &
  12. !$omp & omp_out = omp_out + iand (omp_in, -4)) initializer (omp_priv = 3)
  13. type (dt) :: d
  14. !$omp declare reduction (+ : dt : omp_out%x = omp_out%x &
  15. !$omp & + iand (omp_in%x, -8))
  16. !$omp declare reduction (foo : dt : omp_out%x = iand (omp_in%x, -8) &
  17. !$omp & + omp_out%x) initializer (omp_priv = dt (5, 21))
  18. interface operator (+)
  19. function notdefined(x, y)
  20. use udr1, only : dt
  21. type(dt), intent (in) :: x, y
  22. type(dt) :: notdefined
  23. end function
  24. end interface
  25. j = 0
  26. !$omp parallel do reduction (foo : j)
  27. do i = 1, 100
  28. j = j + i
  29. end do
  30. if (j .ne. 5050) call abort
  31. j = 3
  32. !$omp parallel do reduction (bar : j)
  33. do i = 1, 100
  34. j = j + 4 * i
  35. end do
  36. if (j .ne. (5050 * 4 + 3)) call abort
  37. !$omp parallel do reduction (+ : d)
  38. do i = 1, 100
  39. if (d%y .ne. 9) call abort
  40. d%x = d%x + 8 * i
  41. end do
  42. if (d%x .ne. (5050 * 8 + 7) .or. d%y .ne. 9) call abort
  43. d = dt (5, 21)
  44. !$omp parallel do reduction (foo : d)
  45. do i = 1, 100
  46. if (d%y .ne. 21) call abort
  47. d%x = d%x + 8 * i
  48. end do
  49. if (d%x .ne. (5050 * 8 + 5) .or. d%y .ne. 21) call abort
  50. end