blob: b77117ec61101bd67ebe27639b58d096d5c36a91 [file] [log] [blame]
! 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