From c6e8d9e2d802c3140d2b8cb0de1716d02a2ba4ff Mon Sep 17 00:00:00 2001
From: Hans Pabst <hans.pabst@intel.com>
Date: Thu, 6 Jun 2024 13:33:24 +0200
Subject: [PATCH] Expressed INTENT, and factored one access out of ATOMIC
 update.

---
 src/hfx_energy_potential.F | 27 ++++++++++++++++++---------
 1 file changed, 18 insertions(+), 9 deletions(-)

diff --git a/src/hfx_energy_potential.F b/src/hfx_energy_potential.F
index 117db63ae1..3c004c0bc0 100644
--- a/src/hfx_energy_potential.F
+++ b/src/hfx_energy_potential.F
@@ -2466,13 +2466,14 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, &
       REAL(dp), DIMENSION(*), INTENT(INOUT)              :: pbd, pbc, pad, pac, kbd, kbc, kad, kac
       INTEGER, INTENT(IN)                                :: iatom, jatom, katom, latom, iset, jset, &
                                                             kset, lset
-      INTEGER, DIMENSION(:, :), POINTER                  :: offset_bd_set, offset_bc_set, &
+      INTEGER, DIMENSION(:, :), POINTER, INTENT(IN)      :: offset_bd_set, offset_bc_set, &
                                                             offset_ad_set, offset_ac_set
       INTEGER, INTENT(IN)                                :: atomic_offset_bd, atomic_offset_bc, &
                                                             atomic_offset_ad, atomic_offset_ac
 
       INTEGER                                            :: i, j, ma, mb, mc, md, offset_ac, &
                                                             offset_ad, offset_bc, offset_bd
+      REAL(dp)                                           :: ki
 
       IF (jatom >= latom) THEN
          i = 1
@@ -2573,8 +2574,9 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, &
          j = offset_bd
          DO md = 1, md_max
             DO mb = 1, mb_max
+               ki = kbd(i)
 !$OMP           ATOMIC
-               ks(j) = ks(j) + kbd(i)
+               ks(j) = ks(j) + ki
                i = i + 1
                j = j + 1
             END DO
@@ -2584,8 +2586,9 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, &
          DO md = 1, md_max
             j = offset_bd + md - 1
             DO mb = 1, mb_max
+               ki = kbd(i)
 !$OMP           ATOMIC
-               ks(j) = ks(j) + kbd(i)
+               ks(j) = ks(j) + ki
                i = i + 1
                j = j + md_max
             END DO
@@ -2596,8 +2599,9 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, &
          j = offset_bc
          DO mc = 1, mc_max
             DO mb = 1, mb_max
+               ki = kbc(i)
 !$OMP           ATOMIC
-               ks(j) = ks(j) + kbc(i)
+               ks(j) = ks(j) + ki
                i = i + 1
                j = j + 1
             END DO
@@ -2607,8 +2611,9 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, &
          DO mc = 1, mc_max
             j = offset_bc + mc - 1
             DO mb = 1, mb_max
+               ki = kbc(i)
 !$OMP           ATOMIC
-               ks(j) = ks(j) + kbc(i)
+               ks(j) = ks(j) + ki
                i = i + 1
                j = j + mc_max
             END DO
@@ -2619,8 +2624,9 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, &
          j = offset_ad
          DO md = 1, md_max
             DO ma = 1, ma_max
+               ki = kad(i)
 !$OMP           ATOMIC
-               ks(j) = ks(j) + kad(i)
+               ks(j) = ks(j) + ki
                i = i + 1
                j = j + 1
             END DO
@@ -2630,8 +2636,9 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, &
          DO md = 1, md_max
             j = offset_ad + md - 1
             DO ma = 1, ma_max
+               ki = kad(i)
 !$OMP           ATOMIC
-               ks(j) = ks(j) + kad(i)
+               ks(j) = ks(j) + ki
                i = i + 1
                j = j + md_max
             END DO
@@ -2642,8 +2649,9 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, &
          j = offset_ac
          DO mc = 1, mc_max
             DO ma = 1, ma_max
+               ki = kac(i)
 !$OMP           ATOMIC
-               ks(j) = ks(j) + kac(i)
+               ks(j) = ks(j) + ki
                i = i + 1
                j = j + 1
             END DO
@@ -2653,8 +2661,9 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, &
          DO mc = 1, mc_max
             j = offset_ac + mc - 1
             DO ma = 1, ma_max
+               ki = kac(i)
 !$OMP           ATOMIC
-               ks(j) = ks(j) + kac(i)
+               ks(j) = ks(j) + ki
                i = i + 1
                j = j + mc_max
             END DO