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