mirror of
https://github.com/autc04/Retro68.git
synced 2024-11-30 19:53:46 +00:00
73 lines
1.8 KiB
Fortran
73 lines
1.8 KiB
Fortran
|
! { dg-do run }
|
||
|
|
!$ use omp_lib
|
||
|
|
|
||
|
|
character (len = 8) :: h, i
|
||
|
|
character (len = 4) :: j, k
|
||
|
|
h = '01234567'
|
||
|
|
i = 'ABCDEFGH'
|
||
|
|
j = 'IJKL'
|
||
|
|
k = 'MN'
|
||
|
|
call test (h, j)
|
||
|
|
contains
|
||
|
|
subroutine test (p, q)
|
||
|
|
character (len = 8) :: p
|
||
|
|
character (len = 4) :: q, r
|
||
|
|
character (len = 16) :: f
|
||
|
|
character (len = 32) :: g
|
||
|
|
integer, dimension (18) :: s
|
||
|
|
logical :: l
|
||
|
|
integer :: m
|
||
|
|
f = 'test16'
|
||
|
|
g = 'abcdefghijklmnopqrstuvwxyz'
|
||
|
|
r = ''
|
||
|
|
l = .false.
|
||
|
|
s = -6
|
||
|
|
!$omp parallel firstprivate (f, p, s) private (r, m) reduction (.or.:l) &
|
||
|
|
!$omp & num_threads (4)
|
||
|
|
m = omp_get_thread_num ()
|
||
|
|
if (any (s .ne. -6)) l = .true.
|
||
|
|
l = l .or. f .ne. 'test16' .or. p .ne. '01234567'
|
||
|
|
l = l .or. g .ne. 'abcdefghijklmnopqrstuvwxyz'
|
||
|
|
l = l .or. i .ne. 'ABCDEFGH' .or. q .ne. 'IJKL'
|
||
|
|
l = l .or. k .ne. 'MN'
|
||
|
|
!$omp barrier
|
||
|
|
if (m .eq. 0) then
|
||
|
|
f = 'ffffffff0'
|
||
|
|
g = 'xyz'
|
||
|
|
i = '123'
|
||
|
|
k = '9876'
|
||
|
|
p = '_abc'
|
||
|
|
q = '_def'
|
||
|
|
r = '1_23'
|
||
|
|
else if (m .eq. 1) then
|
||
|
|
f = '__'
|
||
|
|
p = 'xxx'
|
||
|
|
r = '7575'
|
||
|
|
else if (m .eq. 2) then
|
||
|
|
f = 'ZZ'
|
||
|
|
p = 'm2'
|
||
|
|
r = 'M2'
|
||
|
|
else if (m .eq. 3) then
|
||
|
|
f = 'YY'
|
||
|
|
p = 'm3'
|
||
|
|
r = 'M3'
|
||
|
|
end if
|
||
|
|
s = m
|
||
|
|
!$omp barrier
|
||
|
|
l = l .or. g .ne. 'xyz' .or. i .ne. '123' .or. k .ne. '9876'
|
||
|
|
l = l .or. q .ne. '_def'
|
||
|
|
if (any (s .ne. m)) l = .true.
|
||
|
|
if (m .eq. 0) then
|
||
|
|
l = l .or. f .ne. 'ffffffff0' .or. p .ne. '_abc' .or. r .ne. '1_23'
|
||
|
|
else if (m .eq. 1) then
|
||
|
|
l = l .or. f .ne. '__' .or. p .ne. 'xxx' .or. r .ne. '7575'
|
||
|
|
else if (m .eq. 2) then
|
||
|
|
l = l .or. f .ne. 'ZZ' .or. p .ne. 'm2' .or. r .ne. 'M2'
|
||
|
|
else if (m .eq. 3) then
|
||
|
|
l = l .or. f .ne. 'YY' .or. p .ne. 'm3' .or. r .ne. 'M3'
|
||
|
|
end if
|
||
|
|
!$omp end parallel
|
||
|
|
if (l) call abort
|
||
|
|
end subroutine test
|
||
|
|
end
|