Problem with OpenMP loop and polymorphic object

Problem with OpenMP loop and polymorphic object

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:

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

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:

<Configuration Name="Debug|x64">
 <Tool Name="VFFortranCompilerTool" AdditionalOptions="&#xA;" SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" Optimization="optimizeDisabled" Preprocess="preprocessYes" AdditionalIncludeDirectories="&quot;C:Program Files (x86)IntelComposer XE 2013mklinclude&quot;;&quot;C:Program Files (x86)IntelComposer XE 2013compilerinclude&quot;" OpenMP="OpenMPParallelCode" F2003Semantics="true" Diagnostics="diagnosticsShowAll" DebugParameter="debugParameterAll" WarnInterfaces="true" Traceback="true" BoundsCheck="true" RuntimeLibrary="rtMultiThreadedDebug" Interfaces="true"/>
 <Tool Name="VFLinkerTool" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" AdditionalLibraryDirectories="&quot;C:Program Files (x86)IntelComposer XE 2013mkllibintel64&quot;" GenerateDebugInformation="true" GenerateMapFile="true" SubSystem="subSystemConsole" AdditionalDependencies="mkl_lapack95_ilp64.lib mkl_intel_ilp64.lib mkl_intel_thread.lib mkl_core.lib libiomp5md.lib"/>
 <Tool Name="VFResourceCompilerTool"/>
 <Tool Name="VFMidlTool" SuppressStartupBanner="true" TargetEnvironment="midlTargetAMD64"/>
 <Tool Name="VFCustomBuildTool"/>
 <Tool Name="VFPreLinkEventTool"/>
 <Tool Name="VFPreBuildEventTool"/>
 <Tool Name="VFPostBuildEventTool"/>
 <Tool Name="VFManifestTool" SuppressStartupBanner="true"/></Configuration>

Best regards, Arash.

15 posts / 0 new
Last post
For more complete information about compiler optimizations, see our Optimization Notice.

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

Arash.

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:

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

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 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.

Steve - Intel Developer Support

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 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.

Steve - Intel Developer Support

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 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.

Steve - Intel Developer Support

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 any local variable in the function and private to each call of the routine in each thread.

Steve - Intel Developer Support

Thank you Steve for your help.

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-polymorphic and still saw a problem, but I'll take another look. You could be right.

Steve - Intel Developer Support

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 should work, or the compiler should complain if such is not supported.

Steve - Intel Developer Support

Leave a Comment

Please sign in to add a comment. Not a member? Join today