TheRock/rocm-systems/projects/rocprofiler-systems/examples/openmp/fortran/host.f90

! Copyright (c) Advanced Micro Devices, Inc.
! SPDX-License-Identifier: MIT
!
! Combined OpenMP host example that runs two distinct phases in sequence:
!   Phase 1: round-robin parallel loop
!   Phase 2: parallel task with detach (Currently Disabled)


program host_combined
    use omp_lib
    implicit none

    call run_ordered_phase()
    print *, "----"
    ! DISABLED until underlying SDK issue is fixed
    ! (ROCP fatal occurs when early_fulfill arrives after task_complete, which should not be the case)
    ! call run_task_detach_phase()

contains

    ! ------------------------------------------------------------------ !
    ! Phase 1: round-robin parallel loop                                  !
    ! ------------------------------------------------------------------ !
    subroutine run_ordered_phase()
        integer, parameter :: N = 20
        integer :: i
        integer :: values(0:N)

        do i = 0, N
            values(i) = i
        end do

        !$omp parallel do num_threads(2) shared(values) schedule(static, 1)
        do i = 0, N
            values(i) = values(i) + omp_get_thread_num()
        end do
        !$omp end parallel do

        print *, "[phase 1] final values:"
        do i = 0, N
            print *, "values(", i, ")=", values(i)
        end do
    end subroutine run_ordered_phase

    ! ------------------------------------------------------------------ !
    ! Phase 2: parallel task with detach                                  !
    ! ------------------------------------------------------------------ !
    subroutine run_task_detach_phase()
        integer, parameter :: N = 1000
        integer(kind=omp_event_handle_kind) :: event
        real(8) :: data(N)
        real(8) :: result
        integer :: i, j
        real(8) :: s

        do i = 1, N
            data(i) = real(i, kind=8)
        end do
        result = 0.0d0

        print *, "[phase 2] parallel task with detach"

        !$omp parallel num_threads(2) shared(data, result, event)
        !$omp single
            !$omp task detach(event) shared(data, result) private(j, s)
                s = 0.0d0
                do j = 1, N
                    s = s + data(j) * data(j)
                end do
                result = s
            !$omp end task

            !$omp task shared(event)
                call simulate_async_work()
                call omp_fulfill_event(event)
            !$omp end task

            !$omp taskwait
        !$omp end single
        !$omp end parallel

        print *, "[phase 2] result =", result
    end subroutine run_task_detach_phase

    ! ------------------------------------------------------------------ !
    ! Helper: simulate some host-side work before fulfilling the event    !
    ! ------------------------------------------------------------------ !
    subroutine simulate_async_work()
        integer :: k
        real(8) :: tmp
        tmp = 0.0d0
        do k = 1, 100000
            tmp = tmp + sin(real(k, kind=8))
        end do
        ! Use tmp so the loop is not eliminated by the optimizer
        if (tmp > huge(tmp)) print *, tmp
    end subroutine simulate_async_work

end program host_combined