Mercurial > hg > CbC > CbC_gcc

comparison libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90 @ 0:a06113de4d67

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
first commit
author kent <kent@cr.ie.u-ryukyu.ac.jp>
date Fri, 17 Jul 2009 14:47:48 +0900
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:a06113de4d67
1 ! { dg-do compile }
2 ! { dg-options "-ffixed-form" }
3 MODULE DATA
4 USE OMP_LIB, ONLY: OMP_NEST_LOCK_KIND
5 TYPE LOCKED_PAIR
6 INTEGER A
7 INTEGER B
8 INTEGER (OMP_NEST_LOCK_KIND) LCK
9 END TYPE
10 END MODULE DATA
11 SUBROUTINE INCR_A(P, A)
12 ! called only from INCR_PAIR, no need to lock
13 USE DATA
14 TYPE(LOCKED_PAIR) :: P
15 INTEGER A
16 P%A = P%A + A
17 END SUBROUTINE INCR_A
18 SUBROUTINE INCR_B(P, B)
19 ! called from both INCR_PAIR and elsewhere,
20 ! so we need a nestable lock
21 USE OMP_LIB ! or INCLUDE "omp_lib.h"
22 USE DATA
23 TYPE(LOCKED_PAIR) :: P
24 INTEGER B
25 CALL OMP_SET_NEST_LOCK(P%LCK)
26 P%B = P%B + B
27 CALL OMP_UNSET_NEST_LOCK(P%LCK)
28 END SUBROUTINE INCR_B
29 SUBROUTINE INCR_PAIR(P, A, B)
30 USE OMP_LIB ! or INCLUDE "omp_lib.h"
31 USE DATA
32 TYPE(LOCKED_PAIR) :: P
33 INTEGER A
34 INTEGER B
35 CALL OMP_SET_NEST_LOCK(P%LCK)
36 CALL INCR_A(P, A)
37 CALL INCR_B(P, B)
38 CALL OMP_UNSET_NEST_LOCK(P%LCK)
39 END SUBROUTINE INCR_PAIR
40 SUBROUTINE A40(P)
41 USE OMP_LIB ! or INCLUDE "omp_lib.h"
42 USE DATA
43 TYPE(LOCKED_PAIR) :: P
44 INTEGER WORK1, WORK2, WORK3
45 EXTERNAL WORK1, WORK2, WORK3
46 !$OMP PARALLEL SECTIONS
47 !$OMP SECTION
48 CALL INCR_PAIR(P, WORK1(), WORK2())
49 !$OMP SECTION
50 CALL INCR_B(P, WORK3())
51 !$OMP END PARALLEL SECTIONS
52 END SUBROUTINE A40
53
54 ! { dg-final { cleanup-modules "data" } }