1module m 2 implicit none (external, type) 3 integer :: a, b(0:2) = [1, 1, 1] 4 integer(8) :: c(0:1) = [not(0_8), not(0_8)] 5contains 6 subroutine bar (i) 7 integer :: i 8 !$omp task in_reduction (*: b) in_reduction (iand: c) & 9 !$omp& in_reduction (+: a) 10 a = a + 4 11 b(1) = b(1) * 4 12 c(1) = iand (c(1), not(ishft(1_8, i + 16))) 13 !$omp end task 14 end subroutine bar 15 16 subroutine foo (x) 17 integer :: x 18 !$omp scope reduction (task, +: a) 19 !$omp scope reduction (task, *: b) 20 !$omp scope reduction (task, iand: c) 21 !$omp barrier 22 !$omp sections 23 !$omp section 24 block 25 a = a + 1; b(0) = b(0) * 2; call bar (2); b(2) = b(2) * 3 26 c(1) = iand(c(1), not(ishft(1_8, 2))) 27 end block 28 !$omp section 29 block 30 b(0) = b(0) * 2; call bar (4); b(2) = b(2) * 3 31 c(1) = iand(c(1), not(ishft(1_8, 4))); a = a + 1 32 end block 33 !$omp section 34 block 35 call bar (6); b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 6))) 36 a = a + 1; b(0) = b(0) * 2 37 end block 38 !$omp section 39 block 40 b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 8))) 41 a = a + 1; b(0) = b(0) * 2; call bar (8) 42 end block 43 !$omp section 44 block 45 c(1) = iand(c(1), not(ishft(1_8, 10))); a = a + 1 46 b(0) = b(0) * 2; call bar (10); b(2) = b(2) * 3 47 end block 48 !$omp section 49 block 50 a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3 51 c(1) = iand(c(1), not(ishft(1_8, 12))); call bar (12) 52 end block 53 !$omp section 54 if (x /= 0) then 55 a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3 56 call bar (14); c(1) = iand (c(1), not(ishft(1_8, 14))) 57 end if 58 !$omp end sections 59 !$omp end scope 60 !$omp end scope 61 !$omp end scope 62 end subroutine foo 63end module m 64 65program main 66 use m 67 implicit none (type, external) 68 integer, volatile :: one 69 one = 1 70 call foo (0) 71 if (a /= 30 .or. b(0) /= 64 .or. b(1) /= ishft (1, 12) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 & 72 .or. c(0) /= not(0_8) .or. c(1) /= not(int(z'15541554', kind=8))) & 73 stop 1 74 a = 0 75 b(:) = [1, 1, 1] 76 c(1) = not(0_8) 77 !$omp parallel 78 call foo (one) 79 !$omp end parallel 80 if (a /= 35 .or. b(0) /= 128 .or. b(1) /= ishft(1, 14) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 * 3 & 81 .or. c(0) /= not(0_8) .or. c(1) /= not(int(z'55545554', kind=8))) & 82 stop 2 83end program main 84