topic Problem with OpenMP loop and polymorphic object in Intel® Fortran Compiler

Problem with OpenMP loop and polymorphic object

Arash_Rasekh — Wed, 07 Aug 2013 08:21:13 GMT

Hi,

I have a problem in my program when i compile it with /Qopenmp. At a random point, the following run-time error apeared:

"forrtl: severe (173): a pointer passed to DEALLOCATE points to an object that cannot be deallocated"

Here there is a simplified version of my code:

[fortran]

module ModuleVector
implicit none
integer, parameter :: wp = kind(1.0d0)
!====================================================================================
type,abstract :: TypeVectorBase
real(wp) :: x=0._wp
real(wp) :: y=0._wp
contains
procedure(interfaceVectorAssignment),deferred,private :: vectorAssignment
generic :: assignment(=) =>vectorAssignment
end type
!---------
type,extends(TypeVectorBase) :: TypeVector2d
contains
procedure,private :: vectorAssignment=>vectorAssignment2d
end type
!================================
abstract interface
subroutine interfaceVectorAssignment(vector1,vector2)
import :: TypeVectorBase
class(TypeVectorBase) ,intent(out) :: vector1
class(TypeVectorBase) ,intent(in) :: vector2
end subroutine interfaceVectorAssignment
end interface
!====================================================================================
! declerations
class(TypeVectorBase),allocatable :: baseVector
class(TypeVectorBase),allocatable :: testVector(:,:)
!====================================================================================
contains
subroutine vectorAssignment2d(vector1,vector2)
! 11/18/2012
class(TypeVector2d) ,intent(out) :: vector1
class(TypeVectorBase) ,intent(in) :: vector2
! body
vector1%x=vector2%x
vector1%y=vector2%y
end subroutine vectorAssignment2d
end module
!************************************************************************************
module ModuleEquationOfState
! Created: 02/23/2013
use ModuleVector
implicit none
!====================================================================================
type,abstract :: TypeEquationOfStateBase
class(TypeVectorBase),allocatable :: rhoU
end type TypeEquationOfStateBase
!---------------------------------------
type,extends(TypeEquationOfStateBase) :: TypeCaloricallyPrefectGas
end type TypeCaloricallyPrefectGas
!====================================================================================
! deceleartions
class(TypeEquationOfStateBase),allocatable :: equationOfState
!$OMP THREADPRIVATE(equationOfState)
!====================================================================================
end module ModuleEquationOfState
!************************************************************************************
subroutine initiateCaloricallyPrefectGas(equation)
use ModuleEquationOfState
use ModuleVector
implicit none
! Created : 05/24/2013
!Arguments
class(TypeEquationOfStateBase),intent(inout) :: equation
! local variables
! body
allocate(equation%rhoU,source=baseVector)
end subroutine initiateCaloricallyPrefectGas
!***************************************
subroutine evaluateTimeStepSimple(blockNumber,ElementNumber)
! 05/27/2013
use ModuleVector
use ModuleEquationOfState
implicit none
!Arguments
integer,intent(in) :: blockNumber,ElementNumber
!Local variables
! Body
equationOfState%rhoU=testVector(blockNumber,ElementNumber)
end subroutine evaluateTimeStepSimple
!***************************************
subroutine runLowStorageRungeKutta()
!$ use omp_lib, only: OMP_GET_NUM_PROCS,omp_set_num_threads
!$ use ModuleVector
!$ use ModuleEquationOfState
implicit none
! local variables
integer :: m,i,j
!$ real(8) :: power
!$ integer :: numberOfThreads,numberOfProcessors
!$ power=0.75 !Conditional compilation
!$ numberOfProcessors= OMP_GET_NUM_PROCS() !Conditional compilation
!$ numberOfThreads= numberOfProcessors*power !Conditional compilation
!$ call omp_set_num_threads(numberOfThreads) !Conditional compilation
!$ call omp_set_nested(.true.)
!!$ call omp_set_dynamic(.true.)
do m=1,5
!-----
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) DEFAULT(SHARED) COPYIN(equationOfState)
do i=1,10
!-----
!$OMP PARALLEL DO SCHEDULE(GUIDED) SHARED(i) DEFAULT(SHARED) COPYIN(equationOfState)
do j=1,15
!write(*,*), "Hello world." ! When this statement uncommented, issue doesn't occur.
call evaluateTimeStepSimple(i,j)
end do
!$OMP END PARALLEL DO
!-----
end do
!$OMP END PARALLEL DO
!-----
end do
end subroutine runLowStorageRungeKutta
!***************************************
program testProgram
use ModuleVector
use ModuleEquationOfState
allocate(TypeVector2d::baseVector)
allocate(testVector(10,15),source=baseVector)
allocate(TypeCaloricallyPrefectGas:: equationOfState)
testVector.x=10._wp
testVector.y=20._wp
call initiateCaloricallyPrefectGas(equationOfState)
call runLowStorageRungeKutta()
end

