| program main |
| use omp_lib |
| use iso_c_binding |
| implicit none (type, external) |
| |
| integer :: d, id |
| integer(kind=1), target :: a(4) |
| integer(kind=1), pointer :: p, q |
| |
| d = omp_get_default_device () |
| id = omp_get_initial_device () |
| |
| if (d < 0 .or. d >= omp_get_num_devices ()) & |
| d = id |
| |
| a = transfer (int(z'cdcdcdcd'), mold=a) |
| |
| !$omp target enter data map (to:a) |
| |
| a = transfer (int(z'abababab'), mold=a) |
| p => a(1) |
| q => a(3) |
| |
| !$omp target enter data map (alloc:p, q) |
| |
| if (d /= id) then |
| if (omp_target_is_present (c_loc(a), d) == 0) & |
| stop 1 |
| if (omp_target_is_present (c_loc(p), d) == 0) & |
| stop 2 |
| if (omp_target_is_present (c_loc(q), d) == 0) & |
| stop 3 |
| end if |
| |
| !$omp target exit data map (release:a) |
| |
| if (d /= id) then |
| if (omp_target_is_present (c_loc(a), d) == 0) & |
| stop 4 |
| if (omp_target_is_present (c_loc(p), d) == 0) & |
| stop 5 |
| if (omp_target_is_present (c_loc(q), d) == 0) & |
| stop 6 |
| end if |
| |
| !$omp target exit data map (from:q) |
| |
| if (d /= id) then |
| if (omp_target_is_present (c_loc(a), d) /= 0) & |
| stop 7 |
| if (omp_target_is_present (c_loc(p), d) /= 0) & |
| stop 8 |
| if (omp_target_is_present (c_loc(q), d) /= 0) & |
| stop 9 |
| |
| if (q /= int(z'cd', kind=1)) & |
| stop 10 |
| if (p /= int(z'ab', kind=1)) & |
| stop 11 |
| end if |
| end program main |
