How can I do a swap between two elements belonging to the same polymorphic variable?

Question

What is the best method when you need interchange the values in two polymorphic elements? (Using standard fortran 2008).

I'm sending an example (please try don't modify the type variables).

The problems that I have using intel compiler v.19 and gfortran 8.1 in windows are different.

Here a complete example. Look at the subroutine where I have defined the swap procedure. Currently is activate the version that works in GFortran but I have error with intel compiler. If you comment this part and uncomment the lines for ifort, then works for intel and not for 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

Any suggestion?

Answer 1

The answer by roygvib summarizes the problem well. If this assignment is to be performed in user's code where the types are known or are known to be from a small set of possible types, one can just protect the assignment by the select type typeguard.

The real problem happens in a generic code that is written without the knowledge of the user's derived types. Therefore it may have no access to possible user-defined assignments. I suggest a possible solution using a callback procedure. Basically, the user defines an assignment or swap procedure which is then called by the library code.

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

in the user's code

   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

Answer 2

Compiling the original code with gfortran-8.2 gives

    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

I think this is because List % reflections(i) is not separately allocatable (even though List % reflections itself is allocatable as an array of uniform type). This point seems to be discussed in detail, e.g., in this Q/A page, which suggests two alternative approaches: (A) convince the compiler that all elements will be of the same type; or (B) use an (array) container.

---

If we use the "container" approach, I think we can use move_alloc() to swap two polymorphic objects (without knowing the dynamic type). For example, a bit modified version of the original code may be

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

Result (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 

---

I think we could also use polymorphic assignment for the above swap() routine, for example:

   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

This compiles with gfortran-8.2, but gives a strange result... (a possible compiler bug?). I guess newer compilers like GCC-9 or Intel Fortran may give an expected result.

---

On the other hand, if we use a polymorphic array, we may need to use select type explicitly for swapping the two elements. (But I hope there is a different approach...) The code may then look like:

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

(The result is the same as above.)