Fortran 中的指针数组

Question

近 10 年来，我一直在编写一个用于热力学计算的大型 Fortran 程序，当我开始时，我对新的 Fortran 标准还很陌生（我熟悉 F77，而且太老了，无法学习其他东西）。我发现新的 TYPE 结构非常好并且经常使用它们，但我不知道一些限制，例如不允许创建指针数组，我后来才发现。

现在我正在更正一些旧代码，我惊讶地发现在记录声明中：TYPE gtp_phase_add

一个声明：TYPE(tpfun_expression), dimension(:), pointer :: explink

其中 explink 用于指向另一个包含数学表达式的结构。这并没有产生任何编译错误（我通常使用 gfortran，但我也用 intel fortran 编译了这个程序）。当我看到这段旧代码（大约 10 年前写的）时，我认为缺少“可分配”，但添加后会出现编译错误。

我制作了一个最小的完整程序来模拟它的使用方式：

MODULE test1
  implicit none
  
  TYPE tpfun_expression
     integer nc
     double precision, allocatable, dimension(:) :: coeffs
     integer, allocatable, dimension(:) :: powers
  END type tpfun_expression

  TYPE gtp_phase_add
!**************************************************************************
! My question is if it is correct Fortran to have an array of pointers here
     TYPE(tpfun_expression), dimension(:), pointer :: explink
!**************************************************************************
     TYPE(gtp_phase_add), pointer :: nextadd
  END TYPE gtp_phase_add

contains

  subroutine create_tpfun(n,coeffs,powers,exp)
    integer n,i,powers(*)
    double precision coeffs(*)
    type(tpfun_expression), pointer :: exp
    allocate(exp%coeffs(n))
    allocate(exp%powers(n))
    exp%nc=n
    do i=1,n
       exp%coeffs(i)=coeffs(i)
       exp%powers(i)=powers(i)
    enddo
    return
  end subroutine create_tpfun

  subroutine create_addrec(typ,this)
    integer typ,n,m
    TYPE(tpfun_expression), target :: exp1
    TYPE(tpfun_expression), pointer :: exp2
    TYPE(gtp_phase_add), pointer :: this
    integer ipow(4)
    double precision coeffs(4)
!
!**************************************************************************
! here I allocate a pointer array
    allocate(this%explink(typ))
!**************************************************************************
    if(typ.eq.1) then
       do m=1,4
          ipow(m)=m-1
          coeffs(m)=2.0D0*m
       enddo
       exp2=>this%explink(1)
       call create_tpfun(4,coeffs,ipow,exp2)
    else
       do m=1,4
          ipow(m)=m-1
          coeffs(m)=3.0D0
       enddo
       exp2=>this%explink(1)
       call create_tpfun(4,coeffs,ipow,exp2)
       do m=1,3
          ipow(m)=1-m
          coeffs(m)=5.0D0
       enddo
       exp2=>this%explink(2)
       call create_tpfun(3,coeffs,ipow,exp2)
    endif
    return
  end subroutine create_addrec

end MODULE test1

program main
  use test1
  integer n,m,j,k,q
  TYPE(gtp_phase_add), target :: addrec
  TYPE(gtp_phase_add), pointer :: next,first
  TYPE(tpfun_expression) :: exp
  
  first=>addrec
  next=>addrec
  write(*,*)'Creating addrec 1'
  call create_addrec(1,next)
  allocate(next%nextadd)
  write(*,*)'Creating addrec 2'
  next=>next%nextadd
  call create_addrec(2,next)
! just a check that the functions are correct
  write(*,*)'Listing functions in all addrecs'
  next=>first
  q=0
  do while(associated(next))
     q=q+1
     write(*,*)'Addition record ',q
     n=size(next%explink)
     do m=1,n
        k=next%explink(m)%nc
        write(*,10)(next%explink(m)%coeffs(j),next%explink(m)%powers(j),j=1,k)
     enddo
10   format(10(F6.3,1x,i3))
     next=>next%nextadd
  enddo
