1C******************************************************************************
2C FILE: omp_orphan.f
3C DESCRIPTION:
4C   OpenMP Example - Parallel region with an orphaned directive - Fortran
5C   Version
6C   This example demonstrates a dot product being performed by an orphaned
7C   loop reduction construct.  Scoping of the reduction variable is critical.
8C AUTHOR: Blaise Barney  5/99
9C LAST REVISED:
10C******************************************************************************
11
12      PROGRAM ORPHAN
13      COMMON /DOTDATA/ A, B, SUM
14      INTEGER I, VECLEN
15      PARAMETER (VECLEN = 100)
16      REAL*8 A(VECLEN), B(VECLEN), SUM
17
18      DO I=1, VECLEN
19         A(I) = 1.0 * I
20         B(I) = A(I)
21      ENDDO
22      SUM = 0.0
23!$OMP PARALLEL
24      CALL DOTPROD
25!$OMP END PARALLEL
26      WRITE(*,*) "Sum = ", SUM
27      END
28
29
30
31      SUBROUTINE DOTPROD
32      COMMON /DOTDATA/ A, B, SUM
33      INTEGER I, TID, OMP_GET_THREAD_NUM, VECLEN
34      PARAMETER (VECLEN = 100)
35      REAL*8 A(VECLEN), B(VECLEN), SUM
36
37      TID = OMP_GET_THREAD_NUM()
38!$OMP DO REDUCTION(+:SUM)
39      DO I=1, VECLEN
40         SUM = SUM + (A(I)*B(I))
41         PRINT *, '  TID= ',TID,'I= ',I
42      ENDDO
43      RETURN
44      END
45