Question

我的问题是将模块中包含的一系列功能的名称传递给do循环中的子例程。

我发布了部分代码。与主模块相比，这些模块位于两个单独的文件中。

%%% FILE testKer_mod.f90

module kernel
  implicit none
  contains

  ! POLYNOMIAL 
  function poly(x, ts, ndim, a, param1, param2)
     integer, intent (in) :: ndim
     real*8, dimension(ndim), intent(in) :: x
     real*8, dimension(ndim), intent(in) :: ts
     real*8, intent(in) :: a, param1, param2
     real*8 :: r
     real*8 :: poly 

     r = (x(1:ndim) - ts(1:ndim))

     poly = r**(.5*a)

   end function poly

   ! GAUSSIAN
   function gauss(x, ts, ndim, a, gamma, param2)
      integer, intent (in) :: ndim 
      real*8, dimension(ndim), intent(in) :: x
      real*8, dimension(ndim), intent(in) :: ts
      real*8, intent(in) :: a, param2, gamma
      real*8 :: r
      real*8 :: gauss

      r = (x(1:ndim) - ts(1:ndim))

     gauss = exp(-(gamma*r)**a)

  end function gauss

end module kernel

%%%

%%% FILE testSRBF_mod.f90

  module srbf
    implicit none
    contains    

  subroutine weigth(nx, x, nts, ts, ndim, s, kernel, StocPar, param, coe, mat)
    integer :: i,j,k,l,m,n
    integer :: info
    integer :: nx, nts, ndim
    integer, dimension(nts) :: ipiv 
    real*8, dimension(nts) :: w
    real*8, dimension(nts) :: s
    real*8, dimension(2) :: param
    real*8, dimension(nx,ndim) :: x
    real*8, dimension(nts,ndim) :: ts
    real*8, dimension(nx,nts) :: phi, mat
    real*8, dimension(nts) :: coe
    real*8 :: stocPar

    interface
     real*8 function kernel(x1, x2, n3, stov, p1, p2)
       integer, intent (in) :: n3
       real*8, dimension(n3), intent(in) :: x1
       real*8, dimension(n3), intent(in) :: x2
       real*8, intent(in) :: stov, p1, p2
     end function kernel
    end interface

    do i = 1, nx
      do j = 1, nts
          phi(i,j) = kernel(x(i,1:ndim), ts(j,1:ndim), ndim, stocPar, param(1), param(2))
      end do
    end do

    w = s       
    mat = phi   
    call DGESV(nts,1,mat,nts,ipiv,w,nts,info) 
    coe = w
  end subroutine weigth 
end module srbf

%%%

%%%主程序测试。f90
程序MKRBF

   use kernel
   use srbf

   implicit none

   !real*8 :: SelKer
   integer :: i,j,k
   integer, parameter :: n = 3
   integer, parameter :: nKer = 2
   real*8, dimension(2,2) :: ParBound, auxpar
   real*8, dimension(2) :: Bound
   real*8, dimension(n) :: Var, func
   real*8, dimension(n,nKer) :: coe
   real*8, dimension(n,n) :: mat

   !external SelKer

   interface
     real*8 function SelKer(ind)
       integer, intent (in) :: ind
     end function SelKer
   end interface

   Bound(1) = 0
   Bound(2) = 5

   ParBound(1,1) = 1 
   ParBound(1,2) = 5
   ParBound(2,1) = 1 
   ParBound(2,2) = 5

   auxpar(1,1) = 0 
   auxpar(1,2) = 0
   auxpar(2,1) = 1 
   auxpar(2,2) = 1

   var(:) = (/ 0., 2.5, 5. /)

   do i = 1, n
       func(i) = cos(3*Var(i)) * exp(-.25*Var(i));
   end do

   do i = 1, nKer
       call weigth(n,Var,n,Var,1,func,SelKer(i),2.0D0,auxpar,coe,mat)
   end do
end program MKRBF

function SelKer(indx)
  integer, intent(in) :: indx
  real*8 :: SelKer

  select case (indx)
  case (1)
    SelKer = poly
  case (2)
    SelKer = gauss
  end select
  return
end function SelKer

%%%

我尝试使用界面和外部方法，但是程序给了我相同的错误：

gfortran testKer_mod.f90 testSRBF_mod.f90 test.f90 -llapack -o test
test.f90:46:38:

    call weigth(n,Var,n,Var,1,func,SelKer(i),2.0D0,auxpar,coe,mat)
                                  1
 Error: Expected a procedure for argument 'kernel' at (1)

我该如何解决？

Answer 1

在主程序中查看接口块

interface
  real*8 function SelKer(ind)
    integer, intent (in) :: ind
  end function SelKer
end interface

SelKer是具有real*8结果的函数。¹ SelKer(i)是这样的函数结果。至关重要的是，SelKer(i)不是具有real*8结果的函数，而是这样的real*8值。 weigth期望kernel的参数是一个函数（它是一个过程）。这是错误消息。

谈到外部功能SelKer的实现方式：

SelKer = poly

在函数poly中，不是模块内核中的函数poly，而是局部（默认）实标量变量（具有未定义的值）。请注意，该函数中缺少implicit none。

相反，您希望使用的是过程指针。这是一个广泛的话题，所以我只说明这种方法。

将SelKer移动为模块kernel中的过程（从主程序中删除相应的接口块）。
将函数结果SelKer声明为类型procedure(poly)。
对结果使用指针分配，例如SelKer => gauss。

还有其他也许更好的方法来构造这样的程序。特别是，许多人建议不要使用过程指针函数结果。

¹ real*8不是标准的Fortran。

如何在子程序/函数中传递函数名

1 个答案: