reduction-3.f90 3.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171
  1. ! { dg-do run }
  2. ! double precision reductions
  3. program reduction_3
  4. implicit none
  5. integer, parameter :: n = 10, vl = 2
  6. integer :: i
  7. double precision, parameter :: e = .001
  8. double precision :: vresult, result
  9. logical :: lresult, lvresult
  10. double precision, dimension (n) :: array
  11. do i = 1, n
  12. array(i) = i
  13. end do
  14. result = 0
  15. vresult = 0
  16. ! '+' reductions
  17. !$acc parallel vector_length(vl) num_gangs(1)
  18. !$acc loop reduction(+:result)
  19. do i = 1, n
  20. result = result + array(i)
  21. end do
  22. !$acc end parallel
  23. ! Verify the results
  24. do i = 1, n
  25. vresult = vresult + array(i)
  26. end do
  27. if (abs (result - vresult) .ge. e) call abort
  28. result = 1
  29. vresult = 1
  30. ! '*' reductions
  31. !$acc parallel vector_length(vl) num_gangs(1)
  32. !$acc loop reduction(*:result)
  33. do i = 1, n
  34. result = result * array(i)
  35. end do
  36. !$acc end parallel
  37. ! Verify the results
  38. do i = 1, n
  39. vresult = vresult * array(i)
  40. end do
  41. if (result.ne.vresult) call abort
  42. result = 0
  43. vresult = 0
  44. ! 'max' reductions
  45. !$acc parallel vector_length(vl) num_gangs(1)
  46. !$acc loop reduction(max:result)
  47. do i = 1, n
  48. result = max (result, array(i))
  49. end do
  50. !$acc end parallel
  51. ! Verify the results
  52. do i = 1, n
  53. vresult = max (vresult, array(i))
  54. end do
  55. if (result.ne.vresult) call abort
  56. result = 1
  57. vresult = 1
  58. ! 'min' reductions
  59. !$acc parallel vector_length(vl) num_gangs(1)
  60. !$acc loop reduction(min:result)
  61. do i = 1, n
  62. result = min (result, array(i))
  63. end do
  64. !$acc end parallel
  65. ! Verify the results
  66. do i = 1, n
  67. vresult = min (vresult, array(i))
  68. end do
  69. if (result.ne.vresult) call abort
  70. result = 1
  71. vresult = 1
  72. ! '.and.' reductions
  73. !$acc parallel vector_length(vl) num_gangs(1)
  74. !$acc loop reduction(.and.:lresult)
  75. do i = 1, n
  76. lresult = lresult .and. (array(i) .ge. 5)
  77. end do
  78. !$acc end parallel
  79. ! Verify the results
  80. do i = 1, n
  81. lvresult = lvresult .and. (array(i) .ge. 5)
  82. end do
  83. if (result.ne.vresult) call abort
  84. lresult = .false.
  85. lvresult = .false.
  86. ! '.or.' reductions
  87. !$acc parallel vector_length(vl) num_gangs(1)
  88. !$acc loop reduction(.or.:lresult)
  89. do i = 1, n
  90. lresult = lresult .or. (array(i) .ge. 5)
  91. end do
  92. !$acc end parallel
  93. ! Verify the results
  94. do i = 1, n
  95. lvresult = lvresult .or. (array(i) .ge. 5)
  96. end do
  97. if (result.ne.vresult) call abort
  98. lresult = .false.
  99. lvresult = .false.
  100. ! '.eqv.' reductions
  101. !$acc parallel vector_length(vl) num_gangs(1)
  102. !$acc loop reduction(.eqv.:lresult)
  103. do i = 1, n
  104. lresult = lresult .eqv. (array(i) .ge. 5)
  105. end do
  106. !$acc end parallel
  107. ! Verify the results
  108. do i = 1, n
  109. lvresult = lvresult .eqv. (array(i) .ge. 5)
  110. end do
  111. if (result.ne.vresult) call abort
  112. lresult = .false.
  113. lvresult = .false.
  114. ! '.neqv.' reductions
  115. !$acc parallel vector_length(vl) num_gangs(1)
  116. !$acc loop reduction(.neqv.:lresult)
  117. do i = 1, n
  118. lresult = lresult .neqv. (array(i) .ge. 5)
  119. end do
  120. !$acc end parallel
  121. ! Verify the results
  122. do i = 1, n
  123. lvresult = lvresult .neqv. (array(i) .ge. 5)
  124. end do
  125. if (result.ne.vresult) call abort
  126. end program reduction_3