Cancel openmp do loops

[Erik_T_1]

Using Windows 10, IFORT 19.1.0.166 with Visual Studio 2019 using openmp targetting the CPU:

I am trying to cancel nested loops with openmp do loop as the outer loop. Here is an example code:

  program TestFortranConsole
  use omp_lib
  implicit none

  integer           ::  nx,ny,nz
  integer           ::  counter
  integer           ::  ix,iy,iz
  real,allocatable  ::  arr(:,:,:)
  logical           ::  shouldCancel
  integer           ::  tn
  nx = 10
  ny = 10
  nz = 10
  shouldCancel = .false.
  counter = 0
  allocate(arr(nx,ny,nz))
  !$OMP PARALLEL DO DEFAULT(PRIVATE) SHARED(shouldCancel,arr,counter)
  loopx: do ix=1,nx
    tn = OMP_GET_THREAD_NUM()
    !$OMP CANCELLATION POINT PARALLEL
    loopy: do iy=1,ny
      if (shouldCancel) then
        exit loopy
      end if

      loopz: do iz=1,nz
        if (shouldCancel) then
          exit loopz
        end if

        !§$OMP CRITICAL
        counter = counter + 1
        write(*,*) counter, ", ", tn
        !§$OMP END CRITICAL
        arr(ix,iy,iz) = counter
        !§$OMP CRITICAL
        if (counter .gt. 100) then
          shouldCancel = .true.
        end if
        !§$OMP CRITICAL
      end do loopz
    end do loopy
    if (shouldCancel) then
      !$OMP CANCEL PARALLEL
      end if
    end do loopx
    !$OMP END PARALLEL DO
    deallocate(arr)
    read(*,*)

  end program TestFortranConsole

Trying to compile this I get two erros with the following info:

..\TestFortranConsole.f90(65): error #8796: There is no innermost OpenMP* enclosing construct that matches the OpenMP* CANCEL or OpenMP* CANCELLATION POINT construct.

They refer to the `!$OMP CANCELLATION POINT PARALLEL` and the `!$OMP CANCEL PARALLEL` statements. I have tried changing the `PARALLEL` to `DO` and `PARALLEL  DO` with the same result.

Does anyone know how to do this?

[jimdempseyatthecove]

You can use a normal parallel do and replace the exit with

    if(shouldCancel) cycle

effectively canceling the loop by performing almost no work.

Jim Dempsey

[Erik_T_1]

Thanks a lot Jim, great idea!

[jimdempseyatthecove]

Erik,

I forgot to mention that the variable shouldCancel should be set and read in a multi-thread compatible manner.

for newer compilers:

     !$omp atomic write
     shouldCancel = .true.
     ...
     !$omp atomic read
     localShouldCancel = shouldCancel ! grab the state and place in thread private copy
     if(localShouldCancel) cycle

for older compiler (and newer as well), I've found it more effective to attribute the shouldCancel with VOLATILE and in which case you do not need the !$omp atomic... nor local copy.

In cases where the parallel region reaches deep in nest level, you can either pass in the reference to the shouldCancel, or make it a module variable (i.e. global).

Jim Dempsey

[jimdempseyatthecove]

Also, when requiring the OpenMP region thread number, split the parallel from the do

!$OMP PARALLEL DEFAULT(PRIVATE) SHARED(shouldCancel,arr,counter)
tn = OMP_GET_THREAD_NUM()
!$OMP DO
...
!$OMP END DO
!$OMP END PARALLEL

Jim Dempsey

[Erik_T_1]

Jim, should I use atomic instead of critical section? From what I understand they are pretty much the same..?

[jimdempseyatthecove]

Critical section has additional overhead. The best and simplest way is to attribute with volatile:

logical, volatile :: shouldCancel ! *** do NOT initialize here (only at load time)
...
shouldCancel = .false. ! *** initialize here (at each entry to procedure)
!$omp parallel default(shared) private(...)
iThread = omp_get_thread_num()
!$omp do ...
do ...
if(shouldCancel) cycle
...
if(reasonToCancel == .true.) shouldCancel = .true. ! do not use shouldCancel=reasonToCancel
...

Note, shouldCancel must not be set to the logical value of whatever you use to make this determination. Reason being is a different thread may unset the value. The interior of the loop should never unset shouldCancel. It is benign to set shouldCancel=.true. more than once.

Jim Dempsey