#multithreading #fortran #locking #openmp #master-slave
Вопрос:
У меня tasklist_GRAD есть массив указателей на функции, и я хочу использовать lock процедуры для выполнения tasks (определенные в другом module ). Вот subroutine то, что я реализовал:
module app_management
use OMP_LIB
use tasks
implicit none
!etats
integer, parameter:: STATE_RUNNING=0
integer, parameter:: STATE_READY=1
integer, parameter:: STATE_WAITING=2
!!$ integer, parameter:: STATE_INACTIVE=3
contains
subroutine management(tasklist_GRAD,var)
INTEGER ::ff
type(tcb)::self
type(variables)::var
!OpenMP variables
integer::num_thread,nthreads
integer, external :: OMP_GET_THREAD_NUM, OMP_GET_NUM_THREADS
type(tcb),dimension(20)::tasklist_GRAD,tasks_ready_master
!Variables pour gestion des threads
integer,allocatable,dimension(:)::threads_list !liste contenant les nums des threads workers
integer,dimension(100)::threads_list_all !liste contenant les nums des threads workers dans l'ordre selon les tâches
integer,dimension(3)::threads_list_part1 ! 3 premières tâches
integer,dimension(16)::threads_list_part3 ! le reste des tâches
integer::threads_list_part2 ! 4 eme tâche
INTEGER(KIND=omp_lock_kind), SAVE :: lock
CALL omp_init_lock (lock)
!=======================================================================================================================================================
!$OMP PARALLEL PRIVATE(num_thread,threads_list_all,nthreads,ff) amp;
!$OMP SHARED(tasklist_GRAD,tasks_ready_master,threads_list,lock) amp;
!$OMP SHARED(threads_list_part1,threads_list_part2,threads_list_part3)
num_thread=OMP_GET_THREAD_NUM() ! le rang du thread
nthreads=OMP_GET_NUM_THREADS() ! le nombre de threads
Choisircese: select case (var%ww_t)
case(0) ! Old CESE
!Thread Application Master (numero 1)
if (num_thread==1) then
do ff=1,3 ! 3 tâches
if (associated(tasklist_GRAD(ff)%f_ptr) .eqv. .true. ) then ! Si tâche attribuée
tasks_ready_master(ff) = tasklist_GRAD(ff) ! égalité de pointeurs
tasks_ready_master(ff)%state=STATE_READY
end if
end do
end if
do while(.not.OMP_test_lock(lock))
!Threads workers
!$OMP DO PRIVATE(ff)
do ff=1,3
call tasks_ready_master(ff)%f_ptr(self,var)
tasks_ready_master(ff)%state=STATE_RUNNING
end do
!$OMP END DO
end do
do ff=1,3
if (tasks_ready_master(ff)%state==STATE_RUNNING) then
tasklist_GRAD(ff)%state=STATE_RUNNING
end if
end do
!Thread Master (numero 0)
if (num_thread==0) then
if(var%pas_t.eq.2)then
var%u_prime_t(2) = var%tab0_t(2,2) var%dt_t/2.0d0*var%grad_x_u_t(2)!d_t_u(2)
var%u_prime_t(var%cpt_t-1) = var%tab0_t(var%cpt_t-1,2) var%dt_t/2.0d0*var%grad_t_u_t(var%cpt_t-1)
var%u_prime_t(1) = var%tab0_t(1,2) var%dt_t/2.0d0*var%grad_t_u_t(1)
var%u_prime_t(var%cpt_t) = var%tab0_t(var%cpt_t,2) var%dt_t/2.0d0*var%grad_t_u_t(var%cpt_t)
var%u_prime_plus_t(1)= (var%u_prime_t(2)-var%tab_t(1,2))/(var%dx_t/2.0d0)
var%u_prime_moins_t(1)=-(var%u_prime_t(1)-var%tab_t(1,2))/(var%dx_t/2.0d0)
var%u_prime_plus_t(var%cpt_t)= (var%u_prime_t(var%cpt_t)-var%tab_t(var%cpt_t,2))/(var%dx_t/2.0d0)
var%u_prime_moins_t(var%cpt_t)= -(var%u_prime_t(var%cpt_t-1)-var%tab_t(var%cpt_t,2))/(var%dx_t/2.0d0)
endif
end if
!Thread Master (numero 0)
if (num_thread==0) then
call tasks_ready_master(4)%f_ptr(self,var)
tasks_ready_master(4)%state=STATE_RUNNING
end if
!$OMP BARRIER
if (num_thread==0) then
!-------Condition cyclique sur les gradients
if(var%pas_t.eq.1)then
var%grad_x_u_t(var%cpt_t)=var%grad_x_u_t(var%cpt_t-1)!w0(u_prime_plus(cpt),u_prime_moins(cpt),2.0d0,0.01d0)
var%grad_x_u_t(1)=var%grad_x_u_t(var%cpt_t)
endif
if(var%pas_t.eq.2)then
var%grad_x_u_t(1)=var%grad_x_u_t(2)!w0(u_prime_plus(1),u_prime_moins(1),0.0d0,1.0d0)!0.99d0)!
var%grad_x_u_t(var%cpt_t)=var%grad_x_u_t(1)!w0(u_prime_plus(cpt),u_prime_moins(cpt),0.0d0,1.0d0)!0.99d0)!
endif
end if
!------- En vrai, pas retesté avec ce type de gradient. M'est avis que ça ne fonctionne sans doute pas
case(2) ! W2
!Thread Application Master (numero 1)
if (num_thread==1) then
do ff=5,20 ! 16 tâches
if (associated(tasklist_GRAD(ff)%f_ptr) .eqv. .true.) then
tasks_ready_master(ff) = tasklist_GRAD(ff)
tasks_ready_master(ff)%state=STATE_READY
end if
end do
end if
do while(.not.OMP_test_lock(lock))
!Threads workers
!$OMP DO SCHEDULE(DYNAMIC) PRIVATE(ff)
do ff=5,20
call tasks_ready_master(ff)%f_ptr(self,var)
tasks_ready_master(ff)%state=STATE_RUNNING
end do
!$OMP END DO
end do
do ff=5,20
if (tasks_ready_master(ff)%state==STATE_RUNNING) then
tasklist_GRAD(ff)%state=STATE_RUNNING
end if
end do
if (num_thread==0) then
var%grad_x_u_t(var%cpt_t)=var%grad_x_u_t(var%cpt_t-1)
var%grad_x_u_t(1)=var%grad_x_u_t(var%cpt_t)
end if
end select choisircese
!$OMP END PARALLEL
CALL omp_destroy_lock (lock)
end subroutine management
end module app_management
Я получаю segmentation fault - invalid memory reference ошибку.
Это связано с тем, что я добавил в код следующую часть:
do while(.not.OMP_test_lock(lock))
!Threads workers
!$OMP DO PRIVATE(ff)
do ff=1,3
call tasks_ready_master(ff)%f_ptr(self,var)
tasks_ready_master(ff)%state=STATE_RUNNING
end do
!$OMP END DO
end do
do ff=1,3
if (tasks_ready_master(ff)%state==STATE_RUNNING) then
tasklist_GRAD(ff)%state=STATE_RUNNING
end if
end do
Например, у меня есть 16 tasks и 4 threads (только 2 workers , что означает, что только 2 будут выполняться tasks ). Я хотел реализовать это с помощью lock подпрограмм, поэтому я добавил упомянутую часть. Всякий раз, когда поток между рабочими свободен, он должен выполнить первый элемент tasklist_GRAD . master Поток должен работать только в том случае, если работник свободен или нет.
Я все еще открываю lock для себя рутину.
Комментарии:
1. Я предполагаю, что вы пробовали-fcheck=все и тому подобное? Кроме того, с полным кодом нам будет очень сложно помочь вам отладить — то, что вы делаете, довольно сложно и, по крайней мере для меня, очень неинтуитивно.
2. Я действительно вижу некоторое беспокойство
integer, external :: OMP_GET_THREAD_NUM, OMP_GET_NUM_THREADS, и я не вижу ниimplicit noneтого, ниinclude 'omp_lib.h'другого, ни лучшегоuse omp_lib, ни какого-либо определенияomp_test_lock()функции… Пожалуйста, подумайте о том, чтобы исправить это в первую очередь3. @Gilles Я отредактировал свой вопрос, чтобы показать вам недостающие моменты. Это целый модуль, содержащий управление подпрограммами.
4. Ну, я очень сомневаюсь, что в этом проблема, но если вы используете модуль, вам не нужно (и не следует) повторно объявлять функции как внешние возвращаемые целые числа. Модуль уже сделал это для вас (и многое другое). Но в качестве первой проверки избавьтесь от этой строки и посмотрите, изменится ли что-нибудь.
5. @IanBush даже когда я избавляюсь
external, у меня все равно остается та же проблема. Надеюсь, вы поняли, что я пытаюсь сделать с помощью процедур блокировки. Например, если у меня 16 задач и 2 работника, я хочу, чтобы работник 1 выполнил первую задачу, а работник 2 выполнил вторую задачу. Работник, который завершит выполнение первым, перейдет к следующей задаче. Я в замешательстве. Таким образом, мы можем выполнить 3 первые задачи только одним работником. Это зависит от времени, затраченного на выполнение.