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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [libgomp/] [testsuite/] [libgomp.fortran/] [appendix-a/] [a.16.1.f90] - Blame information for rev 824

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 38 julius
! { dg-do run }
2
        REAL FUNCTION WORK1(I)
3
            INTEGER I
4
            WORK1 = 1.0 * I
5
            RETURN
6
        END FUNCTION WORK1
7
 
8
        REAL FUNCTION WORK2(I)
9
            INTEGER I
10
            WORK2 = 2.0 * I
11
            RETURN
12
        END FUNCTION WORK2
13
 
14
        SUBROUTINE SUBA16(X, Y, INDEX, N)
15
        REAL X(*), Y(*)
16
        INTEGER INDEX(*), N
17
        INTEGER I
18
!$OMP PARALLEL DO SHARED(X, Y, INDEX, N)
19
          DO I=1,N
20
!$OMP ATOMIC
21
              X(INDEX(I)) = X(INDEX(I)) + WORK1(I)
22
            Y(I) = Y(I) + WORK2(I)
23
          ENDDO
24
      END SUBROUTINE SUBA16
25
 
26
      PROGRAM A16
27
        REAL X(1000), Y(10000)
28
        INTEGER INDEX(10000)
29
        INTEGER I
30
        DO I=1,10000
31
          INDEX(I) = MOD(I, 1000) + 1
32
          Y(I) = 0.0
33
        ENDDO
34
        DO I = 1,1000
35
          X(I) = 0.0
36
        ENDDO
37
        CALL SUBA16(X, Y, INDEX, 10000)
38
        DO I = 1,10
39
          PRINT *, "X(", I, ") = ", X(I), ", Y(", I, ") = ", Y(I)
40
        ENDDO
41
      END PROGRAM A16

powered by: WebSVN 2.1.0

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