Я пытаюсь назначить полиморфный c выделяемый массив ary
, который может принимать 2 расширенных типа baseType
(extType1
и его расширение 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
Для распараллеливания подпрограммы aryPrintTypes
сначала я решил, что возникнет проблема с конструкцией select type
, поскольку ассоциированное имя *1011* this
создано ПОСЛЕ при входе в !$OMP PARALLEL DO
l oop. Поэтому я написал первую распараллеленную версию следующим образом:
!-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!----------------------------------------------------------
Приведенный выше код работает нормально, как я и ожидал. Вывод следующий с использованием 8 потоков:
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
Однако , позже я попробовал вторую распараллеленную версию БЕЗ , объявив this
как POINTER
и Удивительно, но ЭТО ТАКЖЕ РАБОТАЕТ и дает тот же результат, что и первая версия:
!-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!----------------------------------------------------------
Я реализовал обе версии в большом внутреннем вычислительном коде, первая версия работает нормально, так как всегда, но во второй версии тип связанного имени this
НЕ ПРИЗНАЕТСЯ конструкцией select type
в DO l oop.
Информация о компиляторе:
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.
РЕДАКТИРОВАТЬ:
Один комментарий предположил, что конструкция this
в select type
не имеет ничего общего с this
, объявленным как POINTER
в ПЕРВАЯ параллельная версия. Поэтому я удалил объявление POINTER
в первой версии, и оно дает тот же результат:
!-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!----------------------------------------------------------
Таким образом, возникает новый вопрос : является ли ассоциированное имя this
в select type
construct автоматически приватизируется OpenMP без необходимости объявляться как PRIVATE
?