program test_omp_cancellation
    use omp_lib
    use ifport
    implicit none
    
    integer,parameter :: n = 5000000
    real(8) :: r(n)
    integer :: indx,iThread
    logical :: btest
    
    open (file='1111.out',unit=1111)
    
    iThread    = 0
    r          = 0.0
    r(1234567) = 2.0
    
    !$ if (omp_get_cancellation()) then
    !$     write (*,*) 'cancellation set'
    !$ else
    !$     write (*,*) 'cancellation NOT set'
    !$ end if
    
    !$OMP PARALLEL PRIVATE(indx)
    !$OMP DO
    do indx=1,n
        write (1111,*) indx
        !$OMP CANCELLATION POINT DO
        if (r(indx) .eq. 2.0) then
            !$ iThread = omp_get_thread_num()
            write (*,*) indx,iThread
            !$OMP CANCEL DO
        end if
    end do
    !$OMP END DO
    !$OMP END PARALLEL
    
end