I have been playing around with polymorphism in fortran03 and don’t obtain the behaviour I was expecting from the minimum working example (below). I was expecting Matrix to be returned allocated and filled in both examples. Is anyone is able to confirm the behaviour below is expected? If so, how you would go about implementing a routine that returns a correctly allocated and filled array using polymorphism?
The goal is to have a derived type array (SMatrix) that can be either real or integer. This can be output to an allocatable array (Matrix) where the intrinsic type is specified. Subroutines Set_Matrix_1 or Set_Matrix_2 can allocate and fill matrix, regardless of the type of SMatrix or Matrix.
Set_Matrix_1 fails because the allocated ArrayOut seems to be deallocated as it leaves the Select Type block.
Set_Matrix_2 fails because once you allocate ArrayOut, it no longer has knowledge of the intrinsic type of ArrayOut.
Module Smart_Matricies
Type Smart_Matrix
Logical::TypeReal,TypeInt
Real,Dimension(:,:),Allocatable::MatR
Integer,Dimension(:,:),Allocatable::MatI
End Type Smart_Matrix
Contains
Subroutine Set_Matrix_1(ArrayOut,MatrixIn)
Implicit None
Class(*),Dimension(:,:),Allocatable,Intent(InOut)::ArrayOut
Type(Smart_Matrix),Intent(In)::MatrixIn
Integer::ColsMat,RowsMat
Write(*,*) 'ArrayOut is allocated at beginning of Set_Matrix_1?', Allocated(ArrayOut)
If(MatrixIn%TypeReal) then
ColsMat = Size(MatrixIn%MatR,1)
RowsMat = Size(MatrixIn%MatR,2)
ElseIf(MatrixIn%TypeInt) then
ColsMat = Size(MatrixIn%MatI,1)
RowsMat = Size(MatrixIn%MatI,2)
EndIf
Select Type (ArrayOut)
Type is (Integer)
If(.not.Allocated(ArrayOut)) then
Allocate(Integer::ArrayOut(RowsMat,ColsMat))
ElseIf(RowsMat.ne.Size(ArrayOut,1).or.ColsMat.ne.Size(ArrayOut,2)) then
Deallocate(ArrayOut)
Allocate(Integer::ArrayOut(RowsMat,ColsMat))
EndIf
Write(*,*) 'ArrayOut is allocated in integer of Set_Matrix_1?', Allocated(ArrayOut)
If(MatrixIn%TypeInt) then
ArrayOut = MatrixIn%MatI
ElseIf(MatrixIn%TypeReal) then
ArrayOut = MatrixIn%MatR
Else
Write(*,*) 'MatrixIn type not recognised'
EndIf
Type is (Real)
If(.not.Allocated(ArrayOut)) then
Allocate(Real::ArrayOut(RowsMat,ColsMat))
ElseIf(RowsMat.ne.Size(ArrayOut,1).or.ColsMat.ne.Size(ArrayOut,2)) then
Deallocate(ArrayOut)
Allocate(Real::ArrayOut(RowsMat,ColsMat))
EndIf
Write(*,*) 'ArrayOut is allocated in real of Set_Matrix_1?', Allocated(ArrayOut)
If(MatrixIn%TypeInt) then
ArrayOut = MatrixIn%MatI
ElseIf(MatrixIn%TypeReal) then
ArrayOut = MatrixIn%MatR
Else
Write(*,*) 'MatrixIn type not recognised'
EndIf
Class Default
Write(*,*) 'ArrayOut type not recognised'
End Select
Write(*,*) 'ArrayOut is allocated at end of Set_Matrix_1?', Allocated(ArrayOut)
End Subroutine Set_Matrix_1
Subroutine Set_Matrix_2(ArrayOut,MatrixIn)
Implicit None
Class(*),Dimension(:,:),Allocatable,Intent(InOut)::ArrayOut
Type(Smart_Matrix),Intent(In)::MatrixIn
Integer::ColsMat,RowsMat
Write(*,*) 'ArrayOut is allocated at beginning of Set_Matrix_2?', Allocated(ArrayOut)
If(MatrixIn%TypeReal) then
ColsMat = Size(MatrixIn%MatR,1)
RowsMat = Size(MatrixIn%MatR,2)
ElseIf(MatrixIn%TypeInt) then
ColsMat = Size(MatrixIn%MatI,1)
RowsMat = Size(MatrixIn%MatI,2)
EndIf
If(.not.Allocated(ArrayOut)) then
Allocate(ArrayOut(RowsMat,ColsMat))
ElseIf(RowsMat.ne.Size(ArrayOut,1).or.ColsMat.ne.Size(ArrayOut,2)) then
Deallocate(ArrayOut)
Allocate(ArrayOut(RowsMat,ColsMat))
EndIf
Write(*,*) 'ArrayOut is allocated before select type in Set_Matrix_2?', Allocated(ArrayOut)
Select Type (ArrayOut)
Type is (Integer)
If(MatrixIn%TypeInt) then
ArrayOut = MatrixIn%MatI
ElseIf(MatrixIn%TypeReal) then
ArrayOut = MatrixIn%MatR
Else
Write(*,*) 'MatrixIn type not recognised'
EndIf
Type is (Real)
If(MatrixIn%TypeInt) then
ArrayOut = MatrixIn%MatI
ElseIf(MatrixIn%TypeReal) then
ArrayOut = MatrixIn%MatR
Else
Write(*,*) 'MatrixIn type not recognised'
EndIf
Class Default
Write(*,*) 'ArrayOut type not recognised'
End Select
Write(*,*) 'ArrayOut is allocated at end of Set_Matrix_2?', Allocated(ArrayOut)
End Subroutine Set_Matrix_2
End Module Smart_Matricies
Program Test
Use Smart_Matricies
Implicit None
Real,Dimension(:,:),Allocatable::Matrix
Type(Smart_Matrix)::SMatrix
Allocate(SMatrix%MatR(2,2))
SMatrix%MatR = Reshape([1,2,3,4],[2,2])
SMatrix%TypeReal = .True.
SMatrix%TypeInt = .False.
Write(*,*) 'Matrix is allocated at beginning?', Allocated(Matrix)
Call Set_Matrix_1(Matrix,SMatrix)
Write(*,*) 'Matrix is allocated after Set_Matrix_1?', Allocated(Matrix)
Call Set_Matrix_2(Matrix,SMatrix)
Write(*,*) 'Matrix is allocated after Set_Matrix_2?', Allocated(Matrix)
End Program Test
Compiling this with pgfortran 16.7-0 64-bit target on Apple OS/X -tp haswell and running produces the following output:
Matrix is allocated at beginning? F
ArrayOut is allocated at beginning of Set_Matrix_1? F
ArrayOut is allocated in real of Set_Matrix_1? T
ArrayOut is allocated at end of Set_Matrix_1? F
Matrix is allocated after Set_Matrix_1? F
ArrayOut is allocated at beginning of Set_Matrix_2? F
ArrayOut is allocated before select type in Set_Matrix_2? T
ArrayOut type not recognised
ArrayOut is allocated at end of Set_Matrix_2? T
Matrix is allocated after Set_Matrix_2? T
Many thanks!