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