Imported gcc-4.4.3

[msp430-gcc.git] / libgomp / testsuite / libgomp.fortran / omp_orphan.f

diff --git a/libgomp/testsuite/libgomp.fortran/omp_orphan.f b/libgomp/testsuite/libgomp.fortran/omp_orphan.f
new file mode 100644 (file)
index 0000000..7653c78
--- /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