mirror of
https://forge.sourceware.org/marek/gcc.git
synced 2026-02-22 03:47:02 -05:00
99cd28c473
When mapping an allocatable variable (or derived-type component), explicitly or implicitly, all its allocated allocatable components will automatically be mapped. The patch implements the target hooks, added for this feature to omp-low.cc with commit r15-3895-ge4a58b6f28383c. Namely, there is a check whether there are allocatable components at all: gfc_omp_deep_mapping_p. Then gfc_omp_deep_mapping_cnt, counting the number of required mappings; this is a dynamic value as it depends on array bounds and whether an allocatable is allocated or not. And, finally, the actual mapping: gfc_omp_deep_mapping. Polymorphic variables are partially supported: the mapping of the _data component is fully supported, but only components of the declared type are processed for additional allocatables. Additionally, _vptr is not touched. This means that everything needing _vtab information requires unified shared memory; in particular, _size data is required when accessing elements of polymorphic arrays. However, for scalar arrays, accessing components of the declare type should work just fine. As polymorphic variables are not (really) supported and OpenMP 6 explicitly disallows them, there is now a warning (-Wopenmp) when they are encountered. Unlimited polymorphics are rejected (error). Additionally, PRIVATE and FIRSTPRIVATE are not quite supported for allocatable components, polymorphic components and as polymorphic variable. Thus, those are now rejected as well. gcc/fortran/ChangeLog: * f95-lang.cc (LANG_HOOKS_OMP_DEEP_MAPPING, LANG_HOOKS_OMP_DEEP_MAPPING_P, LANG_HOOKS_OMP_DEEP_MAPPING_CNT): Define. * openmp.cc (gfc_match_omp_clause_reduction): Fix location setting. (resolve_omp_clauses): Permit allocatable components, reject them and polymorphic variables in PRIVATE/FIRSTPRIVATE. * trans-decl.cc (add_clause): Set clause location. * trans-openmp.cc (gfc_has_alloc_comps): Add ptr_ok and shallow_alloc_only Boolean arguments. (gfc_omp_replace_alloc_by_to_mapping): New. (gfc_omp_private_outer_ref, gfc_walk_alloc_comps, gfc_omp_clause_default_ctor, gfc_omp_clause_copy_ctor, gfc_omp_clause_assign_op, gfc_omp_clause_dtor): Update call to it. (gfc_omp_finish_clause): Minor cleanups, improve location data, handle allocatable components. (gfc_omp_deep_mapping_map, gfc_omp_deep_mapping_item, gfc_omp_deep_mapping_comps, gfc_omp_gen_simple_loop, gfc_omp_get_array_size, gfc_omp_elmental_loop, gfc_omp_deep_map_kind_p, gfc_omp_deep_mapping_int_p, gfc_omp_deep_mapping_p, gfc_omp_deep_mapping_do, gfc_omp_deep_mapping_cnt, gfc_omp_deep_mapping): New. (gfc_trans_omp_array_section): Save array descriptor in case deep-mapping lang hook will need it. (gfc_trans_omp_clauses): Likewise; use better clause location data. * trans.h (gfc_omp_deep_mapping_p, gfc_omp_deep_mapping_cnt, gfc_omp_deep_mapping): Add function prototypes. libgomp/ChangeLog: * libgomp.texi (5.0 Impl. Status): Mark mapping alloc comps as 'Y'. * testsuite/libgomp.fortran/allocatable-comp.f90: New test. * testsuite/libgomp.fortran/map-alloc-comp-3.f90: New test. * testsuite/libgomp.fortran/map-alloc-comp-4.f90: New test. * testsuite/libgomp.fortran/map-alloc-comp-5.f90: New test. * testsuite/libgomp.fortran/map-alloc-comp-6.f90: New test. * testsuite/libgomp.fortran/map-alloc-comp-7.f90: New test. * testsuite/libgomp.fortran/map-alloc-comp-8.f90: New test. * testsuite/libgomp.fortran/map-alloc-comp-9.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/map-alloc-comp-1.f90: Remove dg-error. * gfortran.dg/gomp/polymorphic-mapping-2.f90: Update warn wording. * gfortran.dg/gomp/polymorphic-mapping.f90: Change expected diagnostic; some tests moved to ... * gfortran.dg/gomp/polymorphic-mapping-1.f90: ... here as new test. * gfortran.dg/gomp/polymorphic-mapping-3.f90: New test. * gfortran.dg/gomp/polymorphic-mapping-4.f90: New test. * gfortran.dg/gomp/polymorphic-mapping-5.f90: New test.
673 lines
24 KiB
Fortran
673 lines
24 KiB
Fortran
module m
|
|
implicit none (type, external)
|
|
type t
|
|
integer, allocatable :: arr(:,:)
|
|
integer :: var
|
|
integer, allocatable :: slr
|
|
end type t
|
|
|
|
contains
|
|
|
|
subroutine check_it (is_present, dummy_alloced, inner_alloc, &
|
|
scalar, array, a_scalar, a_array, &
|
|
l_scalar, l_array, la_scalar, la_array, &
|
|
opt_scalar, opt_array, a_opt_scalar, a_opt_array)
|
|
type(t), intent(inout) :: &
|
|
scalar, array(:,:), opt_scalar, opt_array(:,:), a_scalar, a_array(:,:), &
|
|
a_opt_scalar, a_opt_array(:,:), &
|
|
l_scalar, l_array(:,:), la_scalar, la_array(:,:)
|
|
optional :: opt_scalar, opt_array, a_opt_scalar, a_opt_array
|
|
allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array, la_scalar, la_array
|
|
logical, value :: is_present, dummy_alloced, inner_alloc
|
|
integer :: i, j, k, l
|
|
|
|
! CHECK VALUE
|
|
if (scalar%var /= 42) stop 1
|
|
if (l_scalar%var /= 42) stop 1
|
|
if (is_present) then
|
|
if (opt_scalar%var /= 42) stop 2
|
|
end if
|
|
if (any (shape(array) /= [3,2])) stop 1
|
|
if (any (shape(l_array) /= [3,2])) stop 1
|
|
if (is_present) then
|
|
if (any (shape(opt_array) /= [3,2])) stop 1
|
|
end if
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
if (array(i,j)%var /= i*97 + 100*41*j) stop 3
|
|
if (l_array(i,j)%var /= i*97 + 100*41*j) stop 3
|
|
if (is_present) then
|
|
if (opt_array(i,j)%var /= i*97 + 100*41*j) stop 4
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
if (dummy_alloced) then
|
|
if (a_scalar%var /= 42) stop 1
|
|
if (la_scalar%var /= 42) stop 1
|
|
if (is_present) then
|
|
if (a_opt_scalar%var /= 42) stop 1
|
|
end if
|
|
if (any (shape(a_array) /= [3,2])) stop 1
|
|
if (any (shape(la_array) /= [3,2])) stop 1
|
|
if (is_present) then
|
|
if (any (shape(a_opt_array) /= [3,2])) stop 1
|
|
end if
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
if (a_array(i,j)%var /= i*97 + 100*41*j) stop 1
|
|
if (la_array(i,j)%var /= i*97 + 100*41*j) stop 1
|
|
if (is_present) then
|
|
if (a_opt_array(i,j)%var /= i*97 + 100*41*j) stop 1
|
|
end if
|
|
end do
|
|
end do
|
|
else
|
|
if (allocated (a_scalar)) stop 1
|
|
if (allocated (la_scalar)) stop 1
|
|
if (allocated (a_array)) stop 1
|
|
if (allocated (la_array)) stop 1
|
|
if (is_present) then
|
|
if (allocated (a_opt_scalar)) stop 1
|
|
if (allocated (a_opt_array)) stop 1
|
|
end if
|
|
end if
|
|
|
|
if (inner_alloc) then
|
|
if (scalar%slr /= 467) stop 5
|
|
if (l_scalar%slr /= 467) stop 5
|
|
if (a_scalar%slr /= 467) stop 6
|
|
if (la_scalar%slr /= 467) stop 6
|
|
if (is_present) then
|
|
if (opt_scalar%slr /= 467) stop 7
|
|
if (a_opt_scalar%slr /= 467) stop 8
|
|
end if
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
if (array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 9
|
|
if (l_array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 9
|
|
if (a_array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 10
|
|
if (la_array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 10
|
|
if (is_present) then
|
|
if (opt_array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 11
|
|
if (a_opt_array(i,j)%slr /= (i*97 + 100*41*j) + 467) stop 12
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
do l = 1, 5
|
|
do k = 1, 4
|
|
if (any (shape(scalar%arr) /= [4,5])) stop 1
|
|
if (any (shape(l_scalar%arr) /= [4,5])) stop 1
|
|
if (any (shape(a_scalar%arr) /= [4,5])) stop 1
|
|
if (any (shape(la_scalar%arr) /= [4,5])) stop 1
|
|
if (scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 13
|
|
if (l_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 13
|
|
if (a_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 14
|
|
if (la_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 14
|
|
if (is_present) then
|
|
if (any (shape(opt_scalar%arr) /= [4,5])) stop 1
|
|
if (any (shape(a_opt_scalar%arr) /= [4,5])) stop 1
|
|
if (opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 15
|
|
if (a_opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 16
|
|
end if
|
|
end do
|
|
end do
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
if (any (shape(array(i,j)%arr) /= [i,j])) stop 1
|
|
if (any (shape(l_array(i,j)%arr) /= [i,j])) stop 1
|
|
if (any (shape(a_array(i,j)%arr) /= [i,j])) stop 1
|
|
if (any (shape(la_array(i,j)%arr) /= [i,j])) stop 1
|
|
if (is_present) then
|
|
if (any (shape(opt_array(i,j)%arr) /= [i,j])) stop 1
|
|
if (any (shape(a_opt_array(i,j)%arr) /= [i,j])) stop 1
|
|
endif
|
|
do l = 1, j
|
|
do k = 1, i
|
|
if (array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 17
|
|
if (l_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 17
|
|
if (a_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 18
|
|
if (la_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 18
|
|
if (is_present) then
|
|
if (opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 19
|
|
if (a_opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 20
|
|
end if
|
|
end do
|
|
end do
|
|
end do
|
|
end do
|
|
else if (dummy_alloced) then
|
|
if (allocated (scalar%slr)) stop 1
|
|
if (allocated (l_scalar%slr)) stop 1
|
|
if (allocated (a_scalar%slr)) stop 1
|
|
if (allocated (la_scalar%slr)) stop 1
|
|
if (is_present) then
|
|
if (allocated (opt_scalar%slr)) stop 1
|
|
if (allocated (a_opt_scalar%slr)) stop 1
|
|
endif
|
|
if (allocated (scalar%arr)) stop 1
|
|
if (allocated (l_scalar%arr)) stop 1
|
|
if (allocated (a_scalar%arr)) stop 1
|
|
if (allocated (la_scalar%arr)) stop 1
|
|
if (is_present) then
|
|
if (allocated (opt_scalar%arr)) stop 1
|
|
if (allocated (a_opt_scalar%arr)) stop 1
|
|
endif
|
|
end if
|
|
|
|
! SET VALUE
|
|
scalar%var = 42 + 13
|
|
l_scalar%var = 42 + 13
|
|
if (is_present) then
|
|
opt_scalar%var = 42 + 13
|
|
endif
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
array(i,j)%var = i*97 + 100*41*j + 13
|
|
l_array(i,j)%var = i*97 + 100*41*j + 13
|
|
if (is_present) then
|
|
opt_array(i,j)%var = i*97 + 100*41*j + 13
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
if (dummy_alloced) then
|
|
a_scalar%var = 42 + 13
|
|
la_scalar%var = 42 + 13
|
|
if (is_present) then
|
|
a_opt_scalar%var = 42 + 13
|
|
endif
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
a_array(i,j)%var = i*97 + 100*41*j + 13
|
|
la_array(i,j)%var = i*97 + 100*41*j + 13
|
|
if (is_present) then
|
|
a_opt_array(i,j)%var = i*97 + 100*41*j + 13
|
|
endif
|
|
end do
|
|
end do
|
|
end if
|
|
|
|
if (inner_alloc) then
|
|
scalar%slr = 467 + 13
|
|
l_scalar%slr = 467 + 13
|
|
a_scalar%slr = 467 + 13
|
|
la_scalar%slr = 467 + 13
|
|
if (is_present) then
|
|
opt_scalar%slr = 467 + 13
|
|
a_opt_scalar%slr = 467 + 13
|
|
end if
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
|
|
l_array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
|
|
a_array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
|
|
la_array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
|
|
if (is_present) then
|
|
opt_array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
|
|
a_opt_array(i,j)%slr = (i*97 + 100*41*j) + 467 + 13
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
do l = 1, 5
|
|
do k = 1, 4
|
|
scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
|
|
l_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
|
|
a_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
|
|
la_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
|
|
if (is_present) then
|
|
opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
|
|
a_opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
|
|
end if
|
|
end do
|
|
end do
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
do l = 1, j
|
|
do k = 1, i
|
|
array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
|
|
l_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
|
|
a_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
|
|
la_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
|
|
if (is_present) then
|
|
opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
|
|
a_opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
|
|
end if
|
|
end do
|
|
end do
|
|
end do
|
|
end do
|
|
end if
|
|
|
|
end subroutine
|
|
subroutine check_reset (is_present, dummy_alloced, inner_alloc, &
|
|
scalar, array, a_scalar, a_array, &
|
|
l_scalar, l_array, la_scalar, la_array, &
|
|
opt_scalar, opt_array, a_opt_scalar, a_opt_array)
|
|
type(t), intent(inout) :: &
|
|
scalar, array(:,:), opt_scalar, opt_array(:,:), a_scalar, a_array(:,:), &
|
|
a_opt_scalar, a_opt_array(:,:), &
|
|
l_scalar, l_array(:,:), la_scalar, la_array(:,:)
|
|
optional :: opt_scalar, opt_array, a_opt_scalar, a_opt_array
|
|
allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array, la_scalar, la_array
|
|
logical, value :: is_present, dummy_alloced, inner_alloc
|
|
integer :: i, j, k, l
|
|
|
|
! CHECK VALUE
|
|
if (scalar%var /= 42 + 13) stop 1
|
|
if (l_scalar%var /= 42 + 13) stop 1
|
|
if (is_present) then
|
|
if (opt_scalar%var /= 42 + 13) stop 2
|
|
end if
|
|
if (any (shape(array) /= [3,2])) stop 1
|
|
if (any (shape(l_array) /= [3,2])) stop 1
|
|
if (is_present) then
|
|
if (any (shape(opt_array) /= [3,2])) stop 1
|
|
end if
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
if (array(i,j)%var /= i*97 + 100*41*j + 13) stop 3
|
|
if (l_array(i,j)%var /= i*97 + 100*41*j + 13) stop 3
|
|
if (is_present) then
|
|
if (opt_array(i,j)%var /= i*97 + 100*41*j + 13) stop 4
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
if (dummy_alloced) then
|
|
if (a_scalar%var /= 42 + 13) stop 1
|
|
if (la_scalar%var /= 42 + 13) stop 1
|
|
if (is_present) then
|
|
if (a_opt_scalar%var /= 42 + 13) stop 1
|
|
end if
|
|
if (any (shape(a_array) /= [3,2])) stop 1
|
|
if (any (shape(la_array) /= [3,2])) stop 1
|
|
if (is_present) then
|
|
if (any (shape(a_opt_array) /= [3,2])) stop 1
|
|
end if
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
if (a_array(i,j)%var /= i*97 + 100*41*j + 13) stop 1
|
|
if (la_array(i,j)%var /= i*97 + 100*41*j + 13) stop 1
|
|
if (is_present) then
|
|
if (a_opt_array(i,j)%var /= i*97 + 100*41*j + 13) stop 1
|
|
end if
|
|
end do
|
|
end do
|
|
else
|
|
if (allocated (a_scalar)) stop 1
|
|
if (allocated (la_scalar)) stop 1
|
|
if (allocated (a_array)) stop 1
|
|
if (allocated (la_array)) stop 1
|
|
if (is_present) then
|
|
if (allocated (a_opt_scalar)) stop 1
|
|
if (allocated (a_opt_array)) stop 1
|
|
end if
|
|
end if
|
|
|
|
if (inner_alloc) then
|
|
if (scalar%slr /= 467 + 13) stop 5
|
|
if (l_scalar%slr /= 467 + 13) stop 5
|
|
if (a_scalar%slr /= 467 + 13) stop 6
|
|
if (la_scalar%slr /= 467 + 13) stop 6
|
|
if (is_present) then
|
|
if (opt_scalar%slr /= 467 + 13) stop 7
|
|
if (a_opt_scalar%slr /= 467 + 13) stop 8
|
|
end if
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
if (array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 9
|
|
if (l_array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 9
|
|
if (a_array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 10
|
|
if (la_array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 10
|
|
if (is_present) then
|
|
if (opt_array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 11
|
|
if (a_opt_array(i,j)%slr /= (i*97 + 100*41*j) + 467 + 13) stop 12
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
do l = 1, 5
|
|
do k = 1, 4
|
|
if (any (shape(scalar%arr) /= [4,5])) stop 1
|
|
if (any (shape(l_scalar%arr) /= [4,5])) stop 1
|
|
if (any (shape(a_scalar%arr) /= [4,5])) stop 1
|
|
if (any (shape(la_scalar%arr) /= [4,5])) stop 1
|
|
if (scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 13
|
|
if (l_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 13
|
|
if (a_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 14
|
|
if (la_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 14
|
|
if (is_present) then
|
|
if (any (shape(opt_scalar%arr) /= [4,5])) stop 1
|
|
if (any (shape(a_opt_scalar%arr) /= [4,5])) stop 1
|
|
if (opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 15
|
|
if (a_opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 16
|
|
end if
|
|
end do
|
|
end do
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
if (any (shape(array(i,j)%arr) /= [i,j])) stop 1
|
|
if (any (shape(l_array(i,j)%arr) /= [i,j])) stop 1
|
|
if (any (shape(a_array(i,j)%arr) /= [i,j])) stop 1
|
|
if (any (shape(la_array(i,j)%arr) /= [i,j])) stop 1
|
|
if (is_present) then
|
|
if (any (shape(opt_array(i,j)%arr) /= [i,j])) stop 1
|
|
if (any (shape(a_opt_array(i,j)%arr) /= [i,j])) stop 1
|
|
endif
|
|
do l = 1, j
|
|
do k = 1, i
|
|
if (array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 17
|
|
if (l_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 17
|
|
if (a_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 18
|
|
if (la_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 18
|
|
if (is_present) then
|
|
if (opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 19
|
|
if (a_opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 20
|
|
end if
|
|
end do
|
|
end do
|
|
end do
|
|
end do
|
|
else if (dummy_alloced) then
|
|
if (allocated (scalar%slr)) stop 1
|
|
if (allocated (l_scalar%slr)) stop 1
|
|
if (allocated (a_scalar%slr)) stop 1
|
|
if (allocated (la_scalar%slr)) stop 1
|
|
if (is_present) then
|
|
if (allocated (opt_scalar%slr)) stop 1
|
|
if (allocated (a_opt_scalar%slr)) stop 1
|
|
endif
|
|
if (allocated (scalar%arr)) stop 1
|
|
if (allocated (l_scalar%arr)) stop 1
|
|
if (allocated (a_scalar%arr)) stop 1
|
|
if (allocated (la_scalar%arr)) stop 1
|
|
if (is_present) then
|
|
if (allocated (opt_scalar%arr)) stop 1
|
|
if (allocated (a_opt_scalar%arr)) stop 1
|
|
endif
|
|
end if
|
|
|
|
! (RE)SET VALUE
|
|
scalar%var = 42
|
|
l_scalar%var = 42
|
|
if (is_present) then
|
|
opt_scalar%var = 42
|
|
endif
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
array(i,j)%var = i*97 + 100*41*j
|
|
l_array(i,j)%var = i*97 + 100*41*j
|
|
if (is_present) then
|
|
opt_array(i,j)%var = i*97 + 100*41*j
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
if (dummy_alloced) then
|
|
a_scalar%var = 42
|
|
la_scalar%var = 42
|
|
if (is_present) then
|
|
a_opt_scalar%var = 42
|
|
endif
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
a_array(i,j)%var = i*97 + 100*41*j
|
|
la_array(i,j)%var = i*97 + 100*41*j
|
|
if (is_present) then
|
|
a_opt_array(i,j)%var = i*97 + 100*41*j
|
|
endif
|
|
end do
|
|
end do
|
|
end if
|
|
|
|
if (inner_alloc) then
|
|
scalar%slr = 467
|
|
l_scalar%slr = 467
|
|
a_scalar%slr = 467
|
|
la_scalar%slr = 467
|
|
if (is_present) then
|
|
opt_scalar%slr = 467
|
|
a_opt_scalar%slr = 467
|
|
end if
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
l_array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
a_array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
la_array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
if (is_present) then
|
|
opt_array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
a_opt_array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
do l = 1, 5
|
|
do k = 1, 4
|
|
scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
l_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
a_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
la_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
if (is_present) then
|
|
opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
a_opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
end if
|
|
end do
|
|
end do
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
do l = 1, j
|
|
do k = 1, i
|
|
array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
l_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
a_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
la_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
if (is_present) then
|
|
opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
a_opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
end if
|
|
end do
|
|
end do
|
|
end do
|
|
end do
|
|
end if
|
|
end subroutine
|
|
|
|
subroutine test(scalar, array, a_scalar, a_array, opt_scalar, opt_array, &
|
|
a_opt_scalar, a_opt_array)
|
|
type(t) :: scalar, array(:,:), opt_scalar, opt_array(:,:), a_scalar, a_array(:,:)
|
|
type(t) :: a_opt_scalar, a_opt_array(:,:)
|
|
type(t) :: l_scalar, l_array(3,2), la_scalar, la_array(:,:)
|
|
allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array, la_scalar, la_array
|
|
optional :: opt_scalar, opt_array, a_opt_scalar, a_opt_array
|
|
|
|
integer :: i, j, k, l
|
|
logical :: is_present, dummy_alloced, local_alloced, inner_alloc
|
|
is_present = present(opt_scalar)
|
|
dummy_alloced = allocated(a_scalar)
|
|
inner_alloc = allocated(scalar%slr)
|
|
|
|
l_scalar%var = 42
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
l_array(i,j)%var = i*97 + 100*41*j
|
|
end do
|
|
end do
|
|
|
|
if (dummy_alloced) then
|
|
allocate(la_scalar, la_array(3,2))
|
|
a_scalar%var = 42
|
|
la_scalar%var = 42
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
l_array(i,j)%var = i*97 + 100*41*j
|
|
la_array(i,j)%var = i*97 + 100*41*j
|
|
end do
|
|
end do
|
|
end if
|
|
|
|
if (inner_alloc) then
|
|
l_scalar%slr = 467
|
|
la_scalar%slr = 467
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
l_array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
la_array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
end do
|
|
end do
|
|
|
|
allocate(l_scalar%arr(4,5), la_scalar%arr(4,5))
|
|
do l = 1, 5
|
|
do k = 1, 4
|
|
l_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
la_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
end do
|
|
end do
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
allocate(l_array(i,j)%arr(i,j), la_array(i,j)%arr(i,j))
|
|
do l = 1, j
|
|
do k = 1, i
|
|
l_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
la_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
end do
|
|
end do
|
|
end do
|
|
end do
|
|
end if
|
|
|
|
! implicit mapping
|
|
!$omp target
|
|
if (is_present) then
|
|
call check_it (is_present, dummy_alloced, inner_alloc, &
|
|
scalar, array, a_scalar, a_array, &
|
|
l_scalar, l_array, la_scalar, la_array, &
|
|
opt_scalar, opt_array, a_opt_scalar, a_opt_array)
|
|
else
|
|
call check_it (is_present, dummy_alloced, inner_alloc, &
|
|
scalar, array, a_scalar, a_array, &
|
|
l_scalar, l_array, la_scalar, la_array)
|
|
end if
|
|
!$omp end target
|
|
|
|
if (is_present) then
|
|
call check_reset (is_present, dummy_alloced, inner_alloc, &
|
|
scalar, array, a_scalar, a_array, &
|
|
l_scalar, l_array, la_scalar, la_array, &
|
|
opt_scalar, opt_array, a_opt_scalar, a_opt_array)
|
|
else
|
|
call check_reset (is_present, dummy_alloced, inner_alloc, &
|
|
scalar, array, a_scalar, a_array, &
|
|
l_scalar, l_array, la_scalar, la_array)
|
|
endif
|
|
|
|
! explicit mapping
|
|
!$omp target map(scalar, array, opt_scalar, opt_array, a_scalar, a_array) &
|
|
!$omp& map(a_opt_scalar, a_opt_array) &
|
|
!$omp& map(l_scalar, l_array, la_scalar, la_array)
|
|
if (is_present) then
|
|
call check_it (is_present, dummy_alloced, inner_alloc, &
|
|
scalar, array, a_scalar, a_array, &
|
|
l_scalar, l_array, la_scalar, la_array, &
|
|
opt_scalar, opt_array, a_opt_scalar, a_opt_array)
|
|
else
|
|
call check_it (is_present, dummy_alloced, inner_alloc, &
|
|
scalar, array, a_scalar, a_array, &
|
|
l_scalar, l_array, la_scalar, la_array)
|
|
endif
|
|
!$omp end target
|
|
|
|
if (is_present) then
|
|
call check_reset (is_present, dummy_alloced, inner_alloc, &
|
|
scalar, array, a_scalar, a_array, &
|
|
l_scalar, l_array, la_scalar, la_array, &
|
|
opt_scalar, opt_array, a_opt_scalar, a_opt_array)
|
|
else
|
|
call check_reset (is_present, dummy_alloced, inner_alloc, &
|
|
scalar, array, a_scalar, a_array, &
|
|
l_scalar, l_array, la_scalar, la_array)
|
|
endif
|
|
end subroutine
|
|
end module
|
|
|
|
program main
|
|
use m
|
|
implicit none (type, external)
|
|
type(t) :: scalar, array(3,2), opt_scalar, opt_array(3,2), a_scalar, a_array(:,:)
|
|
type(t) :: a_opt_scalar, a_opt_array(:,:)
|
|
allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array
|
|
integer :: i, j, k, l, n
|
|
|
|
scalar%var = 42
|
|
opt_scalar%var = 42
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
array(i,j)%var = i*97 + 100*41*j
|
|
opt_array(i,j)%var = i*97 + 100*41*j
|
|
end do
|
|
end do
|
|
|
|
! unallocated
|
|
call test (scalar, array, a_scalar, a_array)
|
|
call test (scalar, array, a_scalar, a_array, opt_scalar, opt_array, a_opt_scalar, a_opt_array)
|
|
|
|
! allocated
|
|
allocate(a_scalar, a_opt_scalar, a_array(3,2), a_opt_array(3,2))
|
|
a_scalar%var = 42
|
|
a_opt_scalar%var = 42
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
a_array(i,j)%var = i*97 + 100*41*j
|
|
a_opt_array(i,j)%var = i*97 + 100*41*j
|
|
end do
|
|
end do
|
|
|
|
call test (scalar, array, a_scalar, a_array)
|
|
call test (scalar, array, a_scalar, a_array, opt_scalar, opt_array, a_opt_scalar, a_opt_array)
|
|
|
|
! comps allocated
|
|
scalar%slr = 467
|
|
a_scalar%slr = 467
|
|
opt_scalar%slr = 467
|
|
a_opt_scalar%slr = 467
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
a_array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
opt_array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
a_opt_array(i,j)%slr = (i*97 + 100*41*j) + 467
|
|
end do
|
|
end do
|
|
|
|
allocate(scalar%arr(4,5), a_scalar%arr(4,5), opt_scalar%arr(4,5), a_opt_scalar%arr(4,5))
|
|
do l = 1, 5
|
|
do k = 1, 4
|
|
scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
a_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
a_opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
|
|
end do
|
|
end do
|
|
do j = 1, 2
|
|
do i = 1, 3
|
|
allocate(array(i,j)%arr(i,j), a_array(i,j)%arr(i,j), opt_array(i,j)%arr(i,j), a_opt_array(i,j)%arr(i,j))
|
|
do l = 1, j
|
|
do k = 1, i
|
|
array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
a_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
a_opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
|
|
end do
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
call test (scalar, array, a_scalar, a_array)
|
|
call test (scalar, array, a_scalar, a_array, opt_scalar, opt_array, a_opt_scalar, a_opt_array)
|
|
|
|
deallocate(a_scalar, a_opt_scalar, a_array, a_opt_array)
|
|
end
|