Полиморфный фиктивный аргумент - PullRequest
Новая
       9

Полиморфный фиктивный аргумент

0 голосов
/ 12 июня 2019

У меня есть три функции для одной и той же вещи, но для разных типов фиктивных аргументов: flip, flipLogical и flipInt.Их код на самом деле точно такой же!Есть другая функция, названная flip3D, которая предназначена только для реальных фиктивных аргументов, которая вызывает flip изнутри.Вот как все работает прямо сейчас: 

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, предоставляя реальную переменную в качестве фиктивного аргумента.Я пытаюсь что-то вроде этого: 

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

, но затем я получаю ошибки

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 Ответ

1 голос
/ 12 июня 2019

Я бы сделал это с помощью универсальной функции, реализованной с помощью шаблона, но учтите, что 

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.

РЕДАКТИРОВАТЬ : с учетом файла шаблона 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 typing.

...