Mercurial > hg > CbC > CbC_gcc
comparison libgomp/testsuite/libgomp.fortran/lib3.f @ 0:a06113de4d67
first commit
author | kent <kent@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Fri, 17 Jul 2009 14:47:48 +0900 |
parents | |
children | 04ced10e8804 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:a06113de4d67 |
---|---|
1 C { dg-do run } | |
2 | |
3 INCLUDE "omp_lib.h" | |
4 | |
5 DOUBLE PRECISION :: D, E | |
6 LOGICAL :: L | |
7 INTEGER (KIND = OMP_LOCK_KIND) :: LCK | |
8 INTEGER (KIND = OMP_NEST_LOCK_KIND) :: NLCK | |
9 | |
10 D = OMP_GET_WTIME () | |
11 | |
12 CALL OMP_INIT_LOCK (LCK) | |
13 CALL OMP_SET_LOCK (LCK) | |
14 IF (OMP_TEST_LOCK (LCK)) CALL ABORT | |
15 CALL OMP_UNSET_LOCK (LCK) | |
16 IF (.NOT. OMP_TEST_LOCK (LCK)) CALL ABORT | |
17 IF (OMP_TEST_LOCK (LCK)) CALL ABORT | |
18 CALL OMP_UNSET_LOCK (LCK) | |
19 CALL OMP_DESTROY_LOCK (LCK) | |
20 | |
21 CALL OMP_INIT_NEST_LOCK (NLCK) | |
22 IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 1) CALL ABORT | |
23 CALL OMP_SET_NEST_LOCK (NLCK) | |
24 IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 3) CALL ABORT | |
25 CALL OMP_UNSET_NEST_LOCK (NLCK) | |
26 CALL OMP_UNSET_NEST_LOCK (NLCK) | |
27 IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 2) CALL ABORT | |
28 CALL OMP_UNSET_NEST_LOCK (NLCK) | |
29 CALL OMP_UNSET_NEST_LOCK (NLCK) | |
30 CALL OMP_DESTROY_NEST_LOCK (NLCK) | |
31 | |
32 CALL OMP_SET_DYNAMIC (.TRUE.) | |
33 IF (.NOT. OMP_GET_DYNAMIC ()) CALL ABORT | |
34 CALL OMP_SET_DYNAMIC (.FALSE.) | |
35 IF (OMP_GET_DYNAMIC ()) CALL ABORT | |
36 | |
37 CALL OMP_SET_NESTED (.TRUE.) | |
38 IF (.NOT. OMP_GET_NESTED ()) CALL ABORT | |
39 CALL OMP_SET_NESTED (.FALSE.) | |
40 IF (OMP_GET_NESTED ()) CALL ABORT | |
41 | |
42 CALL OMP_SET_NUM_THREADS (5) | |
43 IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT | |
44 IF (OMP_GET_MAX_THREADS () .NE. 5) CALL ABORT | |
45 IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT | |
46 CALL OMP_SET_NUM_THREADS (3) | |
47 IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT | |
48 IF (OMP_GET_MAX_THREADS () .NE. 3) CALL ABORT | |
49 IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT | |
50 L = .FALSE. | |
51 C$OMP PARALLEL REDUCTION (.OR.:L) | |
52 L = OMP_GET_NUM_THREADS () .NE. 3 | |
53 L = L .OR. (OMP_GET_THREAD_NUM () .LT. 0) | |
54 L = L .OR. (OMP_GET_THREAD_NUM () .GE. 3) | |
55 C$OMP MASTER | |
56 L = L .OR. (OMP_GET_THREAD_NUM () .NE. 0) | |
57 C$OMP END MASTER | |
58 C$OMP END PARALLEL | |
59 IF (L) CALL ABORT | |
60 | |
61 IF (OMP_GET_NUM_PROCS () .LE. 0) CALL ABORT | |
62 IF (OMP_IN_PARALLEL ()) CALL ABORT | |
63 C$OMP PARALLEL REDUCTION (.OR.:L) | |
64 L = .NOT. OMP_IN_PARALLEL () | |
65 C$OMP END PARALLEL | |
66 C$OMP PARALLEL REDUCTION (.OR.:L) IF (.TRUE.) | |
67 L = .NOT. OMP_IN_PARALLEL () | |
68 C$OMP END PARALLEL | |
69 | |
70 E = OMP_GET_WTIME () | |
71 IF (D .GT. E) CALL ABORT | |
72 D = OMP_GET_WTICK () | |
73 C Negative precision is definitely wrong, | |
74 C bigger than 1s clock resolution is also strange | |
75 IF (D .LE. 0 .OR. D .GT. 1.) CALL ABORT | |
76 END |