I'm trying to assign a polymorphic allocatable array ary which can take 2 extended types of baseType (extType1 and its extension extType2):
module mo
!$ use OMP_LIB
implicit none
type baseType
end type baseType
type, extends(baseType) :: extType1
real :: r1
end type extType1
type, extends(extType1) :: extType2
real :: r2
end type extType2
type arrayWrapper
class(extType1), allocatable :: w
end type arrayWrapper
contains
subroutine wrapExtType1(aExt1, a)!-----------------------------------------------------
type(extType1 ), dimension(:) , allocatable, intent(in ) :: aExt1 !
type(arrayWrapper), dimension(:) , allocatable, intent( out) :: a !
integer :: n, i !
!
n = size(aExt1) !
if (allocated(a)) deallocate(a); allocate(a(n)) !
do i = 1, n, 1; allocate(a(i)%w, source=aExt1(i)); end do !
end subroutine wrapExtType1!-----------------------------------------------------------
subroutine wrapExtType2(aExt2, a)!-----------------------------------------------------
type(extType2 ), dimension(:) , allocatable, intent(in ) :: aExt2 !
type(arrayWrapper), dimension(:) , allocatable, intent( out) :: a !
integer :: n, i !
!
n = size(aExt2) !
if (allocated(a)) deallocate(a); allocate(a(n)) !
do i = 1, n, 1; allocate(a(i)%w, source=aExt2(i)); end do !
end subroutine wrapExtType2!-----------------------------------------------------------
!-SEQUENTIAL VERSION :
subroutine aryPrintTypes(a)!-----------------------------------------------------------
type(arrayWrapper) , dimension(:), allocatable, intent(in ) :: a !
integer :: n, i !
!
n = size(a) !
do i = 1, n, 1; select type (this=>a(i)%w) !
type is (extType1) !
write(*,*) "Thread #", OMP_GET_THREAD_NUM(), "i =", i, & !
"type is extType1, r1 =", this%r1 !
type is (extType2) !
write(*,*) "Thread #", OMP_GET_THREAD_NUM(), "i =", i, & !
"type is extType2, r2 =", this%r2 !
end select; end do !
end subroutine aryPrintTypes!----------------------------------------------------------
end module mo
!=====================================MAIN_PROGRAM=====================================!
program PolyArray
!$ use OMP_LIB
use mo
implicit none
type(arrayWrapper), dimension(:), allocatable :: ary
type(extType1 ), dimension(:), allocatable :: aryExt1
type(extType2 ), dimension(:), allocatable :: aryExt2
integer :: n, i
n = 8
allocate (aryExt1(n))
allocate (aryExt2(n))
do i=1,n,1
aryExt1(i)%r1 = 1.*i
aryExt2(i)%r2 = 2.*i
end do
call wrapExtType1(aryExt1, ary)
call aryPrintTypes(ary)
write(*,*) " "
call wrapExtType2(aryExt2, ary)
call aryPrintTypes(ary)
end program PolyArray
To parallelize the aryPrintTypes subroutine, at first, I reckoned there would be a problem with the select type construct since the associated name this is created AFTER entering the !$OMP PARALLEL DO loop. Therefore I wrote the first parallelized version as follows :
!-FIRST PARALLELIZED VERSION :
subroutine aryPrintTypes(a)!-----------------------------------------------------------
type(arrayWrapper) , dimension(:), allocatable, intent(in ) :: a !
class(extType1 ) , pointer :: this !
integer :: n, i !
!
n = size(a) !
!$OMP PARALLEL DO SCHEDULE(STATIC) DEFAULT(SHARED) PRIVATE(i, this) !
do i = 1, n, 1; select type (this=>a(i)%w) !
type is (extType1) !
write(*,*) "Thread #", OMP_GET_THREAD_NUM(), "i =", i, & !
"type is extType1, r1 =", this%r1 !
type is (extType2) !
write(*,*) "Thread #", OMP_GET_THREAD_NUM(), "i =", i, & !
"type is extType2, r2 =", this%r2 !
end select; end do !
!$OMP END PARALLEL DO !
end subroutine aryPrintTypes!----------------------------------------------------------
The above code works fine as I expected. The output is the following using 8 threads:
Thread # 0 i = 1 type is extType1, r1 = 1.0000000000000000
Thread # 2 i = 3 type is extType1, r1 = 3.0000000000000000
Thread # 6 i = 7 type is extType1, r1 = 7.0000000000000000
Thread # 5 i = 6 type is extType1, r1 = 6.0000000000000000
Thread # 4 i = 5 type is extType1, r1 = 5.0000000000000000
Thread # 7 i = 8 type is extType1, r1 = 8.0000000000000000
Thread # 3 i = 4 type is extType1, r1 = 4.0000000000000000
Thread # 1 i = 2 type is extType1, r1 = 2.0000000000000000
Thread # 6 i = 7 type is extType2, r2 = 14.000000000000000
Thread # 2 i = 3 type is extType2, r2 = 6.0000000000000000
Thread # 0 i = 1 type is extType2, r2 = 2.0000000000000000
Thread # 5 i = 6 type is extType2, r2 = 12.000000000000000
Thread # 7 i = 8 type is extType2, r2 = 16.000000000000000
Thread # 1 i = 2 type is extType2, r2 = 4.0000000000000000
Thread # 3 i = 4 type is extType2, r2 = 8.0000000000000000
Thread # 4 i = 5 type is extType2, r2 = 10.000000000000000
However, I later tried a second parallelized version WITHOUT declaring this as a POINTER and, surprisingly, IT ALSO WORKS and gives the same result as the first version :
!-SECOND PARALLELIZED VERSION :
subroutine aryPrintTypes(a)!-----------------------------------------------------------
type(arrayWrapper) , dimension(:), allocatable, intent(in ) :: a !
integer :: n, i !
!
n = size(a) !
!$OMP PARALLEL DO SCHEDULE(STATIC) DEFAULT(PRIVATE) SHARED(a, n) !
do i = 1, n, 1; select type (this=>a(i)%w) !
type is (extType1) !
write(*,*) "Thread #", OMP_GET_THREAD_NUM(), "i =", i, & !
"type is extType1, r1 =", this%r1 !
type is (extType2) !
write(*,*) "Thread #", OMP_GET_THREAD_NUM(), "i =", i, & !
"type is extType2, r2 =", this%r2 !
end select; end do !
!$OMP END PARALLEL DO !
end subroutine aryPrintTypes!----------------------------------------------------------
I implemented both versions in a large in-house computation code, the first version works fine as always, but with the second version the type of the associated name this is NOT RECOGNIZED by the select type construct within the DO loop.
Compiler info:
GNU Fortran (Ubuntu 7.5.0-3ubuntu1~18.04) 7.5.0
Copyright (C) 2017 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
EDIT :
One comment suggested that the this in select type construct has nothing to do with the this declared as POINTER in the FIRST parallelized version. Therefore I removed the POINTER declaration in the first version and it gives the same result :
!-FIRST PARALLELIZED VERSION **(EDITED)**:
subroutine aryPrintTypes(a)!-----------------------------------------------------------
type(arrayWrapper) , dimension(:), allocatable, intent(in ) :: a !
integer :: n, i !
!
n = size(a) !
!$OMP PARALLEL DO SCHEDULE(STATIC) DEFAULT(SHARED) PRIVATE(i) !
do i = 1, n, 1; select type (this=>a(i)%w) !
type is (extType1) !
write(*,*) "Thread #", OMP_GET_THREAD_NUM(), "i =", i, & !
"type is extType1, r1 =", this%r1 !
type is (extType2) !
write(*,*) "Thread #", OMP_GET_THREAD_NUM(), "i =", i, & !
"type is extType2, r2 =", this%r2 !
end select; end do !
!$OMP END PARALLEL DO !
end subroutine aryPrintTypes!----------------------------------------------------------
So the new question is raised : Is the associated name this in select type construct automatically privatized by OpenMP without the need to be declared as PRIVATE ?
It does not need to (and can not) be declared PRIVATE. The associate name is just a synonym for the thing nominated by the selector when the SELECT TYPE (or ASSOCIATE) statement was executed.
The OpenMP 5.0 specification states in s2.19.1.1:
An associate name preserves the association with the selector established at the ASSOCIATE or SELECT TYPE statement.
The association between the associate name and the selector is specific to each thread.
Whether the thing associated with the name is private or shared depends on the data sharing attributes of the selector.
In the example code, the base object a of the selector is shared, but subsequent indexing ensures that different threads do not access the same element of that shared a.