Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> OpenCL в Delphi XE2 под Win64bit, Можете протест-ть на своей видеокарте 
:(
    Опции темы
Prok12
Дата 4.3.2016, 08:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 9
Регистрация: 8.11.2011

Репутация: нет
Всего: 3



Суть проблемы. Есть весьма объёмный ПК для научных расчётов: интерфейс, База данных, много-поточные расчёты (на CPU пока), графика 2D, графика 3D на OpenGL, анимация результатов в виде компрессированного avi-файла на выходе - всё делалось на Delphi XE2...XE6 и прекрасно работает. Надо подключить модуль для переноса части длительных фрагментов расчёта на GPU. Этот модуль пытались писать на Visual Studio 2015 - расширение языка C++ AMP, как DLL: работает, но криво: не на всех видеокартах, увы (текст тестовой программы выложен в той же папке для скачивания - см.ниже). Ну и вечная проблема с недостающими DLL к тому что написано на Visual Studio: даже опции компилятора /MT не помогают... На JAVA тоже сейчас мои коллеги пишут этот расчётный модуль - через OpenCL... Ну не в этом вопрос. Есть примеры использования библиотеки OpenCL.dll прямо в проектах Delphi (чехи, например, делали, есть ещё компоненты от MITOV для Delphi Seattle - http://www.mitov.com/ ). Эти несложные примеры работают, но...только при компиляции под Win32, а компилируешь проект Delphi под Win64 - затык...
-----
Сейчас вроде , удалось траблы победить, и сделать работоспособный тест.  smile 
-----
Вот ссылка для скачивания: http://gofile.me/2Zesj/C0f3wb1o
========
Там в папке:
========
1) Полезная утилита GPU_Caps_Viewer_Setup_v1.26.0.0.exe для контроля состояния видеокарты, особенно, если нажать кнопку "More GPU Info".
2) OpenCL1_2_Delphi.zip - файл с примером от чехов (Университет Брно, насколько помню) использования OpenCL в Delphi, 2013год. У меня этот пример не всегда корректно работал при компиляции под Win64 (не на всех видео-картах). Но там хороший заголовочный файл CL.pas - его можно чуть доработать : заменить тип size_t на NativeInt для Win64, и использовать вместо моего "укороченного" MyOpenCL.pas - см.ниже.
---
3) Вложенная папка OpenCL for Delphi 32bit_64bit с моим вариантом программы-теста. Она самодостаточна: больше ничего не надо, ну разве что последние версии видео-драйверов установить. Тест сделан под Delphi XE2 (работает и под XE6). Причём работает, по крайней мере у меня, при компиляции под Win32, и что более важно- под Win64. Всего 2 файла:
--> MyOpenCL.pas: заголовочный; я его урезал - убрал ненужные мне функции, которые в принципе можно взять из файла чехов CL.pas + учёл полезное замечание с др.форума про NativeInt ;
--> FMain.pas : тестовая программа. Выделяет на GPU память (создаёт буферы) под 16 массивов (квадратных матриц из cl_Float - по 4 байта, размер стороны которых задаётся на основной форме, по умолчанию 1200) и под ещё один массив, того же размера, куда пишется результат несложных вычислений на GPU. Потом запускается итерационный цикл (количество итераций - для проверки времени работы - задаётся тоже на форме, по умолчанию - 12). Внутри каждой итерации 16 массивов заполняются данными, затем запускается ещё и внутренний цикл: 30 проходов вызова расчётного ядра на GPU. Такая структура тестовой программы больше всего подходит под наши научные задачи (вычислит. гидродинамика), но пока это лишь тест. В тесте есть несложная проверка правильности вычислений - для одного из элементов матрицы-результата, поскольку НЕ все драйверы видеокарт (особенно старые) могут диагностировать Kernel Error.
--> программа на С для ядра - текстовый файл ProgramGPU.CL (должен лежать рядом с MyFirstOpenCL.exe !!): там можно глянуть, что делается с одномерными массивами на GPU. Она прямо передаётся в виде строки на GPU, там копилируется и линкуется - ну как обычно в OpenCL.
Нужная DLL для OpenCL - под Win64 или Win32 - подключится из системных папок Windows автоматически, в зависимости от компиляции.
----
4) Можете на своём сетапе запустить прямо готовый MyFirstOpenCL.exe (это версия 64bit !!) с параметрами:
--> размер стороны матрицы = 3200; лезут 17 таких матриц на видеокарту от 1Gb и выше; если не влезут (часть видео-памяти уже занята чем-то - GPU_Caps_Viewer в помощь) - возможны ошибки, которые диагностируются НЕ всем драйверами видеокарт, а только новыми;
--> количество итераций (внешний цикл) = 12.
---
5) У меня для указанного примера время счёта вышло (на работе несколько компов):
NVIDIA GT-430 (1Gb, 96core, 700MHz core) - 3мин 37сек;
NVIDIA GTS-450 (1Gb, 192core, 810MHz core) - 1мин 36сек;
NVIDIA GTX-570 (1.28Gb, 480core, 732MHz core) - 42.5сек;
AMD Radeon R9 M275X (2Gb, 640core, 925MHz core) - 1мин 27сек - настольный моноблок ASUS 2702;
NVIDIA GT-545 (3Gb, 144core, 720MHz core) - 2 мин 50сек (тестировали на др. форуме);
NVIDIA GTX-980 (4Gb, 2048 CUDA Cores, 1278MHz) - 25.8сек (тестировали на др. форуме).
===
Тестировал мои коллеги:
NVIDIA GeForce GTX 780 Ti (3Gb, 2880 CUDA Cores, 876MHz) - 23,6сек
NVIDIA GeForce GTX 750 Ti (2Gb, 640 CUDA Cores, 1020MHz) - 43.7сек
NVIDIA GeForce GTX 980 Ti (6Gb, 2816 CUDA Cores, 1190MHz Boost, MSI) - 22.1сек - установил такой акселератор в свой комп (09.02.16).
----
Может кто-то попробовать MyFirstOpenCL.exe на своих видеокартах???    smile  Особенно интересуют последние AMD Radeon !!  Поскольку это проект дельфовый, никакие внешние DLL ему не нужны (кроме тех что в Windows у всех есть), как и всякие - джава-машины: только для видео-карты новые драйверы желательны.
Запустить, нажать верхнюю кнопку на форме, установить размер матрицы 3200 (если 1200 отработает корректно), выбрать платформу-девайс, нажать нижнюю кнопку на форме. Записать время счёта: оно выдаётся в итоговом окне.
Нам сейчас на работу надо будет покупать новую карту 6-8Gb именно для расчётов...денег более 60тр вряд ли выделят... AMD конечно подешевле, но... Такие сопоставительные тесты на задачах, приближенных к нашим, были бы полезны!! Были бы полезны и замечания участников форума по тестовой программе. Вообще, жду выхода в этом году Nvidia PASCAL (1080ti, к примеру)...
===
К сожалению, у меня нет под рукой видео-карты (акселератора) с памятью на борту 8Gb-12Gb. Было бы интересно протестить и на таких "монстрах", повышая понемногу размер входной матрицы (требуемую память тестовая программа сообщит в начале работы): для того и писалось под Win64 - нужна большая память. Буду признателен!  smile 
===
ПыСы. В ту же папку для скачивания добавил:
1) Новый тестовый пример на Delphi XE2 - в под-папке OpenCL_Demo2016 . Там тестирование с проверкой и сопоставлением расчётов на CPU и на GPU. Да и более культурно текст переписал (исходники все выкладываю!!) Не забудьте, что рядом с EXE должны "лежать" 2 программки-KERNEL (здесь расширение у них не *.CL как в старом тесте, а *.cpp - так их редактор Delphi лучше понимает).
2) В отдельной под-папке внутри OpenCL_Demo2016 примеры моих программок для видеодрайвера (на языке C99) - так называемых KERNEL...
PM MAIL   Вверх
Prok12
  Дата 28.12.2017, 13:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 9
