Проблема соответствия возникает при использовании интерфейсов с указателями на функции

Я начинаю эту тему, чтобы попросить помощи в решении проблемы, которая может возникнуть из-за моей неправильной спецификации интерфейса функции, но я не знаю, как это исправить.

Сообщение об ошибке, с которым я столкнулся, короткое и просто говорит: «Недопустимое число или тип аргументов для lnsrch — аргументы fmin и func не согласуются».

Определение LNSRCH, FMIN и FUNC будет понятно из содержания ниже.

Исходный программный код обрезан, чтобы проиллюстрировать мое намерение, как показано ниже. Он состоит из трех частей: основной программной единицы с именем MAIN, модуля с именем MODEL и модуля с именем NEWTON). Вы должны быть в состоянии воспроизвести сообщение об ошибке, просто используя следующий единственный файл формата .f90: ссылка

Модуль MODEL просто определяет простую систему уравнений с двумя переменными ---y(1)=x(1); y(2)=x(2) --- в подпрограмме FUNC_SYSTEM1. Модуль MODEL также содержит абстрактный интерфейс для будущего расширения, так что я могу просто заставить указатель FUNCV ссылаться на любую другую систему уравнений того же типа, что и текущий пример системы уравнений FUNC_SYSTEM1, за исключением только количества переменных системы уравнений. .

MODULE model                                                             
    IMPLICIT NONE                            
    REAL, DIMENSION(:), POINTER :: fmin_fvecp
    ABSTRACT INTERFACE                              
        FUNCTION function_system_template(x) RESULT(y)     
        REAL, DIMENSION(:), INTENT(IN) :: x     
        REAL, DIMENSION(SIZE(x)) :: y           
        END FUNCTION                                
    END INTERFACE                                   
    PROCEDURE(function_system_template), POINTER :: funcv  
CONTAINS                                                          
    FUNCTION func_system1(x) Result(y)              
    IMPLICIT NONE                             
    REAL, DIMENSION(:), INTENT(IN) :: x   
    REAL, DIMENSION(size(x)) :: y                            
    y(1)=x(1)      
    y(2)=x(2)      
    END FUNCTION func_system1                           
END MODULE model

Модуль NEWTON определяет отношения между тремя подпрограммами, которые являются ключевыми для вычислений программы: BROYDEN вызывает FMIN для получения суммы квадратов x(1) и x(2); одновременно в FMIN вектор x(1) и x(2) присваивается указателю массива с именем FMIN_FVECP. Этот указатель массива должен использоваться для некоторых дополнительных вычислений в функции LNSRCH.

MODULE newton 
    USE model
    IMPLICIT NONE
    REAL, DIMENSION(:), POINTER :: fmin_fvecp
CONTAINS
    SUBROUTINE broyden(x,fmin_fvecp,funcv)           
        IMPLICIT NONE
        REAL, DIMENSION(:), INTENT(IN) :: x
        REAL, DIMENSION(size(x)), TARGET :: y
        REAL, DIMENSION(:), POINTER :: fmin_fvecp
        PROCEDURE(function_system_template), POINTER :: funcv
        fmin_fvecp=>y
        print*,fmin(x,fmin_fvecp,funcv)        ! Get the sum of squares
        print*,fmin_fvecp                      ! Show the vector x(1) and x(2)
        print*,lnsrch(x,fmin,fmin_fvecp,funcv) ! Show the figure calculated in LNSRCH
    END SUBROUTINE broyden

    FUNCTION fmin(x,fmin_fvecp,funcv) RESULT(y)
        IMPLICIT NONE
        REAL, DIMENSION(:), INTENT(IN) :: x
        REAL, DIMENSION(:), POINTER :: fmin_fvecp
        PROCEDURE(function_system_template), POINTER :: funcv
        REAL :: y
        fmin_fvecp=funcv(x)                    ! The value of FMIN_FVECP is assigend
        fmin=dot_product(fmin_fvecp,fmin_fvecp)! when FMIN is called by BROYDEN
    END FUNCTION fmin    

    FUNCTION lnsrch(x,func,a_fvecp,b_funcv) RESULT(y)
        IMPLICIT NONE
        REAL, DIMENSION(:), INTENT(IN) :: x
        REAL, DIMENSION(:), POINTER :: a_fvecp 
        PROCEDURE(function_system_template), POINTER :: b_funcv 
        INTERFACE                              
            FUNCTION func(x,fvecp,funcp) 
            IMPORT :: function_system_template  
            IMPLICIT NONE
            REAL, DIMENSION(:), INTENT(IN) :: x
            REAL :: func
            REAL, DIMENSION(:), POINTER :: fvecp 
            PROCEDURE(function_system_template), POINTER :: funcp 
            END FUNCTION                                
        END INTERFACE
        REAL, DIMENSION(SIZE(x)) :: y
        y=x+a_fvecp+b_funcv(x)+1000.
        END FUNCTION lnsrch
    END MODULE newton

Основная программная единица определяется следующим образом:

