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
|
! { dg-do run }
!
implicit none (type, external)
integer, allocatable :: a_ii, a_ival, a_iarr(:)
integer, pointer :: p_ii, p_ival, p_iarr(:)
nullify (p_ii, p_ival, p_iarr)
call sub()
call sub2()
call call_present_1()
call call_present_2()
! unallocated/disassociated actual arguments to nonallocatable, nonpointer
! dummy arguments are regarded as absent
! Skipping 'ival' dummy argument due to PR fortran/92887
call sub(ii=a_ii, iarr=a_iarr)
call sub(ii=p_ii, iarr=p_iarr)
call sub2(ii=a_ii, iarr=a_iarr)
call sub2(ii=p_ii, iarr=p_iarr)
contains
subroutine call_present_1()
integer :: ii, ival, iarr, iptr, iparr
pointer :: iptr, iparr
dimension :: iarr(2), iparr(:)
allocate(iptr,iparr(2))
ii = 101
ival = 102
iptr = 103
iarr = 104
iparr = 105
call sub_present(ii, ival, iarr, iptr, iparr)
deallocate(iptr,iparr)
end subroutine
subroutine call_present_2()
integer :: ii, ival, iarr, iptr, iparr
pointer :: iptr, iparr
dimension :: iarr(2), iparr(:)
allocate(iptr,iparr(2))
ii = 201
ival = 202
iptr = 203
iarr = 204
iparr = 205
call sub2_present(ii, ival, iarr, iptr, iparr)
deallocate(iptr,iparr)
end subroutine
subroutine sub(ii, ival, iarr, iptr, iparr)
integer, optional :: ii, ival, iarr, iptr, iparr
pointer :: iptr, iparr
dimension :: iarr(:), iparr(:)
value :: ival
integer :: err
err = 42
!$omp target map(ii, ival, iarr, iptr, iparr, err)
if (present(ii)) then
ii = iptr + ival
iarr = iparr
else
err = 0
end if
if (present(ii)) err = 1
if (present(ival)) err = 2
if (present(iarr)) err = 3
if (present(iptr)) err = 4
if (present(iparr)) err = 5
!$omp end target
if (err /= 0) stop 1
end subroutine sub
subroutine sub2(ii, ival, iarr, iptr, iparr)
integer, optional :: ii, ival, iarr, iptr, iparr
pointer :: iptr, iparr
dimension :: iarr(:), iparr(:)
value :: ival
integer :: err(1) ! otherwise, implied defaultmap is firstprivate
err(1) = 42
!$omp target ! automatic mapping with implied defaultmap(tofrom)
if (present(ii)) then
ii = iptr + ival
iarr = iparr
else
err(1) = 0
end if
if (present(ii)) err(1) = 1
if (present(ival)) err(1) = 2
if (present(iarr)) err(1) = 3
if (present(iptr)) err(1) = 4
if (present(iparr)) err(1) = 5
!$omp end target
if (err(1) /= 0) stop 2
end subroutine sub2
subroutine sub_present(ii, ival, iarr, iptr, iparr)
integer, optional :: ii, ival, iarr, iptr, iparr
pointer :: iptr, iparr
dimension :: iarr(:), iparr(:)
value :: ival
integer :: err
err = 42
!$omp target map(ii, ival, iarr, iptr, iparr, err)
if (.not.present(ii)) err = 1
if (.not.present(ival)) err = 2
if (.not.present(iarr)) err = 3
if (.not.present(iptr)) err = 4
if (.not.present(iparr)) err = 5
err = err - 42 - 101-102-103-104-105 + ii+ival+iarr(2)+iptr+iparr(2)
!$omp end target
if (err /= 0) stop 3
end subroutine sub_present
subroutine sub2_present(ii, ival, iarr, iptr, iparr)
integer, optional :: ii, ival, iarr, iptr, iparr
pointer :: iptr, iparr
dimension :: iarr(:), iparr(:)
value :: ival
integer :: err(1) ! otherwise, implied defaultmap is firstprivate
err(1) = 53
!$omp target ! automatic mapping with implied defaultmap(tofrom)
! Note: OpenMP 4.5's 'defaultmap' is not yet supported, PR 92568
if (.not.present(ii)) err = 1
if (.not.present(ival)) err = 2
if (.not.present(iarr)) err = 3
if (.not.present(iptr)) err = 4
if (.not.present(iparr)) err = 5
err = err - 53 - 201-202-203-204-205 + ii+ival+iarr(2)+iptr+iparr(2)
!$omp end target
if (err(1) /= 0) stop 4
end subroutine sub2_present
end
|
