Polymorphic dummy allocatable argument

问题

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

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:

    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:

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

回答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

compiles with gfortran.

EDIT: Given the template file 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

We can compile 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

And produce output:

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

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.

来源：https://stackoverflow.com/questions/56567943/polymorphic-dummy-allocatable-argument

标签

fortran

polymorphism

gfortran