<ATOMIC_OR Example Program>
Module stopping
Use iso_fortran_env
Integer,Parameter :: ntasks = 25
! 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_or(imask[1],2**(tasknum-1))
End Subroutine
Logical Function all_finished()
Integer(atomic_int_kind) res
Call atomic_ref(res,imask[1])
all_finished = res==2**ntasks - 1
End Function
End Module
Program atomic_or_example
Use stopping
Logical :: finished = .False.
Integer mytask
! All images will execute until finished.
mytask = This_Image()
Do While (mytask<=ntasks)
Call do_task(mytask,finished)
If (finished) Then
Call task_finished(mytask)
mytask = mytask + Num_Images()
End If
End Do
If (This_Image()==1) Then
Do While (.Not.all_finished())
Sync Memory
End Do
! In principle we could do something with the results,
! but this is just a simple example.
Print *,'All 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.
Call random_number(x)
done = Any(x>0.99)
End Subroutine
End Program
■ Execution Results
All finished