Search code examples
multithreadingfortranopenmpgfortranbarrier

How can I replace an OMP BARRIER by a wait function?


I want to retire the !$OMP BARRIER in the following code so I thought to replace it by a wait function.

With !$OMP BARRIER:

 if (num_thread==1) then
          do i_task=first_task,last_task
             tasklist_GRAD(i_task)%state=STATE_READY
             call queue_enqueue_data(master_queue,tasklist_GRAD(i_task))   !< add the list elements to the queue (full queue)
          end do
 end if

   
 !$OMP BARRIER     ! barrier to retire 

 call master_worker_execution(self,var,master_queue,worker_queue,first_task,last_task,nthreads,num_thread,lck)

Without !$OMP BARRIER:

if (num_thread==1) then
          omp_start=omp_get_wtime() !start 
          do i_task=first_task,last_task
             tasklist_GRAD(i_task)%state=STATE_READY
             call queue_enqueue_data(master_queue,tasklist_GRAD(i_task))   !< add the list elements to the queue (full queue)
          end do
          omp_end=omp_get_wtime() !end 
end if


   


if (num_thread .ne. 1) then 
         call wait(int(omp_end-omp_start)*1000)
end if
           
call master_worker_execution(self,var,master_queue,worker_queue,first_task,last_task,nthreads,num_thread,lck)

The definition of the wait subroutine:

 subroutine wait(omp_start,omp_end)
    real(kind=REAL64),intent(in)::omp_start,omp_end
    real(kind=REAL64)::time 
    time=omp_end-omp_start
    call sleep(int(time))
  end subroutine wait

The barrier should let the threads (not thread number 1) wait for the thread number 1 to finish queueing the master_queue. That's why I thought to replace it by a wait function.

When executing, I get a segfault due to thread safety (I guess). I have a doubt on using the INT function because I declared omp_start and omp_end as real(kind=REAL64).

EDIT: I modified the wait subroutine according to the answer I got and did the following:

subroutine wait(master_queue)
    type(QUEUE_STRUCT),pointer::master_queue !< the master queue of tasks
    do while (.not. queue_full(master_queue))
       call sleep(1)
    end do
  end subroutine wait

Unfortunately, I'm not getting results as with OMP_BARRIER.

logical function queue_full( queue )
    type(QUEUE_STRUCT), intent(in)  :: queue

    queue_full = (queue%size == queue%capacity)

  end function queue_full

Solution

  • The reason you are getting a segfault is that omp_start and omp_end are set by thread 1 and read by the other threads. As you currently have it, the order in which this happens is undefined, and so they can (and likely will) be read before they are set.

    There is a more fundamental problem however. It looks like you just want the other threads to wait for thread 1 to finish, but there is no way to know in advance how long this will take. As such, there is no way to implement such a wait function. This is the whole reason for using barriers in the first place.