Mercurial > hg > CbC > CbC_gcc
view libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90 @ 158:494b0b89df80 default tip
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 25 May 2020 18:13:55 +0900 |
parents | a06113de4d67 |
children |
line wrap: on
line source
! { dg-do compile } ! { dg-options "-ffixed-form" } MODULE DATA USE OMP_LIB, ONLY: OMP_NEST_LOCK_KIND TYPE LOCKED_PAIR INTEGER A INTEGER B INTEGER (OMP_NEST_LOCK_KIND) LCK END TYPE END MODULE DATA SUBROUTINE INCR_A(P, A) ! called only from INCR_PAIR, no need to lock USE DATA TYPE(LOCKED_PAIR) :: P INTEGER A P%A = P%A + A END SUBROUTINE INCR_A SUBROUTINE INCR_B(P, B) ! called from both INCR_PAIR and elsewhere, ! so we need a nestable lock USE OMP_LIB ! or INCLUDE "omp_lib.h" USE DATA TYPE(LOCKED_PAIR) :: P INTEGER B CALL OMP_SET_NEST_LOCK(P%LCK) P%B = P%B + B CALL OMP_UNSET_NEST_LOCK(P%LCK) END SUBROUTINE INCR_B SUBROUTINE INCR_PAIR(P, A, B) USE OMP_LIB ! or INCLUDE "omp_lib.h" USE DATA TYPE(LOCKED_PAIR) :: P INTEGER A INTEGER B CALL OMP_SET_NEST_LOCK(P%LCK) CALL INCR_A(P, A) CALL INCR_B(P, B) CALL OMP_UNSET_NEST_LOCK(P%LCK) END SUBROUTINE INCR_PAIR SUBROUTINE A40(P) USE OMP_LIB ! or INCLUDE "omp_lib.h" USE DATA TYPE(LOCKED_PAIR) :: P INTEGER WORK1, WORK2, WORK3 EXTERNAL WORK1, WORK2, WORK3 !$OMP PARALLEL SECTIONS !$OMP SECTION CALL INCR_PAIR(P, WORK1(), WORK2()) !$OMP SECTION CALL INCR_B(P, WORK3()) !$OMP END PARALLEL SECTIONS END SUBROUTINE A40 ! { dg-final { cleanup-modules "data" } }