reduction-1.f90 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226
  1. ! { dg-do run }
  2. ! Integer reductions
  3. program reduction_1
  4. implicit none
  5. integer, parameter :: n = 10, vl = 2
  6. integer :: i, vresult, result
  7. logical :: lresult, lvresult
  8. integer, dimension (n) :: array
  9. do i = 1, n
  10. array(i) = i
  11. end do
  12. result = 0
  13. vresult = 0
  14. ! '+' reductions
  15. !$acc parallel vector_length(vl) num_gangs(1)
  16. !$acc loop reduction(+:result)
  17. do i = 1, n
  18. result = result + array(i)
  19. end do
  20. !$acc end parallel
  21. ! Verify the results
  22. do i = 1, n
  23. vresult = vresult + array(i)
  24. end do
  25. if (result.ne.vresult) call abort
  26. result = 0
  27. vresult = 0
  28. ! '*' reductions
  29. !$acc parallel vector_length(vl) num_gangs(1)
  30. !$acc loop reduction(*:result)
  31. do i = 1, n
  32. result = result * array(i)
  33. end do
  34. !$acc end parallel
  35. ! Verify the results
  36. do i = 1, n
  37. vresult = vresult * array(i)
  38. end do
  39. if (result.ne.vresult) call abort
  40. result = 0
  41. vresult = 0
  42. ! 'max' reductions
  43. !$acc parallel vector_length(vl) num_gangs(1)
  44. !$acc loop reduction(max:result)
  45. do i = 1, n
  46. result = max (result, array(i))
  47. end do
  48. !$acc end parallel
  49. ! Verify the results
  50. do i = 1, n
  51. vresult = max (vresult, array(i))
  52. end do
  53. if (result.ne.vresult) call abort
  54. result = 1
  55. vresult = 1
  56. ! 'min' reductions
  57. !$acc parallel vector_length(vl) num_gangs(1)
  58. !$acc loop reduction(min:result)
  59. do i = 1, n
  60. result = min (result, array(i))
  61. end do
  62. !$acc end parallel
  63. ! Verify the results
  64. do i = 1, n
  65. vresult = min (vresult, array(i))
  66. end do
  67. if (result.ne.vresult) call abort
  68. result = 1
  69. vresult = 1
  70. ! 'iand' reductions
  71. !$acc parallel vector_length(vl) num_gangs(1)
  72. !$acc loop reduction(iand:result)
  73. do i = 1, n
  74. result = iand (result, array(i))
  75. end do
  76. !$acc end parallel
  77. ! Verify the results
  78. do i = 1, n
  79. vresult = iand (vresult, array(i))
  80. end do
  81. if (result.ne.vresult) call abort
  82. result = 1
  83. vresult = 1
  84. ! 'ior' reductions
  85. !$acc parallel vector_length(vl) num_gangs(1)
  86. !$acc loop reduction(ior:result)
  87. do i = 1, n
  88. result = ior (result, array(i))
  89. end do
  90. !$acc end parallel
  91. ! Verify the results
  92. do i = 1, n
  93. vresult = ior (vresult, array(i))
  94. end do
  95. if (result.ne.vresult) call abort
  96. result = 0
  97. vresult = 0
  98. ! 'ieor' reductions
  99. !$acc parallel vector_length(vl) num_gangs(1)
  100. !$acc loop reduction(ieor:result)
  101. do i = 1, n
  102. result = ieor (result, array(i))
  103. end do
  104. !$acc end parallel
  105. ! Verify the results
  106. do i = 1, n
  107. vresult = ieor (vresult, array(i))
  108. end do
  109. if (result.ne.vresult) call abort
  110. lresult = .false.
  111. lvresult = .false.
  112. ! '.and.' reductions
  113. !$acc parallel vector_length(vl) num_gangs(1)
  114. !$acc loop reduction(.and.:lresult)
  115. do i = 1, n
  116. lresult = lresult .and. (array(i) .ge. 5)
  117. end do
  118. !$acc end parallel
  119. ! Verify the results
  120. do i = 1, n
  121. lvresult = lvresult .and. (array(i) .ge. 5)
  122. end do
  123. if (result.ne.vresult) call abort
  124. lresult = .false.
  125. lvresult = .false.
  126. ! '.or.' reductions
  127. !$acc parallel vector_length(vl) num_gangs(1)
  128. !$acc loop reduction(.or.:lresult)
  129. do i = 1, n
  130. lresult = lresult .or. (array(i) .ge. 5)
  131. end do
  132. !$acc end parallel
  133. ! Verify the results
  134. do i = 1, n
  135. lvresult = lvresult .or. (array(i) .ge. 5)
  136. end do
  137. if (result.ne.vresult) call abort
  138. lresult = .false.
  139. lvresult = .false.
  140. ! '.eqv.' reductions
  141. !$acc parallel vector_length(vl) num_gangs(1)
  142. !$acc loop reduction(.eqv.:lresult)
  143. do i = 1, n
  144. lresult = lresult .eqv. (array(i) .ge. 5)
  145. end do
  146. !$acc end parallel
  147. ! Verify the results
  148. do i = 1, n
  149. lvresult = lvresult .eqv. (array(i) .ge. 5)
  150. end do
  151. if (result.ne.vresult) call abort
  152. lresult = .false.
  153. lvresult = .false.
  154. ! '.neqv.' reductions
  155. !$acc parallel vector_length(vl) num_gangs(1)
  156. !$acc loop reduction(.neqv.:lresult)
  157. do i = 1, n
  158. lresult = lresult .neqv. (array(i) .ge. 5)
  159. end do
  160. !$acc end parallel
  161. ! Verify the results
  162. do i = 1, n
  163. lvresult = lvresult .neqv. (array(i) .ge. 5)
  164. end do
  165. if (result.ne.vresult) call abort
  166. end program reduction_1