OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgomp/] [testsuite/] [libgomp.fortran/] [vla2.f90] - Blame information for rev 735

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 735 jeremybenn
! { dg-do run }
2
 
3
  call test
4
contains
5
  subroutine check (x, y, l)
6
    integer :: x, y
7
    logical :: l
8
    l = l .or. x .ne. y
9
  end subroutine check
10
 
11
  subroutine foo (c, d, e, f, g, h, i, j, k, n)
12
    use omp_lib
13
    integer :: n
14
    character (len = *) :: c
15
    character (len = n) :: d
16
    integer, dimension (2, 3:5, n) :: e
17
    integer, dimension (2, 3:n, n) :: f
18
    character (len = *), dimension (5, 3:n) :: g
19
    character (len = n), dimension (5, 3:n) :: h
20
    real, dimension (:, :, :) :: i
21
    double precision, dimension (3:, 5:, 7:) :: j
22
    integer, dimension (:, :, :) :: k
23
    logical :: l
24
    integer :: p, q, r
25
    character (len = n) :: s
26
    integer, dimension (2, 3:5, n) :: t
27
    integer, dimension (2, 3:n, n) :: u
28
    character (len = n), dimension (5, 3:n) :: v
29
    character (len = 2 * n + 24) :: w
30
    integer :: x
31
    character (len = 1) :: y
32
    l = .false.
33
!$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) &
34
!$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) &
35
!$omp private (p, q, r, w, x, y)
36
    x = omp_get_thread_num ()
37
    w = ''
38
    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
39
    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
40
    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
41
    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
42
    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
43
    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
44
    c = w(8:19)
45
    d = w(1:7)
46
    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
47
    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
48
    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
49
    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
50
    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
51
    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
52
    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
53
    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
54
    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
55
    s = w(20:26)
56
    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
57
    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
58
    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
59
    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
60
!$omp barrier
61
    y = ''
62
    if (x .eq. 0) y = '0'
63
    if (x .eq. 1) y = '1'
64
    if (x .eq. 2) y = '2'
65
    if (x .eq. 3) y = '3'
66
    if (x .eq. 4) y = '4'
67
    if (x .eq. 5) y = '5'
68
    l = l .or. w(7:7) .ne. y
69
    l = l .or. w(19:19) .ne. y
70
    l = l .or. w(26:26) .ne. y
71
    l = l .or. w(38:38) .ne. y
72
    l = l .or. c .ne. w(8:19)
73
    l = l .or. d .ne. w(1:7)
74
    l = l .or. s .ne. w(20:26)
75
    do 103, p = 1, 2
76
      do 103, q = 3, 7
77
        do 103, r = 1, 7
78
          if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
79
          l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
80
          if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
81
          if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
82
          if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
83
          if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
84
          if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
85
          l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
86
          if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
87
          if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
88
103 continue
89
    do 104, p = 3, 5
90
      do 104, q = 2, 6
91
        do 104, r = 1, 7
92
          l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
93
          l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
94
104 continue
95
    do 105, p = 1, 5
96
      do 105, q = 4, 6
97
        l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
98
105 continue
99
    call check (size (e, 1), 2, l)
100
    call check (size (e, 2), 3, l)
101
    call check (size (e, 3), 7, l)
102
    call check (size (e), 42, l)
103
    call check (size (f, 1), 2, l)
104
    call check (size (f, 2), 5, l)
105
    call check (size (f, 3), 7, l)
106
    call check (size (f), 70, l)
107
    call check (size (g, 1), 5, l)
108
    call check (size (g, 2), 5, l)
109
    call check (size (g), 25, l)
110
    call check (size (h, 1), 5, l)
111
    call check (size (h, 2), 5, l)
112
    call check (size (h), 25, l)
113
    call check (size (i, 1), 3, l)
114
    call check (size (i, 2), 5, l)
115
    call check (size (i, 3), 7, l)
116
    call check (size (i), 105, l)
117
    call check (size (j, 1), 4, l)
118
    call check (size (j, 2), 5, l)
119
    call check (size (j, 3), 7, l)
120
    call check (size (j), 140, l)
121
    call check (size (k, 1), 5, l)
122
    call check (size (k, 2), 1, l)
123
    call check (size (k, 3), 3, l)
124
    call check (size (k), 15, l)
125
!$omp end parallel
126
    if (l) call abort
127
  end subroutine foo
128
 
129
  subroutine test
130
    character (len = 12) :: c
131
    character (len = 7) :: d
132
    integer, dimension (2, 3:5, 7) :: e
133
    integer, dimension (2, 3:7, 7) :: f
134
    character (len = 12), dimension (5, 3:7) :: g
135
    character (len = 7), dimension (5, 3:7) :: h
136
    real, dimension (3:5, 2:6, 1:7) :: i
137
    double precision, dimension (3:6, 2:6, 1:7) :: j
138
    integer, dimension (1:5, 7:7, 4:6) :: k
139
    integer :: p, q, r
140
    call foo (c, d, e, f, g, h, i, j, k, 7)
141
  end subroutine test
142
end

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.