多态虚拟可分配参数 [英] Polymorphic dummy allocatable argument

问题描述

我有三个功能可用于同一件事，但适用于不同的伪参数类型:flip，flipLogical和flipInt.他们的代码实际上完全相同！还有另一个函数叫做flip3D，它仅用于真正的伪参数，它从其内部调用flip.这就是现在一切正常的方式:

I have three functions that to the same thing but for different dummy argument types: flip, flipLogical and flipInt. Their very code is actually exactly the same! There is another function, called flip3D, which is only for real dummy arguments, that calls flip from its inside. This is the way that everything is working right now:

function flip(data)
   real, dimension(:,:), intent(in) :: data
   real, dimension(:,:), allocatable :: flip
   integer :: m, n, i

   m = size(data,1)
   n = size(data,2)

   allocate(flip(m,n))

   do i=1,m
      flip(m-i+1,:) = data(i,:)
   end do
 end function flip

 function flipLogical(data)
   logical, dimension(:,:), intent(in) :: data
   logical, dimension(:,:), allocatable :: flipLogical
   integer :: m, n, i

   m = size(data,1)
   n = size(data,2)

   allocate(flipLogical(m,n))

   do i=1,m
      flipLogical(m-i+1,:) = data(i,:)
   end do
 end function flipLogical

 function flipInt(data)
   integer, dimension(:,:), intent(in) :: data
   integer, dimension(:,:), allocatable :: flipInt
   integer :: m, n, i

   m = size(data,1)
   n = size(data,2)

   allocate(flipInt(m,n))

   do i=1,m
      flipInt(m-i+1,:) = data(i,:)
   end do
 end function flipInt

 function flip3D(data)
   real, dimension(:,:,:), intent(in) :: data
   real, dimension(:,:,:), allocatable :: flip3D
   integer :: m, n, o, j

   m = size(data, 1)
   n = size(data, 2)
   o = size(data, 3)

   allocate(flip3D(n, m, o))

   do j = 1, o
      flip3D(:,:,j) = flip(data(:,:,j))
   end do
 end function flip3D

尽管这很好，但它却很丑陋.我希望有一个多态函数flip，它适用于任何类型，并且我可以从flip3D调用它，以提供一个实变量作为伪参数.我正在尝试类似的事情:

Although this is working just fine, it is terrible ugly. I want to have a polymorphic function flip which just works for any type and that I can call from flip3D providing a real variable as dummy argument. I'm trying something like that:

function flip(data)
   class(*), dimension(:,:), intent(in) :: data
   class(*), dimension(:,:), allocatable :: flip
   integer :: m, n, i

   m = size(data,1)
   n = size(data,2)

   allocate(flip(m,n), mold=data)

   do i=1,m
      flip(m-i+1,:) = data(i,:)
   end do
 end function flip

但随后我收到了错误消息

but then I receive the errors

script.f90:698:7:

script.f90:698:7:

    flip(m-i+1,:) = data(i,:)
   1 Error: Nonallocatable variable must not be polymorphic in intrinsic assignment at (1) - check that there is a matching specific subroutine for '=' operator

script.f90:714:23:

script.f90:714:23:

    flip3D(:,:,j) = flip(data(:,:,j))
                   1 Error: Can't convert CLASS(*) to REAL(4) at (1)

推荐答案

我会通过通过模板实现的通用函数来完成此操作，但请注意

I would have done this with a generic function implemented via a template but note that

function flip(data)
   class(*), dimension(:,:), intent(in) :: data
   class(*), dimension(:,:), allocatable :: flip
   integer :: i

   flip = data([(i,i=m,1,-1)],:)
 end function flip

用gfortran编译.

compiles with gfortran.

编辑:给定模板文件flip.i90:

function Qflip(Qdata)
   dimension Qdata(:,:)
   intent(in) Qdata
   dimension Qflip(size(Qdata,1),size(Qdata,2))
   integer i

   do i = 1, size(Qdata,1)
      Qflip(size(Qdata,1)-i+1,:) = Qdata(i,:)
   end do
end function Qflip

我们可以编译flip.f90:

module real_mod
   implicit real(Q)
   private
   public flip
   interface flip
      module procedure Qflip
   end interface flip
   contains
include 'flip.i90'
end module real_mod

module Logical_mod
   implicit Logical(Q)
   private
   public flip
   interface flip
      module procedure Qflip
   end interface flip
   contains
include 'flip.i90'
end module Logical_mod

module Int_mod
   implicit integer(Q)
   private
   public flip
   interface flip
      module procedure Qflip
   end interface flip
   contains
include 'flip.i90'
end module Int_mod

module flip_mod
   use real_mod
   use Logical_mod
   use Int_mod
end module flip_mod

program flipmeoff
   use flip_mod
   implicit none
   real :: R(3,3) = reshape([ &
      1, 2, 3, &
      4, 5, 6, &
      7, 8, 9],shape(R),order=[2,1])
   Logical :: L(3,3) = reshape([ &
      .TRUE., .TRUE., .FALSE., &
      .FALSE., .TRUE., .FALSE., &
      .FALSE., .FALSE., .TRUE.],shape(L),order=[2,1])
   integer :: I(3,3) = reshape([ &
      1, 2, 3, &
      4, 5, 6, &
      7, 8, 9],shape(I),order=[2,1])
   write(*,'(3(f3.1:1x))') transpose(R)
   write(*,'()')
   write(*,'(3(f3.1:1x))') transpose(flip(R))
   write(*,'()')
   write(*,'(3(L1:1x))') transpose(L)
   write(*,'()')
   write(*,'(3(L1:1x))') transpose(flip(L))
   write(*,'()')
   write(*,'(3(i1:1x))') transpose(I)
   write(*,'()')
   write(*,'(3(i1:1x))') transpose(flip(I))
end program flipmeoff

并产生输出:

1.0 2.0 3.0
4.0 5.0 6.0
7.0 8.0 9.0

7.0 8.0 9.0
4.0 5.0 6.0
1.0 2.0 3.0

T T F
F T F
F F T

F F T
F T F
T T F

1 2 3
4 5 6
7 8 9

7 8 9
4 5 6
1 2 3

不幸的是，Fortran不允许您重命名内部类型，就像可以派生类型一样.结果是可以与内部类型一起使用的模板文件必须使用implicit键入.

It's unfortunate that Fortran doesn't allow you to rename intrinsic types like you can derived types. The consequence is that template files that can be used with intrinsic types have to use implicit typing.

这篇关于多态虚拟可分配参数的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！