1! Test the `acc_get_property' and '`acc_get_property_string' library
2! functions by printing the results of those functions for all devices
3! of all device types mentioned in the OpenACC standard.
4!
5! See also acc_get_property.c
6
7program test
8  use openacc
9  implicit none
10
11  print *, "acc_device_none:"
12  ! For completeness; not expected to print anything
13  call print_device_properties (acc_device_none)
14
15  print *, "acc_device_default:"
16  call print_device_properties (acc_device_default)
17
18  print *, "acc_device_host:"
19  call print_device_properties (acc_device_host)
20
21  print *, "acc_device_not_host:"
22  call print_device_properties (acc_device_not_host)
23end program test
24
25! Print the values of the properties of all devices of the given type
26! and do basic device independent validation.
27subroutine print_device_properties (device_type)
28  use openacc
29  use iso_c_binding, only: c_size_t
30  implicit none
31
32  integer, intent(in) :: device_type
33
34  integer :: device_count
35  integer :: device
36  integer(c_size_t) :: v
37  character*256 :: s
38
39  device_count = acc_get_num_devices(device_type)
40
41  do device = 0, device_count - 1
42     print "(a, i0)", "  Device ", device
43
44     call acc_get_property_string (device, device_type, acc_property_vendor, s)
45     print "(a, a)", "    Vendor: ", trim (s)
46     if (s == "") then
47        print *, "acc_property_vendor should not be empty."
48        stop 1
49     end if
50
51     v = acc_get_property (device, device_type, acc_property_memory)
52     print "(a, i0)", "    Total memory: ", v
53     if (v < 0) then
54        print *, "acc_property_memory should not be negative."
55        stop 1
56     end if
57
58     v = acc_get_property (device, device_type, acc_property_free_memory)
59     print "(a, i0)", "    Free memory: ", v
60     if (v < 0) then
61        print *, "acc_property_free_memory should not to be negative."
62        stop 1
63     end if
64
65     v = acc_get_property (device, device_type, int(2360, kind = acc_device_property))
66     if (v /= 0) then
67        print *, "Value of unknown numeric property should be 0."
68        stop 1
69     end if
70
71     call acc_get_property_string (device, device_type, acc_property_name, s)
72     print "(a, a)", "    Name: ", trim (s)
73     if (s == "") then
74        print *, "acc_property_name should not be empty."
75        stop 1
76     end if
77
78     call acc_get_property_string (device, device_type, acc_property_driver, s)
79     print "(a, a)", "    Driver: ", trim (s)
80     if (s == "") then
81        print *, "acc_property_driver should not be empty."
82        stop 1
83     end if
84
85     call acc_get_property_string (device, device_type, int(4060, kind = acc_device_property), s)
86     if (s /= "") then
87        print *, "Value of unknown string property should be empty string."
88        stop 1
89     end if
90
91  end do
92end subroutine print_device_properties
93