From c564feb569835ba4f8a499414a93258f6df97acb Mon Sep 17 00:00:00 2001
From: Hans Pabst <hans.pabst@intel.com>
Date: Thu, 11 Sep 2025 14:55:10 +0200
Subject: [PATCH] Use OpenMP named critical sections and nowait

- Named criticals in an attempt to slightly reduce contention (qs_tensors.F).
- Rely on NOWAIT to omit implicit barriers when unnecessary.
---
 src/dbt/dbt_reshape_ops.F |  8 ++++----
 src/qs_tensors.F          | 16 ++++++++--------
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/src/dbt/dbt_reshape_ops.F b/src/dbt/dbt_reshape_ops.F
index 6bd480f28f..b77f0feae1 100644
--- a/src/dbt/dbt_reshape_ops.F
+++ b/src/dbt/dbt_reshape_ops.F
@@ -165,7 +165,7 @@ CONTAINS
       CALL dbt_communicate_buffer(mp_comm, buffer_recv, buffer_send)
 !$OMP BARRIER
 
-!$OMP DO
+!$OMP DO NOWAIT
       DO iproc = 0, numnodes - 1
          DEALLOCATE (buffer_send(iproc)%blocks, buffer_send(iproc)%data)
       END DO
@@ -230,14 +230,14 @@ CONTAINS
 !> \author Patrick Seewald
 ! **************************************************************************************************
    SUBROUTINE dbt_communicate_buffer(mp_comm, buffer_recv, buffer_send)
-      TYPE(mp_comm_type), INTENT(IN)                    :: mp_comm
+      TYPE(mp_comm_type), INTENT(IN)                        :: mp_comm
       TYPE(block_buffer_type), DIMENSION(0:), INTENT(INOUT) :: buffer_recv, buffer_send
 
       CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_communicate_buffer'
 
       INTEGER                                               :: iproc, numnodes, &
                                                                rec_counter, send_counter, i
-      TYPE(mp_request_type), ALLOCATABLE, DIMENSION(:, :)                 :: req_array
+      TYPE(mp_request_type), ALLOCATABLE, DIMENSION(:, :)   :: req_array
       INTEGER                                               :: handle
 
       CALL timeset(routineN, handle)
@@ -275,7 +275,7 @@ CONTAINS
 !$OMP END MASTER
 
       ELSE
-!$OMP DO SCHEDULE(static)
+!$OMP DO SCHEDULE(static) NOWAIT
          DO i = 1, SIZE(buffer_send(0)%blocks, 1)
             buffer_recv(0)%blocks(i, :) = buffer_send(0)%blocks(i, :)
          END DO
diff --git a/src/qs_tensors.F b/src/qs_tensors.F
index 1936d0e7dc..f865ca431c 100644
--- a/src/qs_tensors.F
+++ b/src/qs_tensors.F
@@ -1496,7 +1496,7 @@ CONTAINS
          END DO
 
          CALL timeset(routineN//"_put_dbcsr", handle2)
-!$OMP CRITICAL
+!$OMP CRITICAL(qs_tensors_t3c_der_i)
          sp = SHAPE(block_t_i(:, :, :, 1))
          sp([2, 3, 1]) = sp
 
@@ -1519,19 +1519,19 @@ CONTAINS
                                RESHAPE(block_t_k(:, :, :, i_xyz), SHAPE=sp, ORDER=[2, 3, 1]), &
                                summation=.TRUE.)
          END DO
-!$OMP END CRITICAL
+!$OMP END CRITICAL(qs_tensors_t3c_der_i)
 
          IF (nl_3c%sym == symmetric_jk) THEN
             sp = SHAPE(block_t_j(:, :, :, 1))
             sp([2, 3, 1]) = sp
-!$OMP CRITICAL
+!$OMP CRITICAL(qs_tensors_t3c_der_j)
             DO i_xyz = 1, 3
                IF (.NOT. block_j_not_zero(i_xyz)) CYCLE
                CALL dbt_put_block(t3c_der_j(jcell, kcell, i_xyz), blk_idx, sp, &
                                   RESHAPE(block_t_j(:, :, :, i_xyz), SHAPE=sp, ORDER=[2, 3, 1]), &
                                   summation=.TRUE.)
             END DO
-!$OMP END CRITICAL
+!$OMP END CRITICAL(qs_tensors_t3c_der_j)
          END IF
 
          CALL timestop(handle2)
@@ -2635,7 +2635,7 @@ CONTAINS
          END DO
 
          IF (block_not_zero) THEN
-!$OMP CRITICAL
+!$OMP CRITICAL(qs_tensors_t3c)
             CALL timeset(routineN//"_put_dbcsr", handle2)
             IF (debug) THEN
                CALL dbt_get_block(t3c(jcell, kcell), blk_idx, dummy_block_t, found=found)
@@ -2649,7 +2649,7 @@ CONTAINS
                                RESHAPE(block_t, SHAPE=sp, ORDER=[2, 3, 1]), summation=.TRUE.)
 
             CALL timestop(handle2)
-!$OMP END CRITICAL
+!$OMP END CRITICAL(qs_tensors_t3c)
          END IF
 
          DEALLOCATE (block_t)
@@ -3462,10 +3462,10 @@ CONTAINS
 !$OMP PRIVATE(iter,ind,offset,nblk,iblk)
       CALL dbt_iterator_start(iter, tensor)
       nblk = dbt_iterator_num_blocks(iter)
-!$OMP CRITICAL
+!$OMP CRITICAL(qs_tensors_offset)
       offset = shared_offset
       shared_offset = shared_offset + nblk
-!$OMP END CRITICAL
+!$OMP END CRITICAL(qs_tensors_offset)
       DO iblk = 1, nblk
          CALL dbt_iterator_next_block(iter, ind)
          blk_indices(offset + iblk, :) = ind(:)