! Collection of code snippets by Arne Vajhøj 
! (from articles on eksperten.dk / vajhoej.dk written sometime between 2004 and now) 
program comp
    call test(256, 1)
    call test(256, 2)
    call test(256, 4)
    call test(256, 8)
    call test(256, 16)
    call test(256, 32)
    call test(256, 64)
end

subroutine test(njobs, nthreads)
    use omp_lib
    implicit none
    integer(kind=4) njobs, nthreads
    integer(kind=4) i, j, k, t1, t2
    character(len=2) sa(njobs)
    call omp_set_num_threads(nthreads)
    call system_clock(t1)
    do i = 1, njobs
        sa(i) = 'X '
    end do
    !$omp parallel private(i) shared(sa)
    !$omp do
    do i = 1, njobs
        call run(sa(i))
    end do
    !$omp end do
    !$omp end parallel
    do i = 1, njobs
        if (sa(i) .ne. 'XX') then
            write(*,*) 'Ooops'
        end if
    end do
    call system_clock(t2)
    write(*,'(1x,I3,A,I2,A,F4.1,A)') njobs,' jobs executing in ', nthreads, ' threads : ', (t2 - t1) / 1000.0, ' seconds'
end

subroutine run(s)
    use iso_c_binding
    implicit none
    character(len=2) s
    call usleep(100000)
    s(2:2) = 'X'
end
