libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90

   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