xref: /llvm-project/offload/test/offloading/fortran/target_map_common_block.f90 (revision 8823448807f3b1a1362d1417e062d763734e02f5)
1! Basic offloading test with a target region
2! REQUIRES: flang, amdgpu
3! RUN: %libomptarget-compile-fortran-run-and-check-generic
4
5! Testing simple variables in common block.
6program main
7  call check_device
8  call commonblock_simple_with_implicit_type_var
9  call commonblock_simple_with_integer
10  call commonblock_simple_with_real
11  call commonblock_simple_to_from
12  call set_commonblock_named
13  call use_commonblock_named
14end program main
15
16!-----
17
18subroutine check_device
19  use omp_lib
20  integer :: devices(2)
21  devices(1) = omp_get_device_num()
22  !$omp target map(tofrom:devices)
23    devices(2) = omp_get_device_num()
24  !$omp end target
25  print *, omp_get_num_devices()
26  !CHECK: [[ND:[0-9]+]]
27  print *, omp_get_default_device()
28  !CHECK: [[DD:[0-9]+]]
29  !CHECK: devices: [[ND]] [[DD]]
30  print *, "devices: ", devices
31end subroutine check_device
32
33!-----
34
35subroutine commonblock_simple_with_implicit_type_var
36  use omp_lib
37  common var1
38  var1 = 10
39  print *, "var1 before target = ", var1
40  !$omp target map(tofrom:var1)
41    var1 = 20
42  !$omp end target
43  print *, "var1 after target = ", var1
44end subroutine
45
46! CHECK: var1 before target = 10
47! CHECK: var1 after target = 20
48
49! -----
50
51subroutine commonblock_simple_with_integer
52  use omp_lib
53  integer :: var2
54  common var2
55  var2 = 10
56  print *, "var2 before target = ", var2
57  !$omp target map(tofrom:var2)
58    var2 = 20
59  !$omp end target
60  print *, "var2 after target = ", var2
61end subroutine
62
63! CHECK: var2 before target = 10
64! CHECK: var2 after target = 20
65
66! -----
67
68subroutine commonblock_simple_with_real
69  use omp_lib
70  real :: var3
71  common var3
72  var3 = 12.5
73  print *, "var3 before target = ", var3
74  !$omp target map(tofrom:var3)
75    var3 = 14.5
76  !$omp end target
77  print *, "var3 after target = ", var3
78end subroutine
79
80! CHECK: var3 before target = 12.5
81! CHECK: var3 after target = 14.5
82
83! -----
84
85subroutine commonblock_simple_to_from
86  use omp_lib
87  integer :: var4, tmp
88  common var4
89  var4 = 10
90  tmp = 20
91  !$omp target map(to:var4) map(from:tmp)
92    tmp = var4
93    var4 = 20
94  !$omp end target
95  print *, "var4 after target = ", var4
96  print *, "tmp after target = ", tmp
97end subroutine
98
99! CHECK: var4 after target = 10
100! CHECK: tmp after target = 10
101
102! -----
103
104subroutine set_commonblock_named
105  integer :: var6
106  common /my_common_block/ var6
107  var6 = 20
108end subroutine
109
110subroutine use_commonblock_named
111  integer :: var6
112  common /my_common_block/ var6
113  print *, "var6 before target = ", var6
114  !$omp target map(tofrom: var6)
115    var6 = 30
116  !$omp end target
117  print *, "var6 after target = ", var6
118end subroutine
119
120! CHECK: var6 before target = 20
121! CHECK: var6 after target = 30
122