＜ATOMIC_XOR Example Program＞

Module taskmanager
  Use iso_fortran_env
  Integer(atomic_int_kind) :: ntasks[*] = 2
  Integer,Parameter :: maxtasks = 30
  ! This only works for ntasks up to Bit_Size(0_atomic_int_kind)-1.
  Integer(atomic_int_kind) :: imask[*] = 0
Contains
  Subroutine task_finished(tasknum)
    Integer,Intent(In) :: tasknum
    CALL atomic_xor(imask[1],2**(tasknum-1))
  End Subroutine
  Logical Function task_available(tasknum)
    Integer,Intent(In) :: tasknum
    Integer check,n
    Call atomic_ref(n,ntasks[1])
    If (tasknum>n) Then
      task_available = .False.
    Else
      Call atomic_ref(check,imask[1])
      task_available = .Not.Btest(check,tasknum-1)
    End If
  End Function
  Subroutine newtask
    Integer m
    Call atomic_ref(m,ntasks[1])
    If (m<maxtasks) Call atomic_define(ntasks[1],m+1)
  End Subroutine
  Logical Function all_finished()
    Integer(atomic_int_kind) res,n
    Call atomic_ref(res,imask[1])
    Call atomic_ref(n,ntasks[1])
    all_finished = res==Maskr(n)
  End Function
End Module
Program atomic_xor_example
  Use taskmanager
  Logical :: finished
  Integer mytask
  ! All images will execute until all are finished.
  mytask = This_Image()
  Do
    If (task_available(mytask)) Then
      Call do_task(mytask,finished)
      If (finished) Then
        Call task_finished(mytask)
        mytask = mytask + Num_Images()
      End If
    Else
      If (all_finished()) Exit
      Sync Memory ! Not needed, just to take some time.
    End If
  End Do
  If (This_Image()==1) Then
    ! In principle we could do something with the results,
    ! but this is just a simple example.
    Call atomic_ref(mytask,ntasks)
    Print *,mytask,'tasks finished'
  End If
Contains
  Subroutine do_task(tasknum,done)
    Integer,Intent(In) :: tasknum
    Logical,Intent(Out) :: done
    Real x(tasknum)
    ! Because this is an example, we don't actually do any work.
    ! We just randomly (1% per element, i.e. approx tasknum%) set the done flag.
    ! 10% of the time we also spawn a new task (up to the maximum).
    Call random_number(x)
    If (Any(x>0.9)) Call newtask
    done = Any(x>0.99)
  End Subroutine
End Program

---

■ Execution Results

 30 tasks finished