1program main 2 use omp_lib 3 use iso_c_binding 4 implicit none (type, external) 5 6 integer :: d, id 7 integer(kind=1), target :: a(4) 8 integer(kind=1), pointer :: p, q 9 10 d = omp_get_default_device () 11 id = omp_get_initial_device () 12 13 if (d < 0 .or. d >= omp_get_num_devices ()) & 14 d = id 15 16 a = transfer (int(z'cdcdcdcd'), mold=a) 17 18 !$omp target enter data map (to:a) 19 20 a = transfer (int(z'abababab'), mold=a) 21 p => a(1) 22 q => a(3) 23 24 !$omp target enter data map (alloc:p, q) 25 26 if (d /= id) then 27 if (omp_target_is_present (c_loc(a), d) == 0) & 28 stop 1 29 if (omp_target_is_present (c_loc(p), d) == 0) & 30 stop 2 31 if (omp_target_is_present (c_loc(q), d) == 0) & 32 stop 3 33 end if 34 35 !$omp target exit data map (release:a) 36 37 if (d /= id) then 38 if (omp_target_is_present (c_loc(a), d) == 0) & 39 stop 4 40 if (omp_target_is_present (c_loc(p), d) == 0) & 41 stop 5 42 if (omp_target_is_present (c_loc(q), d) == 0) & 43 stop 6 44 end if 45 46 !$omp target exit data map (from:q) 47 48 if (d /= id) then 49 if (omp_target_is_present (c_loc(a), d) /= 0) & 50 stop 7 51 if (omp_target_is_present (c_loc(p), d) /= 0) & 52 stop 8 53 if (omp_target_is_present (c_loc(q), d) /= 0) & 54 stop 9 55 56 if (q /= int(z'cd', kind=1)) & 57 stop 10 58 if (p /= int(z'ab', kind=1)) & 59 stop 11 60 end if 61end program main 62