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