mirror of
https://github.com/OpenMP/Examples.git
synced 2025-04-04 05:41:33 +01:00
50 lines
978 B
Fortran
50 lines
978 B
Fortran
! @@name: atomic.1f
|
|
! @@type: F-fixed
|
|
! @@compilable: yes
|
|
! @@linkable: yes
|
|
! @@expect: success
|
|
REAL FUNCTION WORK1(I)
|
|
INTEGER I
|
|
WORK1 = 1.0 * I
|
|
RETURN
|
|
END FUNCTION WORK1
|
|
|
|
REAL FUNCTION WORK2(I)
|
|
INTEGER I
|
|
WORK2 = 2.0 * I
|
|
RETURN
|
|
END FUNCTION WORK2
|
|
|
|
SUBROUTINE SUB(X, Y, INDEX, N)
|
|
REAL X(*), Y(*)
|
|
INTEGER INDEX(*), N
|
|
|
|
INTEGER I
|
|
|
|
!$OMP PARALLEL DO SHARED(X, Y, INDEX, N)
|
|
DO I=1,N
|
|
!$OMP ATOMIC UPDATE
|
|
X(INDEX(I)) = X(INDEX(I)) + WORK1(I)
|
|
Y(I) = Y(I) + WORK2(I)
|
|
ENDDO
|
|
|
|
END SUBROUTINE SUB
|
|
|
|
PROGRAM ATOMIC_EXAMPLE
|
|
REAL X(1000), Y(10000)
|
|
INTEGER INDEX(10000)
|
|
INTEGER I
|
|
|
|
DO I=1,10000
|
|
INDEX(I) = MOD(I, 1000) + 1
|
|
Y(I) = 0.0
|
|
ENDDO
|
|
|
|
DO I = 1,1000
|
|
X(I) = 0.0
|
|
ENDDO
|
|
|
|
CALL SUB(X, Y, INDEX, 10000)
|
|
|
|
END PROGRAM ATOMIC_EXAMPLE
|