libgomp/testsuite/libgomp.oacc-fortran/acc_get_property.f90

   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
   7 program 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)
  23 end program test
  24
  25 ! Print the values of the properties of all devices of the given type
  26 ! and do basic device independent validation.
  27 subroutine 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
  92 end subroutine print_device_properties