source: CIVL/examples/omp/dataracebench-1.3.2/micro-benchmarks-fortran/DRB022-reductionmissing-var-yes.f95

main
Last change on this file was ea777aa, checked in by Alex Wilton <awilton@…>, 3 years ago

Moved examples, include, build_default.properties, common.xml, and README out from dev.civl.com into the root of the repo.

git-svn-id: svn://vsl.cis.udel.edu/civl/trunk@5704 fb995dde-84ed-4084-dfe6-e5aef3e2452c

  • Property mode set to 100755
File size: 1.8 KB
Line 
1!!!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!!!
2!!! Copyright (c) 2017-20, Lawrence Livermore National Security, LLC
3!!! and DataRaceBench project contributors. See the DataRaceBench/COPYRIGHT file for details.
4!!!
5!!! SPDX-License-Identifier: (BSD-3-Clause)
6!!!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!!!
7
8!A kernel for two level parallelizable loop with reduction:
9!if reduction(+:sum) is missing, there is race condition.
10!Data race pairs:
11! sum@60 vs. sum@60
12! sum@60 vs. sum@60
13
14program DRB022_reductionmissing_var_yes
15 use omp_lib
16 implicit none
17
18 integer :: i, j, len, argCount, allocStatus, rdErr, ix
19 real :: temp, getSum
20 character(len=80), dimension(:), allocatable :: args
21 real, dimension (:,:), allocatable :: u
22
23 len = 100
24 getSum = 0.0
25
26 argCount = command_argument_count()
27 if (argCount == 0) then
28 write (*,'(a)') "No command line arguments provided."
29 end if
30
31 allocate(args(argCount), stat=allocStatus)
32 if (allocStatus > 0) then
33 write (*,'(a)') "Allocation error, program terminated."
34 stop
35 end if
36
37 do ix = 1, argCount
38 call get_command_argument(ix,args(ix))
39 end do
40
41 if (argCount >= 1) then
42 read (args(1), '(i10)', iostat=rdErr) len
43 if (rdErr /= 0 ) then
44 write (*,'(a)') "Error, invalid integer value."
45 end if
46 end if
47
48 allocate (u(len, len))
49
50 do i = 1, len
51 do j = 1, len
52 u(i,j) = 0.5
53 end do
54 end do
55
56 !$omp parallel do private(temp, i, j)
57 do i = 1, len
58 do j = 1, len
59 temp = u(i,j)
60 getSum = getSum + temp * temp
61 end do
62 end do
63 !$omp end parallel do
64
65 print*,"sum =", getSum
66
67
68 deallocate(args,u)
69end program
Note: See TracBrowser for help on using the repository browser.