Вложенный параллелизм OpenMP использует доступные потоки - PullRequest
Новая
       57

Вложенный параллелизм OpenMP использует доступные потоки

0 голосов
/ 08 января 2020

Итак, у меня есть этот простой Fortran do l oop, и внутри этого l oop вызывается пара подпрограмм. Я сделал do l oop параллельно с OpenMP, как это 

    !$omp parallel do
    do i=1,n
        call a()
        call b()
    enddo
    !$omp end parallel do

Теперь в большинстве случаев число итераций в l oop меньше по сравнению с количеством доступных процессоров / потоков и подпрограммы, которые вызываются внутри l oop, могут вызываться параллельно. Итак, есть ли способ вызвать подпрограммы параллельно внутри параллели сделать l oop? Я пробовал с task, как это 

    !$omp parallel do
    do i=1,n
        !$omp task
        call a(i , j )
        !$omp end    task
        !$omp task
        call b(i, k)
        !$omp end task
        !$omp taskwait
    enddo
    !$omp end parallel do

Но это показывает некоторую ошибку с segmentation fault. Есть ли способ достичь этого.

ОБНОВЛЕНИЕ:

Итак, я выяснил, что основная причина ошибки сегментации исходит из библиотеки fftw. Давайте рассмотрим фиктивную программу 

program name
    !$use omp_lib
    implicit real*8(a-h,p-z)
    call system_clock(count_rate=irate)
    call system_clock(it1)
    !$ call omp_set_nested(.true.)
    !$omp parallel do 
    do i =1,5
        call test(i)
        print *, i
    enddo
    !$omp end parallel do 
    call system_clock(it2)
    print *, (it2-it1)/real(irate, kind=8)
end program name


subroutine test(ii)
    ! just a dummy subroutine for heavy computation
    implicit real*8(a-h,p-z)
        do j=1,40000
            !$omp task
            do k=1,40000
                x = exp(sqrt(sqrt(2.0d0*ii**3)**2))
            enddo
            !$omp end task
        enddo
end subroutine

Эта программа работает именно так, как я хочу, используя директивы задачи, использует оставшиеся потоки и повышает производительность. Теперь давайте рассмотрим другую фиктивную программу, но с fftw, похожую на ту, с которой я работаю. 

program name
    !$use omp_lib
    implicit real*8(a-h,p-z)
    integer, parameter :: n=8192*8
    complex(kind=8) :: arr(n)
    real(kind=8) :: tmp1(n), tmp2(n)
    integer(kind=8) :: pF
    integer :: i

    call system_clock(count_rate=irate)
    call dfftw_plan_dft_1d(pF,n,arr,arr,-1,0) ! forward
    call system_clock(it1)

    !$ call omp_set_nested(.true.)
    !$omp parallel do private(arr)
    do i =1,5
        call random_number(tmp1)
        call random_number(tmp2)
        arr = cmplx(tmp1, tmp2, kind=8)
        call test(pF, arr)
        print *, i
    enddo
    !$omp end parallel do 
    call system_clock(it2)

    print *, (it2-it1)/real(irate, kind=8)

end program name


subroutine test(pF, arr)
    implicit real*8(a-h,p-z)
    complex(kind=8) :: arr(:)
    integer(kind=8) :: pF
    do j=1,100
        !$omp task private(arr)
        do k=1, 100
            call dfftw_execute_dft(pF, arr, arr)
        enddo
        !$omp end task
    enddo
end subroutine

Теперь это вызывает ошибку сегментации. (ПРИМЕЧАНИЕ: у меня нет случайного числового вызова в моей реальной программе, они здесь только для фиктивной цели). Я проверил http://www.fftw.org/fftw3_doc/Thread-safety.html и fftw_execute поточно-ориентированный, и программа работает без директив task. Но с task выдает ошибку. Кто-нибудь знает, как это исправить?

1 Ответ

1 голос
/ 08 января 2020

Вздох, еще один пример того, почему !$omp do parallel является плохой идеей ... Я действительно думаю, что лучше четко разделить фазы создания потоков и разделения рабочих ресурсов.

Как Владимир говорит в комментариях, вы не предоставили достаточно подробных сведений, чтобы объяснить причину ошибки сегментации. Однако у вас, похоже, есть несколько неправильных представлений об OpenMP, которые я могу попытаться устранить.

Во-первых, очень быстрый и грязный способ добиться того, чего вы хотите, и избежать каких-либо дополнительных директив OpenMP - 

!$omp parallel default( none ) private( i ) shared( n ) ! Create threads
!$omp do                                                ! Now share out the work
Do i = 1, 2 * n
   If( Mod( i, 2 ) == 1 ) Then
     Call a
   Else
     Call b
End Do
!$omp end do
!$omp end parallel

Однако если вы хотите использовать задачи, вы, вероятно, не будете делать это самым простым способом, если все вызовы a и b полностью независимы. В этом случае помните, что новая задача создается всякий раз, когда ЛЮБОЙ поток достигает !$omp task, и что эта задача может быть выполнена любым потоком, а не только тем, который ее создал. После этой логики c что-то вроде 

!$omp parallel default( none ) private( i ) shared( n ) ! Crate the threads
!$omp single
Do i = 1, n
   !$omp task
   Call a
   !$omp end task
   !$omp task
   call b
   !$omp end task
end do
!$omp end single
!$omp end parallel

- это то, что вы хотите - вы используете один поток для создания списка задач, а затем (или, более вероятно, во время создания списка) все доступные потоки выполнит их, каждая задача будет принята следующим доступным потоком. Примечание. Я также пропустил директиву TaskWait, так как из вашего описания я не уверен, почему вы считаете, что она вам нужна, поскольку в этот момент я не вижу необходимости в синхронизации.

...