Ah, sorry, you are right.

Arash_Rasekh · ‎08-07-2013

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.

Arash_Rasekh · ‎08-07-2013

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

Arash.

Arash_Rasekh · ‎08-07-2013

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)

Steven_L_Intel1 · ‎08-07-2013

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.

Arash_Rasekh · ‎08-07-2013

Hi,

Thank you Steve.

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

Steven_L_Intel1 · ‎08-07-2013

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.

Arash_Rasekh · ‎08-07-2013

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)

Steven_L_Intel1 · ‎08-07-2013

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.

Arash_Rasekh · ‎08-07-2013

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?

Steven_L_Intel1 · ‎08-07-2013

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

Arash_Rasekh · ‎08-07-2013

Thank you Steve for your help.

IanH · ‎08-07-2013

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

Steven_L_Intel1 · ‎08-07-2013

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

IanH · ‎08-07-2013

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.

Steven_L_Intel1 · ‎08-08-2013

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

Problem with OpenMP loop and polymorphic object