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