Поиск:

Ответ в темуСоздание новой темы Создание опроса
> [Interop] Вызов Fortran DLL из Delphi. Сюжет 1. Передача массивов в процедуры. 
:(
    Опции темы
Spike
Дата 18.9.2006, 10:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 52
Регистрация: 5.7.2005
Где: Протвино МО

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



Cr@$h показал вызов процедур из Fortran - DLL на С++, кину свои пять копеек:
Вызов Fortran-DLL из Delphi, Передача массивов в процедуры

код в Дельфи:   
   
   //Массив
   MyArray : array of array of array of integer;
   //Вектор экстентов
   Extents : array of integer;
   //Целочисленные указатели
   pExtents, pArray : integer;

   SetLength(Extents, 3);

   Extents[0]:=StrToInt(Edit1.Text); //Указатели
   Extents[1]:=StrToInt(Edit2.Text); //Указатели
   Extents[2]:=StrToInt(Edit3.Text); //Данные

   SetLength(MyArray, Extents[0], Extents[1], Extents[2]);

......
//Заполнение массива
......

 pExtents:=integer(pointer(Extents));
 pArrey:=integer(pointer(MyArray));

//Вызов фортранной DLL
   DecodeArray(3,pExtents,pArray);


Интерфейсный модуль:

unit InterfaceUnit;
interface
   procedure DecodeArray(Dim, pExtents, pMat: integer); stdcall;
implementation
   procedure DecodeArray; external 'FortranDLL.dll' name 'FDLL_mp_decodearray';
end.

код в Фортране:

module FDLL

use Assistant

implicit none

contains

!**************************************************************************
subroutine DecodeArray(Dim,pExtents,pArray)

  !DEC$ ATTRIBUTES STDCALL, DLLEXPORT::DecodeArray

  !Параметры процедуры
    integer Dim            !Размерность массива
    integer pExtents    !Указатель на вектор экстентов
    integer pArray        !Указатель на массив
  !Локальные переменные
    integer Extents(Dim)    !Вектор экстентов
    integer rows, cols        !Экстенты формируемого массива
    integer FilledCols        !Счетчик заполненных столбцов
  !Назначение указателей
    pointer(pExtents, Extents)    !Заполнение вектора экстентов
!=================
    integer i, j
!=================

    FilledCols=0
    
    !Экстенты формируемого динамического массива 
    !    rows - последний элемент вектора Extents (данные)
    !    cols - произведение всех элементов Extents кроме последнего
    rows=Extents(Dim)
    cols=product(Extents(1:(Dim-1)))

    
    !Размещение динамического массива
    call ConfigArray(.TRUE., rows, cols)

!Вызов "распаковки" динамического массива в массив Array
         call pRArray2Array(Dim, Extents, pArray, 1, FilledCols)
!Некие операции с массивом Array
    Array=Array*5

    FilledCols=0
!Запаковывка в прежнем виде
    call Array2pRArray(Dim, Extents, pArray, 1, FilledCols)

!Удаление динамического массива
    call ConfigArray(FALSE.)
end subroutine DecodeArray
!************************************************************************** 
end module FDLL




module Assistant

implicit none

save
   integer, allocatable :: Array( : , : )



contains

!**************************************************************************
!Конфигурирование массива 
!**************************************************************************
subroutine ConfigArray(AllocateDeallocate, rows, cols)
        
    integer, optional :: rows, cols
    logical  AllocateDeallocate

!=================
    
    !Если массив Array еще не размещен
    if (.NOT.(allocated(Array))) then
        !Если массив Array надо разместить в памяти
        if (AllocateDeallocate) then
            !Размещение массива Array в памяти
            allocate(Array(rows,cols))
        end if
    !Если массив Array уже размещен
    else
        !Если надо освободить память от массива Array
        if (.NOT.(AllocateDeallocate)) then
            !Освобождение памяти от массива Array
            deallocate(Array)
        end if
    end if

!=================

end subroutine ConfigArray
!**************************************************************************


!**************************************************************************
!Рекурсивная процедура формирования массива Array из памяти
!(из вектора векторов)
!**************************************************************************
recursive subroutine pRArray2Array(Dim, Extents, pArray, CurDim, FilledCols)
        
  !Входные параметры
    integer Dim            !Размерность массива
    integer Extents(Dim)    !Вектор экстентов
    integer pArray        !Указатель на массив
    integer CurDim        !Текущее измерение в рекурсии
    integer FilledCols    !Счетчик заполненных столбцов

!=================

  !Локальные переменные
    integer  i
    integer  ArrayV(Extents(CurDim))

!=================

  !Указатели
    pointer(pArrayV, ArrayV)

!=================

  !Заполняем вектор ArrayV значениями ячеек памяти начиная с pArray
    pArrayV=pArray

  !Если спустились на нижний уровень рекурсии то заполняем вектор Column
  !значениями ячеек памяти начиная с ArrayV(i)
    if (CurDim==Dim) then
      !Увеличиваем на 1 счетчик заполненных столбцов массива Array
        FilledCols=FilledCols+1
      !Заполняем столбец с индексом FilledCols массива Array
        Array(1:Extents(Dim), FilledCols)=ArrayV
    else
      !Цикл по элементам вектора ArrayV
        do i=1,Extents(CurDim)
          !Рекурсивный вызов
            call pRArray2Array(Dim, Extents, ArrayV(i), CurDim+1, FilledCols)
        end do
    end if

end subroutine pRArray2Array
!**************************************************************************


!**************************************************************************
!Рекурсивная процедура изменения вектора векторов в памяти из массива Array
!
!**************************************************************************
recursive subroutine Array2pRArray(Dim, Extents, pArray, CurDim, FilledCols)
        
  !Входные параметры
    integer Dim            !Размерность массива
    integer Extents(Dim)    !Вектор экстентов
    integer pArray        !Указатель на массив
    integer CurDim        !Текущее измерение в рекурсии
    integer FilledCols    !Счетчик заполненных столбцов

!=================

  !Локальные переменные
    integer  i
    integer  ArrayV(Extents(CurDim))

!=================

  !Указатели
    pointer(pArrayV, ArrayV)

!=================

  !Заполнение вектора ArrayV значениями ячеек памяти начиная с pArray
    pArrayV=pArray

  !Если спустились на нижний уровень рекурсии
    if (CurDim==Dim) then
      !Увеличиваем на 1 счетчик заполненных столбцов массива Array
        FilledCols=FilledCols+1
      !Заполняем вектор векторов в памяти из массива Array
        ArrayV=Array(1:Extents(Dim), FilledCols)
    else
      !Цикл по элементам вектора ArrayV
        do i=1,Extents(CurDim)
          !Рекурсивный вызов
            call Array2pRArray(Dim, Extents, ArrayV(i), CurDim+1, FilledCols)
        end do
    end if

end subroutine Array2pRArray
!**************************************************************************

end module Assistant

В приведенном примере формируется двумерный массив, где столбцы - вектора данных из исходного динамического массива в Дельфи. Если сильно уж нужно будет именно многомерный массив в Фортране, то необходимо жестко прописывать размерности при объявлении Array и т.д.

Cr@$h, это можно в Forki - права соблюдены ;-) 

