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