2024-04-16 08:59:23 -07:00

64 lines
2.0 KiB
Fortran

! @@name: metadirective.4
! @@type: F-free
! @@operation: run
! @@expect: success
! @@version: omp_5.2
subroutine foo(a, n, use_gpu)
integer :: n, a(n)
logical :: use_gpu
integer :: b=0 !! use b to detect if run on gpu
!$omp metadirective &
!$omp& when(user={condition(use_gpu)}: &
!$omp& target teams distribute parallel do &
!$omp& private(b) map(from:a(1:n)) ) &
!$omp& otherwise( &
!$omp& parallel do)
do i = 1,n; a(i)=i; if(i==n) b=1; end do
if(b==0) print *, "PASSED 1 of 3" ! bc b is firstprivate for gpu run
end subroutine
subroutine bar (a, n, run_parallel, unbalanced)
use omp_lib, only : omp_get_thread_num, omp_in_parallel
integer :: n, a(n)
logical :: run_parallel, unbalanced
integer :: b=0
!$omp begin metadirective when(user={condition(run_parallel)}: parallel)
if(omp_in_parallel() .and. omp_get_thread_num() == 0) &
print *,"PASSED 2 of 3"
!$omp metadirective &
!$omp& when(construct={parallel}, user={condition(unbalanced)}: &
!$omp& do schedule(guided) private(b)) &
!$omp& when(construct={parallel}: do schedule(static))
do i = 1,n; a(i)=i; if(i==n) b=1; end do
!$omp end metadirective
if(b==0) print *, "PASSED 3 of 3" !!if guided, b=0 since b is private
end subroutine
program meta
use omp_lib
integer, parameter :: N=100
integer :: p(N)
integer :: env_stat
!! App normally sets these, dependent on input parameters
logical :: use_gpu=.true., run_parallel=.true., unbalanced=.true.
!! Testing: set Env Var MK_FAIL to anything to fail tests
call get_environment_variable('MK_FAIL',status=env_stat)
if(env_stat /= 1) then ! status =1 when not set!
use_gpu=.false.; run_parallel=.false.; unbalanced=.false.
endif
call foo(p, N, use_gpu)
call bar(p, N, run_parallel,unbalanced)
end program