PROGRAM main
    USE model                            
    USE newton                           
    IMPLICIT NONE  
    REAL, DIMENSION(:), allocatable :: x
    allocate(x(2))
    x=[1.,2.]                         ! The input arguments to be passed into 
    funcv=>func_system1               ! the equation system, FUNC_SYSTEM1.
    call broyden(x,fmin_fvecp,funcv)  ! Call BROYDEN to do the subsequent calcualtion
    deallocate(x)    
END PROGRAM main

Извините за длинный пост. Спасибо за время, прочитанное через мой вопрос. С нетерпением жду любых входных данных для работы с сообщением об ошибке. Спасибо.

Ли


person Li-Pin Juan    schedule 28.04.2013    source источник
comment
Вы объявляете fmin_fvecp1 в обоих модулях, что является конфликтом, поскольку оба используются в программе. У вас есть fmin=.. в function fmin, но нет y=..., что является проблемой, поскольку вы объявили result (y).   -  person M. S. B.    schedule 29.04.2013
comment
@MSB: Это ошибка из-за копирования и вставки кода моей программы разных версий. Спасибо, что указали на это. После удаления избыточного объявления «FMIN_FVECP» из модуля «NEWTON» по-прежнему появляется то же сообщение об ошибке.   -  person Li-Pin Juan    schedule 29.04.2013


Ответы (2)


Помимо конфликтного использования fmin_fvecp1, упомянутого в комментариях (для которого я ожидал бы явной ошибки компилятора, обратите внимание, что объявления фиктивных аргументов с тем же именем скрывают переменную модуля в соответствующих процедурах модуля в модуле newton), обратите внимание, что тела интерфейса не автоматически наследуют через ассоциацию с хостом сущности, определенные в их единице области видимости хостов, если оператор IMPORT не переносит эту сущность в область действия блока интерфейса.

Следовательно, символ function_system_template в интерфейсном блоке для func фиктивного аргумента в lnsrch не совпадает с этим символом за пределами интерфейсного блока - следовательно, фактические и фиктивные процедуры аргументов не имеют одинаковых характеристик. Отсутствие объявления для символа внутри блока интерфейса является нарушением ограничения — я ожидал бы от компилятора достаточно конкретной ошибки для этого.

person IanH    schedule 28.04.2013
comment
Спасибо за ответ. Я использую оператор IMPORT в блоке интерфейса для фиктивного аргумента FUNC в LNSRCH и все равно получаю то же сообщение об ошибке. Могу я спросить, не заметили ли вы еще какую-нибудь ошибку? Мне странно, что сообщение о конфликте продолжает появляться. Спасибо. - person Li-Pin Juan; 29.04.2013
comment
Мою программу, добавленную оператором IMPORT, можно загрузить по этой ссылке. Это единый файл формата .f90. Спасибо. - person Li-Pin Juan; 29.04.2013

Код, показанный в приведенном ниже содержимом, — это обходной путь, который я наконец получил: я создаю дополнительный абстрактный интерфейс и объединяю все подпрограммы в один модуль. Подпрограммы BROYDEN, FMIN и LNSRCH переименовываются в MajorSolver, MiddleFunction и AssistantSolver. В основном блоке программы проводятся три эксперимента и показываются их результаты. Общий механизм каждого эксперимента работает следующим образом: выбирается система уравнений и передается в MajorSolver; тем временем предполагается указатель массива. Указатель массива вместе с указателем подпрограммы, который ссылается на MiddleFunction, передаются в функцию AssistantSolver для вычисления суммы квадратов элементов во входном аргументе x. В конце концов, MajorSolver возвращает для заданного входного вектора x долю квадрата соответствующей записи в сумме квадратов.

MODULE model                                                             
IMPLICIT NONE                            
REAL, DIMENSION(:), POINTER :: fvec1p, fvec2p           ! <<Note1>>           
ABSTRACT INTERFACE                                      ! <<Note1>> !
    FUNCTION functions_system(x) RESULT(y)              !           !
    IMPLICIT NONE                                       !           !
    REAL, DIMENSION(:), INTENT(IN) :: x                 !           !
    REAL, DIMENSION(SIZE(x)) :: y                       !           !
    END FUNCTION                                        !           !
END INTERFACE                                           !           !

ABSTRACT INTERFACE                                      ! <<Note2>> 
    FUNCTION middle_function_template(x,fvec_p,proc_p) RESULT(y)  
    IMPLICIT NONE                                       !
    REAL, DIMENSION(:), INTENT(IN) :: x                 !
    REAL, DIMENSION(:), POINTER :: fvec_p               !
    PROCEDURE(functions_system), POINTER :: proc_p      !
    REAL :: y                                           !
    END FUNCTION                                        !
END INTERFACE                                           !

