1*404b540aSrobert! { dg-do compile } 2*404b540aSrobert! { dg-options "-ffixed-form" } 3*404b540aSrobert MODULE DATA 4*404b540aSrobert USE OMP_LIB, ONLY: OMP_NEST_LOCK_KIND 5*404b540aSrobert TYPE LOCKED_PAIR 6*404b540aSrobert INTEGER A 7*404b540aSrobert INTEGER B 8*404b540aSrobert INTEGER (OMP_NEST_LOCK_KIND) LCK 9*404b540aSrobert END TYPE 10*404b540aSrobert END MODULE DATA 11*404b540aSrobert SUBROUTINE INCR_A(P, A) 12*404b540aSrobert ! called only from INCR_PAIR, no need to lock 13*404b540aSrobert USE DATA 14*404b540aSrobert TYPE(LOCKED_PAIR) :: P 15*404b540aSrobert INTEGER A 16*404b540aSrobert P%A = P%A + A 17*404b540aSrobert END SUBROUTINE INCR_A 18*404b540aSrobert SUBROUTINE INCR_B(P, B) 19*404b540aSrobert ! called from both INCR_PAIR and elsewhere, 20*404b540aSrobert ! so we need a nestable lock 21*404b540aSrobert USE OMP_LIB ! or INCLUDE "omp_lib.h" 22*404b540aSrobert USE DATA 23*404b540aSrobert TYPE(LOCKED_PAIR) :: P 24*404b540aSrobert INTEGER B 25*404b540aSrobert CALL OMP_SET_NEST_LOCK(P%LCK) 26*404b540aSrobert P%B = P%B + B 27*404b540aSrobert CALL OMP_UNSET_NEST_LOCK(P%LCK) 28*404b540aSrobert END SUBROUTINE INCR_B 29*404b540aSrobert SUBROUTINE INCR_PAIR(P, A, B) 30*404b540aSrobert USE OMP_LIB ! or INCLUDE "omp_lib.h" 31*404b540aSrobert USE DATA 32*404b540aSrobert TYPE(LOCKED_PAIR) :: P 33*404b540aSrobert INTEGER A 34*404b540aSrobert INTEGER B 35*404b540aSrobert CALL OMP_SET_NEST_LOCK(P%LCK) 36*404b540aSrobert CALL INCR_A(P, A) 37*404b540aSrobert CALL INCR_B(P, B) 38*404b540aSrobert CALL OMP_UNSET_NEST_LOCK(P%LCK) 39*404b540aSrobert END SUBROUTINE INCR_PAIR 40*404b540aSrobert SUBROUTINE A40(P) 41*404b540aSrobert USE OMP_LIB ! or INCLUDE "omp_lib.h" 42*404b540aSrobert USE DATA 43*404b540aSrobert TYPE(LOCKED_PAIR) :: P 44*404b540aSrobert INTEGER WORK1, WORK2, WORK3 45*404b540aSrobert EXTERNAL WORK1, WORK2, WORK3 46*404b540aSrobert!$OMP PARALLEL SECTIONS 47*404b540aSrobert!$OMP SECTION 48*404b540aSrobert CALL INCR_PAIR(P, WORK1(), WORK2()) 49*404b540aSrobert!$OMP SECTION 50*404b540aSrobert CALL INCR_B(P, WORK3()) 51*404b540aSrobert!$OMP END PARALLEL SECTIONS 52*404b540aSrobert END SUBROUTINE A40 53