X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=libgomp%2Ftestsuite%2Flibgomp.fortran%2Fomp_orphan.f;fp=libgomp%2Ftestsuite%2Flibgomp.fortran%2Fomp_orphan.f;h=7653c78d2e40d42d88a65b8882594bca5f32dbd6;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=0000000000000000000000000000000000000000;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git

diff --git a/libgomp/testsuite/libgomp.fortran/omp_orphan.f b/libgomp/testsuite/libgomp.fortran/omp_orphan.f
new file mode 100644
index 00000000..7653c78d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_orphan.f
@@ -0,0 +1,44 @@
+C******************************************************************************
+C FILE: omp_orphan.f
+C DESCRIPTION:
+C   OpenMP Example - Parallel region with an orphaned directive - Fortran
+C   Version
+C   This example demonstrates a dot product being performed by an orphaned
+C   loop reduction construct.  Scoping of the reduction variable is critical.
+C AUTHOR: Blaise Barney  5/99
+C LAST REVISED:
+C******************************************************************************
+
+      PROGRAM ORPHAN
+      COMMON /DOTDATA/ A, B, SUM
+      INTEGER I, VECLEN
+      PARAMETER (VECLEN = 100)
+      REAL*8 A(VECLEN), B(VECLEN), SUM
+
+      DO I=1, VECLEN
+         A(I) = 1.0 * I
+         B(I) = A(I)
+      ENDDO
+      SUM = 0.0
+!$OMP PARALLEL
+      CALL DOTPROD
+!$OMP END PARALLEL
+      WRITE(*,*) "Sum = ", SUM
+      END
+
+
+
+      SUBROUTINE DOTPROD
+      COMMON /DOTDATA/ A, B, SUM
+      INTEGER I, TID, OMP_GET_THREAD_NUM, VECLEN
+      PARAMETER (VECLEN = 100)
+      REAL*8 A(VECLEN), B(VECLEN), SUM
+
+      TID = OMP_GET_THREAD_NUM()
+!$OMP DO REDUCTION(+:SUM)
+      DO I=1, VECLEN
+         SUM = SUM + (A(I)*B(I))
+         PRINT *, '  TID= ',TID,'I= ',I
+      ENDDO
+      RETURN
+      END