Регистрация: 8.11.2011

Репутация: нет
Всего: 3



Дополню (конец декабря 2017). Внутри той же ссылки для скачивания http://gofile.me/2Zesj/C0f3wb1o добавил папку:

OpenCL_Demo2017 Barrier and Local_Memory REDUCT

В ней новый пример под Delphi XE8 64bit (работает и при компиляции в Delphi под Win32, но с ограничениями, о которых будет сказано ниже).

Отличия:
1. Добавлен пример простейшей редукции с использованием barrier и LocalMemory с обилием комментариев внутри Kernel-файла ProgramGPU1.cpp

2. Показано, как внутри Kernel создать а-ля динамический массив (стандарт языка OpenCL 1.2 этого не позволяет).

3. Главное. На форме (см. вложенный в новую папку для скачивания скан экрана) добавлены Gauge-компоненты,
показывающие:
  • общую загрузку CPU ;
  • загрузку CPU данной задачей ;
  • загрузку GPU (общую);
  • загрузку контроллера памяти GPU - только для NVIDIA;
  • проценты использованной памяти GPU - только для NVIDIA;
  • потребляемую мощность GPU - в Ваттах, только для NVIDIA;
  • температуру GPU (в текстовом виде, град. С);
  • частоту вращения вентилятора GPU (в текстовом виде, %);
  • частоты GPU и памяти GPU в данное время (в текстовом виде, MHz).
 smile 

4. Для определения загрузки GPU-NVIDIA используется nvml.dll  - мануал 2017 здесь :
 https://docs.nvidia.com/deploy/pdf/NVML_API...rence_Guide.pdf ,
причём "проценты использованной памяти" определяются только для карт NVIDIA, и при компиляции в Delphi под 64bit. Эта динамич. библиотека для каждой карты NVIDIA - своя, обычно при установке драйвера карты она попадает в папку
C:\Program Files\NVIDIA Corporation\NVSMI\nvml.dll (этот путь прямо прописан в прилагаемом примере по ссылке).
Всё что связано с определением загрузки CPU-GPU находится в отдельном модуле ProcessorUsage.pas, который может быть применён и для других программ (без OpenCL).

