以下例子来自https://computing.llnl.gov/tutorials/openMP/exercise.html网站
一、打印线程（Hello world）
C******************************************************************************
C FILE: omp_hello.f
C DESCRIPTION:
C OpenMP Example - Hello World - Fortran Version
C In this simple example, the master thread forks a parallel region.
C All threads in the team obtain their unique thread number and print it.
C The master thread only prints the total number of threads. Two OpenMP
C library routines are used to obtain the number of threads and each
C thread's number.
C AUTHOR: Blaise Barney 5/99
C LAST REVISED:
C******************************************************************************
PROGRAM HELLO
INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM
C Fork a team of threads giving them their own copies of variables
!$OMP PARALLEL PRIVATE(NTHREADS, TID)
C Obtain thread number
TID = OMP_GET_THREAD_NUM()
PRINT *, 'Hello World from thread = ', TID
C Only master thread does this
IF (TID .EQ. 0) THEN
NTHREADS = OMP_GET_NUM_THREADS()
PRINT *, 'Number of threads = ', NTHREADS
END IF
C All threads join master thread and disband
!$OMP END PARALLEL
END
二、循环（Loop work-sharing）
1 C****************************************************************************** 2 C FILE: omp_workshare1.f 3 C DESCRIPTION: 4 C OpenMP Example - Loop Work-sharing - Fortran Version 5 C In this example, the iterations of a loop are scheduled dynamically 6 C across the team of threads. A thread will perform CHUNK iterations 7 C at a time before being scheduled for the next CHUNK of work. 8 C AUTHOR: Blaise Barney 5/99 9 C LAST REVISED: 01/09/04 10 C****************************************************************************** 11 12 PROGRAM WORKSHARE1 13 14 INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS, 15 + OMP_GET_THREAD_NUM, N, CHUNKSIZE, CHUNK, I 16 PARAMETER (N=100) 17 PARAMETER (CHUNKSIZE=10) 18 REAL A(N), B(N), C(N) 19 20 ! Some initializations 21 DO I = 1, N 22 A(I) = I * 1.0 23 B(I) = A(I) 24 ENDDO 25 CHUNK = CHUNKSIZE 26 27 !$OMP PARALLEL SHARED(A,B,C,NTHREADS,CHUNK) PRIVATE(I,TID) 28 29 TID = OMP_GET_THREAD_NUM() 30 IF (TID .EQ. 0) THEN 31 NTHREADS = OMP_GET_NUM_THREADS() 32 PRINT *, 'Number of threads =', NTHREADS 33 END IF 34 PRINT *, 'Thread',TID,' starting...' 35 !$OMP DO SCHEDULE(DYNAMIC,CHUNK) 36 DO I = 1, N 37 C(I) = A(I) + B(I) 38 WRITE(*,100) TID,I,C(I) 39 100 FORMAT(' Thread',I2,': C(',I3,')=',F8.2) 40 ENDDO 41 !$OMP END DO NOWAIT 42 PRINT *, 'Thread',TID,' done.' 43 !$OMP END PARALLEL 44 45 END
三、Sections work-sharing
C****************************************************************************** C FILE: omp_workshare2.f C DESCRIPTION: C OpenMP Example - Sections Work-sharing - Fortran Version C In this example, the OpenMP SECTION directive is used to assign C different array operations to each thread that executes a SECTION. C AUTHOR: Blaise Barney 5/99 C LAST REVISED: 07/16/07 C****************************************************************************** PROGRAM WORKSHARE2 INTEGER N, I, NTHREADS, TID, OMP_GET_NUM_THREADS, + OMP_GET_THREAD_NUM PARAMETER (N=50) REAL A(N), B(N), C(N), D(N) ! Some initializations DO I = 1, N A(I) = I * 1.5 B(I) = I + 22.35 C(N) = 0.0 D(N) = 0.0 ENDDO !$OMP PARALLEL SHARED(A,B,C,D,NTHREADS), PRIVATE(I,TID) TID = OMP_GET_THREAD_NUM() IF (TID .EQ. 0) THEN NTHREADS = OMP_GET_NUM_THREADS() PRINT *, 'Number of threads =', NTHREADS END IF PRINT *, 'Thread',TID,' starting...' !$OMP SECTIONS !$OMP SECTION PRINT *, 'Thread',TID,' doing section 1' DO I = 1, N C(I) = A(I) + B(I) WRITE(*,100) TID,I,C(I) 100 FORMAT(' Thread',I2,': C(',I2,')=',F8.2) ENDDO !$OMP SECTION PRINT *, 'Thread',TID,' doing section 2' DO I = 1, N D(I) = A(I) * B(I) WRITE(*,100) TID,I,D(I) ENDDO !$OMP END SECTIONS NOWAIT PRINT *, 'Thread',TID,' done.' !$OMP END PARALLEL END
四、Combined parallel loop reduction
C****************************************************************************** C FILE: omp_reduction.f C DESCRIPTION: C OpenMP Example - Combined Parallel Loop Reduction - Fortran Version C This example demonstrates a sum reduction within a combined parallel loop C construct. Notice that default data element scoping is assumed - there C are no clauses specifying shared or private variables. OpenMP will C automatically make loop index variables private within team threads, and C global variables shared. C AUTHOR: Blaise Barney 5/99 C LAST REVISED: C****************************************************************************** PROGRAM REDUCTION INTEGER I, N REAL A(100), B(100), SUM ! Some initializations N = 100 DO I = 1, N A(I) = I *1.0 B(I) = A(I) ENDDO SUM = 0.0 !$OMP PARALLEL DO REDUCTION(+:SUM) DO I = 1, N SUM = SUM + (A(I) * B(I)) ENDDO PRINT *, ' Sum = ', SUM END
五、Orphaned parallel loop reduction
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
六、Matrix multiply
C****************************************************************************** C FILE: omp_mm.f C DESCRIPTION: C OpenMp Example - Matrix Multiply - Fortran Version C Demonstrates a matrix multiply using OpenMP. Threads share row iterations C according to a predefined chunk size. C AUTHOR: Blaise Barney C LAST REVISED: 1/5/04 Blaise Barney C****************************************************************************** PROGRAM MATMULT INTEGER NRA, NCA, NCB, TID, NTHREADS, I, J, K, CHUNK, + OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM C number of rows in matrix A PARAMETER (NRA=62) C number of columns in matrix A PARAMETER (NCA=15) C number of columns in matrix B PARAMETER (NCB=7) REAL*8 A(NRA,NCA), B(NCA,NCB), C(NRA,NCB) C Set loop iteration chunk size CHUNK = 10 C Spawn a parallel region explicitly scoping all variables !$OMP PARALLEL SHARED(A,B,C,NTHREADS,CHUNK) PRIVATE(TID,I,J,K) TID = OMP_GET_THREAD_NUM() IF (TID .EQ. 0) THEN NTHREADS = OMP_GET_NUM_THREADS() PRINT *, 'Starting matrix multiple example with', NTHREADS, + 'threads' PRINT *, 'Initializing matrices' END IF C Initialize matrices !$OMP DO SCHEDULE(STATIC, CHUNK) DO 30 I=1, NRA DO 30 J=1, NCA A(I,J) = (I-1)+(J-1) 30 CONTINUE !$OMP DO SCHEDULE(STATIC, CHUNK) DO 40 I=1, NCA DO 40 J=1, NCB B(I,J) = (I-1)*(J-1) 40 CONTINUE !$OMP DO SCHEDULE(STATIC, CHUNK) DO 50 I=1, NRA DO 50 J=1, NCB C(I,J) = 0 50 CONTINUE C Do matrix multiply sharing iterations on outer loop C Display who does which iterations for demonstration purposes PRINT *, 'Thread', TID, 'starting matrix multiply...' !$OMP DO SCHEDULE(STATIC, CHUNK) DO 60 I=1, NRA PRINT *, 'Thread', TID, 'did row', I DO 60 J=1, NCB DO 60 K=1, NCA C(I,J) = C(I,J) + A(I,K) * B(K,J) 60 CONTINUE C End of parallel region !$OMP END PARALLEL C Print results PRINT *, '******************************************************' PRINT *, 'Result Matrix:' DO 90 I=1, NRA DO 80 J=1, NCB WRITE(*,70) C(I,J) 70 FORMAT(2x,f8.2,$) 80 CONTINUE PRINT *, ' ' 90 CONTINUE PRINT *, '******************************************************' PRINT *, 'Done.' END
七、Get and print environment information
C****************************************************************************** C FILE: omp_getEnvInfo.f C DESCRIPTION: C OpenMP Example - Get Environment Information - Fortran Version C The master thread queries and prints selected environment information. C AUTHOR: Blaise Barney 7/06 C LAST REVISED: 07/12/06 C****************************************************************************** PROGRAM GETINFO INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS, + OMP_GET_THREAD_NUM, OMP_GET_NUM_PROCS, OMP_GET_MAX_THREADS, + OMP_IN_PARALLEL, OMP_GET_DYNAMIC, OMP_GET_NESTED, + PROCS, MAXT C These are for AIX compilations C INTEGER INPAR, DYNAMIC, NESTED C These are for non-AIX compilations LOGICAL INPAR, DYNAMIC, NESTED C Start parallel region !$OMP PARALLEL PRIVATE(NTHREADS, TID) C Obtain thread number TID = OMP_GET_THREAD_NUM() C Only master thread does this IF (TID .EQ. 0) THEN PRINT *, 'Thread',tid,'getting environment information' C Get environment information PROCS = OMP_GET_NUM_PROCS() NTHREADS = OMP_GET_NUM_THREADS() MAXT = OMP_GET_MAX_THREADS() INPAR = OMP_IN_PARALLEL() DYNAMIC = OMP_GET_DYNAMIC() NESTED = OMP_GET_NESTED() C Print environment information PRINT *, 'Number of processors = ', PROCS PRINT *, 'Number of threads = ', NTHREADS PRINT *, 'Max threads = ', MAXT PRINT *, 'In parallel? = ', INPAR PRINT *, 'Dynamic threads enabled? = ', DYNAMIC PRINT *, 'Nested parallelism supported? = ', NESTED END IF C Done !$OMP END PARALLEL END
八、Programs with bugs
（1)omp_bug1.f
C****************************************************************************** C FILE: omp_bug1.f C DESCRIPTION: C This example attempts to show use of the PARALLEL DO construct. However C it will generate errors at compile time. Try to determine what is causing C the error. See omp_bug1fix.f for a corrected version. C AUTHOR: Blaise Barney 5/99 C LAST REVISED: C****************************************************************************** PROGRAM WORKSHARE3 INTEGER TID, OMP_GET_THREAD_NUM, N, I, CHUNKSIZE, CHUNK PARAMETER (N=50) PARAMETER (CHUNKSIZE=5) REAL A(N), B(N), C(N) ! Some initializations DO I = 1, N A(I) = I * 1.0 B(I) = A(I) ENDDO CHUNK = CHUNKSIZE !$OMP PARALLEL DO SHARED(A,B,C,CHUNK) !$OMP& PRIVATE(I,TID) !$OMP& SCHEDULE(STATIC,CHUNK) TID = OMP_GET_THREAD_NUM() DO I = 1, N C(I) = A(I) + B(I) PRINT *,'TID= ',TID,'I= ',I,'C(I)= ',C(I) ENDDO !$OMP END PARALLEL DO END
C****************************************************************************** C FILE: omp_bug1fix.f C DESCRIPTION: C This is a corrected version of the omp_bug1fix.f example. Corrections C include removing all statements between the PARALLEL DO construct and C the actual DO loop, and introducing logic to preserve the ability to C query a thread's id and print it from inside the DO loop. C AUTHOR: Blaise Barney 5/99 C LAST REVISED: C****************************************************************************** PROGRAM WORKSHARE4 INTEGER TID, OMP_GET_THREAD_NUM, N, I, CHUNKSIZE, CHUNK PARAMETER (N=50) PARAMETER (CHUNKSIZE=5) REAL A(N), B(N), C(N) CHARACTER FIRST_TIME ! Some initializations DO I = 1, N A(I) = I * 1.0 B(I) = A(I) ENDDO CHUNK = CHUNKSIZE FIRST_TIME = 'Y' !$OMP PARALLEL DO SHARED(A,B,C,CHUNK) !$OMP& PRIVATE(I,TID) !$OMP& SCHEDULE(STATIC,CHUNK) !$OMP& FIRSTPRIVATE(FIRST_TIME) DO I = 1, N IF (FIRST_TIME .EQ. 'Y') THEN TID = OMP_GET_THREAD_NUM() FIRST_TIME = 'N' ENDIF C(I) = A(I) + B(I) PRINT *,'TID= ',TID,'I= ',I,'C(I)= ',C(I) ENDDO !$OMP END PARALLEL DO END
（3）omp_bug2.f
C****************************************************************************** C FILE: omp_bug2.f C DESCRIPTION: C Another OpenMP program with a bug C AUTHOR: Blaise Barney 1/7/04 C LAST REVISED: C****************************************************************************** PROGRAM BUG2 INTEGER NTHREADS, I, TID, OMP_GET_NUM_THREADS, + OMP_GET_THREAD_NUM REAL*8 TOTAL C Spawn parallel region !$OMP PARALLEL C Obtain thread number TID = OMP_GET_THREAD_NUM() C Only master thread does this IF (TID .EQ. 0) THEN NTHREADS = OMP_GET_NUM_THREADS() PRINT *, 'Number of threads = ', NTHREADS END IF PRINT *, 'Thread ',TID,'is starting...' !$OMP BARRIER C Do some work TOTAL = 0.0 !$OMP DO SCHEDULE(DYNAMIC,10) DO I=1, 1000000 TOTAL = TOTAL + I * 1.0 END DO WRITE(*,100) TID,TOTAL 100 FORMAT('Thread',I2,' is done! Total= ',E12.6) !$OMP END PARALLEL END
（4）omp_bug3.f
C****************************************************************************** C FILE: omp_bug3.f C DESCRIPTION: C Run time bug C AUTHOR: Blaise Barney 01/09/04 C LAST REVISED: 06/28/05 C****************************************************************************** PROGRAM BUG3 INTEGER N, I, NTHREADS, TID, SECTION, OMP_GET_NUM_THREADS, + OMP_GET_THREAD_NUM PARAMETER (N=50) REAL A(N), B(N), C(N) C Some initializations DO I = 1, N A(I) = I * 1.0 B(I) = A(I) ENDDO !$OMP PARALLEL PRIVATE(C,I,TID,SECTION) TID = OMP_GET_THREAD_NUM() IF (TID .EQ. 0) THEN NTHREADS = OMP_GET_NUM_THREADS() PRINT *, 'Number of threads = ', NTHREADS END IF C Use barriers for clean output !$OMP BARRIER PRINT *, 'Thread ',TID,' starting...' !$OMP BARRIER !$OMP SECTIONS !$OMP SECTION SECTION = 1 DO I = 1, N C(I) = A(I) * B(I) ENDDO CALL PRINT_RESULTS(C, TID, SECTION) !$OMP SECTION SECTION = 2 DO I = 1, N C(I) = A(I) + B(I) ENDDO CALL PRINT_RESULTS(C, TID, SECTION) !$OMP END SECTIONS C Use barrier for clean output !$OMP BARRIER PRINT *, 'Thread',tid,' exiting...' !$OMP END PARALLEL END SUBROUTINE PRINT_RESULTS(C, TID, SECTION) INTEGER TID, SECTION, N, I, J PARAMETER (N=50) REAL C(N) J = 1 C Use critical for clean output !$OMP CRITICAL PRINT *, ' ' PRINT *, 'Thread',TID,' did section',SECTION DO I=1, N WRITE(*,100) C(I) 100 FORMAT(E12.6,$) J = J + 1 IF (J .EQ. 6) THEN PRINT *, ' ' J = 1 END IF END DO PRINT *, ' ' !$OMP END CRITICAL !$OMP BARRIER PRINT *,'Thread',TID,' done and synchronized' END SUBROUTINE PRINT_RESULTS
(4)omp_bug4.f
C****************************************************************************** C FILE: omp_bug4.f C DESCRIPTION: C This very simple program causes a segmentation fault. C AUTHOR: Blaise Barney 01/09/04 C LAST REVISED: C****************************************************************************** PROGRAM BUG4 INTEGER N, NTHREADS, TID, I, J, OMP_GET_NUM_THREADS, + OMP_GET_THREAD_NUM PARAMETER(N=1048) REAL*8 A(N,N) C Fork a team of threads with explicit variable scoping !$OMP PARALLEL SHARED(NTHREADS) PRIVATE(I,J,TID,A) C Obtain/print thread info TID = OMP_GET_THREAD_NUM() IF (TID .EQ. 0) THEN NTHREADS = OMP_GET_NUM_THREADS() PRINT *, 'Number of threads = ', NTHREADS END IF PRINT *, 'Thread',TID,' starting...' C Each thread works on its own private copy of the array DO I=1,N DO J=1,N A(J,I) = TID + I + J END DO END DO C For confirmation PRINT *, 'Thread',TID,'done. Last element=',A(N,N) C All threads join master thread and disband !$OMP END PARALLEL END
(5)omp_bug4fix.f
#!/bin/csh #****************************************************************************** # FILE: omp_bug4fix # DESCRIPTION: # This script is used to set the thread stack size limit to accomodate # the omp_bug4 example. The example code requires @16MB per thread. For # safety, this script sets the stack limit to 20MB. Note that the way # to do this differs between architectures. # AUTHOR: Blaise Barney 01/12/04 # LAST REVISED: #*****************************************************************************/ # This is for all systems limit stacksize unlimited # This is for IBM AIX systems setenv XLSMPOPTS "stack=20000000" # This is for Linux systems setenv KMP_STACKSIZE 20000000 # This is for HP/Compaq Tru64 systems setenv MP_STACK_SIZE 20000000 # Now call the executable - change the name to match yours omp_bug4
(6)omp_bug5.f
C****************************************************************************** C FILE: omp_bug5.f C DESCRIPTION: C Using SECTIONS, two threads initialize their own array and then add C it to the other's array, however a deadlock occurs. C AUTHOR: Blaise Barney 01/09/04 C LAST REVISED: C****************************************************************************** PROGRAM BUG5 INTEGER*8 LOCKA, LOCKB INTEGER NTHREADS, TID, I, + OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM PARAMETER (N=1000000) REAL A(N), B(N), PI, DELTA PARAMETER (PI=3.1415926535) PARAMETER (DELTA=.01415926535) C Initialize the locks CALL OMP_INIT_LOCK(LOCKA) CALL OMP_INIT_LOCK(LOCKB) C Fork a team of threads giving them their own copies of variables !$OMP PARALLEL SHARED(A, B, NTHREADS, LOCKA, LOCKB) PRIVATE(TID) C Obtain thread number and number of threads TID = OMP_GET_THREAD_NUM() !$OMP MASTER NTHREADS = OMP_GET_NUM_THREADS() PRINT *, 'Number of threads = ', NTHREADS !$OMP END MASTER PRINT *, 'Thread', TID, 'starting...' !$OMP BARRIER !$OMP SECTIONS !$OMP SECTION PRINT *, 'Thread',TID,' initializing A()' CALL OMP_SET_LOCK(LOCKA) DO I = 1, N A(I) = I * DELTA ENDDO CALL OMP_SET_LOCK(LOCKB) PRINT *, 'Thread',TID,' adding A() to B()' DO I = 1, N B(I) = B(I) + A(I) ENDDO CALL OMP_UNSET_LOCK(LOCKB) CALL OMP_UNSET_LOCK(LOCKA) !$OMP SECTION PRINT *, 'Thread',TID,' initializing B()' CALL OMP_SET_LOCK(LOCKB) DO I = 1, N B(I) = I * PI ENDDO CALL OMP_SET_LOCK(LOCKA) PRINT *, 'Thread',TID,' adding B() to A()' DO I = 1, N A(I) = A(I) + B(I) ENDDO CALL OMP_UNSET_LOCK(LOCKA) CALL OMP_UNSET_LOCK(LOCKB) !$OMP END SECTIONS NOWAIT PRINT *, 'Thread',TID,' done.' !$OMP END PARALLEL END
C****************************************************************************** C FILE: omp_bug5fix.f C DESCRIPTION: C The problem in omp_bug5.f is that the first thread acquires locka and then C tries to get lockb before releasing locka. Meanwhile, the second thread C has acquired lockb and then tries to get locka before releasing lockb. C This solution overcomes the deadlock by using locks correctly. C AUTHOR: Blaise Barney 01/09/04 C LAST REVISED: C****************************************************************************** PROGRAM BUG5 INTEGER*8 LOCKA, LOCKB INTEGER NTHREADS, TID, I, + OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM PARAMETER (N=1000000) REAL A(N), B(N), PI, DELTA PARAMETER (PI=3.1415926535) PARAMETER (DELTA=.01415926535) C Initialize the locks CALL OMP_INIT_LOCK(LOCKA) CALL OMP_INIT_LOCK(LOCKB) C Fork a team of threads giving them their own copies of variables !$OMP PARALLEL SHARED(A, B, NTHREADS, LOCKA, LOCKB) PRIVATE(TID) C Obtain thread number and number of threads TID = OMP_GET_THREAD_NUM() !$OMP MASTER NTHREADS = OMP_GET_NUM_THREADS() PRINT *, 'Number of threads = ', NTHREADS !$OMP END MASTER PRINT *, 'Thread', TID, 'starting...' !$OMP BARRIER !$OMP SECTIONS !$OMP SECTION PRINT *, 'Thread',TID,' initializing A()' CALL OMP_SET_LOCK(LOCKA) DO I = 1, N A(I) = I * DELTA ENDDO CALL OMP_UNSET_LOCK(LOCKA) CALL OMP_SET_LOCK(LOCKB) PRINT *, 'Thread',TID,' adding A() to B()' DO I = 1, N B(I) = B(I) + A(I) ENDDO CALL OMP_UNSET_LOCK(LOCKB) !$OMP SECTION PRINT *, 'Thread',TID,' initializing B()' CALL OMP_SET_LOCK(LOCKB) DO I = 1, N B(I) = I * PI ENDDO CALL OMP_UNSET_LOCK(LOCKB) CALL OMP_SET_LOCK(LOCKA) PRINT *, 'Thread',TID,' adding B() to A()' DO I = 1, N A(I) = A(I) + B(I) ENDDO CALL OMP_UNSET_LOCK(LOCKA) !$OMP END SECTIONS NOWAIT PRINT *, 'Thread',TID,' done.' !$OMP END PARALLEL END
(8)omp_bug6.f
C****************************************************************************** C FILE: omp_bug6.f C DESCRIPTION: C This program compiles and runs fine, but produces the wrong result. C Compare to omp_orphan.f. C AUTHOR: Blaise Barney 6/05 C LAST REVISED: 06/27/05 C****************************************************************************** PROGRAM ORPHAN COMMON /DOTDATA/ A, B INTEGER I, VECLEN REAL*8 SUM PARAMETER (VECLEN = 100) REAL*8 A(VECLEN), B(VECLEN) DO I=1, VECLEN A(I) = 1.0 * I B(I) = A(I) ENDDO SUM = 0.0 !$OMP PARALLEL SHARED (SUM) CALL DOTPROD !$OMP END PARALLEL WRITE(*,*) "Sum = ", SUM END SUBROUTINE DOTPROD COMMON /DOTDATA/ A, B INTEGER I, TID, OMP_GET_THREAD_NUM, VECLEN c REAL*8 SUM PARAMETER (VECLEN = 100) REAL*8 A(VECLEN), B(VECLEN) 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