From abdd4c7dbd64d40686bfe5a8c224129954a8cac7 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 18 Jun 2021 12:48:07 +0200 Subject: [PATCH] Protection of writes in openmp --- src/zmq/utils.irp.f | 52 ++++++++++++++++++++++----------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/src/zmq/utils.irp.f b/src/zmq/utils.irp.f index 7cb6c896..2cb230c7 100644 --- a/src/zmq/utils.irp.f +++ b/src/zmq/utils.irp.f @@ -127,9 +127,9 @@ function zmq_port(ishift) END_DOC integer, intent(in) :: ishift character*(8) :: zmq_port - !$OMP CRITICAL(write) + !$OMP CRITICAL write(zmq_port,'(I8)') zmq_port_start+ishift - !$OMP END CRITICAL(write) + !$OMP END CRITICAL zmq_port = adjustl(trim(zmq_port)) end @@ -520,9 +520,9 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in) zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_socket_pull = new_zmq_pull_socket () - !$OMP CRITICAL(write) + !$OMP CRITICAL write(name,'(A,I8.8)') trim(name_in)//'.', icount - !$OMP END CRITICAL(write) + !$OMP END CRITICAL sze = len(trim(name)) zmq_state = trim(name) call lowercase(name,sze) @@ -586,9 +586,9 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in) integer, save :: icount=0 icount = icount+1 - !$OMP CRITICAL(write) + !$OMP CRITICAL write(name,'(A,I8.8)') trim(name_in)//'.', icount - !$OMP END CRITICAL(write) + !$OMP END CRITICAL sze = len(trim(name)) call lowercase(name,sze) if (name /= zmq_state) then @@ -710,9 +710,9 @@ integer function disconnect_from_taskserver_state(zmq_to_qp_run_socket, worker_i disconnect_from_taskserver_state = -1 - !$OMP CRITICAL(write) + !$OMP CRITICAL write(message,*) 'disconnect '//trim(state), worker_id - !$OMP END CRITICAL(write) + !$OMP END CRITICAL sze = min(510,len(trim(message))) rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0) @@ -789,9 +789,9 @@ integer function zmq_abort(zmq_to_qp_run_socket) character*(512) :: message zmq_abort = 0 - !$OMP CRITICAL(write) + !$OMP CRITICAL write(message,*) 'abort ' - !$OMP END CRITICAL(write) + !$OMP END CRITICAL sze = len(trim(message)) @@ -833,9 +833,9 @@ integer function task_done_to_taskserver(zmq_to_qp_run_socket, worker_id, task_i task_done_to_taskserver = 0 - !$OMP CRITICAL(write) + !$OMP CRITICAL write(message,*) 'task_done '//trim(zmq_state), worker_id, task_id - !$OMP END CRITICAL(write) + !$OMP END CRITICAL sze = len(trim(message)) rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0) @@ -868,11 +868,11 @@ integer function tasks_done_to_taskserver(zmq_to_qp_run_socket, worker_id, task_ tasks_done_to_taskserver = 0 - !$OMP CRITICAL(write) + !$OMP CRITICAL allocate(character(LEN=64+n_tasks*12) :: message) write(fmt,*) '(A,X,A,I10,X,', n_tasks, '(I11,1X))' write(message,*) 'task_done '//trim(zmq_state), worker_id, (task_id(k), k=1,n_tasks) - !$OMP END CRITICAL(write) + !$OMP END CRITICAL sze = len(trim(message)) rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0) @@ -914,9 +914,9 @@ integer function get_task_from_taskserver(zmq_to_qp_run_socket,worker_id,task_id get_task_from_taskserver = 0 - !$OMP CRITICAL(write) + !$OMP CRITICAL write(message,*) 'get_task '//trim(zmq_state), worker_id - !$OMP END CRITICAL(write) + !$OMP END CRITICAL sze = len(trim(message)) rc = f77_zmq_send(zmq_to_qp_run_socket, message, sze, 0) @@ -977,9 +977,9 @@ integer function get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id,task_i get_tasks_from_taskserver = 0 - !$OMP CRITICAL(write) + !$OMP CRITICAL write(message,'(A,A,X,I10,I10)') 'get_tasks ', trim(zmq_state), worker_id, n_tasks - !$OMP END CRITICAL(write) + !$OMP END CRITICAL sze = len(trim(message)) rc = f77_zmq_send(zmq_to_qp_run_socket, message, sze, 0) @@ -1079,9 +1079,9 @@ integer function zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,mo zmq_delete_task = 0 - !$OMP CRITICAL(write) + !$OMP CRITICAL write(message,*) 'del_task ', zmq_state, task_id - !$OMP END CRITICAL(write) + !$OMP END CRITICAL rc = f77_zmq_send(zmq_to_qp_run_socket,trim(message),len(trim(message)),0) if (rc /= len(trim(message))) then zmq_delete_task = -1 @@ -1121,9 +1121,9 @@ integer function zmq_delete_task_async_send(zmq_to_qp_run_socket,task_id,sending endif zmq_delete_task_async_send = 0 - !$OMP CRITICAL(write) + !$OMP CRITICAL write(message,*) 'del_task ', zmq_state, task_id - !$OMP END CRITICAL(write) + !$OMP END CRITICAL rc = f77_zmq_send(zmq_to_qp_run_socket,trim(message),len(trim(message)),0) if (rc /= len(trim(message))) then zmq_delete_task_async_send = -1 @@ -1181,10 +1181,10 @@ integer function zmq_delete_tasks(zmq_to_qp_run_socket,zmq_socket_pull,task_id,n allocate(character(LEN=64+n_tasks*12) :: message) - !$OMP CRITICAL(write) + !$OMP CRITICAL write(fmt,*) '(A,1X,A,1X,', n_tasks, '(I11,1X))' write(message,*) 'del_task '//trim(zmq_state), (task_id(k), k=1,n_tasks) - !$OMP END CRITICAL(write) + !$OMP END CRITICAL rc = f77_zmq_send(zmq_to_qp_run_socket,trim(message),len(trim(message)),0) @@ -1230,10 +1230,10 @@ integer function zmq_delete_tasks_async_send(zmq_to_qp_run_socket,task_id,n_task allocate(character(LEN=64+n_tasks*12) :: message) - !$OMP CRITICAL(write) + !$OMP CRITICAL write(fmt,*) '(A,1X,A,1X,', n_tasks, '(I11,1X))' write(message,*) 'del_task '//trim(zmq_state), (task_id(k), k=1,n_tasks) - !$OMP END CRITICAL(write) + !$OMP END CRITICAL rc = f77_zmq_send(zmq_to_qp_run_socket,trim(message),len(trim(message)),0)