5. Если есть желание попробовать OpenCL не только на видеокартах, но и на процессорах INTEL, надо поставить драйвер https://software.intel.com/en-us/articles/o...est_CPU_runtime

6. Буду весьма признателен, если кто-то подскажет способ измерения загрузки памяти GPU от AMD, Есть похожая DLL - как у NVIDIA, только для AMD Radeon?  
Может, эти: atiadlxx.dll  ,  atiadlxy.dll  ,  GPUPerfAPIGL.dll  ?  smile  Первую из них уже частично использовал для определения загрузки GPU-AMD, температуры, частот, скорости Карлсона AMD, (но не занятой/свободной памяти AMD!).
Документация atiadlxx.dll частично есть в папке Supporting Information : в ней надо открыть в любом броузере ADL_SDK.html.
-------------------------
7. Ещё раз напоминаю, что при запуске *.exe рядом с ним должны лежать два текстовых файла *.cpp - они будут отправлены на компиляцию драйверу видеокарты!

8. Пример делался в Delphi XE8, компилировался под 64bit. Система - Windows 10Pro. При компиляции под 32bit не будут отображаться компоненты загрузки GPU (даже если у вас карта NVIDIA, и по указанному пути удастся найти библиотеку nvml.dll). Кроме того, из-за ограничений в адресации памяти под 32bit, максимальный размер матриц 1400 x 8 (так и задано по умолчанию на форме).
Скан экрана при работе этой тестовой программы (Reduct DEMO.tiff) есть в указанной новой папке.

Дублирую здесь содержимое файла ProcessorUsage.pas (от 24.01.18) для измерения загрузки CPU-GPU-NVIDIA-AMD (хотя он есть в папке для скачивания):
Код

unit ProcessorUsage;
{=====================================================================}
{****  Моделирование 3D течений, переноса тепла и деформаций дна. ****}
{====  Модуль определения загрузки CPU (общей и процессом) и GPU  ====}
{=========    Прокофьев В.А.  АО "ВНИИГ им. Б.Е.Веденеева"    ========}
{=========  01.2018  С.Петербург.  e-mail: [email protected]  ========}
{=====================================================================}
interface

uses Windows, SysUtils, Dialogs;

// В начале 1 раз вызвать с параметром Initialize = True
procedure CPUusage(const Initialize : Boolean;
  out Total, MyProcess, TotalMemory, ProcessMemory : Integer);
//... Температуры выдаются в град.С, частоты- в MHz,  ...
//... потребляемая мощность- в Ваттах, остальное- в % ...
procedure GPUusageInitialize; // Запустить 1 раз в начале
procedure GPUusageNVIDIA(const GPU_num : Byte;
  out GPU_usage, MemoryController, Memory, Temperature,
  GPU_freq,  MEM_freq, FanSpeed, Power : Integer);
procedure GPUusageAMD(const GPU_num : Byte;
  out GPU_usage, Temperature, GPU_freq, Mem_freq, FanSpeed : Integer);
procedure GPUusageShutdown;   // Запустить 1 раз в конце
//
type TypeGPU = (gpuNO = 0,  gpuNVIDIA = 1,  gpuAMD = 2);
//
var Initialize_NVIDIA_OK : Boolean = False;
    Initialize_AMD_OK : Boolean = False;
//
//=====================================================================
implementation
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//++++++++++++++++ Сначала работаем с загрузкой CPU +++++++++++++++++++
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
var OldIdleTime64,  OldSysTime64,  OldProcT64 : Int64;
//
{==== Определение размера выделенной приложению памяти (в Байтах) ====}
function MyGetAllocatedMemory: UInt64;
var St: TMemoryManagerState;   Sb: TSmallBlockTypeState;
begin
GetMemoryManagerState(St);
Result := St.TotalAllocatedMediumBlockSize +
  St.TotalAllocatedLargeBlockSize;
For Sb in St.SmallBlockTypeStates do
 Result := Result + Sb.UseableBlockSize * Sb.AllocatedBlockCount;
end;

//=====================================================================
//========== Определение загрузки CPU (в процентах 0..100) ============
//=====================================================================
procedure CPUusage(const Initialize : Boolean;
  out Total, MyProcess, TotalMemory, ProcessMemory : Integer);
var IdleTime, CreationTime, ExitTime, KernelTime, UserTime : TFileTime;
 IdleTime64, KernelTime64, UserTime64, NewProcT64, DIdle, Dsum : Int64;
 MemStatusCPU: TMemoryStatus;
begin
   Try
   Dsum := 1;   //... только чтобы не было Warning
//=== 1) Определим загрузку CPU всеми процессами в системе (Total) ====
   GetSystemTimes(IdleTime, KernelTime, UserTime);
