libgomp/testsuite/libgomp.fortran/omp_orphan.f

   1 C******************************************************************************
   2 C FILE: omp_orphan.f
   3 C DESCRIPTION:
   4 C   OpenMP Example - Parallel region with an orphaned directive - Fortran
   5 C   Version
   6 C   This example demonstrates a dot product being performed by an orphaned
   7 C   loop reduction construct.  Scoping of the reduction variable is critical.
   8 C AUTHOR: Blaise Barney  5/99
   9 C LAST REVISED:
  10 C******************************************************************************
  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