如何编写“allocate”的包装器

Question

我正在尝试编写“allocate”函数的包装器，即接收数组和维度、分配内存并返回已分配数组的函数。最重要的是，该函数必须能够处理不同级别的数组。但是，我必须在函数接口中明确声明数组的级别，在这种情况下，只有在将特定级别的数组作为参数传递时，代码才会编译。例如，此代码无法编译：

module memory_allocator
contains 

  subroutine memory(array, length)
    implicit none

    real(8), allocatable, intent(out), dimension(:) :: array
    integer, intent(in) :: length

    integer :: ierr

    print *, "memory: before: ", allocated(array)

    allocate(array(length), stat=ierr)
    if (ierr /= 0) then
      print *, "error allocating memory: ierr=", ierr
    end if

    print *, "memory: after: ", allocated(array)

  end subroutine memory

  subroutine freem(array)
    implicit none

    real(8), allocatable, dimension(:) :: array

    print *, "freem: before: ", allocated(array)
    deallocate(array)
    print *, "freem: after: ", allocated(array)

  end subroutine freem

end module memory_allocator

program alloc
  use memory_allocator
  implicit none

  integer, parameter :: n = 3
  real(8), allocatable, dimension(:,:,:) :: foo
  integer :: i, j, k

  print *, "main: before memory: ", allocated(foo)
  call memory(foo, n*n*n)
  print *, "main: after memory: ", allocated(foo)

  do i = 1,n
    do j = 1,n
      do k = 1, n
        foo(i, j, k) = real(i*j*k)
      end do
    end do
  end do

  print *, foo

  print *, "main: before freem: ", allocated(foo)
  call freem(foo)  
  print *, "main: after freem: ", allocated(foo)

end program alloc

编译错误：

gfortran -o alloc alloc.f90 -std=f2003
alloc.f90:46.14:

  call memory(foo, n*n*n)
              1
Error: Rank mismatch in argument 'array' at (1) (1 and 3)
alloc.f90:60.13:

  call freem(foo)  
             1
Error: Rank mismatch in argument 'array' at (1) (1 and 3)  

有没有实现这种包装器的方法？..谢谢！

- robusta

Answer 1

这可以通过通用接口块实现。您需要为每个要处理的等级创建过程，例如memory_1d、memory_2d、... memory_4d。（很明显需要大量复制粘贴）然后，编写一个通用接口块，给所有这些过程提供memory作为通用过程名称的替代名称。当您调用memory时，编译器根据参数的等级区分应该调用哪个memory_Xd。freem函数也是如此。

这就是内置函数（如sin）长期以来的工作方式--您可以使用不同的精度或复杂度参数调用sin，并且编译器会确定实际调用的sin函数。在旧的FORTRAN中，您必须为不同的sin函数使用不同的名称。在现代Fortran中，您可以使用自己的例程设置相同的内容。

编辑：添加了一个代码示例，演示该方法和语法：

module double_array_mod

   implicit none

   interface double_array
      module procedure double_vector
      module procedure double_array_2D
   end interface double_array

   private  ! hides items not listed on public statement 
   public :: double_array

contains

   subroutine double_vector (vector)
      integer, dimension (:), intent (inout) :: vector
      vector = 2 * vector
   end subroutine double_vector

   subroutine double_array_2D (array)
      integer, dimension (:,:), intent (inout) :: array
      array = 2 * array
   end subroutine double_array_2D

end module double_array_mod


program demo_user_generic

   use double_array_mod

   implicit none

   integer, dimension (2) :: A = [1, 2]
   integer, dimension (2,2) :: B = reshape ( [11, 12, 13, 14], [2,2] )
   integer :: i

   write (*, '( / "vector before:", / 2(2X, I3) )' )  A
   call double_array (A)
   write (*, '( / "vector after:", / 2(2X, I3) )' )  A

   write (*, '( / "2D array before:" )' )
   do i=1, 2
      write (*, '( 2(2X, I3) )' )  B (i, :)
   end do
   call double_array (B)
   write (*, '( / "2D array after:" )' )
   do i=1, 2
      write (*, '( 2(2X, I3) )' )  B (i, :)
   end do   

   stop
end program demo_user_generic

- M. S. B.

---

非常感谢！虽然在分配器模块中需要代码重复，但至少我可以在调用此分配器函数时使用通用名称。这就是我想要的。 - robusta

Answer 2

subroutine memory(array, length) 的第一个虚拟参数是一维数组（real(8), allocatable, intent(out), dimension(:) :: array）。

从您的主程序中使用三维数组foo（real(8), allocatable, dimension(:,:,:) :: foo）调用此子程序显然是错误的。这就是编译器实际上所说的。

如果你真的需要这样的子程序，那么为不同维度的每个数组编写一对memory/freem子程序- 一个子程序对于一维数组，另一个对于二维数组等等。

顺便说一下，memory子程序通常是不同的，因为为了分配n维数组，您需要将n个范围传递给上述子程序。

- Wildcat

---

kemiisto，我知道这个编译错误非常明显。我也知道实现我想要的方式之一是为不同等级编写单独的分配器。我将不得不在最后选择这样做 :) 但我的问题是 - 是否有一种合法的Fortran方法编写一个包装器来使用相同功能进行分配，即针对等级通用...无论如何，还是谢谢！ - robusta