// См.   https://www.codeproject.com/Articles/9113/
//   Get-CPU-Usage-with-GetSystemTimes
   Move(IdleTime, IdleTime64, 8);
   Move(KernelTime, KernelTime64, 8);    Move(UserTime, UserTime64, 8);
      If Initialize then Total := 0 else begin
      DIdle := IdleTime64 - OldIdleTime64;
      Dsum := KernelTime64 + UserTime64 - OldSysTime64;
      If Dsum <= 0 then DSum := 1;
// KernelTime включает в себя и IdleTime !
      Total := Round(100.0 * (Dsum - Didle) / Dsum);
      If Total < 0 then Total := 0;
      If Total > 100 then Total := 100;
      end;
   OldIdleTime64 := IdleTime64;  // Время простоя CPU
// Общее время, включая простой
   OldSysTime64 := KernelTime64 + UserTime64;
//
//=== 2) Определим загрузку CPU только нашим процессом (MyProcess) ====
   GetProcessTimes(GetCurrentProcess, CreationTime,
    ExitTime, KernelTime, UserTime);
   Move(KernelTime, KernelTime64, 8);  Move(UserTime, UserTime64, 8);
   NewProcT64 := KernelTime64 + UserTime64;
// Dsum- интервал астрономического времени между 2-мя вызовами CPUusage
   If Initialize then MyProcess := 0 else
    MyProcess := Round(100.0 * (NewProcT64 - OldProcT64) / Dsum);
   If MyProcess < 0 then MyProcess := 0;
   If MyProcess > 100 then MyProcess := 100;
   OldProcT64 := NewProcT64;
//
//=============== 3) Определим загрузку памяти CPU ====================
   MemStatusCPU.dwLength := SizeOf(MemStatusCPU);
   GlobalMemoryStatus(MemStatusCPU);
   TotalMemory := MemStatusCPU.dwMemoryLoad; // Всего занято процентов
   ProcessMemory := Round(100 * MyGetAllocatedMemory /
    MemStatusCPU.dwTotalPhys);  // Только нашим процессом, в процентах
   except
   Total := 0;   MyProcess := 0;
   TotalMemory := 0;   ProcessMemory := 0;
   end;
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//+++++++++++ Далее работаем с имеющимися в системе GPU +++++++++++++++
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
type Empty_Record = record  end;   // По аналогии с OpenCL Headers
  nvmlDevice_t = ^Empty_Record;    // в Header-файле для MS C++ также
  p_nvmlDevice_t = ^nvmlDevice_t;
  nvmlReturn_t = Integer;
//..... Для определения загрузки GPU и контроллера памяти NVIDIA ......
  nvmlUtilization_t = packed record
    GPU,  Mem : UInt;
   end;
  p_nvmlUtilization_t = ^nvmlUtilization_t;
//......... Для определения процентной загрузки памяти NVIDIA .........
  nvmlMemory_t = packed record
    Total,  Free,  Used : UInt64;
   end;
  p_nvmlMemory_t = ^nvmlMemory_t;
//
//~~~~ Clock types (для определения частот GPU и Memory у NVIDIA) ~~~~~
const NVML_CLOCK_GRAPHICS  = 0;   // Graphics clock domain
      NVML_CLOCK_MEM       = 2;   // Memory clock domain

var  // Описываем прототипы вызываемых из nvml.dll функций
 nvmlInit : function() :  nvmlReturn_t;  stdcall;
 nvmlShutdown : function() :  nvmlReturn_t;  stdcall;
//.....................................................................
 nvmlDeviceGetCount : function(pDevCount: pUInt) :
  nvmlReturn_t;  stdcall;
//.....................................................................
 nvmlDeviceGetHandleByIndex : function (GPUnum : UInt;
  pHandle: p_nvmlDevice_t) :  nvmlReturn_t;  stdcall;
//.....................................................................
 nvmlDeviceGetUtilizationRates : function (GPU_Handle1 : nvmlDevice_t;
  pUtilization: p_nvmlUtilization_t) :  nvmlReturn_t;  stdcall;
//.....................................................................
 nvmlDeviceGetMemoryInfo : function(GPU_Handle1 : nvmlDevice_t;
  pDeviceMem: p_nvmlMemory_t) :  nvmlReturn_t;  stdcall;
//.....................................................................
 nvmlDeviceGetTemperature : function(GPU_Handle1 : nvmlDevice_t;
  SensorType : Integer;  pTemp : pUInt) :  nvmlReturn_t;  stdcall;
//.....................................................................
 nvmlDeviceGetClockInfo : function(GPU_Handle1 : nvmlDevice_t;
  ClockType: Integer;  Clock : pUInt) :  nvmlReturn_t;  stdcall;
//.....................................................................
 nvmlDeviceGetFanSpeed : function(GPU_Handle1 : nvmlDevice_t;
  speed: pUInt) :  nvmlReturn_t;  stdcall;
//.....................................................................
 nvmlDeviceGetPowerUsage : function(GPU_Handle1 : nvmlDevice_t;
  pPower : pUint) :  nvmlReturn_t;  stdcall;
//
//
//+++++++++++ Типы для библиотечных функций atiadlxx.dll ++++++++++++++
//                         (AMD - GPU)
// MyMALLOC подсмотрел здесь :   http://www.delphipraxis.net/
//     131660-uebersetzung-c-pascal-callback-zugriffsverletzung.html
type tADL_MAIN_MALLOC_CALLBACK = function(iSize : Integer) :
   Pointer;   stdcall;
  pADL_MAIN_MALLOC_CALLBACK = ^tADL_MAIN_MALLOC_CALLBACK;
// Указатель на эту ф-ю выделения памяти передаётся в инициализацию AMD
function MyMALLOC(iSize : Integer) : Pointer;  stdcall;
begin
Result := AllocMem(iSize);
end;

//...... Для получении информации о загрузке GPU-AMD и частотах .......
type ADLPMActivity = packed record
    iSize : Integer;   // Must be set to the size of the structure
    iEngineClock : Integer;  // Current engine frequency [in 10KHz]
    iMemoryClock : Integer;  // Current memory frequency [in 10KHz]
    iVddc : Integer;         //    Current core voltage.
    iActivityPercent : Integer;  //    GPU utilization.
    iCurrentPerformanceLevel : Integer; //Performance level index.
    iCurrentBusSpeed : Integer;  //    Current PCIE bus speed.
    iCurrentBusLanes : Integer;  //    Number of PCIE bus lanes.
    iMaximumBusLanes : Integer;  //    Maximum number of PCIE bus lanes.
    iReserved : Integer;         //    Reserved for future purposes.
   end;
 pADLPMActivity = ^ADLPMActivity;

//........ Для получении информации о температуре GPU-AMD .............
type ADLTemperature = packed record
    iSize : Integer;   //    Must be set to the size of the structure
    iTemperature : Integer;  //    Temperature in millidegrees Celsius
   end;
 pADLTemperature = ^ADLTemperature;

//.......... Для получении информации о памяти на борту AMD ...........
type ADLMemoryInfo = packed record
    iMemorySize : Int64;       // Memory size in bytes
// Только AnsiChar позволяет прочитать тип памяти из следующей строки
    strMemoryType: array[0..255] of AnsiChar;
    iMemoryBandwidth : Int64;  // Memory bandwidth in Mbytes/s.
   end;
  pADLMemoryInfo = ^ADLMemoryInfo;

//........ Для получении информации о скорости вентилятора AMD ........
const ADL_DL_FANCTRL_SPEED_TYPE_PERCENT      = 1;
      ADL_DL_FANCTRL_FLAG_USER_DEFINED_SPEED = 1;

type ADLFanSpeedValue = packed record
    iSize : Integer;   // Must be set to the size of the structure
// Possible values: ADL_DL_FANCTRL_SPEED_TYPE_PERCENT or
//  ADL_DL_FANCTRL_SPEED_TYPE_RPM
    iSpeedType : Integer;
    iFanSpeed : Integer;   // Fan speed value
// The only flag for now is: ADL_DL_FANCTRL_FLAG_USER_DEFINED_SPEED
    iFlags : Integer;
   end;
  pADLFanSpeedValue = ^ADLFanSpeedValue;
//
//=== Функции Overdrive6 работают не на всех системах => Overdrive5 ===
var  // Описываем прототипы вызываемых из atiadlxx.dll функций
  ADL_Main_Control_Create : function(
    callback : pADL_MAIN_MALLOC_CALLBACK;
    iEnumConnectedAdapters : Integer) :  nvmlReturn_t;  stdcall;
//.....................................................................
  ADL_Main_Control_Destroy: function() :  nvmlReturn_t;  stdcall;
//.....................................................................
  ADL_Overdrive5_CurrentActivity_Get: function(iAdapterIndex : Integer;
    pActivity : pADLPMActivity) :  nvmlReturn_t;  stdcall;
//.....................................................................
  ADL_Adapter_NumberOfAdapters_Get : function(pNumAdapters : pInt) :
    nvmlReturn_t;  stdcall;
//.....................................................................
  ADL_Adapter_Active_Get : function(iAdapterIndex : Integer;
    pStatus : pInt) : nvmlReturn_t;  stdcall;
//.....................................................................
  ADL_Overdrive5_Temperature_Get : function(iAdapterIndex : Integer;
    iThermalControllerIndex : Integer;
    pTemperature : pADLTemperature) :  nvmlReturn_t;  stdcall;
//.....................................................................
  ADL_Overdrive5_FanSpeed_Get : function(iAdapterIndex : Integer;
    iThermalControllerIndex : Integer;
    pFanSpeedValue : pADLFanSpeedValue) : nvmlReturn_t;  stdcall;
//.....................................................................
  ADL_Adapter_MemoryInfo_Get : function(iAdapterIndex : Integer;
    pMemoryInfo: pADLMemoryInfo) : nvmlReturn_t;  stdcall;
//.....................................................................