PROCEDURE(functions_system), POINTER :: proc1p, proc2p  ! <<Note1>>   
CONTAINS                                                          
FUNCTION func_system1(x) RESULT(y)                      ! Equation system             
    IMPLICIT NONE                                       ! in two variables     
    REAL, DIMENSION(:), INTENT(IN) :: x   
    REAL, DIMENSION(size(x)) :: y                            
    y(1)=x(1)                                        
    y(2)=x(2)                                  
END FUNCTION func_system1

FUNCTION func_system2(x) RESULT(y)                      ! Equation system
    IMPLICIT NONE                                       ! in three variables  
    REAL, DIMENSION(:), INTENT(IN) :: x
    REAL, DIMENSION(size(x)) :: y
    y(1)=x(1)*10.
    y(2)=x(2)*10.
    y(3)=x(3)*10.
END FUNCTION func_system2

FUNCTION func_system3(x) RESULT(y)
    IMPLICIT NONE
    REAL, DIMENSION(:), INTENT(IN) :: x 
    REAL, DIMENSION(SIZE(x)) :: y
    REAL, DIMENSION(:), POINTER :: ans2
    proc2p=>func_system1                                ! 
    allocate(ans2(2))                                   ! <<Note2>>
    call MajorSolver(ans2,x(1:2),fvec2p,proc2p)         !
    y(1)=ans2(1)
    y(2)=ans2(2)
    y(3)=0.
    deallocate(ans2)
END FUNCTION func_system3

SUBROUTINE MajorSolver(ans,x,fvec_p,proc_p)
    IMPLICIT NONE
    REAL, DIMENSION(:), POINTER :: ans
    REAL, DIMENSION(:), INTENT(IN) :: x
    REAL, DIMENSION(:), POINTER :: fvec_p
    PROCEDURE(functions_system), POINTER :: proc_p
    PROCEDURE(middle_function_template), POINTER :: proc3p
    REAL, DIMENSION(SIZE(x)), TARGET :: y
    REAL :: z
    fvec_p=>y                                           ! pointer initialization <<Note1>>
    proc3p=>MiddleFunction                              ! <<Note2>>
    z=AssistantSolver(x,proc3p,fvec_p,proc_p) 
    ans=fvec_p**2/z          
END SUBROUTINE MajorSolver

FUNCTION MiddleFunction(x,fvec_p,proc_p)                ! <<Note2>> This function returns something
    IMPLICIT NONE                                       ! back to MajorSolver. In this    
    REAL, DIMENSION(:), INTENT(IN) :: x                 ! case, it computes the inner product.
    REAL, DIMENSION(:), POINTER :: fvec_p               ! 
    PROCEDURE(functions_system), POINTER :: proc_p
    REAL :: MiddleFunction
    fvec_p=proc_p(x)
    MiddleFunction=dot_product(fvec_p,fvec_p)
END FUNCTION

FUNCTION AssistantSolver(x,func,fvec_p,proc_p)          ! <<Note2>> 
    IMPLICIT NONE                                       ! 
    REAL, DIMENSION(:), INTENT(IN) :: x                 ! 
    procedure(middle_function_template), pointer :: func! 
    REAL, DIMENSION(:), POINTER :: fvec_p               !  
    PROCEDURE(functions_system), POINTER :: proc_p      ! 
    REAL :: AssistantSolver                             ! 
    AssistantSolver=func(x,fvec_p,proc_p)               ! 
END FUNCTION AssistantSolver                            ! 
END MODULE model

PROGRAM main
USE model
IMPLICIT NONE
REAL, DIMENSION(:), POINTER :: ans
REAL :: data2(2), data3(3)
data2=[1.,2.]
proc1p=>func_system1
allocate(ans(size(data2)))
call MajorSolver(ans,data2,fvec1p,proc1p)
write(*,'(a,2(f7.3))'),'Equations system 1: Ans= ',ans
nullify(ans)

data3=[1.,2.,3.]
proc1p=>func_system2
allocate(ans(size(data3)))
call MajorSolver(ans,data3,fvec1p,proc1p)
write(*,'(a,3(f7.3))'),'Equations system 2: Ans= ',ans
nullify(ans,proc1p)

data3=[1.,2.,3.]
proc1p=>func_system3
allocate(ans(size(data3)))                              ! 
call MajorSolver(ans,data3,fvec1p,proc1p)               ! <<Note1>>
write(*,'(a,3(f7.3))'),'Equations system 3: Ans= ',ans  ! 
! The answer is 0.059 0.941 0.000
! Because in system 3 we calculate system 1 first, the 3rd entry of 
! data3 will be ignored before passed into system 1. The result is
! [0.200 0.800] as we already know in system 1.
! Then this vector will be passed into MajorSolver again. So, 
! the answer is [0.059 0.941] = [0.2**2/(0.2**2+0.8**2) 0.8**2/(0.2**2+0.8**2)]

END PROGRAM main

Результат

Equations system 1: Ans=   0.200  0.800
Equations system 2: Ans=   0.071  0.286  0.643
Equations system 3: Ans=   0.059  0.941  0.000
Press any key to continue . . .
person Li-Pin Juan    schedule 30.04.2013