OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgomp/] [testsuite/] [libgomp.fortran/] [omp_orphan.f] - Blame information for rev 735

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 735 jeremybenn
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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.