1! { dg-do run } 2!$ use omp_lib 3 4 character (len = 8) :: h, i 5 character (len = 4) :: j, k 6 h = '01234567' 7 i = 'ABCDEFGH' 8 j = 'IJKL' 9 k = 'MN' 10 call test (h, j) 11contains 12 subroutine test (p, q) 13 character (len = 8) :: p 14 character (len = 4) :: q, r 15 character (len = 16) :: f 16 character (len = 32) :: g 17 integer, dimension (18) :: s 18 logical :: l 19 integer :: m 20 f = 'test16' 21 g = 'abcdefghijklmnopqrstuvwxyz' 22 r = '' 23 l = .false. 24 s = -6 25!$omp parallel firstprivate (f, p, s) private (r, m) reduction (.or.:l) & 26!$omp & num_threads (4) 27 m = omp_get_thread_num () 28 if (any (s .ne. -6)) l = .true. 29 l = l .or. f .ne. 'test16' .or. p .ne. '01234567' 30 l = l .or. g .ne. 'abcdefghijklmnopqrstuvwxyz' 31 l = l .or. i .ne. 'ABCDEFGH' .or. q .ne. 'IJKL' 32 l = l .or. k .ne. 'MN' 33!$omp barrier 34 if (m .eq. 0) then 35 f = 'ffffffff0' 36 g = 'xyz' 37 i = '123' 38 k = '9876' 39 p = '_abc' 40 q = '_def' 41 r = '1_23' 42 else if (m .eq. 1) then 43 f = '__' 44 p = 'xxx' 45 r = '7575' 46 else if (m .eq. 2) then 47 f = 'ZZ' 48 p = 'm2' 49 r = 'M2' 50 else if (m .eq. 3) then 51 f = 'YY' 52 p = 'm3' 53 r = 'M3' 54 end if 55 s = m 56!$omp barrier 57 l = l .or. g .ne. 'xyz' .or. i .ne. '123' .or. k .ne. '9876' 58 l = l .or. q .ne. '_def' 59 if (any (s .ne. m)) l = .true. 60 if (m .eq. 0) then 61 l = l .or. f .ne. 'ffffffff0' .or. p .ne. '_abc' .or. r .ne. '1_23' 62 else if (m .eq. 1) then 63 l = l .or. f .ne. '__' .or. p .ne. 'xxx' .or. r .ne. '7575' 64 else if (m .eq. 2) then 65 l = l .or. f .ne. 'ZZ' .or. p .ne. 'm2' .or. r .ne. 'M2' 66 else if (m .eq. 3) then 67 l = l .or. f .ne. 'YY' .or. p .ne. 'm3' .or. r .ne. 'M3' 68 end if 69!$omp end parallel 70 if (l) stop 1 71 end subroutine test 72end 73