![]() |
|
![]() ![]() ![]() |
|
Spike |
|
|||
![]() Шустрый ![]() Профиль Группа: Участник Сообщений: 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 |
|||
|
||||
Cr@$h |
|
|||
![]() Исследователь ![]() ![]() ![]() Профиль Группа: Участник Клуба Сообщений: 1693 Регистрация: 3.4.2005 Где: Санкт-Петербург, Россия Репутация: 1 Всего: 41 |
||||
|
||||
Spike |
|
|||
![]() Шустрый ![]() Профиль Группа: Участник Сообщений: 52 Регистрация: 5.7.2005 Где: Протвино МО Репутация: нет Всего: 1 |
||||
|
||||
Cr@$h |
|
|||
![]() Исследователь ![]() ![]() ![]() Профиль Группа: Участник Клуба Сообщений: 1693 Регистрация: 3.4.2005 Где: Санкт-Петербург, Россия Репутация: 1 Всего: 41 |
Хорошо. Я залью, обязательно.
|
|||
|
||||
![]() ![]() ![]() |
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей) | |
0 Пользователей: | |
« Предыдущая тема | Fortran | Следующая тема » |
|
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности Powered by Invision Power Board(R) 1.3 © 2003 IPS, Inc. |