Pointers 使用带有函数指针的接口时会出现一致性问题

我启动这个线程是为了请求帮助解决一个问题，这个问题可能来自于我对函数接口的错误规范，但我不知道如何修复它

我遇到的错误消息很短，只是说，“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

很抱歉邮件太长。谢谢你花时间阅读我的问题。期待任何关于解决错误消息的输入。谢谢

---

Lee

除了注释中提到的fmin_fvecp1的冲突用法（我认为这是一个显式的编译器错误，请注意，同名的伪参数声明将模块变量隐藏在模块

newton

中的相关模块过程中）之外，请注意，接口主体不会通过主机关联自动继承在其主机范围单元中定义的实体，除非IMPORT语句将该实体引入接口块的范围

---

因此，

lnsrch

中的

func

伪参数的接口块中的符号

function\u system\u template

与接口块外的符号不同-因此，实际参数过程和伪参数过程不具有相同的特征。接口块中缺少符号声明是一种约束冲突-我本以为编译器会为此产生一个合理的特定错误。

下面内容中显示的代码是我最终得到的解决方法：我创建了额外的抽象接口，并将所有子程序汇集到一个模块中。子程序

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

---

您在两个模块中都声明了

fmin_fvecp1

，这是一个冲突，因为这两个模块都在程序中使用。您在

函数fmin

中有

fmin=…

，但没有

y=…

，这是一个问题，因为您声明了

result（y）

@M.S.B.：这是从不同版本的程序代码中复制和粘贴的错误。谢谢你指出这一点。从模块“NEWTON”中删除“FMIN_FVECP”的冗余声明后，仍然会显示相同的错误消息。感谢您的回复。我在接口bloack中为

LNSRCH

中的

FUNC

伪参数使用IMPORT语句，但仍然得到相同的错误消息。请问您是否能发现进一步的错误？我觉得奇怪的是，冲突信息不断出现。谢谢。我添加了导入语句的程序可以从这里下载。这是一个.f90格式的文件。谢谢

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 . . .