var GPU_count_NVIDIA, GPU_count_AMD: Integer; //UInt;
    LibHandleNV, LibHandleAMD: hModule;
    ShowMessageAMD : Boolean;
//
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//++++ Инициализация функций из библиотек nvml.dll и atiadlxx.dll +++++
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure GPUusageInitializeNVIDIA;   forward;
procedure GPUusageInitializeAMD;   forward;
//
procedure GPUusageInitialize;
begin
GPUusageInitializeNVIDIA;
GPUusageInitializeAMD;
end;
//
//=====================================================================
//====  Сначала пытаемся инициализировать библиотеку для NVIDIA  ======
//=====================================================================
procedure GPUusageInitializeNVIDIA;
//.... По умолчанию устанавливается только версия библиотеки 64bit ....
// См.  https://devtalk.nvidia.com/default/topic/525514/
//   can-39-t-find-nvml-dll-in-display-drivers/
const nvml_Lib : WideString =
  'C:\Program Files\NVIDIA Corporation\NVSMI\nvml.dll';
//.....................................................................
   procedure ProcNV(var Fun: Pointer;  const FunName: WideString);
   begin
   FreeAndNil(Fun);
// Здесь 2-ой параметр м.б. либо ANSI, либо Unicode=WideChar - overload
   Fun := GetProcAddress(LibHandleNV, PWideChar(FunName));
   end;
//.....................................................................
begin
   If not Initialize_NVIDIA_OK then try
// Проверим, существует ли по указанному пути файл библиотеки nvml.dll
   If not FileExists(nvml_Lib) then raise EAbort.Create('');
// Лучше конкретно писать LoadLibraryW : работаем с Unicode = PWideChar
   LibHandleNV := LoadLibraryW(PWideChar(nvml_Lib));
// Если не удалось загрузить библиотеку nvml.dll
   If LibHandleNV = 0 then raise EAbort.Create('');
// Определяем адреса всех необходимых процедур из библиотеки NVIDIA
   ProcNV(@nvmlInit, 'nvmlInit');
   ProcNV(@nvmlShutdown, 'nvmlShutdown');
   ProcNV(@nvmlDeviceGetCount, 'nvmlDeviceGetCount');
   ProcNV(@nvmlDeviceGetHandleByIndex, 'nvmlDeviceGetHandleByIndex');
   ProcNV(@nvmlDeviceGetUtilizationRates,
    'nvmlDeviceGetUtilizationRates');
   ProcNV(@nvmlDeviceGetMemoryInfo, 'nvmlDeviceGetMemoryInfo');
   ProcNV(@nvmlDeviceGetTemperature, 'nvmlDeviceGetTemperature');
   ProcNV(@nvmlDeviceGetClockInfo, 'nvmlDeviceGetClockInfo');
   ProcNV(@nvmlDeviceGetFanSpeed, 'nvmlDeviceGetFanSpeed');
   ProcNV(@nvmlDeviceGetPowerUsage, 'nvmlDeviceGetPowerUsage');
// Инициализация функций библиотеки nvml.dll
   If nvmlInit() <> 0 then raise EAbort.Create('');
// Определение кол-ва GPU в конкретной системе : только для контроля
   If nvmlDeviceGetCount(@GPU_count_NVIDIA) <> 0 then
    raise EAbort.Create('');
   Initialize_NVIDIA_OK := True;
   except
   Initialize_NVIDIA_OK := False;     FreeLibrary(LibHandleNV);
   end;
end;
//
//=====================================================================
//======  Далее пытаемся инициализировать библиотеку для AMD  =========
//=====================================================================
procedure GPUusageInitializeAMD;
var MaxAMD, iAdapterAMD, StatusAMD : Integer;
//.....................................................................
   procedure ProcAMD(var Fun: Pointer;  const FunName: WideString);
   begin
   FreeAndNil(Fun);
// Здесь 2-ой параметр м.б. либо ANSI, либо Unicode(WideChar)- overload
   Fun := GetProcAddress(LibHandleAMD, PWideChar(FunName));
   end;
//.....................................................................
begin
ShowMessageAMD := True;
   If not Initialize_AMD_OK then try
   LibHandleAMD := LoadLibraryW(PWideChar(WideString('atiadlxx.dll')));
// Если не удалось загрузить библиотеку atiadlxx.dll
   If LibHandleAMD = 0 then raise EAbort.Create('');
// Определяем адреса всех необходимых процедур из библиотеки AMD
   ProcAMD(@ADL_Main_Control_Create, 'ADL_Main_Control_Create');
   ProcAMD(@ADL_Main_Control_Destroy, 'ADL_Main_Control_Destroy');
   ProcAMD(@ADL_Overdrive5_CurrentActivity_Get,
    'ADL_Overdrive5_CurrentActivity_Get');
   ProcAMD(@ADL_Adapter_NumberOfAdapters_Get,
    'ADL_Adapter_NumberOfAdapters_Get');
   ProcAMD(@ADL_Adapter_Active_Get, 'ADL_Adapter_Active_Get');
   ProcAMD(@ADL_Overdrive5_Temperature_Get,
    'ADL_Overdrive5_Temperature_Get');
   ProcAMD(@ADL_Overdrive5_FanSpeed_Get,
    'ADL_Overdrive5_FanSpeed_Get');
   ProcAMD(@ADL_Adapter_MemoryInfo_Get,
    'ADL_Adapter_MemoryInfo_Get');
//
//....... Определяем GPU_HandleAMD (инициализация функций AMD) ........
// 2-ой парметр = 0 : значит, что для всех доступных AMD-устройств
   If ADL_Main_Control_Create(@MyMALLOC, 0) <> 0
    then raise EAbort.Create('');
//
//=====> Получаем информацию об общем количестве адаптеров AMD <=======
   If ADL_Adapter_NumberOfAdapters_Get(@MaxAMD) <> 0
    then raise EAbort.Create('');
//......... Подсчитаем количество активных адаптеров AMD ..............
   GPU_count_AMD := 0; // На моноблоке ASUS ET2702i вышло MaxAMD = 6 !
      For iAdapterAMD := 0 to MaxAMD - 1 do begin
      If ADL_Adapter_Active_Get(iAdapterAMD, @StatusAMD) <> 0
       then raise EAbort.Create('');
      If StatusAMD <> 0 then Inc(GPU_count_AMD);
      end;
//.....................................................................
   Initialize_AMD_OK := True;
   except
   Initialize_AMD_OK := False;     FreeLibrary(LibHandleAMD);
   end;
end;
//
procedure NVIDIA_Shutdown;  forward;
//=====================================================================
//===== Определение загрузки NVIDIA-GPU с номером GPU_num (от 0) ======
//=====================================================================
procedure GPUusageNVIDIA(const GPU_num : Byte;
  out GPU_usage, MemoryController, Memory, // Всё в процентах
  Temperature,   // degrees C
  GPU_freq,  MEM_freq,  // MHz
  FanSpeed,      // Скорость вентилятора в процентах
  Power : Integer);  // Потребляемая мощность в Ваттах
var GPU_Handle : nvmlDevice_t;     UtilGPU : nvmlUtilization_t;
    MemGPU : nvmlMemory_t;         nvmlValue : UInt;
begin
//!!! Значение -1 -это признак, что параметр не удалось определить !!!!
GPU_usage := -1;     MemoryController := -1;    Memory := -1;
GPU_freq := -1;      MEM_freq := -1;
Temperature := -1;   FanSpeed := -1;       Power := -1;
   If Initialize_NVIDIA_OK and (GPU_num < GPU_count_NVIDIA) then try
//
//=============> Определение Handle для выбранного GPU <===============
   If nvmlDeviceGetHandleByIndex(GPU_num, @GPU_Handle) <> 0
    then raise EAbort.Create('');
// След. вызовы будут с ошибками, если nvml.dll от другой видеокарты!!
//
//====> Получаем информацию о загрузке потоковых процессоров GPU <=====
   If nvmlDeviceGetUtilizationRates(GPU_Handle, @UtilGPU) = 0
    then begin
   GPU_usage := UtilGPU.GPU;    MemoryController := UtilGPU.Mem;
   end;
//
//=======> Получаем информацию об использовании памяти GPU <===========
   If nvmlDeviceGetMemoryInfo(GPU_Handle, @MemGPU) = 0
    then Memory := Round( 100 * MemGPU.Used / MemGPU.Total );
//
//=========> Получаем информацию о температуре NVIDIA-GPU <============
   If nvmlDeviceGetTemperature(GPU_Handle, 0, @nvmlValue) = 0
    then Temperature := nvmlValue;
//
//=====> Получаем информацию о частотах процессора и памяти GPU <======
   If nvmlDeviceGetClockInfo(GPU_Handle, NVML_CLOCK_GRAPHICS,
    @nvmlValue) = 0 then GPU_freq := nvmlValue;
   If nvmlDeviceGetClockInfo(GPU_Handle, NVML_CLOCK_MEM,
    @nvmlValue) = 0 then MEM_freq := nvmlValue;
//
//=====> Получаем информацию о скорости вентилятора NVIDIA-GPU <=======
   If nvmlDeviceGetFanSpeed(GPU_Handle, @nvmlValue) = 0
    then FanSpeed := nvmlValue;    //...в процентах, а не в RPM
//
//=====> Получаем информацию о потребляемой мощности NVIDIA-GPU <======
   If nvmlDeviceGetPowerUsage(GPU_Handle, @nvmlValue) = 0
    then Power := Round(1E-3 * nvmlValue);  //...миллиВатты в Ватты
//
   except
   NVIDIA_Shutdown;
   end;
// Если не удалось определить ни одного параметра, отключаем библиотеку
If GPU_usage + MemoryController + Memory + GPU_freq + MEM_freq +
 Temperature + FanSpeed + Power = -8 then NVIDIA_Shutdown;
