Как написать обертку для «выделить»

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)  

Есть ли способ реализации такой оболочки? ..

Спасибо!

Answer 1

Это можно сделать через общий интерфейсный блок.Вы должны создать процедуры для каждого ранга, который вы хотите обработать, например, memory_1d, memory_2d, ... memory_4d.(Очевидно, много вырезок и вставок.) Затем вы пишете универсальный интерфейсный блок, который дает всем этим процедурам память альтернативных имен в качестве общего имени процедуры.Когда вы вызываете memory, компилятор различает, какой memory_Xd следует вызывать, основываясь на ранге аргумента.То же самое для ваших функций freem.

Вот как давно работали внутренние функции, такие как sin - вы можете вызывать sin с реальными аргументами различных предвидений или со сложным аргументом, и компилятор вычисляет с помощьюфактическая функция греха для вызова.В действительно старом Фортране вам приходилось использовать разные имена для разных функций sin.Теперь на современном Фортране вы можете настроить то же самое с помощью своих собственных подпрограмм.

Редактировать: добавить пример кода, демонстрирующий метод и синтаксис:

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

Answer 2

subroutine memory(array, length) имеет первый фиктивный параметр одномерный массив (real(8), allocatable, intent(out), dimension(:) :: array).

Вызов этой подпрограммы из основной программы с 3-мерным массивом foo (real(8), allocatable, dimension(:,:,:) :: foo), очевидно, является ошибкой. И это то, что на самом деле сказал компилятор.

Если вам действительно нужны такие подпрограммы, запишите одну пару memory / freem подпрограмм для каждого массива разного измерения - одну пару подпрограмм для одномерного массива, другую для 2-мерного массива и т. Д.

Кстати, подпрограммы memory в общем случае будут другими, потому что для выделения n-мерного массива необходимо передать n экстентов в вышеупомянутую подпрограмму.