end program main

这按我的预期工作，我很惊讶我允许声明一个指针数组，所以我想知道这是否是正确的 Fortran。 抱歉，如果我无法理解如何更优雅地编辑它。

Answer 1

是的，你可以有一个带有指针属性的数组。考虑琐碎的代码

program foo
  integer, target :: i(10)
  integer, pointer :: j(:)
  i = [(n,n=1,10)]
  j => i
  print '(10(I3))', j
end program foo

使用 gfortran 编译时，没有警告/错误（不应该是正确的程序），输出为 1 2 3 4 5 6 7 8 9 10。上面的一个稍微复杂一点的版本是

program foo
  integer, pointer :: j(:)
  allocate(j(10))
  j = [(n,n=1,10)]
  print '(10(I3))', j
end program foo

allocate 语句将分配可以称为匿名目标的 10 个元素（因为没有更好的名称）。 j 指向那个匿名目标。与第一个程序相比，这里的区别在于j = [(n,n=1,10] 是一个内在赋值，而前者j => i 是指针赋值。

PS：如果不需要pointer，使用allocatable 是（IMO）的好习惯。

Answer 2

注意变量integer, pointer :: ptr(:) 是指向数组（或数组切片）的指针，而不是指针数组。我的意思是这个程序是有效的：

program test
  implicit none
  
  integer, target, allocatable :: foo(:)
  integer, pointer             :: ptr(:)
  
  foo = [1,2,3]
  
  ptr => foo
  write(*,*) ptr ! writes "1 2 3".
  
  ptr => foo(2:1:-1)
  write(*,*) ptr ! writes "2 1".
end program

但这个程序不是：

program test
  implicit none
  
  integer, target, allocatable :: foo(:)
  integer, target              :: bar
  integer, pointer             :: ptr(:)
  
  foo = [1,2,3]
  bar = 4
  
  ptr => foo
  ptr(2) => bar ! Not valid.
  write(*,*) ptr
end program

如果你想要一个充当指针数组的东西，你需要将指针包装在一个类中，例如：

program test
  implicit none
  
  type :: IntPointer
    integer, pointer :: ptr
  end type
  
  integer, target,  allocatable :: foo(:)
  integer, target               :: bar
  type(IntPointer), allocatable :: ptr(:)
  
  integer :: i
  
  foo = [1,2,3]
  bar = 4
  
  allocate(ptr(2))
  ptr(1)%ptr => foo(2)
  ptr(2)%ptr => bar
  
  write(*,*) (ptr(i)%ptr, i=1, size(ptr))
end program

这也是为什么pointer 不能是allocatable 的原因：指针不是由单独指针组成的数组，每个指针都有自己的目标，而是指向数组（或数组切片）的单个指针，加上一些有关该数组（或数组切片）的大小和形状的元数据。这意味着指针的内存需求与目标的size() 无关，因此出于内存管理目的，allocatable pointer 没有意义。

当您在pointer :: ptr(:) 上调用allocate(ptr) 时，您实际上并没有分配ptr，而是分配了一个（未命名的）数组，然后将ptr 指向该数组。

Answer 3

@BoSundman：正如你在 cmets 中所说，你仍然感到困惑，我想我会提供一个框架挑战，这可能有助于理清一些事情。

特别是，我建议您只使用数组来替换指向数组的指针。您最初使用指向数组的指针是完全有效的 Fortran，但我认为指向数组的指针并不是完成这项工作的最佳工具。

我已经使用我希望更清晰的 Fortran 重写了您提供的代码 sn-p：

module precision
  ! This is the modern way of defining floating point precision.
  integer, parameter :: dp = selected_real_kind(15,300)
end module

MODULE test1
  use precision
  implicit none
  
  type tpfun_expression
    ! 'nc' does not need to be stored separately, as nc=size(coeffs).
    real(dp), allocatable, dimension(:) :: coeffs
    integer,  allocatable, dimension(:) :: powers
  end type tpfun_expression

  type gtp_phase_add
    ! Rather than having 'explink' as a pointer to an array,
    !    consider using an allocatable array.
    type(tpfun_expression), allocatable, dimension(:) :: explink
    type(gtp_phase_add), pointer                      :: nextadd
  end type gtp_phase_add

contains

  ! Consider replacing subroutines with functions where appropriate.
  function create_tpfun(coeffs,powers) result(exp)
    ! Using 'intent(in)' tells the compiler (and anyone reading your code) that
    !    input arguments will not be modified.
    real(dp), intent(in)   :: coeffs(:)
    integer,  intent(in)   :: powers(:)
    ! The function returns a `type(tpfun_expression)` object, rather than
    !    working with a pointer.
    type(tpfun_expression) :: exp
    
    ! You can perform array copying as a single operation.
    exp%coeffs = coeffs
    exp%powers = powers
    
    ! There is no need for 'return' at the end of a function or subroutine.
    ! 'return' happens automatically when the end is reached.
  end function

  function create_addrec(typ) result(this)
    integer, intent(in) :: typ
    TYPE(gtp_phase_add) :: this
    
    integer,  allocatable :: ipow(:)
    real(dp), allocatable :: coeffs(:)
    
    integer :: m
    
    allocate(this%explink(typ))
    if(typ.eq.1) then
      ! The expression [(m-1,m=1,4)] uses an "implied do loop" to create an
      !    array in a single line of code. This is equivalent to the lines:
      !
      ! allocate(ipow(4))
      ! do m=1,4
      !   ipow(m) = m-1
      ! enddo
      !
      ipow = [(m-1,m=1,4)]
      coeffs = [(2.0_dp*m,m=1,4)]
      ! Since 'create_tpfun' is now a function,
      !    the syntax of calling it changes slightly.
      this%explink(1) = create_tpfun(coeffs,ipow)
    else
      ipow = [(m-1,m=1,4)]
      coeffs = [(3.0_dp,m=1,4)]
      this%explink(1) = create_tpfun(coeffs,ipow)
      
      ipow = [(1-m,m=1,3)]
      coeffs = [(5.0_dp,m=1,3)]
      this%explink(2) = create_tpfun(coeffs,ipow)
    endif
    
    ! The pointer 'this%nextadd' should be nullified.
    nullify(this%nextadd)
  end function
end module

program main
  use precision
  use test1
  implicit none
  
  TYPE(gtp_phase_add), target  :: first
  TYPE(gtp_phase_add), pointer :: next
  
  integer m,j,q
  
  write(*,*)'Creating addrec 1'
  next=>first
  next = create_addrec(1)
  write(*,*)'Creating addrec 2'
  allocate(next%nextadd)
  next=>next%nextadd
  next = create_addrec(2)
  
  ! just a check that the functions are correct
  write(*,*)'Listing functions in all addrecs'
  next=>first
  q=0
  do while(associated(next))
     q=q+1
     write(*,*)'Addition record ',q
     ! I have replaced 'n' and 'k' with 'size(next%explink)' and
     !    'size(next%explink(m)%coeffs)' respectively.
     do m=1,size(next%explink)
        ! I broke this line across multiple lines using '&',
        !    as it was a little long.
        write(*,10) ( next%explink(m)%coeffs(j),   &
                    & next%explink(m)%powers(j),   &
                    & j=1,                         &
                    & size(next%explink(m)%coeffs) )
     enddo
10   format(10(F6.3,1x,i3))
     next=>next%nextadd
  enddo
end program main

Answer 4

这不是一个答案，而是一个跟进来解释我的困惑。

! Another test of fortran pointer arrays
  module example1
    implicit none
  
    type an_element
       character symbol*2
       type(an_element), pointer :: nextel
    end type an_element

    type subsystyp1
       character sysname*24
! here it seems I can have an array of pointers
       type(an_element), dimension(:), pointer :: ellista
    end type subsystyp1
    
    type elarray
! this is a type which contain just a pointer
       type(an_element), pointer :: p1
    end type elarray

    type subsystyp2
       character sysname*24
! here an array of a type which contain a pointer can be allocated
       type(elarray), dimension(:), allocatable :: ellista
    end type subsystyp2

  end module example1

  program test
    use example1
    integer ii
    type(an_element), target :: element
    type(an_element), pointer :: firstelem
    type(an_element), pointer :: nextelem
    type(subsystyp1) :: sys1
    type(subsystyp2) :: sys2
!
! create a linked list of elements
    element%symbol='Al'
    firstelem=>element
!
    allocate(element%nextel); nextelem=>element%nextel
    nextelem%symbol='Be'
    allocate(nextelem%nextel); nextelem=>nextelem%nextel
    nextelem%symbol='C'
    allocate(nextelem%nextel); nextelem=>nextelem%nextel
    nextelem%symbol='Fe'
    allocate(nextelem%nextel); nextelem=>nextelem%nextel
    nextelem%symbol='Mn'
    nullify(nextelem%nextel)
! list all the elements in the list
    nextelem=>firstelem
    write(*,10,advance='no')'All elements: '
    do while(associated(nextelem))
       write(*,10,advance='no')nextelem%symbol
       nextelem=>nextelem%nextel
10     format(a,1x)
    enddo
    write(*,*)
! Allocate a subsystem using subsystyp1  and set pointers to same elements
    sys1%sysname='ternary sys1'
    allocate(sys1%ellista(3))
! I cannot assign this as a pointer, that creates a compiler error
!    sys1%ellista(1)=>firstelem
    sys1%ellista(1)=firstelem
    sys1%ellista(2)=firstelem%nextel%nextel
    sys1%ellista(3)=sys1%ellista(2)%nextel
    write(*,20)trim(sys1%sysname),(sys1%ellista(ii)%symbol,ii=1,3)
20  format(a,': ',10(a,1x))
! Allocate a subsystem using subsystyp2 and set pointers to elements
    allocate(sys2%ellista(3))
    sys2%sysname='ternary sys2'
    sys2%ellista(1)%p1=>firstelem
    sys2%ellista(2)%p1=>firstelem%nextel%nextel
    sys2%ellista(3)%p1=>sys2%ellista(2)%p1%nextel
!
    write(*,20)trim(sys2%sysname),(sys2%ellista(ii)%p1%symbol,ii=1,3)
! So far so good ...
! Now change the element symbol in the one of the elements
    write(*,*)'Change the name of third element to "He" in main list'
    firstelem%nextel%nextel%symbol='He'
! list the whole list
    nextelem=>firstelem
    write(*,10,advance='no')'All elements: '
    do while(associated(nextelem))
       write(*,10,advance='no')nextelem%symbol
       nextelem=>nextelem%nextel
    enddo
    write(*,*)
! In sys1 the element name has nnot changed because ellista was assigned with "="
    write(*,20)trim(sys1%sysname),(sys1%ellista(ii)%symbol,ii=1,3)
! In sys2 the element name has changed because p1 is a pointer
    write(*,20)trim(sys2%sysname),(sys2%ellista(ii)%p1%symbol,ii=1,3)
!
  end program test

输出将是

All elements:  Al Be C  Fe Mn
ternary sys1: Al C  Fe
ternary sys2: Al C  Fe
 Change the name of third element to "He" in main list
All elements:  Al Be He Fe Mn
ternary sys1: Al C  Fe
ternary sys2: Al He Fe

由“=”分配给记录的指针将复制该记录。如果以后记录中有更改，则不会包含在副本中。但是，如果一个指针由“=>”分配，则更改将可用。这是微不足道的，但如果分配不明确，如通过子例程调用，结果可能会令人困惑。

我知道我很老套，喜欢保留“返回”，我不喜欢这个隐含的 do 循环的语法。对我来说，这看起来像是一位经理的发明，他按照程序员编写的代码行数支付报酬。