end;
//
procedure AMD_Shutdown;  forward;
//=====================================================================
//======= Определение загрузки AMD-GPU с номером GPU_num (от 0) =======
//=====================================================================
procedure GPUusageAMD(const GPU_num : Byte;
  out GPU_usage, Temperature, GPU_freq, Mem_freq, FanSpeed : Integer);
var MemoryInfo : ADLMemoryInfo;      MemoryType : String;
    MyFanSpeed : ADLFanSpeedValue;   MyActivity : ADLPMActivity;
    MyTemp : ADLTemperature;
const CRLF = #13#10;   // Переход на новую строку для ShowMessage
begin
//!!! Значение -1 -это признак, что параметр не удалось определить !!!!
GPU_usage := -1;      GPU_freq := -1;    MEM_freq := -1;
Temperature := -1;    FanSpeed := -1;
   If Initialize_AMD_OK and (GPU_num < GPU_count_AMD) then try
//
//====> Получаем информацию о загрузке потоковых процессоров GPU <=====
   MyActivity.iSize := SizeOf(ADLPMActivity);
      If ADL_Overdrive5_CurrentActivity_Get(GPU_num, @MyActivity) = 0
      then begin
      GPU_usage := MyActivity.iActivityPercent;
      GPU_freq := Round(0.01 * MyActivity.iEngineClock);
      MEM_freq := Round(0.01 * MyActivity.iMemoryClock);
      end;
//
//===========> Получаем информацию о температуре AMD-GPU <=============
   MyTemp.iSize := SizeOf(ADLTemperature);
   If ADL_Overdrive5_Temperature_Get(GPU_num, 0, @MyTemp) = 0 then
// Температура была в милли-градусах C
    Temperature := Round(0.001 * MyTemp.iTemperature);
//
//======> Получаем информацию о скорости вентилятора AMD-GPU <=========
   MyFanSpeed.iSize := SizeOf(ADLFanSpeedValue);
   MyFanSpeed.iFlags := ADL_DL_FANCTRL_FLAG_USER_DEFINED_SPEED;
   MyFanSpeed.iSpeedType := ADL_DL_FANCTRL_SPEED_TYPE_PERCENT;
   If ADL_Overdrive5_FanSpeed_Get(GPU_num, 0, @MyFanSpeed) = 0
    then FanSpeed := MyFanSpeed.iFanSpeed;
//
//...... Один раз покажем информацию о памяти на борту AMD-GPU ........
      If ShowMessageAMD then begin
      ShowMessageAMD := False;
//===> Получаем информацию об общем количестве памяти на борту GPU <===
         If ADL_Adapter_MemoryInfo_Get(GPU_num, @MemoryInfo) = 0
         then begin
// Переводим AnsiString --> String , контролируем длину строки
         MemoryType := String(MemoryInfo.strMemoryType);
         ShowMessage('Active GPU_count_AMD = ' +
          IntToStr(GPU_count_AMD) + CRLF +
          'Memory (' + MemoryType + ') = ' +
          IntToStr(Round(MemoryInfo.iMemorySize / (1024*1024))) +
          ' MBytes' + CRLF + 'MemoryType string Length = ' +
          IntToStr(Length(MemoryType)) + CRLF + 'Memory Bandwidth= ' +
          IntToStr(MemoryInfo.iMemoryBandwidth) + ' MBytes/s');
         end;
      end;
   except
   AMD_Shutdown;
   end;
// Если не удалось определить ни одного параметра, отключаем библиотеку
If GPU_usage + GPU_freq + MEM_freq +
 Temperature + FanSpeed = -5 then AMD_Shutdown;
end;
//
//---------------------------------------------------------------------
//----------- Отключение библиотек nvml.dll и atiadlxx.dll ------------
//---------------------------------------------------------------------
procedure NVIDIA_Shutdown;
begin
   If Initialize_NVIDIA_OK then try
   Initialize_NVIDIA_OK := False;    nvmlShutdown();
   finally
   FreeLibrary(LibHandleNV);
   end;
end;
//.....................................................................
procedure AMD_Shutdown;
begin
   If Initialize_AMD_OK then try
   Initialize_AMD_OK := False;   ADL_Main_Control_Destroy();
   finally
   FreeLibrary(LibHandleAMD);
   end;
end;
//.....................................................................
procedure GPUusageShutdown;
begin
NVIDIA_Shutdown;   AMD_Shutdown;
end;

end.


Всех с наступающим Новым годом !!


Это сообщение отредактировал(а) Prok12 - 27.1.2018, 08:51
PM MAIL   Вверх
Prok12
Дата 6.6.2019, 16:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 9
Регистрация: 8.11.2011

Репутация: нет
Всего: 3



Обновлённая ссылка на DEMO:
Demo 2019
Последняя версия в папке:
OpenCL_Demo2018 Barrier and Local_Memory REDUCT Delphi Tokyo 10.2.2 !! LAST !!

Это сообщение отредактировал(а) Prok12 - 6.6.2019, 17:14
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »


 




[ Время генерации скрипта: 0.1386 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.