Как я могу сделать обмен между двумя элементами, принадлежащими к одной и той же полиморфной переменной?

Question

Каков наилучший метод, когда вам нужно поменять значения в двух полиморфных элементах? (Используется стандартная версия Fortran 2008).

Я отправляю пример (, пожалуйста, попробуйте не изменять переменные типа ).

Проблемы с использованием компилятора intel v.19 и gfortran 8.1 в Windows различны.

Вот полный пример. Посмотрите на подпрограмму, где я определил процедуру обмена. В настоящее время активировать версию, которая работает в GFortran, но у меня ошибка с компилятором Intel. Если вы прокомментируете эту часть и раскомментируете строки для 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

Есть предложения?

Answer 1

Компиляция исходного кода с помощью 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

(Результат такой же, как указано выше.)

Answer 2

Ответ Ройгвиба хорошо суммирует проблему. Если это назначение должно выполняться в коде пользователя, где типы известны или известны из небольшого набора возможных типов, можно просто защитить назначение с помощью select type typeguard.

Настоящая проблема возникает в общем коде, который написан без знания производных типов пользователя. Поэтому он может не иметь доступа к возможным пользовательским назначениям. Я предлагаю возможное решение, используя процедуру обратного вызова. По сути, пользователь определяет процедуру присваивания или обмена, которая затем вызывается библиотечным кодом.

subroutine sub_that_needs_assignments(array, assign)
  class(*) :: array
  interface
    subroutne assign(out, in)
    end subroutine
  end interface


  call assign(array(i), array(i+1))

  !or you can even assign a new elemnt from somewhere else
  ! possibly  protect by same_type_as()
end subroutine

в коде пользователя

   subroutine assign_my_type(out, in)
     class(*), ... :: out
     class(*), ... :: in

     select type (out)
       type is (my_type)
         select type (in)   ! not always necessary
           type is (in)
             out = in

         end select
      end select
      !add appropriate error checking

  end subroutine