Question

我正在尝试使用指针过程在特定条件下选择所需的功能（在本例中为do循环）。发布我的代码的一部分，在其中向您展示我打算做什么。

！主程序

program 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
  pointer :: fp
  procedure(SelKer), pointer :: fp => null()

  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
      fp => SelKer
      call weigth(n,Var,n,Var,1,func,fp(i),2.0D0,auxpar,coe,mat)
  end do
end program MKRBF

！模块testKernel.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 = sqrt(sum((x(1:ndim) - ts(1:ndim))**2.))

    poly = r**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 = sqrt(sum((x(1:ndim) - ts(1:ndim))**2.))

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

 end function gauss

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

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

end module kernel

！模块testSRBF.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

这会导致编译错误

testKer_mod.f90:41:20: SelKer => poly
Error: Function 'poly' requires an argument list at (1)

，其他功能相同。

Answer 1

考虑函数SelKer：

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

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

这里poly和gauss是我们定义的模块过程。

函数结果SelKer已声明为real*8标量非指针值。它不是过程指针。要将函数结果声明为带有接口poly的过程指针（请注意poly和gauss具有相同的特征）：

procedure(poly), pointer :: SelKer

通过此更改，select case构造中的指针分配语句现在有效：函数结果指向相应的函数。

也就是说，问题的主体还有其他部分要解决。现在看看

pointer :: fp
procedure(SelKer), pointer :: fp => null()

以及

fp => SelKer
call weigth(n,Var,n,Var,1,func,fp(i),2.0D0,auxpar,coe,mat)

第一个块有问题：您不能两次为fp指定指针属性。删除行pointer :: fp。

使用fp始终指向SelKer也是多余的：您最好只写

call weigth(n,Var,n,Var,1,func,Selker(i),2.0D0,auxpar,coe,mat)

，并且没有fp作为过程指针。 fp作为过程指针的更有用的用途是

procedure(poly), pointer :: fp=>null
...
do i = 1, nKer
  fp => SelKer(i)
  call weigth(n,Var,n,Var,1,func,fp,2.0D0,auxpar,coe,mat)
end do

如何使用Fortran过程指针获取函数名称？

1 个答案: