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