[/fortran]

When i uncomment the write statement in runLowStorageRungeKutta subroutine, the program work without problem.

I use Intel Fortran 13.0.3615 and my project configuration is:

[xml]

[/xml]

Best regards, Arash.

The problem apear in

Arash_Rasekh — Wed, 07 Aug 2013 08:27:24 GMT

The problem apear in vectorAssignment2d subroutine which called in nested parallel loop by calling evaluateTimeStepSimple.

Arash.

After changing the intent of

Arash_Rasekh — Wed, 07 Aug 2013 18:07:56 GMT

After changing the intent of vector1 from intent(in) to intent(inout), the problem solved but new issues apeard.

Here there is the new code which new function added to it:

[fortran]

module ModuleVector
implicit none
integer, parameter :: wp = kind(1.0d0)
!====================================================================================
type,abstract :: TypeVectorBase
real(wp) :: x=0._wp
real(wp) :: y=0._wp
contains
procedure(interfaceVectorAssignment),deferred,private :: vectorAssignment
procedure(interfaceVectorVectorRealVectorOperator),deferred,private :: vectorVectorRealAdditionVectorResult
generic :: assignment(=) =>vectorAssignment
generic,public :: add=>vectorVectorRealAdditionVectorResult
end type
!---------
type,extends(TypeVectorBase) :: TypeVector2d
contains
procedure,private :: vectorAssignment=>vectorAssignment2d
procedure,private :: vectorVectorRealAdditionVectorResult =>vectorVectorRealAdditionVectorResult2d
end type
!================================
abstract interface
subroutine interfaceVectorAssignment(vector1,vector2)
import :: TypeVectorBase
class(TypeVectorBase) ,intent(inout) :: vector1
class(TypeVectorBase) ,intent(in) :: vector2
end subroutine interfaceVectorAssignment
!--------
function interfaceVectorVectorRealVectorOperator(vector1,vector2) result(vector3)
import :: TypeVectorBase,wp
class(TypeVectorBase),intent(in) :: vector1
real(wp),intent(in) :: vector2(:)
!class(TypeVectorBase),intent(inout) :: vector1 ! changed due to OMP bugs.
!real(wp),intent(inout) :: vector2(:)! changed due to OMP bugs.
class(TypeVectorBase),allocatable:: vector3
end function interfaceVectorVectorRealVectorOperator
end interface
!================================
!====================================================================================
! declerations
class(TypeVectorBase),allocatable :: baseVector
class(TypeVectorBase),allocatable :: testVector(:,:)
!====================================================================================
contains
subroutine vectorAssignment2d(vector1,vector2)
! 11/18/2012
class(TypeVector2d) ,intent(inout) :: vector1
class(TypeVectorBase) ,intent(in) :: vector2
! body
vector1%x=vector2%x
vector1%y=vector2%y
end subroutine vectorAssignment2d
!-------------
function vectorVectorRealAdditionVectorResult2d(vector1,vector2) result(vector3)
!12/15/2012
! arguments
class(TypeVector2d),intent(in) :: vector1
real(wp),intent(in) :: vector2(:)
class(TypeVectorBase),allocatable:: vector3
!!$OMP THREADPRIVATE(vector3)
! body
!
allocate(TypeVector2d :: vector3)
vector3.x=vector1.x+vector2(1)
vector3.y=vector1.y+vector2(2)
return
end function vectorVectorRealAdditionVectorResult2d
end module
!************************************************************************************
module ModuleEquationOfState
! Created: 02/23/2013
use ModuleVector
implicit none
!====================================================================================
type,abstract :: TypeEquationOfStateBase
class(TypeVectorBase),allocatable :: rhoU
integer,allocatable :: a
end type TypeEquationOfStateBase
!---------------------------------------
type,extends(TypeEquationOfStateBase) :: TypeCaloricallyPrefectGas
end type TypeCaloricallyPrefectGas
!====================================================================================
! deceleartions
class(TypeEquationOfStateBase),allocatable :: equationOfState
!$OMP THREADPRIVATE(equationOfState)
!====================================================================================
end module ModuleEquationOfState
!************************************************************************************
subroutine initiateCaloricallyPrefectGas(equation)
use ModuleEquationOfState
use ModuleVector
implicit none
! Created : 05/24/2013
!Arguments
class(TypeEquationOfStateBase),intent(inout) :: equation
! local variables
! body
allocate(equation%rhoU,source=baseVector)
allocate(equation%a)
end subroutine initiateCaloricallyPrefectGas
!***************************************
subroutine evaluateTimeStepSimple(blockNumber,ElementNumber)
! 05/27/2013
use ModuleVector
use ModuleEquationOfState
implicit none
!Arguments
integer,intent(in) :: blockNumber,ElementNumber
!Local variables
! Body
equationOfState%rhoU=testVector(blockNumber,ElementNumber)
end subroutine evaluateTimeStepSimple
!***************************************
subroutine runLowStorageRungeKutta()
!$ use omp_lib, only: OMP_GET_NUM_PROCS,omp_set_num_threads
!$ use ModuleVector
!$ use ModuleEquationOfState
implicit none
! local variables
integer :: m,i,j
!$ real(8) :: power
!$ integer :: numberOfThreads,numberOfProcessors
!$ power=0.75 !Conditional compilation
!$ numberOfProcessors= OMP_GET_NUM_PROCS() !Conditional compilation
!$ numberOfThreads= numberOfProcessors*power !Conditional compilation
!$ call omp_set_num_threads(numberOfThreads) !Conditional compilation
!$ call omp_set_nested(.true.)
!!$ call omp_set_dynamic(.true.)
do m=1,1
!-----
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) DEFAULT(SHARED) COPYIN(equationOfState)
do i=1,10
!-----
!$OMP PARALLEL DO SCHEDULE(GUIDED) SHARED(i) DEFAULT(SHARED) COPYIN(equationOfState)
do j=1,10
!write(*,*), "Hello world." ! When this statement uncommented, issue doesn't occur.
call evaluateTimeStepSimple(i,j)
testVector(i,j)=equationOfState%rhoU%add([1._wp,1._wp])

