1! FIRSTPRIVATE: CLASS(*) + intrinsic types
2program select_type_openmp
3  implicit none
4  class(*), allocatable :: val1, val1a, val2, val3
5
6  call sub() ! local var
7
8  call sub2(val1, val1a, val2, val3) ! allocatable args
9
10  allocate(val1, source=7)
11  allocate(val1a, source=7)
12  allocate(val2, source="abcdef")
13  allocate(val3, source=4_"zyx4")
14  call sub3(val1, val1a, val2, val3)  ! nonallocatable vars
15  deallocate(val1, val1a, val2, val3)
16contains
17subroutine sub()
18  class(*), allocatable :: val1, val1a, val2, val3
19  allocate(val1a, source=7)
20  allocate(val2, source="abcdef")
21  allocate(val3, source=4_"zyx4")
22
23  if (allocated(val1)) stop 1
24
25  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
26    if (allocated(val1)) stop 2
27    if (.not.allocated(val1a)) stop 3
28    if (.not.allocated(val2)) stop 4
29    if (.not.allocated(val3)) stop 5
30
31    allocate(val1, source=7)
32
33    select type (val1)
34      type is (integer)
35        if (val1 /= 7) stop 6
36        val1 = 8
37      class default
38        stop 7
39    end select
40
41    select type (val1a)
42      type is (integer)
43        if (val1a /= 7) stop 8
44        val1a = 8
45      class default
46        stop 9
47    end select
48
49    select type (val2)
50      type is (character(len=*))
51        if (len(val2) /= 6) stop 10
52        if (val2 /= "abcdef") stop 11
53        val2 = "123456"
54      class default
55        stop 12
56    end select
57
58    select type (val3)
59      type is (character(len=*, kind=4))
60        if (len(val3) /= 4) stop 13
61        if (val3 /= 4_"zyx4") stop 14
62        val3 = 4_"AbCd"
63      class default
64        stop 15
65    end select
66
67    select type (val3)
68      type is (character(len=*, kind=4))
69        if (len(val3) /= 4) stop 16
70        if (val3 /= 4_"AbCd") stop 17
71        val3 = 4_"1ab2"
72      class default
73        stop 18
74    end select
75
76    select type (val2)
77      type is (character(len=*))
78        if (len(val2) /= 6) stop 19
79        if (val2 /= "123456") stop 20
80        val2 = "A2C4E6"
81      class default
82        stop 21
83    end select
84
85    select type (val1)
86      type is (integer)
87        if (val1 /= 8) stop 22
88        val1 = 9
89      class default
90        stop 23
91    end select
92
93    select type (val1a)
94      type is (integer)
95        if (val1a /= 8) stop 24
96        val1a = 9
97      class default
98        stop 25
99    end select
100  !$OMP END PARALLEL
101
102  if (allocated(val1)) stop 26
103  if (.not. allocated(val1a)) stop 27
104  if (.not. allocated(val2)) stop 28
105
106  select type (val2)
107    type is (character(len=*))
108      if (len(val2) /= 6) stop 29
109      if (val2 /= "abcdef") stop 30
110    class default
111      stop 31
112  end select
113  select type (val3)
114    type is (character(len=*,kind=4))
115      if (len(val3) /= 4) stop 32
116      if (val3 /= 4_"zyx4") stop 33
117    class default
118      stop 34
119  end select
120  deallocate(val1a, val2, val3)
121end subroutine sub
122
123subroutine sub2(val1, val1a, val2, val3)
124  class(*), allocatable :: val1, val1a, val2, val3
125  optional :: val1a
126  allocate(val1a, source=7)
127  allocate(val2, source="abcdef")
128  allocate(val3, source=4_"zyx4")
129
130  if (allocated(val1)) stop 35
131
132  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
133    if (allocated(val1)) stop 36
134    if (.not.allocated(val1a)) stop 37
135    if (.not.allocated(val2)) stop 38
136    if (.not.allocated(val3)) stop 39
137
138    allocate(val1, source=7)
139
140    select type (val1)
141      type is (integer)
142        if (val1 /= 7) stop 40
143        val1 = 8
144      class default
145        stop 41
146    end select
147
148    select type (val1a)
149      type is (integer)
150        if (val1a /= 7) stop 42
151        val1a = 8
152      class default
153        stop 43
154    end select
155
156    select type (val2)
157      type is (character(len=*))
158        if (len(val2) /= 6) stop 44
159        if (val2 /= "abcdef") stop 45
160        val2 = "123456"
161      class default
162        stop 46
163    end select
164
165    select type (val3)
166      type is (character(len=*, kind=4))
167        if (len(val3) /= 4) stop 47
168        if (val3 /= 4_"zyx4") stop 48
169        val3 = "AbCd"
170      class default
171        stop 49
172    end select
173
174    select type (val3)
175      type is (character(len=*, kind=4))
176        if (len(val3) /= 4) stop 50
177        if (val3 /= 4_"AbCd") stop 51
178        val3 = 4_"1ab2"
179      class default
180        stop 52
181    end select
182
183    select type (val2)
184      type is (character(len=*))
185        if (len(val2) /= 6) stop 53
186        if (val2 /= "123456") stop 54
187        val2 = "A2C4E6"
188      class default
189        stop 55
190    end select
191
192    select type (val1)
193      type is (integer)
194        if (val1 /= 8) stop 56
195        val1 = 9
196      class default
197        stop 57
198    end select
199
200    select type (val1a)
201      type is (integer)
202        if (val1a /= 8) stop 58
203        val1a = 9
204      class default
205        stop 59
206    end select
207  !$OMP END PARALLEL
208
209  if (allocated(val1)) stop 60
210  if (.not. allocated(val1a)) stop 61
211  if (.not. allocated(val2)) stop 62
212
213  select type (val2)
214    type is (character(len=*))
215      if (len(val2) /= 6) stop 63
216      if (val2 /= "abcdef") stop 64
217    class default
218        stop 65
219  end select
220
221  select type (val3)
222    type is (character(len=*, kind=4))
223      if (len(val3) /= 4) stop 66
224      if (val3 /= 4_"zyx4") stop 67
225      val3 = 4_"AbCd"
226    class default
227      stop 68
228  end select
229  deallocate(val1a, val2, val3)
230end subroutine sub2
231
232subroutine sub3(val1, val1a, val2, val3)
233  class(*) :: val1, val1a, val2, val3
234  optional :: val1a
235
236  !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
237    select type (val1)
238      type is (integer)
239        if (val1 /= 7) stop 69
240        val1 = 8
241      class default
242        stop 70
243    end select
244
245    select type (val1a)
246      type is (integer)
247        if (val1a /= 7) stop 71
248        val1a = 8
249      class default
250        stop 72
251    end select
252
253    select type (val2)
254      type is (character(len=*))
255        if (len(val2) /= 6) stop 73
256        if (val2 /= "abcdef") stop 74
257        val2 = "123456"
258      class default
259        stop 75
260    end select
261
262    select type (val3)
263      type is (character(len=*, kind=4))
264        if (len(val3) /= 4) stop 76
265        if (val3 /= 4_"zyx4") stop 77
266        val3 = 4_"AbCd"
267      class default
268        stop 78
269    end select
270
271    select type (val3)
272      type is (character(len=*, kind=4))
273        if (len(val3) /= 4) stop 79
274        if (val3 /= 4_"AbCd") stop 80
275        val3 = 4_"1ab2"
276      class default
277        stop 81
278    end select
279
280    select type (val2)
281      type is (character(len=*))
282        if (len(val2) /= 6) stop 82
283        if (val2 /= "123456") stop 83
284        val2 = "A2C4E6"
285      class default
286        stop 84
287    end select
288
289    select type (val1)
290      type is (integer)
291        if (val1 /= 8) stop 85
292        val1 = 9
293      class default
294        stop 86
295    end select
296
297    select type (val1a)
298      type is (integer)
299        if (val1a /= 8) stop 87
300        val1a = 9
301      class default
302        stop 88
303    end select
304  !$OMP END PARALLEL
305
306  select type (val2)
307    type is (character(len=*))
308      if (len(val2) /= 6) stop 89
309      if (val2 /= "abcdef") stop 90
310    class default
311      stop 91
312  end select
313
314  select type (val3)
315    type is (character(len=*, kind=4))
316      if (len(val3) /= 4) stop 92
317      if (val3 /= 4_"zyx4") stop 93
318      val3 = 4_"AbCd"
319    class default
320      stop 94
321  end select
322end subroutine sub3
323end program select_type_openmp
324