时间戳

首页 > 解决方案 > 如何在属于同一多态变量的两个元素之间进行交换？

fortran - 如何在属于同一多态变量的两个元素之间进行交换？

问题描述

当您需要交换两个多态元素中的值时，最好的方法是什么？（使用标准 fortran 2008）。

我正在发送一个示例（请尽量不要修改类型变量）。

我在 Windows 中使用英特尔编译器 v.19 和 gfortran 8.1 时遇到的问题是不同的。

这里有一个完整的例子。查看我定义交换过程的子程序。目前是激活在 GFortran 中工作的版本，但我对英特尔编译器有错误。如果您评论这部分并取消注释 ifort 的行，则适用于 intel 而不适用于 gfortran....

    Program Check
   implicit none

   !> Type definitions
   Type :: Refl_Type
      integer,dimension(:), allocatable :: H            
      integer                           :: Mult  =0     
   End Type Refl_Type

   Type :: RefList_Type
      integer                                     :: Nref
      class(refl_Type), dimension(:), allocatable :: Reflections
   end Type RefList_Type

   Type(RefList_Type)            :: List
   Type(Refl_Type), dimension(3) :: Refl_Ini

   !> Variables 
   integer :: i

   !> Init
   Refl_Ini(1)%H=[1, 0, 0]; Refl_Ini(1)%Mult=1
   Refl_Ini(2)%H=[0, 2, 0]; Refl_Ini(2)%Mult=2
   Refl_Ini(3)%H=[0, 0, 3]; Refl_Ini(3)%Mult=3

   List%Nref=3
   List%Reflections=Refl_Ini

   !> Print Step:1
   do i=1, List%Nref
      print '(i3,2x,3i4,2x,i3)', i,List%Reflections(i)%H, List%Reflections(i)%Mult
   end do  
   print*,' '
   print*,' '

   !> Swap
   call Swap_Elements_List(List, 1, 3)

   !> Print Step:2
   do i=1, List%Nref
      print '(i3,2x,3i4,2x,i3)', i,List%Reflections(i)%H, List%Reflections(i)%Mult
   end do

Contains

   Subroutine Swap_Elements_List(List, i, j)
      !---- Argument ----!
      type (RefList_Type), intent(in out) :: List
      integer,             intent(in)     :: i,j

      !---- Local Variables ----!
      class(Refl_Type), allocatable :: tmp

      !> IFort
      !tmp=List%reflections(i)
      !List%reflections(i)=List%reflections(j)
      !List%reflections(j)=tmp

      !> Gfortran
      associate(t1 => list%reflections(i), t2 => list%reflections(j), tt => tmp)
         tt=t1
         t1=t2
         t2=tt
      end associate  
   End Subroutine Swap_Elements_List

End Program Check

有什么建议吗？

标签： fortrangfortranintel-fortran

解决方案

用 gfortran-8.2 编译原始代码给出

    test.f90:34:6:
           List%reflections(i)=List%reflections(j) !!<---
          1
    Error: Nonallocatable variable must not be polymorphic in 
           intrinsic assignment at (1) - check that there is a 
           matching specific subroutine for '=' operator

我认为这是因为List % reflections(i)不是单独的allocatable（即使它List % reflections本身可以分配为统一类型的数组）。这一点似乎已经详细讨论过，例如，在这个Q/A 页面中，它提出了两种替代方法： (A) 让编译器相信所有元素都属于同一类型；或 (B) 使用（数组）容器。

如果我们使用“容器”方法，我认为我们可以使用move_alloc()来交换两个多态对象（不知道动态类型）。例如，原始代码的一些修改版本可能是

program main
   implicit none

   type :: Refl_t
      integer, allocatable :: H(:)
   endtype

   type, extends(Refl_t) :: ExtRefl_t
      real :: foo
   endtype

   type :: RefList_t
      class(Refl_t), allocatable :: refl
   endtype

   type(RefList_t) :: list( 3 )

   call init()

   print *, "Before:"
   call output()

   call swap( 1, 2 )

   print *, "After:"
   call output()

contains

   subroutine swap( i, j )
       integer, intent(in) :: i, j
       class(Refl_t), allocatable :: tmp

       call move_alloc( from= list( i )% refl, to= tmp             )
       call move_alloc( from= list( j )% refl, to= list( i )% refl )
       call move_alloc( from= tmp,             to= list( j )% refl )
   end
   subroutine init()
       integer i
       do i = 1, 3
           allocate( ExtRefl_t :: list( i ) % refl )

           select type( x => list( i ) % refl )
               type is ( ExtRefl_t )
                   x % H   = [ i, i * 10 ]
                   x % foo = i * 100
           endselect
       enddo
   end
   subroutine output()
       integer i
       do i = 1, 3
           select type( x => list( i ) % refl )
               type is ( ExtRefl_t )
                   print *, "i = ", i, " : H = ", x % H, " foo = ", x % foo
           endselect
       enddo
   end
end program

结果（gfortran-8.2）：

 Before:
 i =            1  : H =            1          10  foo =    100.000000    
 i =            2  : H =            2          20  foo =    200.000000    
 i =            3  : H =            3          30  foo =    300.000000    
 After:
 i =            1  : H =            2          20  foo =    200.000000    
 i =            2  : H =            1          10  foo =    100.000000    
 i =            3  : H =            3          30  foo =    300.000000

我认为我们也可以对上述swap()例程使用多态赋值，例如：

   subroutine swap( i, j )
       integer, intent(in) :: i, j
       class(Refl_t), allocatable :: tmp

       tmp              = list( i ) % refl
       list( i ) % refl = list( j ) % refl
       list( j ) % refl = tmp
   end

这使用 gfortran-8.2 编译，但给出了一个奇怪的结果......（可能的编译器错误？）。我猜像 GCC-9 或 Intel Fortran 这样的新编译器可能会给出预期的结果。

另一方面，如果我们使用多态数组，我们可能需要select type显式地使用来交换两个元素。（但我希望有不同的方法......）然后代码可能如下所示：

program main
   implicit none

   type :: Refl_t
      integer, allocatable :: H(:)
   endtype

   type, extends(Refl_t) :: ExtRefl_t
      real :: foo
   endtype

   class(Refl_t), allocatable :: refls( : )

   allocate( ExtRefl_t :: refls( 3 ) )
   call init()

   print *, "Before:"
   call output()

   call swap( 1, 2 )

   print *, "After:"
   call output()

contains

   subroutine swap( i, j )
       integer, intent(in) :: i, j

       selecttype ( refls )
           type is ( ExtRefl_t )
               block
                 type(ExtRefl_t) :: tmp

                 tmp        = refls( i )   !<-- assignment of concrete type
                 refls( i ) = refls( j )
                 refls( j ) = tmp
               endblock
           class default
               stop
       endselect
   end
   subroutine init()
       integer i

       select type( refls )
           type is ( ExtRefl_t )
               do i = 1, 3
                   refls( i ) % H   = [ i, i * 10 ]
                   refls( i ) % foo = i * 100
               enddo
       endselect
   end
   subroutine output()
       integer i
       select type( refls )
           type is ( ExtRefl_t )
               do i = 1, 3
                   print *, "i = ", i, " : H = ", refls( i ) % H, &
                            " foo = ", refls( i ) % foo
               enddo
       endselect
   end
end program

（结果与上述相同。）

推荐阅读