end do
!$OMP END PARALLEL DO
!!$omp barrier
!-----
end do
!$OMP END PARALLEL DO
!-----
end do
end subroutine runLowStorageRungeKutta
!***************************************
program testProgram
use ModuleVector
use ModuleEquationOfState
allocate(TypeVector2d::baseVector)
allocate(testVector(50,50),source=baseVector)
allocate(TypeCaloricallyPrefectGas:: equationOfState)
testVector.x=10._wp
testVector.y=20._wp
call initiateCaloricallyPrefectGas(equationOfState)
call runLowStorageRungeKutta()
end

[/fortran]

The new problem occur due to allocation and deallocation of vector3 in function vectorVectorRealAdditionVectorResult2d by multiple threads at same time. Because the vector3 is the return value of the function, i cannot define it as a threadprivate variable. (it need save attribute which cannot use for result of function)

I want to know is there anyway to define the result value of a function as a private variable for each thread (in dynamic extent of a parallel region)?

P.S: I have to much functions where their results are polymorphic variables or allocatable arrays. So i cannot change them to subroutine in order to prevent ussing temporary variables.(i.e result of function)

You do have an error in your

Steven_L_Intel1 — Wed, 07 Aug 2013 18:36:55 GMT

You do have an error in your program which the compiler warns me about - you call initiateCaloricallyPrefectGas from the main program, and this routine has an implicit interface (it isn't in a module.) However, the routine has a polymorphic argument and the standard requires an explicit interface in this case. You should put those routines in a module as well.

What you're doing should work - it is almost certainly a compiler bug that it doesn't. I will take a look at the revised program and see what is going on.

Hi,

Arash_Rasekh — Wed, 07 Aug 2013 18:58:11 GMT

Hi,

Thank you Steve.

In my orginal program explicit interfaces are included, But here for simplification i removed them from sample code.

Ok. They don't affect the

Steven_L_Intel1 — Wed, 07 Aug 2013 19:22:41 GMT

Ok. They don't affect the symptoms, but I wanted to mention it.

Out of curiosity, why did you use OMP !$ to conditionally USE the modules in runLowStorageRungeKutta? The program won't compile then if you don't enable OpenMP.

I'm working on a project

Arash_Rasekh — Wed, 07 Aug 2013 19:48:33 GMT

I'm working on a project which have serial and parallel cores. The cores are FORTRAN DLL and handled by a C# user interface. I use conditional compilation just for safety, because the cores built by a set of shared sources. (i.e. the serial and parallel cores sources are almost same and just their project configurations are different)

I have escalated the problem

Steven_L_Intel1 — Wed, 07 Aug 2013 19:54:59 GMT

I have escalated the problem to developers as issue DPD200246974.

I asked about the conditional compilation for the USE lines specifically, as without them the source would not compile at all - at least not in this version. Maybe your actual code looks different.

Ah, sorry, you are right.

Arash_Rasekh — Wed, 07 Aug 2013 20:11:17 GMT

Ah, sorry, you are right.

In the original code they must compiled just for parallel core. i forget to remove their conditional compilation on the sample code.

In OpenMP Application Program Interface Version3.1 specification document, the data-sharing attributes of result values for FORTRAN doesn't mentioned. Are they encountered as local variables - and thus they are shared variables- or they are private to each thread?

They should be the same as

Steven_L_Intel1 — Wed, 07 Aug 2013 20:15:25 GMT

They should be the same as any local variable in the function and private to each call of the routine in each thread.

Thank you Steve for your help

Arash_Rasekh — Wed, 07 Aug 2013 20:53:56 GMT

Thank you Steve for your help.

The OpenMP 4.0 spec says

IanH — Wed, 07 Aug 2013 23:06:13 GMT

The OpenMP 4.0 spec says "polymorphic things aren't supported". Is this really a bug proper, or just a reflection of that spec?

I made the type non

Steven_L_Intel1 — Thu, 08 Aug 2013 00:32:48 GMT

I made the type non-polymorphic and still saw a problem, but I'll take another look. You could be right.

If your answer was "sod the

IanH — Thu, 08 Aug 2013 01:26:41 GMT

If your answer was "sod the spec - we've taken the initiative to extend our implementation of OpenMP to cover other bits of F2003 in what we think is a sensible fashion" I'd be very happy.

My opinion is that either it

Steven_L_Intel1 — Thu, 08 Aug 2013 13:22:52 GMT

My opinion is that either it should work, or the compiler should complain if such is not supported.