|
0
|
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" } }
|
