libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90

   1 ! { 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