Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Fortran > Переменные процедурного типа: есть ли такое в F90


Автор: voytalexey 28.11.2011, 18:16
Обычно работаю на Дельфи, а тут пришлось писать небольшую DLL на Compaq VF 6.5
И появился вопрос: есть ли возможность в фортране объявлять и использовать переменные процедурного типа?
Делаю DLL с использованием IMSL, использую функцию вычисления интеграла:

CALL DQDAGS (Fun1, ArrX(i-1), ArrX(i), 0.001, 0.001, integral, ERREST);

Здесь первый параметр это имя функции. Таких функций у меня будет около десятка, все одной сигнатуры (как требует IMSL), но с разным содержанием. Вызов DQDAGS делается много раз внутри цикла. Не хочется делать внутри цикла монстру типа:

if (i==1) then; CALL DQDAGS (Fun1, .....); endif;
if (i==2) then; CALL DQDAGS (Fun2, .....); endif;
.......................
if (i==10) then; CALL DQDAGS (Fun10, .....); endif;

Хочется до цикла сдеать что-то типа:

if (i==1) then; Fun=Fun1; endif;
if (i==2) then; Fun=Fun2; endif;
.......................
if (i==10) then; Fun=Fun10; endif;

а внутри цикла вызывать
CALL DQDAGS (Fun, .....); 

Можно ли такое в принципе сделать в Фортран90, и как объявить переменную "Fun" ?
Че-то туплю, не могу в хелпе найти ни однозначно положительного, ни однозначно отрицательного ответа.
Буду благодарен за любой аргументированный ответ, хоть положительный, хоть отрицательный.

Автор: FCM 30.11.2011, 15:46
В современном Фортране (F2003, F2008) для этого есть ссылки на процедуры. Такую ссылку можно прикреплять к разным процедурам и пользоваться ее именем вместо имени адресата.
Но, если говорить о линейке Visual Fortran, к CVF6.5 это не относится.

В рамках CVF можно попробовать целочисленные указатели:
Код

PROGRAM SMTH__
  IMPLICIT NONE
  REAL(8), EXTERNAL :: ADRESAT_OF_P, FN1, FN2
  POINTER (P, ADRESAT_OF_P)
  INTEGER :: IFLAG
...
  IF(IFLAG==1)  P = LOC(FN1)
  IF(IFLAG==2)  P = LOC(FN2)
...

  CALL SUB(ADRESAT_OF_P, ...)
 ...
END 

SUBROUTINE SUB(FUN, ...)
    REAL(8):: FUN
   ...
END


Попробуй. Напиши, что получилось

Возможно есть еще подходы -  но что-то пока в голову ничего другого не идет. 

PS/ 
Если в IF-блоке одна инструкция, то вместо, например,  
Цитата(voytalexey @  28.11.2011,  18:16 Найти цитируемый пост)
if (i==1) then; CALL DQDAGS (Fun1, .....); endif;

можно проще
Код

if (i==1)  CALL DQDAGS (Fun1, .....)

Автор: voytalexey 1.12.2011, 15:21
Попробовал вариант предложенный FCM, с небольшими изменениями, т.к. впрямую в проект DLL не переносится.
На "живом" проекте выскакивала плавающая ошибка, сделал упрощённый модуль.
Вот что получилось в тестовом модуле:
Код

module Temp
implicit none
contains
!===============================================================================
subroutine TempTemp(ModelNo,AAA,BBB)
!DEC$ ATTRIBUTES  STDCALL, DLLEXPORT :: TempTemp
!DEC$ ATTRIBUTES  ALIAS: 'TempTemp'::TempTemp
!DEC$ ATTRIBUTES  VALUE :: ModelNo
!DEC$ ATTRIBUTES  REFERENCE :: AAA, BBB
integer(4) :: ModelNo
real(8) :: AAA, BBB,  x, y

!REAL(8), EXTERNAL :: ADRESAT_OF_P, MyFun1, MyFun2, MyFun3     error LNK2001: unresolved external symbol _MYFUN1
REAL(8), EXTERNAL :: ADRESAT_OF_P 
POINTER (P, ADRESAT_OF_P)

x=AAA
y=BBB

!ADRESAT_OF_P=1.11111    Error: This name has already been used as an external function name. 
!ADRESAT_OF_P=P            Error: This name has already been used as an external function name.

if (ModelNo==1) P = LOC(MyFun1)
if (ModelNo==2) P = LOC(MyFun2)
if (ModelNo==3) P = LOC(MyFun3)

!if (ModelNo==1) ADRESAT_OF_P = LOC(MyFun1)  Error: This name has already been used as an external function name. 

call MyMegaFun(ADRESAT_OF_P,x,y)
!call MyMegaFun(P,x,y)   Error: This actual argument must be the name of an external user function or the name of an intrinsic function. 

AAA=x
BBB=y
end subroutine 
!===============================================================================
function MyFun1(x)
real(8) ::x, MyFun1
MyFun1=1.1111*x;
end function
!===============================================================================
function MyFun2(x)
real(8) ::x, MyFun2
MyFun2=2.0*x;
!result=1.1111*x;
end function
!===============================================================================
function MyFun3(x)
real(8) ::x, MyFun3
MyFun3=3.0*x;
!result=1.1111*x;
end function
!===============================================================================
subroutine MyMegaFun(f,x,y)
real(8) ::x, y
real(8), external ::f
y=f(x);
end subroutine
!===============================================================================
end module

При проходе дебаггером видно что перед вызвовм 
call MyMegaFun(ADRESAT_OF_P,x,y)
указатель P указывает куда надо, а вот величина ADRESAT_OF_P в окне просмотра локальных переменных равна нулю.
Далее пошагово попадая внутрь "MyMegaFun" я вижу что переменные "x" и "y" имеют величину как и ожидается, а вот переменная "f" указывает куда-то в мусор, причем всегда в один и тот же, независимо от значения "ModelNo" и "P". Как следствие указателя в мусор, при выполнении строки "y=f(x);" вылетает AV.
Вот такие результаты.

Автор: FCM 1.12.2011, 17:24
Тот вариант, что я предложил,  проверял на Intel Visual Fortran 12.1  - все работало. 
Gfortran тот вариант не поддержал.
Видимо и CVF такой вариант  неприемлет.
Получили, что нестандартное расширение  ведет себя "нестандартно" (не одинаково) .
Стандартное (но уже в рамках F2003) решение подразумевает использование ссылок на процедуры - и поддерживается в Intel Fortran 12.1 и gfortran.

Хотелось бы понять стратегию твоего изначального проекта. Действительно ли нужен динамический выбор интегрируемой функции? Интегрируемая функция должна где задаваться - в CVF или в Delfi? 

Автор: BakinEugene 1.12.2011, 20:11
В программе, с которой я сейчас работаю, сделано так:

Код

    PROGRAM name

       REAL(8), EXTERNAL :: subName
       CALL another(subName)

    END PROGRAM name

     SUBROUTINE subName()
     ...
     END SUBROUTINE subName

     ...

    SUBROUTINE another(someSubroutine)
       REAL(8), EXTERNAL :: someSubroutine
       CALL someSubroutine()
    END SUBROUTINE


Но это написано на некой помеси 77 фортрана с 90, модули там не используются, и попытка распихать процедуры по модулям - рушит все это счастье. 
Зато компилируется и под Compaq и под gfortran.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)