Это сообщение отредактировал(а) Spike - 3.3.2010, 09:48
PM MAIL   Вверх
Cr@$h
Дата 23.9.2006, 05:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Исследователь
***


Профиль
Группа: Участник Клуба
Сообщений: 1693
Регистрация: 3.4.2005
Где: Санкт-Петербург, Россия

Репутация: 1
Всего: 41



Цитата(Spike @  18.9.2006,  11:15 Найти цитируемый пост)
Cr@$h, это можно в Forki - права соблюдены 

Конечно, давай перекину. Нужно даже. Оформлять как авторскую статью или как общую статью Viki?
PM MAIL ICQ   Вверх
Spike
Дата 25.9.2006, 14:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 52
Регистрация: 5.7.2005
Где: Протвино МО

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



Цитата(Cr@$h @  23.9.2006,  05:46 Найти цитируемый пост)
Оформлять как авторскую статью или как общую статью Viki? 

Да все равно
PM MAIL   Вверх
Cr@$h
Дата 25.9.2006, 17:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Исследователь
***


Профиль
Группа: Участник Клуба
Сообщений: 1693
Регистрация: 3.4.2005
Где: Санкт-Петербург, Россия

Репутация: 1
Всего: 41



Хорошо. Я залью, обязательно.
PM MAIL ICQ   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Fortran | Следующая тема »


 




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


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

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