Cut release version 2026.2

2026-07-29 06:35:28 -04:00 · 2026-07-15 11:11:06 +02:00
832 changed files with 11870 additions and 26080 deletions
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@ -10,15 +10,6 @@ cmake_minimum_required(VERSION 3.24)
 # include our cmake snippets
 set(CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} ${CMAKE_CURRENT_SOURCE_DIR}/cmake)
 # Require out-of-source builds
 file(TO_CMAKE_PATH "${CMAKE_BINARY_DIR}/CMakeLists.txt" LOC_PATH)
 if(EXISTS "${LOC_PATH}")
  message(
    FATAL_ERROR
      "You cannot build in a source directory (or any directory with a CMakeLists.txt file). "
      "Please make a build subdirectory.")
 endif()
 # =================================================================================================
 # PROJECT AND VERSION
 include(CMakeDependentOption)
@ -40,6 +31,15 @@ project(
 list(APPEND CMAKE_MODULE_PATH "${PROJECT_SOURCE_DIR}/cmake/modules")
 # Require out-of-source builds
 file(TO_CMAKE_PATH "${PROJECT_BINARY_DIR}/CMakeLists.txt" LOC_PATH)
 if(EXISTS "${LOC_PATH}")
  message(
    FATAL_ERROR
      "You cannot build in a source directory (or any directory with a CMakeLists.txt file). Please make a build subdirectory."
  )
 endif()
 # set language and standard.
 #
 # cmake does not provide any mechanism to set the fortran standard. Adding the
@ -106,6 +106,10 @@ foreach(__var ROCM_ROOT CRAY_ROCM_ROOT ORNL_ROCM_ROOT CRAY_ROCM_PREFIX
  endif()
 endforeach()
 set(CMAKE_INSTALL_LIBDIR
    "lib"
    CACHE PATH "Default installation directory for libraries")
 # =================================================================================================
 # OPTIONS
 option(CMAKE_POSITION_INDEPENDENT_CODE "Enable position independent code" ON)
@ -222,18 +226,18 @@ cmake_dependent_option(
  CP2K_USE_CUSOLVER_MP "Enable cuSOLVERMp. Only active when CUDA is ON" OFF
  "CP2K_USE_ACCEL MATCHES \"CUDA\"" OFF)
-cmake_dependent_option(CP2K_USE_NVHPC "Enable Nvidia NVHPC kit" OFF
+cmake_dependent_option(CP2K_USE_NVHPC OFF "Enable Nvidia NVHPC kit"
-                       "CP2K_USE_ACCEL MATCHES \"CUDA\"" OFF)
+                       "(NOT CP2K_USE_ACCEL MATCHES \"CUDA\")" OFF)
 cmake_dependent_option(
-  CP2K_USE_SPLA_GEMM_OFFLOADING
+  CP2K_USE_SPLA_GEMM_OFFLOADING ON
-  "Enable SpLA dgemm offloading (only valid with GPU support on)" ON
+  "Enable SpLA dgemm offloading (only valid with GPU support on)"
-  "CP2K_USE_ACCEL MATCHES \"HIP|CUDA\" AND CP2K_USE_SPLA" OFF)
+  "(NOT CP2K_USE_ACCEL MATCHES \"NONE\") AND (CP2K_USE_SPLA)" OFF)
 cmake_dependent_option(
-  CP2K_USE_CRAY_PM_ACCEL_ENERGY
+  CP2K_USE_CRAY_PM_ACCEL_ENERGY ON
-  "Enable CRAY power management framework with gpu support" ON
+  "Enable CRAY power management framework with gpu support"
-  "CP2K_USE_ACCEL MATCHES \"OPENCL|HIP|CUDA\" AND CP2K_USE_CRAY_PM_ENERGY" OFF)
+  "(NOT CP2K_USE_ACCEL MATCHES \"NONE\") AND (CP2K_USE_CRAY_PM_ENERGY)" OFF)
 cmake_dependent_option(
  CP2K_USE_LIBGINT "Enable LibGint support" ${CP2K_USE_EVERYTHING}
@ -880,7 +884,6 @@ macro(cp2k_detect_dftd4_api)
 endmacro()
 if(CP2K_USE_DFTD4)
  find_package(mctc-lib REQUIRED) # workaround: find mctc-lib first
  find_package(dftd4 REQUIRED)
  cp2k_detect_dftd4_api()
 endif()
@ -906,10 +909,7 @@ if(CP2K_USE_ACE)
 endif()
 if(CP2K_USE_TBLITE)
-  find_package(tblite CONFIG REQUIRED)
+  find_package(tblite REQUIRED)
  if(tblite_VERSION VERSION_LESS "0.7.0")
    message(FATAL_ERROR "tblite >= 0.7.0 is required; found ${tblite_VERSION}")
  endif()
  add_library(cp2k::tblite INTERFACE IMPORTED)
  target_link_libraries(
    cp2k::tblite INTERFACE tblite::tblite mctc-lib::mctc-lib dftd4::dftd4
@ -1076,10 +1076,11 @@ if(CP2K_USE_CUSOLVER_MP)
  else()
    message("    - CAL Include directories: ${CP2K_CAL_INCLUDE_DIRS}\n"
            "    - CAL Libraries: ${CP2K_CAL_LINK_LIBRARIES}")
    message("    - UCC Include directories: ${CP2K_UCC_INCLUDE_DIRS}\n"
            "    - UCC Libraries: ${CP2K_UCC_LINK_LIBRARIES}\n"
            "    - UCX Libraries: ${CP2K_UCX_LINK_LIBRARIES}\n")
  endif()
  message("    - UCC Include directories: ${CP2K_UCC_INCLUDE_DIRS}\n"
          "    - UCC Libraries: ${CP2K_UCC_LINK_LIBRARIES}\n"
          "    - UCX Libraries: ${CP2K_UCX_LINK_LIBRARIES}\n")
 endif()
 if(CP2K_USE_LIBXC)
--- a/1
+++ b/1
@ -0,0 +1 @@
 git:c92cc08
--- a/cmake/cp2kConfig.cmake.in
+++ b/cmake/cp2kConfig.cmake.in
@ -144,7 +144,6 @@ if(NOT TARGET cp2k::cp2k)
  set(CP2K_USE_DFTD4 @CP2K_USE_DFTD4@)
  if(CP2K_USE_DFTD4)
    find_dependency(mctc-lib REQUIRED) # workaround: find mctc-lib first
    find_dependency(dftd4 REQUIRED)
  endif()
--- a/cmake/modules/FindCuSolverMP.cmake
+++ b/cmake/modules/FindCuSolverMP.cmake
@ -12,6 +12,8 @@
 include(FindPackageHandleStandardArgs)
 include(cp2k_utils)
 find_package(ucc REQUIRED)
 # First, find CuSolverMP library and headers
 cp2k_set_default_paths(CUSOLVER_MP "CUSOLVER_MP")
 cp2k_find_libraries(CUSOLVER_MP "cusolverMp")
@ -39,13 +41,12 @@ if(CP2K_CUSOLVER_MP_INCLUDE_DIRS)
    find_package(Nccl REQUIRED)
    set(CP2K_CUSOLVERMP_USE_NCCL
        ON
-        CACHE BOOL "CuSolverMP uses NCCL for communication" FORCE)
+        CACHE BOOL "CuSolverMP uses NCCL for communication")
  else()
    find_package(Cal REQUIRED)
    find_package(ucc REQUIRED)
    set(CP2K_CUSOLVERMP_USE_NCCL
        OFF
-        CACHE BOOL "CuSolverMP uses Cal for communication" FORCE)
+        CACHE BOOL "CuSolverMP uses Cal for communication")
  endif()
 endif()
@ -63,13 +64,13 @@ if(NOT TARGET cp2k::CUSOLVER_MP::cusolver_mp)
  if(CP2K_CUSOLVERMP_USE_NCCL)
    set(_comm_lib "cp2k::NCCL::nccl")
  else()
-    set(_comm_lib "cp2k::CAL::cal;cp2k::UCC::ucc")
+    set(_comm_lib "cp2k::CAL::cal")
  endif()
  set_target_properties(
    cp2k::CUSOLVER_MP::cusolver_mp
    PROPERTIES INTERFACE_LINK_LIBRARIES
-               "${CP2K_CUSOLVER_MP_LINK_LIBRARIES};${_comm_lib}")
+               "${CP2K_CUSOLVER_MP_LINK_LIBRARIES};${_comm_lib};cp2k::UCC::ucc")
  set_target_properties(
    cp2k::CUSOLVER_MP::cusolver_mp
    PROPERTIES INTERFACE_INCLUDE_DIRECTORIES "${CP2K_CUSOLVER_MP_INCLUDE_DIRS}")
--- a/data/MACE/MACE_scratch_run-3.model-cp2k.pth
+++ b/data/MACE/MACE_scratch_run-3.model-cp2k.pth
--- a/data/xTB_sp_param_030
+++ b/data/xTB_sp_param_030
@ -1,82 +0,0 @@
 # Spin paramters for gfn1-xTB (units Eh)
 #
 #High-throughput screening of spin states for transition metal
 #complexes with spin-polarized extended tight-binding methods
 #Hagen Neugebauer, Benedikt Baedorf, Sebastian Ehlert, Andreas Hansen, Stefan Grimme
 #J Comput Chem. 44:2120-2129 (2023)
 #
 # Sign change from suppl material needed!
 #
 # element  Wss  Wsp  Wpp  Wsd  Wpd  Wdd
 1  -0.071550 -0.000000 -0.000000 -0.000000 -0.000000 -0.000000
 2  -0.614675 -0.033587 -0.125800 -0.000000 -0.000000 -0.000000
 3  -0.017775 -0.013937 -0.018050 -0.000000 -0.000000 -0.000000
 4  -0.022850 -0.018612 -0.017575 -0.000000 -0.000000 -0.000000
 5  -0.027325 -0.022037 -0.019600 -0.000000 -0.000000 -0.000000
 6  -0.030200 -0.025025 -0.022725 -0.000000 -0.000000 -0.000000
 7  -0.033000 -0.027475 -0.025475 -0.000000 -0.000000 -0.000000
 8  -0.035100 -0.029500 -0.027825 -0.000000 -0.000000 -0.000000
 9  -0.036900 -0.031200 -0.029900 -0.000000 -0.000000 -0.000000
 10 -0.055008 -0.012830 -0.022600 -0.011925 -0.016737 -0.080725
 11 -0.015100 -0.013337 -0.023025 -0.000000 -0.000000 -0.000000
 12 -0.016500 -0.013175 -0.017400 -0.000000 -0.000000 -0.000000
 13 -0.018250 -0.013837 -0.014000 -0.008175 -0.011637 -0.012875
 14 -0.019525 -0.015000 -0.014350 -0.008437 -0.011637 -0.014075
 15 -0.020550 -0.016112 -0.014900 -0.009300 -0.011975 -0.014825
 16 -0.021325 -0.017012 -0.015500 -0.009987 -0.012137 -0.014950
 17 -0.021825 -0.017712 -0.016075 -0.010987 -0.012612 -0.015075
 18 -0.342475 -0.077825 -0.120675 -0.015500 -0.023075 -0.051925
 19 -0.010650 -0.010900 -0.016375 -0.000000 -0.000000 -0.000000
 20 -0.011800 -0.010387 -0.013350 -0.005562 -0.003512 -0.010200
 21 -0.012725 -0.010912 -0.013850 -0.004787 -0.002412 -0.012525
 22 -0.013525 -0.011225 -0.014675 -0.004350 -0.001975 -0.013900
 23 -0.014075 -0.011512 -0.015275 -0.004037 -0.001725 -0.014900
 24 -0.015175 -0.012450 -0.021225 -0.004150 -0.001662 -0.013875
 25 -0.015000 -0.011787 -0.016725 -0.003550 -0.001325 -0.016525
 26 -0.015400 -0.011925 -0.017850 -0.003300 -0.001162 -0.017125
 27 -0.015825 -0.012037 -0.018700 -0.003137 -0.001050 -0.017750
 28 -0.016150 -0.012175 -0.019700 -0.002987 -0.000950 -0.018300
 29 -0.017150 -0.013175 -0.030375 -0.002775 -0.000650 -0.017475
 30 -0.016850 -0.012312 -0.021450 -0.000000 -0.000000 -0.000000
 31 -0.017225 -0.012787 -0.013400 -0.008525 -0.013000 -0.015775
 32 -0.017550 -0.013375 -0.013575 -0.008112 -0.012825 -0.017525
 33 -0.017750 -0.013762 -0.013600 -0.007987 -0.012387 -0.017550
 34 -0.017975 -0.014087 -0.013625 -0.008162 -0.011962 -0.017200
 35 -0.018100 -0.014375 -0.013725 -0.008275 -0.011762 -0.016675
 36 -0.299025 -0.066587 -0.101875 -0.012575 -0.021287 -0.048300
 37 -0.009550 -0.009600 -0.016725 -0.000000 -0.000000 -0.000000
 38 -0.010650 -0.009237 -0.012525 -0.000000 -0.000000 -0.000000
 39 -0.011425 -0.009487 -0.012300 -0.006725 -0.003987 -0.009725
 40 -0.011950 -0.009612 -0.013525 -0.006150 -0.003075 -0.010725
 41 -0.012575 -0.010262 -0.019075 -0.006062 -0.002887 -0.010475
 42 -0.012925 -0.010500 -0.022225 -0.005562 -0.002362 -0.010925
 43 -0.013150 -0.010662 -0.024725 -0.005112 -0.002025 -0.011300
 44 -0.013375 -0.010750 -0.027500 -0.004750 -0.001662 -0.011625
 45 -0.013525 -0.010912 -0.032025 -0.004400 -0.001425 -0.011875
 46 -0.018975 -0.023937 -0.180200 -0.002087 -0.001487 -0.011325
 47 -0.013925 -0.011100 -0.039800 -0.003887 -0.001012 -0.012400
 48 -0.013850 -0.010500 -0.019650 -0.000000 -0.000000 -0.000000
 49 -0.014125 -0.010550 -0.011575 -0.005062 -0.009375 -0.010100
 50 -0.014300 -0.010912 -0.011675 -0.004600 -0.009125 -0.011875
 51 -0.014525 -0.011125 -0.011650 -0.004375 -0.008725 -0.012525
 52 -0.014525 -0.011237 -0.011550 -0.004137 -0.008162 -0.012250
 53 -0.014575 -0.011337 -0.011450 -0.004450 -0.008312 -0.012825
 54 -0.255850 -0.055587 -0.085625 -0.004662 -0.013337 -0.037350
 55 -0.008200 -0.008575 -0.015300 -0.000000 -0.000000 -0.000000
 56 -0.009275 -0.008200 -0.011250 -0.000000 -0.000000 -0.000000
 57 -0.009925 -0.008412 -0.011400 -0.005925 -0.003312 -0.009025
 72 -0.012175 -0.009625 -0.012600 -0.007637 -0.004187 -0.010425
 73 -0.012325 -0.009575 -0.013375 -0.007137 -0.003475 -0.010925
 74 -0.012500 -0.009562 -0.014450 -0.006725 -0.002950 -0.011225
 75 -0.012600 -0.009662 -0.014800 -0.006275 -0.002600 -0.011450
 76 -0.012600 -0.009200 -0.020600 -0.005950 -0.002075 -0.011550
 77 -0.012725 -0.009275 -0.021000 -0.005700 -0.001912 -0.011650
 78 -0.013075 -0.010212 -0.033575 -0.005550 -0.001812 -0.011150
 79 -0.013150 -0.009962 -0.053000 -0.005287 -0.001462 -0.011175
 80 -0.013025 -0.009187 -0.029250 -0.000000 -0.000000 -0.000000
 81 -0.013275 -0.009112 -0.010725 -0.000000 -0.000000 -0.000000
 82 -0.013475 -0.009350 -0.010975 -0.000000 -0.000000 -0.000000
 83 -0.013625 -0.009537 -0.010975 -0.000000 -0.000000 -0.000000
 84 -0.013725 -0.009625 -0.010850 -0.000000 -0.000000 -0.000000
 85 -0.013775 -0.009737 -0.010725 -0.002612 -0.007362 -0.011925
 86 -0.254400 -0.050400 -0.080625 -0.001087 -0.011050 -0.035175
--- a/data/xTB_sp_param_060
+++ b/data/xTB_sp_param_060
@ -1,96 +0,0 @@
 # Spin paramters for gfn1-xTB (units Eh)
 #
 #High-throughput screening of spin states for transition metal
 #complexes with spin-polarized extended tight-binding methods
 #Hagen Neugebauer, Benedikt Baedorf, Sebastian Ehlert, Andreas Hansen, Stefan Grimme
 #J Comput Chem. 44:2120-2129 (2023)
 #
 # Sign change from suppl material needed!
 #
 # element  Wss  Wsp  Wpp  Wsd  Wpd  Wdd
  1     -0.0716250   0.0000000   0.0000000   0.0000000   0.0000000   0.0000000   
  2     -0.0865500  -0.0386630  -0.0674250   0.0000000   0.0000000   0.0000000   
  3     -0.0178000  -0.0139500  -0.0180500   0.0000000   0.0000000   0.0000000   
  4     -0.0229750  -0.0186250  -0.0175750   0.0000000   0.0000000   0.0000000   
  5     -0.0272500  -0.0219370  -0.0195750   0.0000000   0.0000000   0.0000000   
  6     -0.0305000  -0.0250250  -0.0226750   0.0000000   0.0000000   0.0000000   
  7     -0.0330750  -0.0275000  -0.0254500   0.0000000   0.0000000   0.0000000   
  8     -0.0350750  -0.0295380  -0.0278500   0.0000000   0.0000000   0.0000000   
  9     -0.0369000  -0.0311870  -0.0299250   0.0000000   0.0000000   0.0000000   
 10     -0.0383000  -0.0326250  -0.0317250  -0.0141250  -0.0152500  -0.0413500   
 11     -0.0150750  -0.0133370  -0.0229250   0.0000000   0.0000000   0.0000000   
 12     -0.0165000  -0.0130750  -0.0175000  -0.0093750  -0.0179630  -0.0223500   
 13     -0.0182500  -0.0138380  -0.0139750  -0.0082250  -0.0117000  -0.0129000   
 14     -0.0195250  -0.0150000  -0.0143750  -0.0084500  -0.0116120  -0.0140000   
 15     -0.0205750  -0.0161250  -0.0149000  -0.0093000  -0.0119870  -0.0148250   
 16     -0.0213250  -0.0170130  -0.0155000  -0.0100370  -0.0121750  -0.0149500   
 17     -0.0217500  -0.0177130  -0.0160500  -0.0109750  -0.0126620  -0.0150750   
 18     -0.0221500  -0.0183630  -0.0165500  -0.0118870  -0.0131130  -0.0153000   
 19     -0.0106500  -0.0109000  -0.0164750   0.0000000   0.0000000   0.0000000   
 20     -0.0118000  -0.0104500  -0.0134500  -0.0055000  -0.0035130  -0.0101750   
 21     -0.0127250  -0.0108620  -0.0138500  -0.0047880  -0.0024130  -0.0125250   
 22     -0.0134250  -0.0112380  -0.0146500  -0.0043380  -0.0019750  -0.0138750   
 23     -0.0140750  -0.0114630  -0.0152750  -0.0040500  -0.0017250  -0.0149250   
 24     -0.0144750  -0.0116120  -0.0160000  -0.0037250  -0.0014630  -0.0157750   
 25     -0.0149000  -0.0118000  -0.0167250  -0.0034870  -0.0013120  -0.0165000   
 26     -0.0154000  -0.0120250  -0.0177500  -0.0032880  -0.0011630  -0.0171250   
 27     -0.0157000  -0.0120250  -0.0187000  -0.0031500  -0.0010250  -0.0177500   
 28     -0.0161500  -0.0122000  -0.0197000  -0.0030370  -0.0009130  -0.0183000   
 29     -0.0166500  -0.0123500  -0.0203000  -0.0028250  -0.0008620  -0.0188250   
 30     -0.0168500  -0.0123250  -0.0214500   0.0000000   0.0000000   0.0000000   
 31     -0.0172250  -0.0128120  -0.0134000  -0.0085250  -0.0130000  -0.0157750   
 32     -0.0174500  -0.0133500  -0.0135500  -0.0081120  -0.0128130  -0.0175250   
 33     -0.0178750  -0.0137630  -0.0135750  -0.0080500  -0.0123250  -0.0176500   
 34     -0.0180000  -0.0141250  -0.0136250  -0.0081500  -0.0120130  -0.0172000   
 35     -0.0181000  -0.0143750  -0.0136750  -0.0082750  -0.0117500  -0.0167750   
 36     -0.0181250  -0.0145500  -0.0137000  -0.0086880  -0.0118000  -0.0164250   
 37     -0.0095500  -0.0096000  -0.0167250   0.0000000   0.0000000   0.0000000   
 38     -0.0105750  -0.0092870  -0.0125500  -0.0074000  -0.0059000  -0.0079500   
 39     -0.0115000  -0.0098250  -0.0136000  -0.0072880  -0.0046250  -0.0090000   
 40     -0.0121500  -0.0099880  -0.0162250  -0.0066250  -0.0036250  -0.0098750   
 41     -0.0125750  -0.0102620  -0.0191750  -0.0060630  -0.0029250  -0.0104750   
 42     -0.0129000  -0.0105000  -0.0222250  -0.0055750  -0.0024250  -0.0109000   
 43     -0.0131250  -0.0106250  -0.0247250  -0.0051250  -0.0020120  -0.0113000   
 44     -0.0133500  -0.0107620  -0.0276000  -0.0047370  -0.0016750  -0.0116000   
 45     -0.0135500  -0.0108380  -0.0320500  -0.0043750  -0.0014250  -0.0118750   
 46     -0.0136500  -0.0109440  -0.0287000  -0.0041250  -0.0012880  -0.0121250   
 47     -0.0139250  -0.0110500  -0.0241750  -0.0038870  -0.0009630  -0.0124000   
 48     -0.0138500  -0.0105000  -0.0196500   0.0000000   0.0000000   0.0000000   
 49     -0.0142250  -0.0105500  -0.0115750  -0.0050370  -0.0093750  -0.0100000   
 50     -0.0143000  -0.0108750  -0.0116750  -0.0046880  -0.0090750  -0.0118750   
 51     -0.0145250  -0.0111250  -0.0116250  -0.0043750  -0.0087130  -0.0124250   
 52     -0.0145250  -0.0112500  -0.0115750  -0.0041870  -0.0081750  -0.0121750   
 53     -0.0146500  -0.0113870  -0.0114750  -0.0044620  -0.0083620  -0.0128250   
 54     -0.0146500  -0.0114250  -0.0114500  -0.0048750  -0.0085750  -0.0132000   
 55     -0.0082000  -0.0085880  -0.0153000   0.0000000   0.0000000   0.0000000   
 56     -0.0092500  -0.0083000  -0.0113750  -0.0063870  -0.0042250  -0.0079250   
 57     -0.0099000  -0.0084250  -0.0114000  -0.0059370  -0.0033750  -0.0090250   
 58     -0.0881750  -0.0066380  -0.0019250  -0.0017000  -0.0017000  -0.0234250   
 59     -0.0890750  -0.0065000  -0.0009500  -0.0015370  -0.0017370  -0.0237000   
 60     -0.0901000  -0.0063750  -0.0000750  -0.0014630  -0.0016250  -0.0230250   
 61     -0.0908000  -0.0064880   0.0004500  -0.0013000  -0.0016500  -0.0226250   
 62     -0.0918250  -0.0065380   0.0014000  -0.0012750  -0.0017250  -0.0222250   
 63     -0.0922250  -0.0065380   0.0017250  -0.0012000  -0.0018000  -0.0218250   
 64     -0.0928812  -0.0065798   0.0024101  -0.0011021  -0.0016846  -0.0209135   
 65     -0.0936096  -0.0066189   0.0030779  -0.0010125  -0.0016808  -0.0201625   
 66     -0.0943380  -0.0066581   0.0037457  -0.0009229  -0.0016769  -0.0194115   
 67     -0.0951750  -0.0067500   0.0042250  -0.0008380  -0.0016250  -0.0190000   
 68     -0.0956500  -0.0067250   0.0040000  -0.0007370  -0.0007630  -0.0176000   
 69     -0.0963500  -0.0067370   0.0044000  -0.0006750  -0.0007065  -0.0160000   
 70     -0.0958500  -0.0066500   0.0024000  -0.0007500  -0.0008000  -0.0175500   
 71     -0.1086250  -0.0079000   0.0063250  -0.0047000  -0.0007120  -0.0269000   
 72     -0.0121750  -0.0096750  -0.0126250  -0.0076250  -0.0041130  -0.0104250   
 73     -0.0123000  -0.0095750  -0.0134000  -0.0071380  -0.0034630  -0.0109250   
 74     -0.0125000  -0.0094620  -0.0144500  -0.0066880  -0.0029130  -0.0112500   
 75     -0.0126000  -0.0093310  -0.0148000  -0.0063000  -0.0026130  -0.0114500   
 76     -0.0127000  -0.0092000  -0.0205750  -0.0059380  -0.0021120  -0.0115500   
 77     -0.0127500  -0.0092750  -0.0209250  -0.0056880  -0.0019120  -0.0116000   
 78     -0.0127500  -0.0092250  -0.0222500  -0.0054370  -0.0017870  -0.0117000   
 79     -0.0129000  -0.0089380  -0.0257625  -0.0052500  -0.0015000  -0.0117750   
 80     -0.0129250  -0.0091870  -0.0292750   0.0000000   0.0000000   0.0000000   
 81     -0.0133500  -0.0091120  -0.0107250   0.0000000   0.0000000   0.0000000   
 82     -0.0135750  -0.0094250  -0.0110000   0.0000000   0.0000000   0.0000000   
 83     -0.0136750  -0.0095380  -0.0109500   0.0000000   0.0000000   0.0000000   
 84     -0.0137500  -0.0096380  -0.0108500   0.0000000   0.0000000   0.0000000   
 85     -0.0137750  -0.0096750  -0.0107250  -0.0026000  -0.0073630  -0.0119000   
 86     -0.0139000  -0.0097380  -0.0106500  -0.0028750  -0.0078120  -0.0130000   
--- a/docs/generate_input_reference.py
+++ b/docs/generate_input_reference.py
@ -342,28 +342,20 @@ def render_keyword(
        output += [f":module: {section_xref}"]
    else:
        output += [":noindex:"]
-    output += [""]
+    output += [f":type: '{data_type}{n_var_brackets}'"]
    # Render keyword properties as compact, unbulleted lines instead of placing the
    # type and default value in the object signature.
    metadata = [f"**Type:** {escape_markdown(data_type + n_var_brackets)}"]
    if default_value or default_unit:
-        default = default_value
+        default_unit_bracketed = f"[{default_unit}]" if default_unit else ""
-        if default_unit:
+        output += [f":value: '{default_value} {default_unit_bracketed}'"]
-            default += f" [{default_unit}]"
+    output += [""]
        metadata += [f"**Default:** {escape_markdown(default.strip())}"]
    if repeats:
-        metadata += ["**Repeatable:** yes"]
+        output += ["**Keyword can be repeated.**", ""]
    if len(keyword_names) > 1:
-        aliases = ", ".join(keyword_names[1:])
+        aliases = " ,".join(keyword_names[1:])
-        metadata += [f"**Aliases:** {escape_markdown(aliases)}"]
+        output += [f"**Aliases:** {escape_markdown(aliases)}", ""]
    if lone_keyword_value:
-        metadata += [f"**Lone keyword:** {escape_markdown(lone_keyword_value)}"]
+        output += [f"**Lone keyword:** `{escape_markdown(lone_keyword_value)}`", ""]
    if usage:
-        metadata += [f"**Usage:** _{escape_markdown(usage)}_"]
+        output += [f"**Usage:** _{escape_markdown(usage)}_", ""]
    output += ["  \n".join(metadata), ""]
    if description:
        output += [f"**Description:** {escape_markdown(description)}", ""]
    if data_type == "enum":
        output += ["**Valid values:**"]
        for item in keyword.findall("DATA_TYPE/ENUMERATION/ITEM"):
@ -377,6 +369,7 @@ def render_keyword(
    if mentions:
        mentions_list = ", ".join([f"⭐[](project:{m})" for m in mentions])
        output += [f"**Mentions:** {mentions_list}", ""]
    output += [escape_markdown(description)]
    if github:
        output += [github_link(location)]
    output += ["", "```", ""]  # Close py:data directive.
--- a/docs/methods/machine_learning/index.md
+++ b/docs/methods/machine_learning/index.md
@ -6,7 +6,6 @@ titlesonly:
 maxdepth: 2
 ---
 nequip
 mace
 nnp
 pao-ml
 deepmd
--- a/docs/methods/machine_learning/mace.md
+++ b/docs/methods/machine_learning/mace.md
@ -1,60 +0,0 @@
 # MACE
 MACE is a framework for building interatomic potentials using higher-order equivariant
 message-passing neural networks. The methodology is described in detail in the literature by Batatia
 et al. (2022).
 **Note:** Running MACE requires a CP2K build with LibTorch support
 Like the [NequIP/Allegro](https://manual.cp2k.org/trunk/methods/machine_learning/nequip.html)
 interface, CP2K runs MACE models through the generic LibTorch interface: a trained MACE model is
 exported once to a self-contained TorchScript file (`.pth`), which CP2K then loads and evaluates at
 runtime. No Python interpreter is involved during the simulation.
 ## Exporting a MACE model for CP2K
 Wraps a trained MACE model (`.model`) and compiles it to CP2K-loadable TorchScrip file with the
 helper script `cp2k/tools/mace/create_cp2k_model.py`:
 ```shell
 python create_cp2k_model.py my_mace.model --dtype float64
 # -> writes my_mace.model-cp2k.pth
 ```
 This conversion only needs to be performed once on a machine with both `torch` and `mace` installed.
 The resulting `*.pth` file uses the same tensor and metadata format as the NequIP interface (inputs
 `pos`, `edge_index`, `edge_cell_shift`, `cell`, `atom_types`; outputs `atomic_energy`, `forces`,
 `virial`) and embeds the metadata (`num_types`, `r_max`, `type_names`, `model_dtype`) that CP2K
 reads to build the neighbour graph. The `torch` version used for export must be compatible with the
 LibTorch version linked into CP2K.
 ## Input Section
 Inference is configured through the [MACE](#CP2K_INPUT.FORCE_EVAL.MM.FORCEFIELD.NONBONDED.MACE)
 section within the `&NONBONDED` forcefield parameters:
 ```text
 &FORCEFIELD
  &NONBONDED
    &MACE
      ATOMS Cu
      POT_FILE_NAME MACE/my_mace.model-cp2k.pth
    &END MACE
  &END NONBONDED
 &END FORCEFIELD
 ```
 - [ATOMS](#CP2K_INPUT.FORCE_EVAL.MM.FORCEFIELD.NONBONDED.MACE.ATOMS): a list of elements/kinds; the
  mapping to the model type list must be consistent with the coordinates in `&COORDS`/`&TOPOLOGY`.
 - [POT_FILE_NAME](#CP2K_INPUT.FORCE_EVAL.MM.FORCEFIELD.NONBONDED.MACE.POT_FILE_NAME): path to the
  exported MACE model.
 MACE is a message-passing model with a non-local receptive field. As with NequIP, the interface
 evaluates the full system on every MPI rank and divides the energy, forces, and virial by the number
 of ranks.
 ## Further Resources
 - **MACE:** Paper [](#Batatia2022) and source code at
  [github.com/ACEsuit/mace](https://github.com/ACEsuit/mace).
 - **e3nn:** For an introduction to Euclidean neural networks, visit [e3nn.org](https://e3nn.org).
--- a/docs/methods/semiempiricals/xtb.md
+++ b/docs/methods/semiempiricals/xtb.md
@ -287,8 +287,9 @@ GFN2-xTB method. Please note that k-points are fully supported for tblite in CP2
 In case of open-shell calculations, a spin-polarization term can be enabled with the
 [LSD](#CP2K_INPUT.FORCE_EVAL.DFT.UKS) keyword in CP2K. In this case, tblite automatically allows the
-usage of spGFN2-xTB for calculations as described in [Neugebauer2023](#Neugebauer2023). An example
+usage of spGFN2-xTB for calculations as described in
-for triplet oxygen is shown here.
+[Neugebauer2023](https://onlinelibrary.wiley.com/doi/full/10.1002/jcc.27185). An example for triplet
 oxygen is shown here.
 ```
 &FORCE_EVAL
--- a/docs/technologies/eigensolvers/cusolvermp.md
+++ b/docs/technologies/eigensolvers/cusolvermp.md
@ -13,6 +13,7 @@ tools for the solution of dense linear systems and eigenvalue problems.
 [cuSOLVERmp] >= 0.7
 - [NCCL]: requires `libnccl.\*` in the `$PATH`
 - [UCC]: requires `libucc.\*` and `libucs.\*` in the `$PATH`
 ## CMake
--- a/docs/technologies/libraries.md
+++ b/docs/technologies/libraries.md
@ -220,8 +220,8 @@ of each atom.
 ## Torch (PyTorch C++ library)
-LibTorch is the C++ distribution of PyTorch. CP2K uses it for the NequIP and MACE interfaces and for
+LibTorch is the C++ distribution of PyTorch. CP2K uses it for the NequIP interface and for GauXC
-GauXC Skala models.
+Skala models.
 - LibTorch can be downloaded from the
  [PyTorch installation page](https://pytorch.org/get-started/locally/).
--- a/docs/versions.md
+++ b/docs/versions.md
@ -5,7 +5,6 @@
 maxdepth: 1
 titlesonly:
 ---
 2026.2 <https://manual.cp2k.org/cp2k-2026_2-branch/index.html>
 2026.1 <https://manual.cp2k.org/cp2k-2026_1-branch/index.html>
 2025.2 <https://manual.cp2k.org/cp2k-2025_2-branch/index.html>
 2025.1 <https://manual.cp2k.org/cp2k-2025_1-branch/index.html>
--- a/make_cp2k.sh
+++ b/make_cp2k.sh
@ -1363,7 +1363,6 @@ if [[ ! -d "${CMAKE_BUILD_PATH}" ]]; then
        -DBUILD_SHARED_LIBS=${BUILD_SHARED_LIBS} \
        -DCMAKE_BUILD_TYPE="${CP2K_BUILD_TYPE}" \
        -DCMAKE_INSTALL_PREFIX="${INSTALL_PREFIX}" \
        -DCMAKE_INSTALL_LIBDIR="lib" \
        -DCMAKE_INSTALL_MESSAGE="${INSTALL_MESSAGE}" \
        -DCMAKE_SKIP_RPATH="ON" \
        -DCMAKE_VERBOSE_MAKEFILE="${VERBOSE_MAKEFILE}" \
@ -1381,7 +1380,6 @@ if [[ ! -d "${CMAKE_BUILD_PATH}" ]]; then
        -DBUILD_SHARED_LIBS=${BUILD_SHARED_LIBS} \
        -DCMAKE_BUILD_TYPE="${CP2K_BUILD_TYPE}" \
        -DCMAKE_INSTALL_PREFIX="${INSTALL_PREFIX}" \
        -DCMAKE_INSTALL_LIBDIR="lib" \
        -DCMAKE_INSTALL_MESSAGE="${INSTALL_MESSAGE}" \
        -DCMAKE_SKIP_RPATH="ON" \
        -DCMAKE_VERBOSE_MAKEFILE="${VERBOSE_MAKEFILE}" \
@ -1403,7 +1401,6 @@ if [[ ! -d "${CMAKE_BUILD_PATH}" ]]; then
        -DCMAKE_EXE_LINKER_FLAGS="-static" \
        -DCMAKE_FIND_LIBRARY_SUFFIXES=".a" \
        -DCMAKE_INSTALL_PREFIX="${INSTALL_PREFIX}" \
        -DCMAKE_INSTALL_LIBDIR="lib" \
        -DCMAKE_INSTALL_MESSAGE="${INSTALL_MESSAGE}" \
        -DCMAKE_SKIP_RPATH="ON" \
        -DCMAKE_VERBOSE_MAKEFILE="${VERBOSE_MAKEFILE}" \
--- a/src/CMakeLists.txt
+++ b/src/CMakeLists.txt
@ -329,7 +329,6 @@ list(
  kpoint_k_r_trafo_simple.F
  kpoint_methods.F
  kpoint_mo_dump.F
  kpoint_mo_symmetry_methods.F
  kpoint_transitional.F
  kpoint_types.F
  kpsym.F
@ -355,7 +354,7 @@ list(
  manybody_deepmd.F
  manybody_gal21.F
  manybody_gal.F
-  manybody_e3nn.F
+  manybody_nequip.F
  manybody_potential.F
  manybody_siepmann.F
  manybody_tersoff.F
@ -884,7 +883,6 @@ list(
  xray_diffraction.F
  xtb_qresp.F
  xtb_coulomb.F
  xtb_spinpol.F
  xtb_eeq.F
  xtb_ehess.F
  xtb_ehess_force.F
@ -1053,9 +1051,7 @@ list(
  emd/rt_propagation_utils.F
  emd/rt_propagator_init.F
  emd/rt_bse.F
  emd/rt_bse_linearized.F
  emd/rt_bse_io.F
  emd/rt_bse_ri_rs.F
  emd/rt_bse_types.F)
 list(
@ -1382,7 +1378,6 @@ list(
  xc/xc.F
  xc/xc_functionals_utilities.F
  xc/xc_fxc_kernel.F
  xc/xc_gauxc_cache.F
  xc/xc_gauxc_functional.F
  xc/xc_gauxc_interface.F
  xc/xc_hcth.F
--- a/src/accint_weights_forces.F
+++ b/src/accint_weights_forces.F
@ -412,7 +412,7 @@ CONTAINS
         NULLIFY (rho_r, rho_g, tau_r, tau_g)
         IF (rho_g_valid) THEN
            CALL create_density_on_pool(xc_pw_pool, rho_g_base, rho_r, rho_g)
-         ELSE IF (ASSOCIATED(rho_r_base)) THEN
+         ELSEIF (ASSOCIATED(rho_r_base)) THEN
            CALL create_density_on_pool_from_r(auxbas_pw_pool, xc_pw_pool, rho_r_base, rho_r, rho_g)
         ELSE
            CPABORT("Fine Grid in xc_density requires rho_r or rho_g")
@ -420,7 +420,7 @@ CONTAINS
         IF (rho_tau_valid) THEN
            IF (rho_tau_g_valid) THEN
               CALL create_density_on_pool(xc_pw_pool, tau_g_base, tau_r, tau_g)
-            ELSE IF (ASSOCIATED(tau_r_base)) THEN
+            ELSEIF (ASSOCIATED(tau_r_base)) THEN
               CALL create_density_on_pool_from_r(auxbas_pw_pool, xc_pw_pool, tau_r_base, tau_r, tau_g)
            ELSE
               CPABORT("Fine Grid in xc_density requires tau_r or tau_g")
@ -482,7 +482,7 @@ CONTAINS
               NULLIFY (rho1_r, rho1_g, tau1_r, tau1_g)
               IF (rho1_g_valid) THEN
                  CALL create_density_on_pool(xc_pw_pool, rho1_g_base, rho1_r, rho1_g)
-               ELSE IF (ASSOCIATED(rho1_r_base)) THEN
+               ELSEIF (ASSOCIATED(rho1_r_base)) THEN
                  CALL create_density_on_pool_from_r(auxbas_pw_pool, xc_pw_pool, rho1_r_base, rho1_r, rho1_g)
               ELSE
                  CPABORT("Fine Grid in xc_density requires rho1_r or rho1_g")
@ -490,7 +490,7 @@ CONTAINS
               IF (rho1_tau_valid) THEN
                  IF (rho1_tau_g_valid) THEN
                     CALL create_density_on_pool(xc_pw_pool, tau1_g_base, tau1_r, tau1_g)
-                  ELSE IF (ASSOCIATED(tau1_r_base)) THEN
+                  ELSEIF (ASSOCIATED(tau1_r_base)) THEN
                     CALL create_density_on_pool_from_r(auxbas_pw_pool, xc_pw_pool, tau1_r_base, tau1_r, tau1_g)
                  ELSE
                     CPABORT("Fine Grid in xc_density requires tau1_r or tau1_g")
@ -518,7 +518,7 @@ CONTAINS
               NULLIFY (rho1_r, rho1_g, tau1_r, tau1_g)
               IF (rho1_g_valid) THEN
                  CALL create_density_on_pool(xc_pw_pool, rho1_g_base, rho1_r, rho1_g)
-               ELSE IF (ASSOCIATED(rho1_r_base)) THEN
+               ELSEIF (ASSOCIATED(rho1_r_base)) THEN
                  CALL create_density_on_pool_from_r(auxbas_pw_pool, xc_pw_pool, rho1_r_base, rho1_r, rho1_g)
               ELSE
                  CPABORT("Fine Grid in xc_density requires rho1_r or rho1_g")
@ -526,7 +526,7 @@ CONTAINS
               IF (rho1_tau_valid) THEN
                  IF (rho1_tau_g_valid) THEN
                     CALL create_density_on_pool(xc_pw_pool, tau1_g_base, tau1_r, tau1_g)
-                  ELSE IF (ASSOCIATED(tau1_r_base)) THEN
+                  ELSEIF (ASSOCIATED(tau1_r_base)) THEN
                     CALL create_density_on_pool_from_r(auxbas_pw_pool, xc_pw_pool, tau1_r_base, tau1_r, tau1_g)
                  ELSE
                     CPABORT("Fine Grid in xc_density requires tau1_r or tau1_g")
@ -574,9 +574,8 @@ CONTAINS
               DEALLOCATE (vxc_rho)
            END IF
            IF (ASSOCIATED(vxc_tau)) THEN
-               IF (.NOT. ASSOCIATED(tau1_r)) THEN
+               IF (.NOT. ASSOCIATED(tau1_r)) &
                  CPABORT("Tau response density required for mGGA xc_density")
               END IF
               DO ispin = 1, nspins
                  CALL pw_multiply_with(vxc_tau(ispin), tau1_r(ispin))
                  CALL pw_axpy(vxc_tau(ispin), exc, 1.0_dp)
--- a/src/admm_dm_methods.F
+++ b/src/admm_dm_methods.F
@ -76,9 +76,8 @@ CONTAINS
         CPABORT("admm_dm_calc_rho_aux: unknown method")
      END SELECT
-      IF (admm_dm%purify) THEN
+      IF (admm_dm%purify) &
         CALL purify_mcweeny(qs_env)
      END IF
      CALL update_rho_aux(qs_env)
@ -121,9 +120,8 @@ CONTAINS
         CPABORT("admm_dm_merge_ks_matrix: unknown method")
      END SELECT
-      IF (admm_dm%purify) THEN
+      IF (admm_dm%purify) &
         CALL dbcsr_deallocate_matrix_set(matrix_ks_merge)
      END IF
      CALL timestop(handle)
@ -219,9 +217,8 @@ CONTAINS
            IF (admm_dm%block_map(iatom, jatom) == 1) THEN
               CALL dbcsr_get_block_p(rho_ao_aux(ispin)%matrix, &
                                      row=iatom, col=jatom, BLOCK=sparse_block_aux, found=found)
-               IF (found) THEN
+               IF (found) &
                  sparse_block_aux = sparse_block
               END IF
            END IF
         END DO
         CALL dbcsr_iterator_stop(iter)
@ -336,9 +333,8 @@ CONTAINS
         CALL dbcsr_iterator_start(iter, matrix_ks_merge(ispin)%matrix)
         DO WHILE (dbcsr_iterator_blocks_left(iter))
            CALL dbcsr_iterator_next_block(iter, iatom, jatom, sparse_block)
-            IF (admm_dm%block_map(iatom, jatom) == 0) THEN
+            IF (admm_dm%block_map(iatom, jatom) == 0) &
               sparse_block = 0.0_dp
            END IF
         END DO
         CALL dbcsr_iterator_stop(iter)
         CALL dbcsr_add(matrix_ks(ispin)%matrix, matrix_ks_merge(ispin)%matrix, 1.0_dp, 1.0_dp)
--- a/src/admm_dm_types.F
+++ b/src/admm_dm_types.F
@ -105,9 +105,8 @@ CONTAINS
         DEALLOCATE (admm_dm%matrix_a)
      END IF
-      IF (ASSOCIATED(admm_dm%block_map)) THEN
+      IF (ASSOCIATED(admm_dm%block_map)) &
         DEALLOCATE (admm_dm%block_map)
      END IF
      DEALLOCATE (admm_dm%mcweeny_history)
      DEALLOCATE (admm_dm)
--- a/src/admm_methods.F
+++ b/src/admm_methods.F
@ -226,13 +226,12 @@ CONTAINS
         END IF
-         IF (admm_env%purification_method == do_admm_purify_cauchy) THEN
+         IF (admm_env%purification_method == do_admm_purify_cauchy) &
            CALL purify_dm_cauchy(admm_env, &
                                  mo_set=mos_aux_fit(ispin), &
                                  density_matrix=rho_ao_aux(ispin)%matrix, &
                                  ispin=ispin, &
                                  blocked=admm_env%block_dm)
         END IF
         !GPW is the default, PW density is computed using the AUX_FIT basis and task_list
         !If GAPW, the we use the AUX_FIT_SOFT basis and task list
@ -2181,15 +2180,13 @@ CONTAINS
               IF (my_kpgrp) THEN
                  CALL cp_fm_start_copy_general(admm_env%work_aux_aux, work_aux_aux, para_env, info(indx, 1))
-                  IF (.NOT. use_real_wfn) THEN
+                  IF (.NOT. use_real_wfn) &
                     CALL cp_fm_start_copy_general(admm_env%work_aux_aux2, work_aux_aux2, &
                                                   para_env, info(indx, 2))
                  END IF
               ELSE
                  CALL cp_fm_start_copy_general(admm_env%work_aux_aux, fmdummy, para_env, info(indx, 1))
-                  IF (.NOT. use_real_wfn) THEN
+                  IF (.NOT. use_real_wfn) &
                     CALL cp_fm_start_copy_general(admm_env%work_aux_aux2, fmdummy, para_env, info(indx, 2))
                  END IF
               END IF
            END DO
         END DO
@ -2987,14 +2984,12 @@ CONTAINS
               IF (my_kpgrp) THEN
                  CALL cp_fm_start_copy_general(admm_env%work_aux_aux, work_aux_aux, para_env, info(indx, 1))
-                  IF (.NOT. use_real_wfn) THEN
+                  IF (.NOT. use_real_wfn) &
                     CALL cp_fm_start_copy_general(admm_env%work_aux_aux2, work_aux_aux2, para_env, info(indx, 2))
                  END IF
               ELSE
                  CALL cp_fm_start_copy_general(admm_env%work_aux_aux, fmdummy, para_env, info(indx, 1))
-                  IF (.NOT. use_real_wfn) THEN
+                  IF (.NOT. use_real_wfn) &
                     CALL cp_fm_start_copy_general(admm_env%work_aux_aux2, fmdummy, para_env, info(indx, 2))
                  END IF
               END IF
            END DO
         END DO
--- a/src/admm_types.F
+++ b/src/admm_types.F
@ -382,15 +382,12 @@ CONTAINS
      admm_env%aux_x_param(:) = admm_control%aux_x_param(:)
      !ADMMP, ADMMQ, ADMMS
-      IF ((.NOT. admm_env%charge_constrain) .AND. (admm_env%scaling_model == do_admm_exch_scaling_merlot)) THEN
+      IF ((.NOT. admm_env%charge_constrain) .AND. (admm_env%scaling_model == do_admm_exch_scaling_merlot)) &
         admm_env%do_admmp = .TRUE.
-      END IF
+      IF (admm_env%charge_constrain .AND. (admm_env%scaling_model == do_admm_exch_scaling_none)) &
      IF (admm_env%charge_constrain .AND. (admm_env%scaling_model == do_admm_exch_scaling_none)) THEN
         admm_env%do_admmq = .TRUE.
-      END IF
+      IF (admm_env%charge_constrain .AND. (admm_env%scaling_model == do_admm_exch_scaling_merlot)) &
      IF (admm_env%charge_constrain .AND. (admm_env%scaling_model == do_admm_exch_scaling_merlot)) THEN
         admm_env%do_admms = .TRUE.
      END IF
      IF ((admm_control%method == do_admm_blocking_purify_full) .OR. &
          (admm_control%method == do_admm_blocked_projection)) THEN
@ -486,16 +483,13 @@ CONTAINS
      DEALLOCATE (admm_env%eigvals_lambda)
      DEALLOCATE (admm_env%eigvals_P_to_be_purified)
-      IF (ASSOCIATED(admm_env%block_map)) THEN
+      IF (ASSOCIATED(admm_env%block_map)) &
         DEALLOCATE (admm_env%block_map)
      END IF
-      IF (ASSOCIATED(admm_env%xc_section_primary)) THEN
+      IF (ASSOCIATED(admm_env%xc_section_primary)) &
         CALL section_vals_release(admm_env%xc_section_primary)
-      END IF
+      IF (ASSOCIATED(admm_env%xc_section_aux)) &
      IF (ASSOCIATED(admm_env%xc_section_aux)) THEN
         CALL section_vals_release(admm_env%xc_section_aux)
      END IF
      IF (ASSOCIATED(admm_env%admm_gapw_env)) CALL admm_gapw_env_release(admm_env%admm_gapw_env)
      IF (ASSOCIATED(admm_env%admm_dm)) CALL admm_dm_release(admm_env%admm_dm)
--- a/src/almo_scf.F
+++ b/src/almo_scf.F
@ -1400,6 +1400,7 @@ CONTAINS
      CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_delocalization'
      INTEGER                                            :: handle, ispin, unit_nr
      LOGICAL                                            :: almo_experimental
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:)        :: no_quench
      TYPE(optimizer_options_type)                       :: arbitrary_optimizer
@ -1461,6 +1462,25 @@ CONTAINS
         !!!! are commented out at the moment because some of their
         !!!! routines have not been thoroughly tested.
         !!!! if we have virtuals pre-optimize and truncate them
         !!!IF (almo_scf_env%need_virtuals) THEN
         !!!   SELECT CASE (almo_scf_env%deloc_truncate_virt)
         !!!   CASE (virt_full)
         !!!      ! simply copy virtual orbitals from matrix_v_full_blk to matrix_v_blk
         !!!      DO ispin=1,almo_scf_env%nspins
         !!!         CALL dbcsr_copy(almo_scf_env%matrix_v_blk(ispin),&
         !!!                 almo_scf_env%matrix_v_full_blk(ispin))
         !!!      ENDDO
         !!!   CASE (virt_number,virt_occ_size)
         !!!      CALL split_v_blk(almo_scf_env)
         !!!      !CALL truncate_subspace_v_blk(qs_env,almo_scf_env)
         !!!   CASE DEFAULT
         !!!      CPErrorMessage(cp_failure_level,routineP,"illegal method for virtual space truncation")
         !!!      CPPrecondition(.FALSE.,cp_failure_level,routineP,failure)
         !!!   END SELECT
         !!!ENDIF
         !!!CALL harris_foulkes_correction(qs_env,almo_scf_env)
         IF (almo_scf_env%xalmo_update_algorithm == almo_scf_pcg) THEN
            CALL almo_scf_xalmo_pcg(qs_env=qs_env, &
@ -1565,6 +1585,18 @@ CONTAINS
                                    perturbation_only=.FALSE., &
                                    special_case=xalmo_case_normal)
            ! RZK-warning THIS IS A HACK TO GET ORBITAL ENERGIES
            almo_experimental = .FALSE.
            IF (almo_experimental) THEN
               almo_scf_env%perturbative_delocalization = .TRUE.
               !DO ispin=1,almo_scf_env%nspins
               !   CALL dbcsr_copy(almo_scf_env%matrix_t(ispin),&
               !           almo_scf_env%matrix_t_blk(ispin))
               !ENDDO
               CALL almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, &
                                               arbitrary_optimizer)
            END IF ! experimental
         ELSE IF (almo_scf_env%xalmo_update_algorithm == almo_scf_trustr) THEN
            CALL almo_scf_xalmo_trustr(qs_env=qs_env, &
@ -2590,9 +2622,8 @@ CONTAINS
      ALLOCATE (almo_scf_env%matrix_p_blk(nspins))
      ALLOCATE (almo_scf_env%matrix_ks(nspins))
      ALLOCATE (almo_scf_env%matrix_ks_blk(nspins))
-      IF (almo_scf_env%need_previous_ks) THEN
+      IF (almo_scf_env%need_previous_ks) &
         ALLOCATE (almo_scf_env%matrix_ks_0deloc(nspins))
      END IF
      DO ispin = 1, nspins
         ! RZK-warning copy with symmery but remember that this might cause problems
         CALL dbcsr_create(almo_scf_env%matrix_p(ispin), &
--- a/src/almo_scf_diis_types.F
+++ b/src/almo_scf_diis_types.F
@ -258,9 +258,8 @@ CONTAINS
      ! update the buffer length
      old_buffer_length = diis_env%buffer_length
      diis_env%buffer_length = diis_env%buffer_length + 1
-      IF (diis_env%buffer_length > diis_env%max_buffer_length) THEN
+      IF (diis_env%buffer_length > diis_env%max_buffer_length) &
         diis_env%buffer_length = diis_env%max_buffer_length
      END IF
      !!!! resize B matrix
      !!!IF (old_buffer_length.lt.diis_env%buffer_length) THEN
@ -403,12 +402,24 @@ CONTAINS
            ! use the eigensystem to invert (implicitly) B matrix
            ! and compute the extrapolation coefficients
            !! ALLOCATE(tmp1(diis_env%buffer_length+1,1))
            !! ALLOCATE(coeff(diis_env%buffer_length+1,1))
            !! tmp1(:,1)=-1.0_dp*m_b_copy(1,:)/eigenvalues(:)
            !! coeff=MATMUL(m_b_copy,tmp1)
            !! DEALLOCATE(tmp1)
            ALLOCATE (tmp1(diis_env%buffer_length + 1))
            ALLOCATE (coeff(diis_env%buffer_length + 1))
            tmp1(:) = -1.0_dp*m_b_copy(1, :)/eigenvalues(:)
            coeff(:) = MATMUL(m_b_copy, tmp1)
            DEALLOCATE (tmp1)
            !IF (unit_nr.gt.0) THEN
            !   DO im=1,diis_env%buffer_length+1
            !      WRITE(unit_nr,*) diis_env%m_b(idomain)%mdata(im,:)
            !   ENDDO
            !   WRITE (unit_nr,*) coeff(:,1)
            !ENDIF
            ! extrapolate the variable
            checksum = 0.0_dp
            IF (diis_env%diis_env_type == diis_env_dbcsr) THEN
@ -430,6 +441,7 @@ CONTAINS
                  checksum = checksum + coeff(im + 1)
               END DO
            END IF
            !WRITE(*,*) checksum
            DEALLOCATE (coeff)
--- a/src/almo_scf_env_methods.F
+++ b/src/almo_scf_env_methods.F
@ -364,6 +364,108 @@ CONTAINS
         almo_scf_env%activate = 0
      END IF
      !CALL section_vals_val_get(almo_scf_section,"DOMAIN_LAYOUT_AOS",&
      !                          i_val=almo_scf_env%domain_layout_aos)
      !CALL section_vals_val_get(almo_scf_section,"DOMAIN_LAYOUT_MOS",&
      !                          i_val=almo_scf_env%domain_layout_mos)
      !CALL section_vals_val_get(almo_scf_section,"MATRIX_CLUSTERING_AOS",&
      !                          i_val=almo_scf_env%mat_distr_aos)
      !CALL section_vals_val_get(almo_scf_section,"MATRIX_CLUSTERING_MOS",&
      !                          i_val=almo_scf_env%mat_distr_mos)
      !CALL section_vals_val_get(almo_scf_section,"CONSTRAINT_TYPE",&
      !                          i_val=almo_scf_env%constraint_type)
      !CALL section_vals_val_get(almo_scf_section,"MU",&
      !                          r_val=almo_scf_env%mu)
      !CALL section_vals_val_get(almo_scf_section,"FIXED_MU",&
      !                          l_val=almo_scf_env%fixed_mu)
      !CALL section_vals_val_get(almo_scf_section,"EPS_USE_PREV_AS_GUESS",&
      !                          r_val=almo_scf_env%eps_prev_guess)
      !CALL section_vals_val_get(almo_scf_section,"MIXING_FRACTION",&
      !                          r_val=almo_scf_env%mixing_fraction)
      !CALL section_vals_val_get(almo_scf_section,"DELOC_CAYLEY_TENSOR_TYPE",&
      !                          i_val=almo_scf_env%deloc_cayley_tensor_type)
      !CALL section_vals_val_get(almo_scf_section,"DELOC_CAYLEY_CONJUGATOR",&
      !                          i_val=almo_scf_env%deloc_cayley_conjugator)
      !CALL section_vals_val_get(almo_scf_section,"DELOC_CAYLEY_MAX_ITER",&
      !                          i_val=almo_scf_env%deloc_cayley_max_iter)
      !CALL section_vals_val_get(almo_scf_section,"DELOC_USE_OCC_ORBS",&
      !                          l_val=almo_scf_env%deloc_use_occ_orbs)
      !CALL section_vals_val_get(almo_scf_section,"DELOC_CAYLEY_USE_VIRT_ORBS",&
      !                          l_val=almo_scf_env%deloc_cayley_use_virt_orbs)
      !CALL section_vals_val_get(almo_scf_section,"DELOC_CAYLEY_LINEAR",&
      !                          l_val=almo_scf_env%deloc_cayley_linear)
      !CALL section_vals_val_get(almo_scf_section,"DELOC_CAYLEY_EPS_CONVERGENCE",&
      !                          r_val=almo_scf_env%deloc_cayley_eps_convergence)
      !CALL section_vals_val_get(almo_scf_section,"DELOC_CAYLEY_OCC_PRECOND",&
      !                          l_val=almo_scf_env%deloc_cayley_occ_precond)
      !CALL section_vals_val_get(almo_scf_section,"DELOC_CAYLEY_VIR_PRECOND",&
      !                          l_val=almo_scf_env%deloc_cayley_vir_precond)
      !CALL section_vals_val_get(almo_scf_section,"ALMO_UPDATE_ALGORITHM_BD",&
      !                          i_val=almo_scf_env%almo_update_algorithm)
      !CALL section_vals_val_get(almo_scf_section,"DELOC_TRUNCATE_VIRTUALS",&
      !                          i_val=almo_scf_env%deloc_truncate_virt)
      !CALL section_vals_val_get(almo_scf_section,"DELOC_VIRT_PER_DOMAIN",&
      !                          i_val=almo_scf_env%deloc_virt_per_domain)
      !
      !CALL section_vals_val_get(almo_scf_section,"OPT_K_EPS_CONVERGENCE",&
      !                          r_val=almo_scf_env%opt_k_eps_convergence)
      !CALL section_vals_val_get(almo_scf_section,"OPT_K_MAX_ITER",&
      !                          i_val=almo_scf_env%opt_k_max_iter)
      !CALL section_vals_val_get(almo_scf_section,"OPT_K_OUTER_MAX_ITER",&
      !                          i_val=almo_scf_env%opt_k_outer_max_iter)
      !CALL section_vals_val_get(almo_scf_section,"OPT_K_TRIAL_STEP_SIZE",&
      !                          r_val=almo_scf_env%opt_k_trial_step_size)
      !CALL section_vals_val_get(almo_scf_section,"OPT_K_CONJUGATOR",&
      !                          i_val=almo_scf_env%opt_k_conjugator)
      !CALL section_vals_val_get(almo_scf_section,"OPT_K_TRIAL_STEP_SIZE_MULTIPLIER",&
      !                          r_val=almo_scf_env%opt_k_trial_step_size_multiplier)
      !CALL section_vals_val_get(almo_scf_section,"OPT_K_CONJ_ITER_START",&
      !                          i_val=almo_scf_env%opt_k_conj_iter_start)
      !CALL section_vals_val_get(almo_scf_section,"OPT_K_PREC_ITER_START",&
      !                          i_val=almo_scf_env%opt_k_prec_iter_start)
      !CALL section_vals_val_get(almo_scf_section,"OPT_K_CONJ_ITER_FREQ_RESET",&
      !                          i_val=almo_scf_env%opt_k_conj_iter_freq)
      !CALL section_vals_val_get(almo_scf_section,"OPT_K_PREC_ITER_FREQ_UPDATE",&
      !                          i_val=almo_scf_env%opt_k_prec_iter_freq)
      !
      !CALL section_vals_val_get(almo_scf_section,"QUENCHER_RADIUS_TYPE",&
      !                          i_val=almo_scf_env%quencher_radius_type)
      !CALL section_vals_val_get(almo_scf_section,"QUENCHER_R0_FACTOR",&
      !                          r_val=almo_scf_env%quencher_r0_factor)
      !CALL section_vals_val_get(almo_scf_section,"QUENCHER_R1_FACTOR",&
      !                          r_val=almo_scf_env%quencher_r1_factor)
      !!CALL section_vals_val_get(almo_scf_section,"QUENCHER_R0_SHIFT",&
      !!                          r_val=almo_scf_env%quencher_r0_shift)
      !!
      !!CALL section_vals_val_get(almo_scf_section,"QUENCHER_R1_SHIFT",&
      !!                          r_val=almo_scf_env%quencher_r1_shift)
      !!
      !!almo_scf_env%quencher_r0_shift = cp_unit_to_cp2k(&
      !!   almo_scf_env%quencher_r0_shift,"angstrom")
      !!almo_scf_env%quencher_r1_shift = cp_unit_to_cp2k(&
      !!   almo_scf_env%quencher_r1_shift,"angstrom")
      !
      !CALL section_vals_val_get(almo_scf_section,"QUENCHER_AO_OVERLAP_0",&
      !                          r_val=almo_scf_env%quencher_s0)
      !CALL section_vals_val_get(almo_scf_section,"QUENCHER_AO_OVERLAP_1",&
      !                          r_val=almo_scf_env%quencher_s1)
      !CALL section_vals_val_get(almo_scf_section,"ENVELOPE_AMPLITUDE",&
      !                          r_val=almo_scf_env%envelope_amplitude)
      !! how to read lists
      !CALL section_vals_val_get(almo_scf_section,"INT_LIST01", &
      !        n_rep_val=n_rep)
      !counter_i = 0
      !DO k = 1,n_rep
      !  CALL section_vals_val_get(almo_scf_section,"INT_LIST01",&
      !          i_rep_val=k,i_vals=tmplist)
      !   DO jj = 1,SIZE(tmplist)
      !      counter_i=counter_i+1
      !      almo_scf_env%charge_of_domain(counter_i)=tmplist(jj)
      !   ENDDO
      !ENDDO
      almo_scf_env%domain_layout_aos = almo_domain_layout_molecular
      almo_scf_env%domain_layout_mos = almo_domain_layout_molecular
      almo_scf_env%mat_distr_aos = almo_mat_distr_molecular
--- a/src/almo_scf_methods.F
+++ b/src/almo_scf_methods.F
@ -1620,9 +1620,8 @@ CONTAINS
      my_algorithm = 0
      IF (PRESENT(algorithm)) my_algorithm = algorithm
-      IF (my_algorithm == 1 .AND. (.NOT. PRESENT(para_env) .OR. .NOT. PRESENT(blacs_env))) THEN
+      IF (my_algorithm == 1 .AND. (.NOT. PRESENT(para_env) .OR. .NOT. PRESENT(blacs_env))) &
         CPABORT("PARA and BLACS env are necessary for cholesky algorithm")
      END IF
      use_sigma_inv_guess = .FALSE.
      IF (PRESENT(use_guess)) THEN
@ -2093,6 +2092,7 @@ CONTAINS
      ALLOCATE (subm_in(ndomains))
      ALLOCATE (subm_temp(ndomains))
      ALLOCATE (subm_out(ndomains))
      !!!TRIM ALLOCATE(subm_trimmer(ndomains))
      CALL init_submatrices(subm_in)
      CALL init_submatrices(subm_temp)
      CALL init_submatrices(subm_out)
@ -2100,6 +2100,11 @@ CONTAINS
      CALL construct_submatrices(matrix_in, subm_in, &
                                 dpattern, map, node_of_domain, select_row)
      !!!TRIM IF (matrix_trimmer_required) THEN
      !!!TRIM    CALL construct_submatrices(matrix_trimmer,subm_trimmer,&
      !!!TRIM            dpattern,map,node_of_domain,select_row)
      !!!TRIM ENDIF
      IF (my_action == 0) THEN
         ! for example, apply preconditioner
         CALL multiply_submatrices('N', 'N', 1.0_dp, operator1, &
@ -2252,10 +2257,16 @@ CONTAINS
      ALLOCATE (subm_main(ndomains))
      CALL init_submatrices(subm_main)
      !!!TRIM ALLOCATE(subm_trimmer(ndomains))
      CALL construct_submatrices(matrix_main, subm_main, &
                                 dpattern, map, node_of_domain, select_row_col)
      !!!TRIM IF (matrix_trimmer_required) THEN
      !!!TRIM    CALL construct_submatrices(matrix_trimmer,subm_trimmer,&
      !!!TRIM            dpattern,map,node_of_domain,select_row)
      !!!TRIM ENDIF
      IF (my_action == -1) THEN
         ! project out the local occupied space
         !tmp=MATMUL(subm_r(idomain)%mdata,Minv)
@ -2304,9 +2315,38 @@ CONTAINS
               END DO
               naos = subm_main(idomain)%nrows
               !WRITE(*,*) "Domain, mo_self_and_neig, ao_domain: ", idomain, n_domain_mos, naos
               ALLOCATE (Minv(naos, naos))
               !!!TRIM IF (my_use_trimmer) THEN
               !!!TRIM    ! THIS IS SUPER EXPENSIVE (ELIMINATE)
               !!!TRIM    ! trim the main matrix before inverting
               !!!TRIM    ! assume that the trimmer columns are different (i.e. the main matrix is different for each MO)
               !!!TRIM    allocate(tmp(naos,nmos(idomain)))
               !!!TRIM    DO ii=1, nmos(idomain)
               !!!TRIM       ! transform the main matrix using the trimmer for the current MO
               !!!TRIM       DO jj=1, naos
               !!!TRIM          DO kk=1, naos
               !!!TRIM             Mstore(jj,kk)=sumb_main(idomain)%mdata(jj,kk)*&
               !!!TRIM                subm_trimmer(idomain)%mdata(jj,ii)*&
               !!!TRIM                subm_trimmer(idomain)%mdata(kk,ii)
               !!!TRIM          ENDDO
               !!!TRIM       ENDDO
               !!!TRIM       ! invert the main matrix (exclude some eigenvalues, shift some)
               !!!TRIM       CALL pseudo_invert_matrix(A=Mstore,Ainv=Minv,N=naos,method=1,&
               !!!TRIM               !range1_thr=1.0E-9_dp,range2_thr=1.0E-9_dp,&
               !!!TRIM               shift=1.0E-5_dp,&
               !!!TRIM               range1=nmos(idomain),range2=nmos(idomain),&
               !!!TRIM
               !!!TRIM       ! apply the inverted matrix
               !!!TRIM       ! RZK-warning this is only possible when the preconditioner is applied
               !!!TRIM       tmp(:,ii)=MATMUL(Minv,subm_in(idomain)%mdata(:,ii))
               !!!TRIM    ENDDO
               !!!TRIM    subm_out=MATMUL(tmp,sigma)
               !!!TRIM    deallocate(tmp)
               !!!TRIM ELSE
               IF (PRESENT(bad_modes_projector_down)) THEN
                  ALLOCATE (proj_array(naos, naos))
                  CALL pseudo_invert_matrix(A=subm_main(idomain)%mdata, Ainv=Minv, N=naos, method=1, &
@ -2320,6 +2360,7 @@ CONTAINS
                  CALL pseudo_invert_matrix(A=subm_main(idomain)%mdata, Ainv=Minv, N=naos, method=1, &
                                            range1=nmos(idomain), range2=n_domain_mos)
               END IF
               !!!TRIM ENDIF
               CALL copy_submatrices(subm_main(idomain), preconditioner(idomain), .FALSE.)
               CALL copy_submatrix_data(Minv, preconditioner(idomain))
@ -2594,6 +2635,24 @@ CONTAINS
         unit_nr = -1
      END IF
      !CALL dpotrf('L', N, Ainv, N, INFO )
      !IF( INFO/=0 ) THEN
      !   CPErrorMessage(cp_failure_level,routineP,"DPOTRF failed")
      !   CPPrecondition(.FALSE.,cp_failure_level,routineP,failure)
      !END IF
      !CALL dpotri('L', N, Ainv, N, INFO )
      !IF( INFO/=0 ) THEN
      !   CPErrorMessage(cp_failure_level,routineP,"DPOTRI failed")
      !   CPPrecondition(.FALSE.,cp_failure_level,routineP,failure)
      !END IF
      !! complete the matrix
      !DO ii=1,N
      !   DO jj=ii+1,N
      !      Ainv(ii,jj)=Ainv(jj,ii)
      !   ENDDO
      !   !WRITE(*,'(100F13.9)') Ainv(ii,:)
      !ENDDO
      ! diagonalize first
      ALLOCATE (eigenvalues(N))
      ! Query the optimal workspace for dsyev
@ -2630,6 +2689,21 @@ CONTAINS
      DEALLOCATE (eigenvalues)
 !!!    ! compute the error
 !!!    allocate(test(N,N))
 !!!    test=MATMUL(Ainv,A)
 !!!    DO ii=1,N
 !!!       test(ii,ii)=test(ii,ii)-1.0_dp
 !!!    ENDDO
 !!!    test_error=0.0_dp
 !!!    DO ii=1,N
 !!!       DO jj=1,N
 !!!          test_error=test_error+test(jj,ii)*test(jj,ii)
 !!!       ENDDO
 !!!    ENDDO
 !!!    WRITE(*,*) "Inversion error: ", SQRT(test_error)
 !!!    deallocate(test)
      CALL timestop(handle)
   END SUBROUTINE matrix_sqrt
@ -2842,6 +2916,21 @@ CONTAINS
      END SELECT
      !! compute the inversion error
      !allocate(temp1(N,N))
      !temp1=MATMUL(Ainv,A)
      !DO ii=1,N
      !   temp1(ii,ii)=temp1(ii,ii)-1.0_dp
      !ENDDO
      !temp1_error=0.0_dp
      !DO ii=1,N
      !   DO jj=1,N
      !      temp1_error=temp1_error+temp1(jj,ii)*temp1(jj,ii)
      !   ENDDO
      !ENDDO
      !WRITE(*,*) "Inversion error: ", SQRT(temp1_error)
      !deallocate(temp1)
      CALL timestop(handle)
   END SUBROUTINE pseudo_invert_matrix
--- a/src/almo_scf_optimizer.F
+++ b/src/almo_scf_optimizer.F
--- a/src/almo_scf_qs.F
+++ b/src/almo_scf_qs.F
@ -288,6 +288,63 @@ CONTAINS
         CALL dbcsr_work_create(matrix_new, work_mutable=.TRUE.)
         CALL dbcsr_get_info(matrix_new, nblkrows_total=nblkrows_tot, &
                             row_blk_size=row_blk_size, col_blk_size=col_blk_size)
         ! startQQQ - this part of the code scales quadratically
         ! therefore it is replaced with a less general but linear scaling algorithm below
         ! the quadratic algorithm is kept to be re-written later
         !QQQCALL dbcsr_get_info(matrix_new, nblkrows_total=nblkrows_tot, nblkcols_total=nblkcols_tot)
         !QQQDO row = 1, nblkrows_tot
         !QQQ   DO col = 1, nblkcols_tot
         !QQQ      tr = .FALSE.
         !QQQ      iblock_row = row
         !QQQ      iblock_col = col
         !QQQ      CALL dbcsr_get_stored_coordinates(matrix_new, iblock_row, iblock_col, tr, hold)
         !QQQ      IF(hold==mynode) THEN
         !QQQ
         !QQQ         ! RZK-warning replace with a function which says if this
         !QQQ         ! distribution block is active or not
         !QQQ         ! Translate indeces of distribution blocks to domain blocks
         !QQQ         if (size_keys(1)==almo_mat_dim_aobasis) then
         !QQQ           domain_row=almo_scf_env%domain_index_of_ao_block(iblock_row)
         !QQQ         else if (size_keys(2)==almo_mat_dim_occ .OR. &
         !QQQ                  size_keys(2)==almo_mat_dim_virt .OR. &
         !QQQ                  size_keys(2)==almo_mat_dim_virt_disc .OR. &
         !QQQ                  size_keys(2)==almo_mat_dim_virt_full) then
         !QQQ           domain_row=almo_scf_env%domain_index_of_mo_block(iblock_row)
         !QQQ         else
         !QQQ           CPErrorMessage(cp_failure_level,routineP,"Illegal dimension")
         !QQQ           CPPrecondition(.FALSE.,cp_failure_level,routineP,failure)
         !QQQ         endif
         !QQQ         if (size_keys(2)==almo_mat_dim_aobasis) then
         !QQQ           domain_col=almo_scf_env%domain_index_of_ao_block(iblock_col)
         !QQQ         else if (size_keys(2)==almo_mat_dim_occ .OR. &
         !QQQ                  size_keys(2)==almo_mat_dim_virt .OR. &
         !QQQ                  size_keys(2)==almo_mat_dim_virt_disc .OR. &
         !QQQ                  size_keys(2)==almo_mat_dim_virt_full) then
         !QQQ           domain_col=almo_scf_env%domain_index_of_mo_block(iblock_col)
         !QQQ         else
         !QQQ           CPErrorMessage(cp_failure_level,routineP,"Illegal dimension")
         !QQQ           CPPrecondition(.FALSE.,cp_failure_level,routineP,failure)
         !QQQ         endif
         !QQQ         ! Finds if we need this block
         !QQQ         ! only the block-diagonal constraint is implemented here
         !QQQ         active=.false.
         !QQQ         if (domain_row==domain_col) active=.true.
         !QQQ         IF (active) THEN
         !QQQ            ALLOCATE (new_block(row_blk_size(iblock_row), col_blk_size(iblock_col)))
         !QQQ            new_block(:, :) = 1.0_dp
         !QQQ            CALL dbcsr_put_block(matrix_new, iblock_row, iblock_col, new_block)
         !QQQ            DEALLOCATE (new_block)
         !QQQ         ENDIF
         !QQQ      ENDIF ! mynode
         !QQQ   ENDDO
         !QQQENDDO
         !QQQtake care of zero-electron fragments
         ! endQQQ - end of the quadratic part
         ! start linear-scaling replacement:
         ! works only for molecular blocks AND molecular distributions
         DO row = 1, nblkrows_tot
@ -554,7 +611,7 @@ CONTAINS
                                 n_el_f=REAL(almo_scf_env%nelectrons_total, dp), &
                                 maxocc=2.0_dp, &
                                 flexible_electron_count=dft_control%relax_multiplicity)
-         ELSE IF (almo_scf_env%nspins == 2) THEN
+         ELSEIF (almo_scf_env%nspins == 2) THEN
            CALL allocate_mo_set(mo_set=mos(ispin), &
                                 nao=nrow_fm, &
                                 nmo=ncol_fm, &
@ -1439,6 +1496,23 @@ CONTAINS
         DEALLOCATE (last_atom_of_molecule)
      END IF
      !mynode = dbcsr_mp_mynode(dbcsr_distribution_mp(&
      !   dbcsr_distribution(almo_scf_env%quench_t(ispin))))
      !CALL dbcsr_get_info(almo_scf_env%quench_t(ispin), distribution=dist, &
      !                    nblkrows_total=nblkrows_tot, nblkcols_total=nblkcols_tot)
      !DO row = 1, nblkrows_tot
      !   DO col = 1, nblkcols_tot
      !      tr = .FALSE.
      !      iblock_row = row
      !      iblock_col = col
      !      CALL dbcsr_get_stored_coordinates(almo_scf_env%quench_t(ispin),&
      !              iblock_row, iblock_col, tr, hold)
      !      CALL dbcsr_get_block_p(almo_scf_env%quench_t(ispin),&
      !              row, col, p_old_block, found)
      !      write(*,*) "RST_NOTE:", mynode, row, col, hold, found
      !   ENDDO
      !ENDDO
      CALL timestop(handle)
   END SUBROUTINE almo_scf_construct_quencher
--- a/src/almo_scf_types.F
+++ b/src/almo_scf_types.F
@ -569,9 +569,8 @@ CONTAINS
         DO istore = 1, MIN(almo_scf_env%almo_history%istore, almo_scf_env%almo_history%nstore)
            CALL dbcsr_release(almo_scf_env%almo_history%matrix_p_up_down(ispin, istore))
         END DO
-         IF (almo_scf_env%almo_history%istore > 0) THEN
+         IF (almo_scf_env%almo_history%istore > 0) &
            CALL dbcsr_release(almo_scf_env%almo_history%matrix_t(ispin))
         END IF
      END DO
      DEALLOCATE (almo_scf_env%almo_history%matrix_p_up_down)
      DEALLOCATE (almo_scf_env%almo_history%matrix_t)
@ -581,9 +580,8 @@ CONTAINS
            CALL dbcsr_release(almo_scf_env%xalmo_history%matrix_p_up_down(ispin, istore))
            !CALL dbcsr_release(almo_scf_env%xalmo_history%matrix_x(ispin, istore))
         END DO
-         IF (almo_scf_env%xalmo_history%istore > 0) THEN
+         IF (almo_scf_env%xalmo_history%istore > 0) &
            CALL dbcsr_release(almo_scf_env%xalmo_history%matrix_t(ispin))
         END IF
      END DO
      DEALLOCATE (almo_scf_env%xalmo_history%matrix_p_up_down)
      !DEALLOCATE (almo_scf_env%xalmo_history%matrix_x)
--- a/src/aobasis/ai_contraction.F
+++ b/src/aobasis/ai_contraction.F
@ -439,7 +439,7 @@ CONTAINS
         ELSE
            qab(ia:ja, ib:jb) = qab(ia:ja, ib:jb) + sab(1:na, 1:nb)
         END IF
-      ELSE IF (dir == "OUT" .OR. dir == "out") THEN
+      ELSEIF (dir == "OUT" .OR. dir == "out") THEN
         !  SAB <= QAB(block)
         ja = ia + na - 1
         jb = ib + nb - 1
--- a/src/aobasis/ai_eri_debug.F
+++ b/src/aobasis/ai_eri_debug.F
@ -128,16 +128,16 @@ CONTAINS
      IF (dn(1) > 0) THEN
         IABCD = os(an, bn, cn + i1, dn - i1) - (D(1) - C(1))*os(an, bn, cn, dn - i1)
-      ELSE IF (dn(2) > 0) THEN
+      ELSEIF (dn(2) > 0) THEN
         IABCD = os(an, bn, cn + i2, dn - i2) - (D(2) - C(2))*os(an, bn, cn, dn - i2)
-      ELSE IF (dn(3) > 0) THEN
+      ELSEIF (dn(3) > 0) THEN
         IABCD = os(an, bn, cn + i3, dn - i3) - (D(3) - C(3))*os(an, bn, cn, dn - i3)
      ELSE
         IF (bn(1) > 0) THEN
            IABCD = os(an + i1, bn - i1, cn, dn) - (B(1) - A(1))*os(an, bn - i1, cn, dn)
-         ELSE IF (bn(2) > 0) THEN
+         ELSEIF (bn(2) > 0) THEN
            IABCD = os(an + i2, bn - i2, cn, dn) - (B(2) - A(2))*os(an, bn - i2, cn, dn)
-         ELSE IF (bn(3) > 0) THEN
+         ELSEIF (bn(3) > 0) THEN
            IABCD = os(an + i3, bn - i3, cn, dn) - (B(3) - A(3))*os(an, bn - i3, cn, dn)
         ELSE
            IF (cn(1) > 0) THEN
@ -145,12 +145,12 @@ CONTAINS
                       0.5_dp*an(1)/eta*os(an - i1, bn, cn - i1, dn) + &
                       0.5_dp*(cn(1) - 1)/eta*os(an, bn, cn - i1 - i1, dn) - &
                       xsi/eta*os(an + i1, bn, cn - i1, dn)
-            ELSE IF (cn(2) > 0) THEN
+            ELSEIF (cn(2) > 0) THEN
               IABCD = ((Q(2) - C(2)) + xsi/eta*(P(2) - A(2)))*os(an, bn, cn - i2, dn) + &
                       0.5_dp*an(2)/eta*os(an - i2, bn, cn - i2, dn) + &
                       0.5_dp*(cn(2) - 1)/eta*os(an, bn, cn - i2 - i2, dn) - &
                       xsi/eta*os(an + i2, bn, cn - i2, dn)
-            ELSE IF (cn(3) > 0) THEN
+            ELSEIF (cn(3) > 0) THEN
               IABCD = ((Q(3) - C(3)) + xsi/eta*(P(3) - A(3)))*os(an, bn, cn - i3, dn) + &
                       0.5_dp*an(3)/eta*os(an - i3, bn, cn - i3, dn) + &
                       0.5_dp*(cn(3) - 1)/eta*os(an, bn, cn - i3 - i3, dn) - &
@ -161,12 +161,12 @@ CONTAINS
                          (W(1) - P(1))*os(an - i1, bn, cn, dn, m + 1) + &
                          0.5_dp*(an(1) - 1)/xsi*os(an - i1 - i1, bn, cn, dn, m) - &
                          0.5_dp*(an(1) - 1)/xsi*rho/xsi*os(an - i1 - i1, bn, cn, dn, m + 1)
-               ELSE IF (an(2) > 0) THEN
+               ELSEIF (an(2) > 0) THEN
                  IABCD = (P(2) - A(2))*os(an - i2, bn, cn, dn, m) + &
                          (W(2) - P(2))*os(an - i2, bn, cn, dn, m + 1) + &
                          0.5_dp*(an(2) - 1)/xsi*os(an - i2 - i2, bn, cn, dn, m) - &
                          0.5_dp*(an(2) - 1)/xsi*rho/xsi*os(an - i2 - i2, bn, cn, dn, m + 1)
-               ELSE IF (an(3) > 0) THEN
+               ELSEIF (an(3) > 0) THEN
                  IABCD = (P(3) - A(3))*os(an - i3, bn, cn, dn, m) + &
                          (W(3) - P(3))*os(an - i3, bn, cn, dn, m + 1) + &
                          0.5_dp*(an(3) - 1)/xsi*os(an - i3 - i3, bn, cn, dn, m) - &
--- a/src/aobasis/ai_os_rr.F
+++ b/src/aobasis/ai_os_rr.F
@ -162,7 +162,7 @@ CONTAINS
                     rr(m, coa, 1) = rr(m, coa, 1) + g*REAL(az - 1, dp)*(rr(m, coa2z, 1) - rr(m + 1, coa2z, 1))
                  END DO
               END IF
-            ELSE IF (ay > 0) THEN
+            ELSEIF (ay > 0) THEN
               DO m = 0, mmax - la
                  rr(m, coa, 1) = rap(2)*rr(m, coa1y, 1) - rcp(2)*rr(m + 1, coa1y, 1)
               END DO
@ -171,7 +171,7 @@ CONTAINS
                     rr(m, coa, 1) = rr(m, coa, 1) + g*REAL(ay - 1, dp)*(rr(m, coa2y, 1) - rr(m + 1, coa2y, 1))
                  END DO
               END IF
-            ELSE IF (ax > 0) THEN
+            ELSEIF (ax > 0) THEN
               DO m = 0, mmax - la
                  rr(m, coa, 1) = rap(1)*rr(m, coa1x, 1) - rcp(1)*rr(m + 1, coa1x, 1)
               END DO
@ -225,7 +225,7 @@ CONTAINS
                           rr(m, coa, cob) = rr(m, coa, cob) + g*REAL(az, dp)*(rr(m, coa1z, cob1z) - rr(m + 1, coa1z, cob1z))
                        END DO
                     END IF
-                  ELSE IF (by > 0) THEN
+                  ELSEIF (by > 0) THEN
                     DO m = 0, mmax - la - lb
                        rr(m, coa, cob) = rbp(2)*rr(m, coa, cob1y) - rcp(2)*rr(m + 1, coa, cob1y)
                     END DO
@ -239,7 +239,7 @@ CONTAINS
                           rr(m, coa, cob) = rr(m, coa, cob) + g*REAL(ay, dp)*(rr(m, coa1y, cob1y) - rr(m + 1, coa1y, cob1y))
                        END DO
                     END IF
-                  ELSE IF (bx > 0) THEN
+                  ELSEIF (bx > 0) THEN
                     DO m = 0, mmax - la - lb
                        rr(m, coa, cob) = rbp(1)*rr(m, coa, cob1x) - rcp(1)*rr(m + 1, coa, cob1x)
                     END DO
--- a/src/aobasis/ai_overlap.F
+++ b/src/aobasis/ai_overlap.F
@ -2050,12 +2050,12 @@ CONTAINS
      DO l = 0, la
         IF (l == 0) THEN
            fun(:, l) = z_one
-         ELSE IF (l == 1) THEN
+         ELSEIF (l == 1) THEN
            fun(:, l) = CMPLX(0.0_dp, 0.5_dp*oa*gval(:), KIND=dp)
-         ELSE IF (l == 2) THEN
+         ELSEIF (l == 2) THEN
            fun(:, l) = CMPLX(-(0.5_dp*oa*gval(:))**2, 0.0_dp, KIND=dp)
            fun(:, l) = fun(:, l) + CMPLX(0.5_dp*oa, 0.0_dp, KIND=dp)
-         ELSE IF (l == 3) THEN
+         ELSEIF (l == 3) THEN
            fun(:, l) = CMPLX(0.0_dp, -(0.5_dp*oa*gval(:))**3, KIND=dp)
            fun(:, l) = fun(:, l) + CMPLX(0.0_dp, 0.75_dp*oa*oa*gval(:), KIND=dp)
         ELSE
@ -2065,12 +2065,12 @@ CONTAINS
      DO l = 0, lb
         IF (l == 0) THEN
            gun(:, l) = z_one
-         ELSE IF (l == 1) THEN
+         ELSEIF (l == 1) THEN
            gun(:, l) = CMPLX(0.0_dp, 0.5_dp*ob*gval(:), KIND=dp)
-         ELSE IF (l == 2) THEN
+         ELSEIF (l == 2) THEN
            gun(:, l) = CMPLX(-(0.5_dp*ob*gval(:))**2, 0.0_dp, KIND=dp)
            gun(:, l) = gun(:, l) + CMPLX(0.5_dp*ob, 0.0_dp, KIND=dp)
-         ELSE IF (l == 3) THEN
+         ELSEIF (l == 3) THEN
            gun(:, l) = CMPLX(0.0_dp, -(0.5_dp*ob*gval(:))**3, KIND=dp)
            gun(:, l) = gun(:, l) + CMPLX(0.0_dp, 0.75_dp*ob*ob*gval(:), KIND=dp)
         ELSE
--- a/src/aobasis/ai_overlap3_debug.F
+++ b/src/aobasis/ai_overlap3_debug.F
@ -99,25 +99,25 @@ CONTAINS
      IF (bn(1) > 0) THEN
         IACB = os_overlap3(an, cn + i1, bn - i1) + (C(1) - B(1))*os_overlap3(an, cn, bn - i1)
-      ELSE IF (bn(2) > 0) THEN
+      ELSEIF (bn(2) > 0) THEN
         IACB = os_overlap3(an, cn + i2, bn - i2) + (C(2) - B(2))*os_overlap3(an, cn, bn - i2)
-      ELSE IF (bn(3) > 0) THEN
+      ELSEIF (bn(3) > 0) THEN
         IACB = os_overlap3(an, cn + i3, bn - i3) + (C(3) - B(3))*os_overlap3(an, cn, bn - i3)
      ELSE
         IF (cn(1) > 0) THEN
            IACB = os_overlap3(an + i1, cn - i1, bn) + (A(1) - C(1))*os_overlap3(an, cn - i1, bn)
-         ELSE IF (cn(2) > 0) THEN
+         ELSEIF (cn(2) > 0) THEN
            IACB = os_overlap3(an + i2, cn - i2, bn) + (A(2) - C(2))*os_overlap3(an, cn - i2, bn)
-         ELSE IF (cn(3) > 0) THEN
+         ELSEIF (cn(3) > 0) THEN
            IACB = os_overlap3(an + i3, cn - i3, bn) + (A(3) - C(3))*os_overlap3(an, cn - i3, bn)
         ELSE
            IF (an(1) > 0) THEN
               IACB = (G(1) - A(1))*os_overlap3(an - i1, cn, bn) + &
                      0.5_dp*(an(1) - 1)/(xsi + xc)*os_overlap3(an - i1 - i1, cn, bn)
-            ELSE IF (an(2) > 0) THEN
+            ELSEIF (an(2) > 0) THEN
               IACB = (G(2) - A(2))*os_overlap3(an - i2, cn, bn) + &
                      0.5_dp*(an(2) - 1)/(xsi + xc)*os_overlap3(an - i2 - i2, cn, bn)
-            ELSE IF (an(3) > 0) THEN
+            ELSEIF (an(3) > 0) THEN
               IACB = (G(3) - A(3))*os_overlap3(an - i3, cn, bn) + &
                      0.5_dp*(an(3) - 1)/(xsi + xc)*os_overlap3(an - i3 - i3, cn, bn)
            ELSE
--- a/src/aobasis/ai_overlap_debug.F
+++ b/src/aobasis/ai_overlap_debug.F
@ -87,18 +87,18 @@ CONTAINS
      IF (bn(1) > 0) THEN
         IAB = os_overlap2(an + i1, bn - i1) + (A(1) - B(1))*os_overlap2(an, bn - i1)
-      ELSE IF (bn(2) > 0) THEN
+      ELSEIF (bn(2) > 0) THEN
         IAB = os_overlap2(an + i2, bn - i2) + (A(2) - B(2))*os_overlap2(an, bn - i2)
-      ELSE IF (bn(3) > 0) THEN
+      ELSEIF (bn(3) > 0) THEN
         IAB = os_overlap2(an + i3, bn - i3) + (A(3) - B(3))*os_overlap2(an, bn - i3)
      ELSE
         IF (an(1) > 0) THEN
            IAB = (P(1) - A(1))*os_overlap2(an - i1, bn) + &
                  0.5_dp*(an(1) - 1)/xsi*os_overlap2(an - i1 - i1, bn)
-         ELSE IF (an(2) > 0) THEN
+         ELSEIF (an(2) > 0) THEN
            IAB = (P(2) - A(2))*os_overlap2(an - i2, bn) + &
                  0.5_dp*(an(2) - 1)/xsi*os_overlap2(an - i2 - i2, bn)
-         ELSE IF (an(3) > 0) THEN
+         ELSEIF (an(3) > 0) THEN
            IAB = (P(3) - A(3))*os_overlap2(an - i3, bn) + &
                  0.5_dp*(an(3) - 1)/xsi*os_overlap2(an - i3 - i3, bn)
         ELSE
--- a/src/aobasis/basis_set_types.F
+++ b/src/aobasis/basis_set_types.F
@ -1680,9 +1680,8 @@ CONTAINS
               l(nshell(iset) - ishell + i, iset) = lshell
            END DO
         END DO
-         IF (LEN_TRIM(line_att) /= 0) THEN
+         IF (LEN_TRIM(line_att) /= 0) &
            CPABORT("Error reading the Basis from input file!")
         END IF
         DO ipgf = 1, npgf(iset)
            is_ok = cp_sll_val_next(list, val)
            IF (.NOT. is_ok) CPABORT("Error reading the Basis set from input file!")
@ -2504,9 +2503,8 @@ CONTAINS
      ng = gto_basis_set%npgf(1)
      DO iset = 1, nset
-         IF ((ng /= gto_basis_set%npgf(iset)) .AND. do_ortho) THEN
+         IF ((ng /= gto_basis_set%npgf(iset)) .AND. do_ortho) &
            CPABORT("different number of primitves")
         END IF
      END DO
      IF (do_ortho) THEN
@ -2684,7 +2682,7 @@ CONTAINS
            s00 = ai*aj*(pi*ab)**1.50_dp
            IF (l == 0) THEN
               sss = s00
-            ELSE IF (l == 1) THEN
+            ELSEIF (l == 1) THEN
               sss = s00*ab*0.5_dp
            ELSE
               CPABORT("aovlp lvalue")
--- a/src/arnoldi/arnoldi_data_methods.F
+++ b/src/arnoldi/arnoldi_data_methods.F
@ -138,15 +138,13 @@ CONTAINS
      CALL control%mp_group%set_handle(group_handle)
      CALL control%pcol_group%set_handle(pcol_handle)
-      IF (.NOT. subgroups_defined) THEN
+      IF (.NOT. subgroups_defined) &
         CPABORT("arnoldi only with subgroups")
      END IF
      control%symmetric = .FALSE.
      ! Will need a fix for complex because there it has to be hermitian
-      IF (SIZE(matrix) == 1) THEN
+      IF (SIZE(matrix) == 1) &
         control%symmetric = dbcsr_get_matrix_type(matrix(1)%matrix) == dbcsr_type_symmetric
      END IF
      ! Set the control parameters
      control%max_iter = max_iter
@ -160,28 +158,23 @@ CONTAINS
      control%nrestart = nrestarts
      control%generalized_ev = generalized_ev
-      IF (control%nval_req > 1 .AND. control%nrestart > 0 .AND. .NOT. control%iram) THEN
+      IF (control%nval_req > 1 .AND. control%nrestart > 0 .AND. .NOT. control%iram) &
         CALL cp_abort(__LOCATION__, 'with more than one eigenvalue requested '// &
                       'internal restarting with a previous EVEC is a bad idea, set IRAM or nrestsart=0')
      END IF
      ! some checks for the generalized EV mode
-      IF (control%generalized_ev .AND. selection_crit == 1) THEN
+      IF (control%generalized_ev .AND. selection_crit == 1) &
         CALL cp_abort(__LOCATION__, &
                       'generalized ev can only highest OR lowest EV')
-      END IF
+      IF (control%generalized_ev .AND. nval_request /= 1) &
      IF (control%generalized_ev .AND. nval_request /= 1) THEN
         CALL cp_abort(__LOCATION__, &
                       'generalized ev can only compute one EV at the time')
-      END IF
+      IF (control%generalized_ev .AND. control%nrestart == 0) &
      IF (control%generalized_ev .AND. control%nrestart == 0) THEN
         CALL cp_abort(__LOCATION__, &
                       'outer loops are mandatory for generalized EV, set nrestart appropriatly')
-      END IF
+      IF (SIZE(matrix) /= 2 .AND. control%generalized_ev) &
      IF (SIZE(matrix) /= 2 .AND. control%generalized_ev) THEN
         CALL cp_abort(__LOCATION__, &
                       'generalized ev needs exactly two matrices as input (2nd is the metric)')
      END IF
      ALLOCATE (control%selected_ind(max_iter))
      CALL set_control(arnoldi_env, control)
@ -393,9 +386,8 @@ CONTAINS
      INTEGER                                            :: ev_ind
      INTEGER, DIMENSION(:), POINTER                     :: selected_ind
-      IF (ind > get_nval_out(arnoldi_env)) THEN
+      IF (ind > get_nval_out(arnoldi_env)) &
         CPABORT('outside range of indexed evals')
      END IF
      selected_ind => get_sel_ind(arnoldi_env)
      ev_ind = selected_ind(ind)
@ -419,9 +411,8 @@ CONTAINS
      INTEGER, DIMENSION(:), POINTER                     :: selected_ind
      NULLIFY (evals)
-      IF (SIZE(eval_out) < get_nval_out(arnoldi_env)) THEN
+      IF (SIZE(eval_out) < get_nval_out(arnoldi_env)) &
         CPABORT('array for eval output too small')
      END IF
      selected_ind => get_sel_ind(arnoldi_env)
      evals => get_evals(arnoldi_env)
--- a/src/arnoldi/arnoldi_geev.F
+++ b/src/arnoldi/arnoldi_geev.F
@ -14,12 +14,7 @@
 !> \author Florian Schiffmann
 ! **************************************************************************************************
 MODULE arnoldi_geev
-#if defined (__HAS_IEEE_EXCEPTIONS)
+   USE kinds,                           ONLY: dp
   USE ieee_exceptions, ONLY: ieee_get_halting_mode, &
                              ieee_set_halting_mode, &
                              IEEE_ALL
 #endif
   USE kinds, ONLY: dp
 #include "../base/base_uses.f90"
   IMPLICIT NONE
@ -81,9 +76,7 @@ CONTAINS
      INTEGER                                            :: ndim
      COMPLEX(dp), DIMENSION(:)                          :: evals
      COMPLEX(dp), DIMENSION(:, :)                       :: revec, levec
-#if defined (__HAS_IEEE_EXCEPTIONS)
+
      LOGICAL, DIMENSION(5)                              :: halt
 #endif
      INTEGER                                            :: i, info
      REAL(dp)                                           :: work(20*ndim)
      REAL(dp), DIMENSION(ndim)                          :: diag, offdiag
@ -100,19 +93,8 @@ CONTAINS
      END DO
 #if defined (__HAS_IEEE_EXCEPTIONS)
      CALL ieee_get_halting_mode(IEEE_ALL, halt)
      CALL ieee_set_halting_mode(IEEE_ALL, .FALSE.)
 #endif
      CALL dstev(jobvr, ndim, diag, offdiag, evec_r, ndim, work, info)
 #if defined (__HAS_IEEE_EXCEPTIONS)
      CALL ieee_set_halting_mode(IEEE_ALL, halt)
 #endif
      CPASSERT(info == 0)
      DO i = 1, ndim
         revec(:, i) = CMPLX(evec_r(:, i), REAL(0.0, dp), dp)
         evals(i) = CMPLX(diag(i), 0.0, dp)
@ -162,7 +144,7 @@ CONTAINS
      i = 1
      DO WHILE (i <= ndim)
         IF (ABS(eval2(i)) < EPSILON(REAL(0.0, dp))) THEN
-            evec_r(:, i) = evec_r(:, i)/NORM2(evec_r(:, i))
+            evec_r(:, i) = evec_r(:, i)/SQRT(DOT_PRODUCT(evec_r(:, i), evec_r(:, i)))
            revec(:, i) = CMPLX(evec_r(:, i), REAL(0.0, dp), dp)
            levec(:, i) = CMPLX(evec_l(:, i), REAL(0.0, dp), dp)
            i = i + 1
--- a/src/arnoldi/arnoldi_methods.F
+++ b/src/arnoldi/arnoldi_methods.F
@ -561,7 +561,7 @@ CONTAINS
      ar_data%local_history = Zmat
      ! broadcast the Hessenberg matrix so we don't need to care later on
-      DEALLOCATE (v_vec); DEALLOCATE (w_vec); DEALLOCATE (s_vec); DEALLOCATE (h_vec); DEALLOCATE (CZmat)
+      DEALLOCATE (v_vec); DEALLOCATE (w_vec); DEALLOCATE (s_vec); DEALLOCATE (h_vec); DEALLOCATE (CZmat);
      DEALLOCATE (Zmat); DEALLOCATE (BZmat)
      CALL timestop(handle)
--- a/src/atom_electronic_structure.F
+++ b/src/atom_electronic_structure.F
@ -343,10 +343,10 @@ CONTAINS
            xcmat%op = 0._dp
            CALL calculate_atom_vxc_lda(xcmat, atom, xc_section)
            ! ZMP added options for the zmp calculations, building external density and vxc potential
-         ELSE IF (need_zmp) THEN
+         ELSEIF (need_zmp) THEN
            xcmat%op = 0._dp
            CALL calculate_atom_zmp(ext_density=ext_density, atom=atom, lprint=.FALSE., xcmat=xcmat)
-         ELSE IF (need_vxc) THEN
+         ELSEIF (need_vxc) THEN
            xcmat%op = 0._dp
            CALL calculate_atom_ext_vxc(vxc=ext_vxc, atom=atom, lprint=.FALSE., xcmat=xcmat)
         ELSE
@ -503,10 +503,10 @@ CONTAINS
               ne = atom%state%occupation(l, k)
               IF (ne == 0._dp) THEN !empty shell
                  EXIT !assume there are no holes
-               ELSE IF (ne == 2._dp*nm) THEN !closed shell
+               ELSEIF (ne == 2._dp*nm) THEN !closed shell
                  atom%state%occa(l, k) = nm
                  atom%state%occb(l, k) = nm
-               ELSE IF (atom%state%multiplicity == -2) THEN !High spin case
+               ELSEIF (atom%state%multiplicity == -2) THEN !High spin case
                  atom%state%occa(l, k) = MIN(ne, nm)
                  atom%state%occb(l, k) = MAX(0._dp, ne - nm)
               ELSE
--- a/src/atom_energy.F
+++ b/src/atom_energy.F
@ -1103,11 +1103,11 @@ CONTAINS
      IF (PRESENT(counter)) THEN
         WRITE (str, "(I12)") counter
-      ELSE IF (PRESENT(rval)) THEN
+      ELSEIF (PRESENT(rval)) THEN
         WRITE (str, "(G18.8)") rval
-      ELSE IF (PRESENT(ival)) THEN
+      ELSEIF (PRESENT(ival)) THEN
         WRITE (str, "(I12)") ival
-      ELSE IF (PRESENT(cval)) THEN
+      ELSEIF (PRESENT(cval)) THEN
         WRITE (str, "(A)") TRIM(ADJUSTL(cval))
      ELSE
         WRITE (str, "(A)") ""
--- a/src/atom_fit.F
+++ b/src/atom_fit.F
@ -657,7 +657,7 @@ CONTAINS
                              ntarget = ntarget + 1
                              wtot = wtot + atom%weight*w_virt/100._dp
                           END IF
-                        ELSE IF (k < atom%state%maxn_occ(l)) THEN
+                        ELSEIF (k < atom%state%maxn_occ(l)) THEN
                           atom%orbitals%wrefene(k, l, 1) = w_semi
                           atom%orbitals%wrefchg(k, l, 1) = w_semi/100._dp
                           atom%orbitals%crefene(k, l, 1) = t_semi
@ -735,7 +735,7 @@ CONTAINS
                              wtot = wtot + atom%weight*2._dp*w_virt/100._dp
                              ntarget = ntarget + 2
                           END IF
-                        ELSE IF (k < atom%state%maxn_occ(l)) THEN
+                        ELSEIF (k < atom%state%maxn_occ(l)) THEN
                           atom%orbitals%wrefene(k, l, 1:2) = w_semi
                           atom%orbitals%wrefchg(k, l, 1:2) = w_semi/100._dp
                           atom%orbitals%crefene(k, l, 1:2) = t_semi
--- a/src/atom_grb.F
+++ b/src/atom_grb.F
@ -152,9 +152,8 @@ CONTAINS
      CALL allocate_grid_atom(basis%grid)
      CALL section_vals_val_get(grb_section, "QUADRATURE", i_val=quadtype)
      CALL section_vals_val_get(grb_section, "GRID_POINTS", i_val=ngp)
-      IF (ngp <= 0) THEN
+      IF (ngp <= 0) &
         CPABORT("# point radial grid < 0")
      END IF
      CALL create_grid_atom(basis%grid, ngp, 1, 1, 0, quadtype)
      basis%grid%nr = ngp
      !
--- a/src/atom_kind_orbitals.F
+++ b/src/atom_kind_orbitals.F
@ -273,7 +273,7 @@ CONTAINS
      ! total number of occupied orbitals
      IF (PRESENT(nocc) .AND. ghost) THEN
         nocc = 0
-      ELSE IF (PRESENT(nocc)) THEN
+      ELSEIF (PRESENT(nocc)) THEN
         nocc = 0
         DO l = 0, lmat
            DO k = 1, 7
--- a/src/atom_operators.F
+++ b/src/atom_operators.F
@ -120,14 +120,14 @@ CONTAINS
                  rc = potential%rcon
                  sc = potential%scon
                  cpot(1:m) = (basis%grid%rad(1:m)/rc)**sc
-               ELSE IF (potential%conf_type == barrier_conf) THEN
+               ELSEIF (potential%conf_type == barrier_conf) THEN
                  om = potential%rcon
                  ron = potential%scon
                  rc = ron + om
                  DO i = 1, m
                     IF (basis%grid%rad(i) < ron) THEN
                        cpot(i) = 0.0_dp
-                     ELSE IF (basis%grid%rad(i) < rc) THEN
+                     ELSEIF (basis%grid%rad(i) < rc) THEN
                        x = (basis%grid%rad(i) - ron)/om
                        x = 1._dp - x
                        cpot(i) = -6._dp*x**5 + 15._dp*x**4 - 10._dp*x**3 + 1._dp
--- a/src/atom_optimization.F
+++ b/src/atom_optimization.F
@ -221,7 +221,7 @@ CONTAINS
            IF (nm < 1) nm = history%max_history
            fmat = a*history%hmat(nnow)%fmat + (1._dp - a)*history%hmat(nm)%fmat
         END IF
-      ELSE IF (history%hlen == 1) THEN
+      ELSEIF (history%hlen == 1) THEN
         fmat = history%hmat(nnow)%fmat
      ELSE
         CPABORT("Length of matrix history hlen < 1")
--- a/src/atom_output.F
+++ b/src/atom_output.F
@ -192,19 +192,16 @@ CONTAINS
         WRITE (iw, '(T36,A,T61,F20.12)') "   Virial (-V/T) ::", -atom%energy%epot/atom%energy%ekin
      END IF
      WRITE (iw, '(T36,A,T61,F20.12)') "     Core Energy ::", atom%energy%ecore
-      IF (atom%energy%exc /= 0._dp) THEN
+      IF (atom%energy%exc /= 0._dp) &
         WRITE (iw, '(T36,A,T61,F20.12)') "       XC Energy ::", atom%energy%exc
      END IF
      WRITE (iw, '(T36,A,T61,F20.12)') "  Coulomb Energy ::", atom%energy%ecoulomb
-      IF (atom%energy%eexchange /= 0._dp) THEN
+      IF (atom%energy%eexchange /= 0._dp) &
         WRITE (iw, '(T34,A,T61,F20.12)') "HF Exchange Energy ::", atom%energy%eexchange
      END IF
      IF (atom%potential%ppot_type /= NO_PSEUDO) THEN
         WRITE (iw, '(T20,A,T61,F20.12)') "    Total Pseudopotential Energy ::", atom%energy%epseudo
         WRITE (iw, '(T20,A,T61,F20.12)') "    Local Pseudopotential Energy ::", atom%energy%eploc
-         IF (atom%energy%elsd /= 0._dp) THEN
+         IF (atom%energy%elsd /= 0._dp) &
            WRITE (iw, '(T20,A,T61,F20.12)') "     Local Spin-potential Energy ::", atom%energy%elsd
         END IF
         WRITE (iw, '(T20,A,T61,F20.12)') " Nonlocal Pseudopotential Energy ::", atom%energy%epnl
      END IF
      IF (atom%potential%confinement) THEN
--- a/src/atom_pseudo.F
+++ b/src/atom_pseudo.F
@ -257,10 +257,10 @@ CONTAINS
                     ne = state%occupation(l, k)
                     IF (ne == 0._dp) THEN !empty shell
                        EXIT !assume there are no holes
-                     ELSE IF (ne == 2._dp*nm) THEN !closed shell
+                     ELSEIF (ne == 2._dp*nm) THEN !closed shell
                        state%occa(l, k) = nm
                        state%occb(l, k) = nm
-                     ELSE IF (state%multiplicity == -2) THEN !High spin case
+                     ELSEIF (state%multiplicity == -2) THEN !High spin case
                        state%occa(l, k) = MIN(ne, nm)
                        state%occb(l, k) = MAX(0._dp, ne - nm)
                     ELSE
--- a/src/atom_set_basis.F
+++ b/src/atom_set_basis.F
@ -204,7 +204,7 @@ CONTAINS
                  basis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - &
                                         2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear
               END DO
-            ELSE IF (basis%basis_type == CGTO_BASIS) THEN
+            ELSEIF (basis%basis_type == CGTO_BASIS) THEN
               DO k = 1, nr
                  rk = basis%grid%rad(k)
                  ear = EXP(-al*basis%grid%rad(k)**2)
--- a/src/atom_sgp.F
+++ b/src/atom_sgp.F
@ -122,7 +122,7 @@ CONTAINS
      ! generate the transformed potentials
      IF (is_ecp) THEN
         CALL ecp_sgp_constr(ecp_pot, sgp_pot, basis)
-      ELSE IF (is_upf) THEN
+      ELSEIF (is_upf) THEN
         CALL upf_sgp_constr(upf_pot, sgp_pot, basis)
      ELSE
         CPABORT("Either ecp_pot or upf_pot is needed for sgp_construction")
@ -137,7 +137,7 @@ CONTAINS
      !
      IF (is_ecp) THEN
         CALL ecpints(hnl%op, basis, ecp_pot)
-      ELSE IF (is_upf) THEN
+      ELSEIF (is_upf) THEN
         CALL upfints(core%op, hnl%op, basis, upf_pot, cutpotu, sgp_pot%ac_local)
      ELSE
         CPABORT("Either ecp_pot or upf_pot is needed for sgp_construction")
@ -246,7 +246,7 @@ CONTAINS
      IF (do_transform) THEN
         IF (is_ecp) THEN
            CALL ecp_sgp_constr(ecp_pot, sgp_pot, atom_ref%basis)
-         ELSE IF (is_upf) THEN
+         ELSEIF (is_upf) THEN
            CALL upf_sgp_constr(upf_pot, sgp_pot, atom_ref%basis)
         ELSE
            CPABORT("Either ecp_pseudo or upf_pseudo is needed for atom_sgp_construction")
@ -279,7 +279,7 @@ CONTAINS
         !
         IF (is_ecp) THEN
            CALL ecpints(hnl%op, atom_ref%basis, ecp_pot)
-         ELSE IF (is_upf) THEN
+         ELSEIF (is_upf) THEN
            CALL upfints(core%op, hnl%op, atom_ref%basis, upf_pot, cutpotu, sgp_pot%ac_local)
         ELSE
            CPABORT("Either ecp_pseudo or upf_pseudo is needed for atom_sgp_construction")
--- a/src/atom_types.F
+++ b/src/atom_types.F
@ -414,9 +414,8 @@ CONTAINS
      CALL allocate_grid_atom(basis%grid)
      CALL section_vals_val_get(basis_section, "QUADRATURE", i_val=quadtype)
      CALL section_vals_val_get(basis_section, "GRID_POINTS", i_val=ngp)
-      IF (ngp <= 0) THEN
+      IF (ngp <= 0) &
         CPABORT("The number of radial grid points must be greater than zero.")
      END IF
      CALL create_grid_atom(basis%grid, ngp, 1, 1, 0, quadtype)
      basis%grid%nr = ngp
      basis%geometrical = .FALSE.
@ -841,9 +840,8 @@ CONTAINS
      CALL allocate_grid_atom(gbasis%grid)
      ngp = SIZE(r)
      quadtype = do_gapw_log
-      IF (ngp <= 0) THEN
+      IF (ngp <= 0) &
         CPABORT("The number of radial grid points must be greater than zero.")
      END IF
      CALL create_grid_atom(gbasis%grid, ngp, 1, 1, 0, quadtype)
      gbasis%grid%nr = ngp
      gbasis%grid%rad(:) = r(:)
--- a/src/atom_upf.F
+++ b/src/atom_upf.F
@ -218,39 +218,39 @@ CONTAINS
            IF (nametag(2:8) == "PP_INFO") THEN
               CPASSERT(nametag(9:9) == ">")
               CALL upf_info_section(parser, pot)
-            ELSE IF (nametag(2:10) == "PP_HEADER") THEN
+            ELSEIF (nametag(2:10) == "PP_HEADER") THEN
               IF (.NOT. (nametag(11:11) == ">")) THEN
                  CALL upf_header_option(parser, pot)
               END IF
-            ELSE IF (nametag(2:8) == "PP_MESH") THEN
+            ELSEIF (nametag(2:8) == "PP_MESH") THEN
               IF (.NOT. (nametag(9:9) == ">")) THEN
                  CALL upf_mesh_option(parser, pot)
               END IF
               CALL upf_mesh_section(parser, pot)
-            ELSE IF (nametag(2:8) == "PP_NLCC") THEN
+            ELSEIF (nametag(2:8) == "PP_NLCC") THEN
               IF (nametag(9:9) == ">") THEN
                  CALL upf_nlcc_section(parser, pot, .FALSE.)
               ELSE
                  CALL upf_nlcc_section(parser, pot, .TRUE.)
               END IF
-            ELSE IF (nametag(2:9) == "PP_LOCAL") THEN
+            ELSEIF (nametag(2:9) == "PP_LOCAL") THEN
               IF (nametag(10:10) == ">") THEN
                  CALL upf_local_section(parser, pot, .FALSE.)
               ELSE
                  CALL upf_local_section(parser, pot, .TRUE.)
               END IF
-            ELSE IF (nametag(2:12) == "PP_NONLOCAL") THEN
+            ELSEIF (nametag(2:12) == "PP_NONLOCAL") THEN
               CPASSERT(nametag(13:13) == ">")
               CALL upf_nonlocal_section(parser, pot)
-            ELSE IF (nametag(2:13) == "PP_SEMILOCAL") THEN
+            ELSEIF (nametag(2:13) == "PP_SEMILOCAL") THEN
               CALL upf_semilocal_section(parser, pot)
-            ELSE IF (nametag(2:9) == "PP_PSWFC") THEN
+            ELSEIF (nametag(2:9) == "PP_PSWFC") THEN
               ! skip section for now
-            ELSE IF (nametag(2:11) == "PP_RHOATOM") THEN
+            ELSEIF (nametag(2:11) == "PP_RHOATOM") THEN
               ! skip section for now
-            ELSE IF (nametag(2:7) == "PP_PAW") THEN
+            ELSEIF (nametag(2:7) == "PP_PAW") THEN
               ! skip section for now
-            ELSE IF (nametag(2:6) == "/UPF>") THEN
+            ELSEIF (nametag(2:6) == "/UPF>") THEN
               EXIT
            END IF
         END IF
@ -856,7 +856,7 @@ CONTAINS
               END IF
               IF (icount > ms) EXIT
            END DO
-         ELSE IF (string(1:15) == "</PP_SEMILOCAL>") THEN
+         ELSEIF (string(1:15) == "</PP_SEMILOCAL>") THEN
            EXIT
         ELSE
            !
--- a/src/atom_utils.F
+++ b/src/atom_utils.F
@ -2549,7 +2549,7 @@ CONTAINS
                           ja = ibptr(ia, la)
                           jb = ibptr(ib, lb)
                           smat(ja:ja + nna - 1, jb:jb + nnb - 1) = smat(ja:ja + nna - 1, jb:jb + nnb - 1) + sab(1:nna, 1:nnb)
-                        ELSE IF (basis%basis_type == CGTO_BASIS) THEN
+                        ELSEIF (basis%basis_type == CGTO_BASIS) THEN
                           DO ka = 1, basis%nbas(la)
                              DO kb = 1, basis%nbas(lb)
                                 ja = ibptr(ka, la)
@ -2572,7 +2572,7 @@ CONTAINS
                                    jb = ibptr(ib, lb)
                                    smat(ja:ja + nna - 1, jb:jb + nnb - 1) = smat(ja:ja + nna - 1, jb:jb + nnb - 1) &
                                                                             + sab(1:nna, 1:nnb)
-                                 ELSE IF (basis%basis_type == CGTO_BASIS) THEN
+                                 ELSEIF (basis%basis_type == CGTO_BASIS) THEN
                                    DO ka = 1, basis%nbas(la)
                                       DO kb = 1, basis%nbas(lb)
                                          ja = ibptr(ka, la)
--- a/src/atoms_input.F
+++ b/src/atoms_input.F
@ -144,9 +144,8 @@ CONTAINS
                     EXIT
                  END IF
               END DO
-               IF (LEN_TRIM(line_att(start_c:end_c - 1)) == 0) THEN
+               IF (LEN_TRIM(line_att(start_c:end_c - 1)) == 0) &
                  CPABORT("incorrectly formatted line in coord section'"//line_att//"'")
               END IF
               IF (wrd == 1) THEN
                  atom_info%id_atmname(iatom) = str2id(s2s(line_att(start_c:end_c - 1)))
               ELSE
@ -196,26 +195,24 @@ CONTAINS
                     EXIT
                  END IF
               END DO
-               IF (LEN_TRIM(line_att(start_c:end_c - 1)) == 0) THEN
+               IF (LEN_TRIM(line_att(start_c:end_c - 1)) == 0) &
                  CALL cp_abort(__LOCATION__, &
                                "Incorrectly formatted input line for atom "// &
                                TRIM(ADJUSTL(cp_to_string(iatom)))// &
                                " found in COORD section. Input line: <"// &
                                TRIM(line_att)//"> ")
               END IF
               SELECT CASE (wrd)
               CASE (1)
                  atom_info%id_atmname(iatom) = str2id(s2s(line_att(start_c:end_c - 1)))
               CASE (2:4)
                  CALL read_float_object(line_att(start_c:end_c - 1), &
                                         atom_info%r(wrd - 1, iatom), error_message)
-                  IF (LEN_TRIM(error_message) /= 0) THEN
+                  IF (LEN_TRIM(error_message) /= 0) &
                     CALL cp_abort(__LOCATION__, &
                                   "Incorrectly formatted input line for atom "// &
                                   TRIM(ADJUSTL(cp_to_string(iatom)))// &
                                   " found in COORD section. "//TRIM(error_message)// &
                                   " Input line: <"//TRIM(line_att)//"> ")
                  END IF
               CASE (5)
                  READ (line_att(start_c:end_c - 1), *) strtmp
                  atom_info%id_molname(iatom) = str2id(strtmp)
@ -346,9 +343,8 @@ CONTAINS
                     EXIT
                  END IF
               END DO
-               IF (wrd /= 5 .AND. end_c >= LEN(line_att) + 1) THEN
+               IF (wrd /= 5 .AND. end_c >= LEN(line_att) + 1) &
                  CPABORT("incorrectly formatted line in coord section'"//line_att//"'")
               END IF
               IF (wrd == 1) THEN
                  at_name(ishell) = line_att(start_c:end_c - 1)
                  CALL uppercase(at_name(ishell))
@ -397,9 +393,8 @@ CONTAINS
                           EXIT
                        END IF
                     END DO
-                     IF (wrd /= 5 .AND. end_c >= LEN(line_att) + 1) THEN
+                     IF (wrd /= 5 .AND. end_c >= LEN(line_att) + 1) &
                        CPABORT("incorrectly formatted line in coord section'"//line_att//"'")
                     END IF
                     IF (wrd == 1) THEN
                        at_name_c(ishell) = line_att(start_c:end_c - 1)
                        CALL uppercase(at_name_c(ishell))
--- a/src/auto_basis.F
+++ b/src/auto_basis.F
@ -61,7 +61,7 @@ CONTAINS
      INTEGER, INTENT(IN), OPTIONAL                      :: basis_sort
      CHARACTER(LEN=2)                                   :: element_symbol
-      CHARACTER(LEN=default_string_length)               :: bsname, kname
+      CHARACTER(LEN=default_string_length)               :: bsname
      INTEGER                                            :: i, j, jj, l, laux, linc, lmax, lval, lx, &
                                                            nsets, nx, z
      INTEGER, DIMENSION(0:18)                           :: nval
@ -84,7 +84,7 @@ CONTAINS
                  2.0_dp, 2.0_dp, 2.0_dp, 2.0_dp, 2.0_dp, 2.0_dp, 2.0_dp, 2.0_dp]
      !
      CPASSERT(.NOT. ASSOCIATED(ri_aux_basis_set))
-      NULLIFY (orb_basis_set, econf)
+      NULLIFY (orb_basis_set)
      IF (.NOT. PRESENT(basis_type)) THEN
         CALL get_qs_kind(qs_kind, basis_set=orb_basis_set, basis_type="ORB")
      ELSE
@ -106,15 +106,6 @@ CONTAINS
         CALL init_orbital_pointers(2*lmax)
         CALL get_basis_products(lmax, zmin, zmax, zeff, pmin, pmax, peff)
         CALL get_qs_kind(qs_kind, zeff=zval, elec_conf=econf, element_symbol=element_symbol)
         IF (.NOT. ASSOCIATED(econf)) THEN
            CALL get_qs_kind(qs_kind, name=kname)
            CALL cp_abort(__LOCATION__, &
                          "AUTO_BASIS RI_AUX cannot process atom kind "// &
                          "<"//TRIM(ADJUSTL(kname))//"> due to missing "// &
                          "definition of potential or electron configuration; "// &
                          "consider setting keyword ELEC_CONF explicitly for "// &
                          "GHOST atom kind that has assigned a basis set")
         END IF
         CALL get_ptable_info(element_symbol, ielement=z)
         lval = 0
         DO l = 0, MAXVAL(UBOUND(econf))
@ -245,7 +236,7 @@ CONTAINS
      LOGICAL, INTENT(IN), OPTIONAL                      :: exact_1c_terms, tda_kernel
      CHARACTER(LEN=2)                                   :: element_symbol
-      CHARACTER(LEN=default_string_length)               :: bsname, kname
+      CHARACTER(LEN=default_string_length)               :: bsname
      INTEGER                                            :: i, j, l, laux, linc, lm, lmax, lval, n1, &
                                                            n2, nsets, z
      INTEGER, DIMENSION(0:18)                           :: nval
@ -276,21 +267,12 @@ CONTAINS
      END IF
      !
      CPASSERT(.NOT. ASSOCIATED(lri_aux_basis_set))
-      NULLIFY (orb_basis_set, econf)
+      NULLIFY (orb_basis_set)
      CALL get_qs_kind(qs_kind, basis_set=orb_basis_set, basis_type="ORB")
      IF (ASSOCIATED(orb_basis_set)) THEN
         CALL get_basis_keyfigures(orb_basis_set, lmax, zmin, zmax, zeff)
         CALL get_basis_products(lmax, zmin, zmax, zeff, pmin, pmax, peff)
         CALL get_qs_kind(qs_kind, zeff=zval, elec_conf=econf, element_symbol=element_symbol)
         IF (.NOT. ASSOCIATED(econf)) THEN
            CALL get_qs_kind(qs_kind, name=kname)
            CALL cp_abort(__LOCATION__, &
                          "AUTO_BASIS LRI_AUX cannot process atom kind "// &
                          "<"//TRIM(ADJUSTL(kname))//"> due to missing "// &
                          "definition of potential or electron configuration; "// &
                          "consider setting keyword ELEC_CONF explicitly for "// &
                          "GHOST atom kind that has assigned a basis set")
         END IF
         CALL get_ptable_info(element_symbol, ielement=z)
         lval = 0
         DO l = 0, MAXVAL(UBOUND(econf))
--- a/src/base/base_hooks.F
+++ b/src/base/base_hooks.F
@ -145,9 +145,8 @@ CONTAINS
      IF (ASSOCIATED(timestop_hook)) THEN
         CALL timestop_hook(handle)
      ELSE
-         IF (handle /= -1) THEN
+         IF (handle /= -1) &
            CALL cp_abort(cp__l("base_hooks.F", __LINE__), "Got wrong handle")
         END IF
      END IF
   END SUBROUTINE timestop
--- a/src/base/machine.F
+++ b/src/base/machine.F
@ -741,17 +741,14 @@ CONTAINS
      ! on a posix system LOGNAME should be defined
      CALL get_environment_variable("LOGNAME", value=user, status=istat)
      ! nope, check alternative
-      IF (istat /= 0) THEN
+      IF (istat /= 0) &
         CALL get_environment_variable("USER", value=user, status=istat)
      END IF
      ! nope, check alternative
-      IF (istat /= 0) THEN
+      IF (istat /= 0) &
         CALL get_environment_variable("USERNAME", value=user, status=istat)
      END IF
      ! fall back
-      IF (istat /= 0) THEN
+      IF (istat /= 0) &
         user = "<unknown>"
      END IF
   END SUBROUTINE m_getlog
--- a/src/bse_full_diag.F
+++ b/src/bse_full_diag.F
@ -22,10 +22,8 @@ MODULE bse_full_diag
                                              exciton_descr_type,&
                                              get_exciton_descriptors,&
                                              get_oscillator_strengths
-   USE bse_util,                        ONLY: assemble_joint_ov_slab,&
+   USE bse_util,                        ONLY: comp_eigvec_coeff_BSE,&
                                              comp_eigvec_coeff_BSE,&
                                              fm_general_add_bse,&
                                              get_bse_spin_block_layout,&
                                              get_multipoles_mo,&
                                              reshuffle_eigvec
   USE cp_blacs_env,                    ONLY: cp_blacs_env_create,&
@ -41,11 +39,9 @@ MODULE bse_full_diag
                                              cp_fm_struct_type
   USE cp_fm_types,                     ONLY: cp_fm_create,&
                                              cp_fm_get_info,&
                                              cp_fm_get_submatrix,&
                                              cp_fm_release,&
                                              cp_fm_set_all,&
                                              cp_fm_to_fm,&
                                              cp_fm_to_fm_submat,&
                                              cp_fm_type
   USE exstates_types,                  ONLY: excited_energy_type
   USE input_constants,                 ONLY: bse_screening_alpha,&
@ -96,44 +92,32 @@ CONTAINS
                       homo, virtual, dimen_RI, mp2_env, &
                       para_env, qs_env)
-      TYPE(cp_fm_type), DIMENSION(:), INTENT(IN)         :: fm_mat_S_ia_bse, fm_mat_S_bar_ij_bse, &
+      TYPE(cp_fm_type), INTENT(IN)                       :: fm_mat_S_ia_bse, fm_mat_S_bar_ij_bse, &
                                                            fm_mat_S_ab_bse
      TYPE(cp_fm_type), INTENT(INOUT)                    :: fm_A
-      REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: Eigenval
+      REAL(KIND=dp), DIMENSION(:)                        :: Eigenval
-      INTEGER, INTENT(IN)                                :: unit_nr
+      INTEGER, INTENT(IN)                                :: unit_nr, homo, virtual, dimen_RI
      INTEGER, DIMENSION(:), INTENT(IN)                  :: homo, virtual
      INTEGER, INTENT(IN)                                :: dimen_RI
      TYPE(mp2_type), INTENT(INOUT)                      :: mp2_env
      TYPE(mp_para_env_type), INTENT(INOUT)              :: para_env
      TYPE(qs_environment_type), POINTER                 :: qs_env
      CHARACTER(LEN=*), PARAMETER                        :: routineN = 'create_A'
-      INTEGER :: a_virt_row, handle, i_occ_row, i_row_global, ii, isp, j_col_global, jj, k_isp, &
+      INTEGER                                            :: a_virt_row, handle, i_occ_row, &
-         k_ov, n_ov_joint, ncol_local_A, nrow_local_A, nspins, sizeeigen
+                                                            i_row_global, ii, j_col_global, jj, &
-      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: eig_offsets, n_ov, offsets
+                                                            ncol_local_A, nrow_local_A, sizeeigen
      INTEGER, DIMENSION(4)                              :: reordering
      INTEGER, DIMENSION(:), POINTER                     :: col_indices_A, row_indices_A
      REAL(KIND=dp)                                      :: alpha, alpha_screening, eigen_diff
      TYPE(cp_blacs_env_type), POINTER                   :: blacs_env
-      TYPE(cp_fm_struct_type), POINTER                   :: fm_struct_A, fm_struct_S_joint, &
+      TYPE(cp_fm_struct_type), POINTER                   :: fm_struct_A, fm_struct_W
-                                                            fm_struct_W
+      TYPE(cp_fm_type)                                   :: fm_A_copy, fm_W
      TYPE(cp_fm_type)                                   :: fm_A_copy, fm_S_joint, fm_W
      TYPE(dft_control_type), POINTER                    :: dft_control
      TYPE(excited_energy_type), POINTER                 :: ex_env
      TYPE(tddfpt2_control_type), POINTER                :: tddfpt_control
      CALL timeset(routineN, handle)
      nspins = SIZE(homo)
      ALLOCATE (n_ov(nspins), offsets(nspins), eig_offsets(nspins))
      CALL get_bse_spin_block_layout(homo, virtual, n_ov, offsets, n_ov_joint)
      ! Flat Eigenval layout: sigma-block isp at eig_offsets(isp)+1 .. eig_offsets(isp)+homo(isp)+virtual(isp)
      eig_offsets(1) = 0
      DO isp = 2, nspins
         eig_offsets(isp) = eig_offsets(isp - 1) + homo(isp - 1) + virtual(isp - 1)
      END DO
      NULLIFY (dft_control, tddfpt_control)
      CALL get_qs_env(qs_env, dft_control=dft_control)
      tddfpt_control => dft_control%tddfpt2_control
@ -149,12 +133,6 @@ CONTAINS
      CASE (bse_triplet)
         alpha = 0.0_dp
      END SELECT
      ! For open-shell (nspins>1): each spin block contributes once; SPIN_CONFIG is ignored.
      IF (nspins > 1) THEN
         CALL cp_warn(__LOCATION__, &
                      "BSE: SPIN_CONFIG ignored for open-shell reference; using alpha=1.")
         alpha = 1.0_dp
      END IF
      IF (mp2_env%bse%screening_method == bse_screening_alpha) THEN
         alpha_screening = mp2_env%bse%screening_factor
@ -171,141 +149,115 @@ CONTAINS
      ! We create v_ia,jb and W_ij,ab, then we communicate entries from local W_ij,ab
      ! to the full matrix v_ia,jb. By adding these and the energy diffenences: v_ia,jb -> A_ia,jb
      ! We use the A matrix already from the start instead of v
-      CALL cp_fm_struct_create(fm_struct_A, context=fm_mat_S_ia_bse(1)%matrix_struct%context, &
+      CALL cp_fm_struct_create(fm_struct_A, context=fm_mat_S_ia_bse%matrix_struct%context, nrow_global=homo*virtual, &
-                               nrow_global=n_ov_joint, ncol_global=n_ov_joint, &
+                               ncol_global=homo*virtual, para_env=fm_mat_S_ia_bse%matrix_struct%para_env)
                               para_env=fm_mat_S_ia_bse(1)%matrix_struct%para_env)
      CALL cp_fm_create(fm_A, fm_struct_A, name="fm_A_iajb")
      CALL cp_fm_set_all(fm_A, 0.0_dp)
-      ! fm_A_copy only used in the TDDFPT do_bse_w_only path (closed-shell only)
+      IF (tddfpt_control%do_bse_w_only) THEN
      IF (tddfpt_control%do_bse_w_only .AND. nspins == 1) THEN
         CALL cp_fm_create(fm_A_copy, fm_struct_A, name="fm_A_iajb")
         CALL cp_fm_set_all(fm_A_copy, 0.0_dp)
      END IF
-      ! Create A matrix from GW Energies, v_ia,jb and W_ij,ab
+      CALL cp_fm_struct_create(fm_struct_W, context=fm_mat_S_ab_bse%matrix_struct%context, nrow_global=homo**2, &
-      ! v_ia,jb = \sum_P B^P_ia B^P_jb  (Coulomb)
+                               ncol_global=virtual**2, para_env=fm_mat_S_ab_bse%matrix_struct%para_env)
      CALL cp_fm_create(fm_W, fm_struct_W, name="fm_W_ijab")
      CALL cp_fm_set_all(fm_W, 0.0_dp)
      ! Create A matrix from GW Energies, v_ia,jb and W_ij,ab (different blacs_env!)
      ! v_ia,jb, which is directly initialized in A (with a factor of alpha)
      ! v_ia,jb = \sum_P B^P_ia B^P_jb
      IF ((.NOT. tddfpt_control%do_bse) .AND. (.NOT. tddfpt_control%do_bse_w_only)) THEN
-         IF (nspins > 1) THEN
+         CALL parallel_gemm(transa="T", transb="N", m=homo*virtual, n=homo*virtual, k=dimen_RI, alpha=alpha, &
-            ! Assemble joint ia-slab for a single Coulomb gemm across all spin blocks
+                            matrix_a=fm_mat_S_ia_bse, matrix_b=fm_mat_S_ia_bse, beta=0.0_dp, &
-            CALL cp_fm_struct_create(fm_struct_S_joint, &
+                            matrix_c=fm_A)
                                     context=fm_mat_S_ia_bse(1)%matrix_struct%context, &
                                     nrow_global=dimen_RI, ncol_global=n_ov_joint, &
                                     para_env=fm_mat_S_ia_bse(1)%matrix_struct%para_env)
            CALL cp_fm_create(fm_S_joint, fm_struct_S_joint, name="fm_S_ia_joint")
            CALL cp_fm_set_all(fm_S_joint, 0.0_dp)
            CALL assemble_joint_ov_slab(fm_mat_S_ia_bse, offsets, n_ov, dimen_RI, fm_S_joint)
            CALL parallel_gemm(transa="T", transb="N", m=n_ov_joint, n=n_ov_joint, k=dimen_RI, &
                               alpha=alpha, matrix_a=fm_S_joint, matrix_b=fm_S_joint, beta=0.0_dp, &
                               matrix_c=fm_A)
            CALL cp_fm_release(fm_S_joint)
            CALL cp_fm_struct_release(fm_struct_S_joint)
         ELSE
            CALL parallel_gemm(transa="T", transb="N", m=homo(1)*virtual(1), n=homo(1)*virtual(1), &
                               k=dimen_RI, alpha=alpha, &
                               matrix_a=fm_mat_S_ia_bse(1), matrix_b=fm_mat_S_ia_bse(1), &
                               beta=0.0_dp, matrix_c=fm_A)
         END IF
      END IF
      IF (unit_nr > 0 .AND. mp2_env%bse%bse_debug_print) THEN
         WRITE (unit_nr, '(T2,A10,T13,A16)') 'BSE|DEBUG|', 'Allocated A_iajb'
      END IF
-      ! W term on sigma-diagonal blocks only: W^sigma_ij,ab = sum_P barB^P_ij B^P_ab
+      ! If infinite screening is applied, fm_W is simply 0 - Otherwise it needs to be computed from 3c integrals
-      ! offsets(isp) places each block at the correct position in joint A.
+      IF (mp2_env%bse%screening_method /= bse_screening_rpa) THEN
-      ! For nspins=1: offsets(1)=0, equivalent to the original code.
+         !W_ij,ab = \sum_P \bar{B}^P_ij B^P_ab
-      DO isp = 1, nspins
+         CALL parallel_gemm(transa="T", transb="N", m=homo**2, n=virtual**2, k=dimen_RI, alpha=alpha_screening, &
-         IF (mp2_env%bse%screening_method /= bse_screening_rpa) THEN
+                            matrix_a=fm_mat_S_bar_ij_bse, matrix_b=fm_mat_S_ab_bse, beta=0.0_dp, &
-            CALL cp_fm_struct_create(fm_struct_W, context=fm_mat_S_ab_bse(isp)%matrix_struct%context, &
+                            matrix_c=fm_W)
-                                     nrow_global=homo(isp)**2, ncol_global=virtual(isp)**2, &
+      END IF
                                     para_env=fm_mat_S_ab_bse(isp)%matrix_struct%para_env)
            CALL cp_fm_create(fm_W, fm_struct_W, name="fm_W_ijab")
            CALL cp_fm_set_all(fm_W, 0.0_dp)
            !W_ij,ab = \sum_P \bar{B}^P_ij B^P_ab
            CALL parallel_gemm(transa="T", transb="N", m=homo(isp)**2, n=virtual(isp)**2, &
                               k=dimen_RI, alpha=alpha_screening, &
                               matrix_a=fm_mat_S_bar_ij_bse(isp), matrix_b=fm_mat_S_ab_bse(isp), &
                               beta=0.0_dp, matrix_c=fm_W)
            reordering = [1, 3, 2, 4]
            CALL fm_general_add_bse(fm_A, fm_W, -1.0_dp, homo(isp), virtual(isp), &
                                    virtual(isp), virtual(isp), unit_nr, reordering, mp2_env, &
                                    row_offset=offsets(isp), col_offset=offsets(isp))
            IF (nspins == 1 .AND. tddfpt_control%do_bse_w_only) THEN
               CALL fm_general_add_bse(fm_A_copy, fm_W, -1.0_dp, homo(1), virtual(1), &
                                       virtual(1), virtual(1), unit_nr, reordering, mp2_env)
            END IF
            ! W and A stash for TDDFPT path (closed-shell only; open-shell deferred)
            IF (nspins == 1) THEN
               IF (tddfpt_control%do_bse .OR. tddfpt_control%do_bse_w_only .OR. &
                   tddfpt_control%do_bse_gw_only) THEN
                  NULLIFY (ex_env)
                  CALL get_qs_env(qs_env, exstate_env=ex_env)
                  IF (.NOT. tddfpt_control%do_bse_gw_only) THEN
                     ALLOCATE (ex_env%bse_w_matrix_MO(1, 1))
                     ALLOCATE (ex_env%bse_a_matrix_MO(1, 1))
                     CALL cp_fm_create(ex_env%bse_w_matrix_MO(1, 1), fm_struct_W)
                     CALL cp_fm_create(ex_env%bse_a_matrix_MO(1, 1), fm_struct_A)
                     CALL cp_fm_to_fm(fm_W, ex_env%bse_w_matrix_MO(1, 1))
                     IF (tddfpt_control%do_bse_w_only) THEN
                        CALL cp_fm_to_fm(fm_A_copy, ex_env%bse_a_matrix_MO(1, 1))
                     ELSE
                        CALL cp_fm_to_fm(fm_A, ex_env%bse_a_matrix_MO(1, 1))
                     END IF
                  END IF
               END IF
            END IF
            CALL cp_fm_release(fm_W)
            CALL cp_fm_struct_release(fm_struct_W)
         END IF
      END DO
      IF (unit_nr > 0 .AND. mp2_env%bse%bse_debug_print) THEN
         WRITE (unit_nr, '(T2,A10,T13,A16)') 'BSE|DEBUG|', 'Allocated W_ijab'
      END IF
      IF (nspins == 1 .AND. tddfpt_control%do_bse_w_only) CALL cp_fm_release(fm_A_copy)
-      ! Get local row/col indices for direct diagonal access
+      ! We start by moving data from local parts of W_ij,ab to the full matrix A_ia,jb using buffers
-      CALL cp_fm_get_info(matrix=fm_A, nrow_local=nrow_local_A, ncol_local=ncol_local_A, &
+      CALL cp_fm_get_info(matrix=fm_A, &
-                          row_indices=row_indices_A, col_indices=col_indices_A)
+                          nrow_local=nrow_local_A, &
                          ncol_local=ncol_local_A, &
                          row_indices=row_indices_A, &
                          col_indices=col_indices_A)
      ! Writing -1.0_dp * W_ij,ab to A_ia,jb, i.e. beta = -1.0_dp,
      ! W_ij,ab: nrow_secidx_in  = homo,    ncol_secidx_in  = virtual
      ! A_ia,jb: nrow_secidx_out = virtual, ncol_secidx_out = virtual
-      !Add (ε_a-ε_i) on the diagonal of each sigma-block; cross-spin blocks have no ε contribution.
+      ! If infinite screening is applied, fm_W is simply 0 - Otherwise it needs to be computed from 3c integrals
      IF (mp2_env%bse%screening_method /= bse_screening_rpa) THEN
         reordering = [1, 3, 2, 4]
         CALL fm_general_add_bse(fm_A, fm_W, -1.0_dp, homo, virtual, &
                                 virtual, virtual, unit_nr, reordering, mp2_env)
         IF (tddfpt_control%do_bse_w_only) THEN
            CALL fm_general_add_bse(fm_A_copy, fm_W, -1.0_dp, homo, virtual, &
                                    virtual, virtual, unit_nr, reordering, mp2_env)
         END IF
      END IF
      !full matrix W is not needed anymore, release it to save memory
      IF (tddfpt_control%do_bse .OR. tddfpt_control%do_bse_w_only .OR. &
          tddfpt_control%do_bse_gw_only) THEN
         NULLIFY (ex_env)
         CALL get_qs_env(qs_env, exstate_env=ex_env)
         IF (.NOT. tddfpt_control%do_bse_gw_only) THEN
            ALLOCATE (ex_env%bse_w_matrix_MO(1, 1)) ! for now only closed-shell
            ALLOCATE (ex_env%bse_a_matrix_MO(1, 1)) ! for now only closed-shell
            CALL cp_fm_create(ex_env%bse_w_matrix_MO(1, 1), fm_struct_W)
            CALL cp_fm_create(ex_env%bse_a_matrix_MO(1, 1), fm_struct_A)
            CALL cp_fm_to_fm(fm_W, ex_env%bse_w_matrix_MO(1, 1))
            IF (tddfpt_control%do_bse_w_only) THEN
               CALL cp_fm_to_fm(fm_A_copy, ex_env%bse_a_matrix_MO(1, 1))
            ELSE
               CALL cp_fm_to_fm(fm_A, ex_env%bse_a_matrix_MO(1, 1))
            END IF
         END IF
      END IF
      CALL cp_fm_release(fm_W)
      IF (tddfpt_control%do_bse_w_only) CALL cp_fm_release(fm_A_copy)
      !Now add the energy differences (ε_a-ε_i) on the diagonal (i.e. δ_ij δ_ab) of A_ia,jb
      IF (.NOT. tddfpt_control%do_bse) THEN
-         DO ii = 1, nrow_local_A
+      DO ii = 1, nrow_local_A
-            i_row_global = row_indices_A(ii)
+
-            DO jj = 1, ncol_local_A
+         i_row_global = row_indices_A(ii)
-               j_col_global = col_indices_A(jj)
+
-               IF (i_row_global == j_col_global) THEN
+         DO jj = 1, ncol_local_A
-                  ! Decode spin: isp such that i_row_global in [offsets(isp)+1, offsets(isp)+n_ov(isp)]
+
-                  isp = nspins
+            j_col_global = col_indices_A(jj)
-                  DO k_isp = 1, nspins - 1
+
-                     IF (i_row_global <= offsets(k_isp) + n_ov(k_isp)) THEN
+            IF (i_row_global == j_col_global) THEN
-                        isp = k_isp
+               i_occ_row = (i_row_global - 1)/virtual + 1
-                        EXIT
+               a_virt_row = MOD(i_row_global - 1, virtual) + 1
-                     END IF
+               eigen_diff = Eigenval(a_virt_row + homo) - Eigenval(i_occ_row)
-                  END DO
+               fm_A%local_data(ii, jj) = fm_A%local_data(ii, jj) + eigen_diff
-                  k_ov = i_row_global - offsets(isp)
+
-                  i_occ_row = (k_ov - 1)/virtual(isp) + 1
+            END IF
                  a_virt_row = MOD(k_ov - 1, virtual(isp)) + 1
                  eigen_diff = Eigenval(eig_offsets(isp) + a_virt_row + homo(isp)) - &
                               Eigenval(eig_offsets(isp) + i_occ_row)
                  fm_A%local_data(ii, jj) = fm_A%local_data(ii, jj) + eigen_diff
               END IF
            END DO
         END DO
      END DO
      END IF
-      ! GW eigenvalue stash for TDDFPT path (closed-shell only)
+      IF (tddfpt_control%do_bse .OR. tddfpt_control%do_bse_w_only .OR. tddfpt_control%do_bse_gw_only) THEN
-      IF (nspins == 1) THEN
+         sizeeigen = SIZE(Eigenval)
-         IF (tddfpt_control%do_bse .OR. tddfpt_control%do_bse_w_only .OR. &
+         ALLOCATE (ex_env%gw_eigen(sizeeigen)) ! for now only closed-shell
-             tddfpt_control%do_bse_gw_only) THEN
+         ex_env%gw_eigen(:) = Eigenval(:)
            sizeeigen = SIZE(Eigenval)
            ALLOCATE (ex_env%gw_eigen(sizeeigen))
            ex_env%gw_eigen(:) = Eigenval(:)
         END IF
      END IF
      CALL cp_fm_struct_release(fm_struct_A)
-      DEALLOCATE (n_ov, offsets, eig_offsets)
+      CALL cp_fm_struct_release(fm_struct_W)
      CALL cp_blacs_env_release(blacs_env)
@ -331,41 +283,32 @@ CONTAINS
   SUBROUTINE create_B(fm_mat_S_ia_bse, fm_mat_S_bar_ia_bse, fm_B, &
                       homo, virtual, dimen_RI, unit_nr, mp2_env)
-      TYPE(cp_fm_type), DIMENSION(:), INTENT(IN)         :: fm_mat_S_ia_bse, fm_mat_S_bar_ia_bse
+      TYPE(cp_fm_type), INTENT(IN)                       :: fm_mat_S_ia_bse, fm_mat_S_bar_ia_bse
      TYPE(cp_fm_type), INTENT(INOUT)                    :: fm_B
-      INTEGER, DIMENSION(:), INTENT(IN)                  :: homo, virtual
+      INTEGER, INTENT(IN)                                :: homo, virtual, dimen_RI, unit_nr
      INTEGER, INTENT(IN)                                :: dimen_RI, unit_nr
      TYPE(mp2_type), INTENT(INOUT)                      :: mp2_env
      CHARACTER(LEN=*), PARAMETER                        :: routineN = 'create_B'
-      INTEGER                                            :: handle, isp, n_ov_joint, nspins
+      INTEGER                                            :: handle
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: n_ov, offsets
      INTEGER, DIMENSION(4)                              :: reordering
      REAL(KIND=dp)                                      :: alpha, alpha_screening
-      TYPE(cp_fm_struct_type), POINTER                   :: fm_struct_B, fm_struct_S_joint, &
+      TYPE(cp_fm_struct_type), POINTER                   :: fm_struct_v
-                                                            fm_struct_W
+      TYPE(cp_fm_type)                                   :: fm_W
      TYPE(cp_fm_type)                                   :: fm_S_joint, fm_W
      CALL timeset(routineN, handle)
      nspins = SIZE(homo)
      ALLOCATE (n_ov(nspins), offsets(nspins))
      CALL get_bse_spin_block_layout(homo, virtual, n_ov, offsets, n_ov_joint)
      IF (unit_nr > 0 .AND. mp2_env%bse%bse_debug_print) THEN
         WRITE (unit_nr, '(T2,A10,T13,A10)') 'BSE|DEBUG|', 'Creating B'
      END IF
-      ! Coulomb prefactor: SPIN_CONFIG sector for closed shell; for open shell each spin block
+      ! Determines factor of exchange term, depending on requested spin configuration (cf. input_constants.F)
      ! contributes once (alpha=1). create_A already emits the SPIN_CONFIG-ignored warning.
      SELECT CASE (mp2_env%bse%bse_spin_config)
      CASE (bse_singlet)
         alpha = 2.0_dp
      CASE (bse_triplet)
         alpha = 0.0_dp
      END SELECT
      IF (nspins > 1) alpha = 1.0_dp
      IF (mp2_env%bse%screening_method == bse_screening_alpha) THEN
         alpha_screening = mp2_env%bse%screening_factor
@ -373,68 +316,40 @@ CONTAINS
         alpha_screening = 1.0_dp
      END IF
-      ! Joint B over all spin blocks: B_ia,jb = alpha*(ia|bj) - W^sigma_ib,aj (W spin-diagonal)
+      CALL cp_fm_struct_create(fm_struct_v, context=fm_mat_S_ia_bse%matrix_struct%context, nrow_global=homo*virtual, &
-      NULLIFY (fm_struct_B)
+                               ncol_global=homo*virtual, para_env=fm_mat_S_ia_bse%matrix_struct%para_env)
-      CALL cp_fm_struct_create(fm_struct_B, context=fm_mat_S_ia_bse(1)%matrix_struct%context, &
+      CALL cp_fm_create(fm_B, fm_struct_v, name="fm_B_iajb")
                               nrow_global=n_ov_joint, ncol_global=n_ov_joint, &
                               para_env=fm_mat_S_ia_bse(1)%matrix_struct%para_env)
      CALL cp_fm_create(fm_B, fm_struct_B, name="fm_B_iajb")
      CALL cp_fm_set_all(fm_B, 0.0_dp)
-      ! Coulomb v_ia,jb = sum_P B^P_ia B^P_jb (= (ia|bj)); cross-spin blocks filled automatically.
+      CALL cp_fm_create(fm_W, fm_struct_v, name="fm_W_ibaj")
-      IF (nspins > 1) THEN
+      CALL cp_fm_set_all(fm_W, 0.0_dp)
         NULLIFY (fm_struct_S_joint)
         CALL cp_fm_struct_create(fm_struct_S_joint, &
                                  context=fm_mat_S_ia_bse(1)%matrix_struct%context, &
                                  nrow_global=dimen_RI, ncol_global=n_ov_joint, &
                                  para_env=fm_mat_S_ia_bse(1)%matrix_struct%para_env)
         CALL cp_fm_create(fm_S_joint, fm_struct_S_joint, name="fm_S_ia_joint")
         CALL cp_fm_set_all(fm_S_joint, 0.0_dp)
         CALL assemble_joint_ov_slab(fm_mat_S_ia_bse, offsets, n_ov, dimen_RI, fm_S_joint)
         CALL parallel_gemm(transa="T", transb="N", m=n_ov_joint, n=n_ov_joint, k=dimen_RI, &
                            alpha=alpha, matrix_a=fm_S_joint, matrix_b=fm_S_joint, beta=0.0_dp, &
                            matrix_c=fm_B)
         CALL cp_fm_release(fm_S_joint)
         CALL cp_fm_struct_release(fm_struct_S_joint)
      ELSE
         CALL parallel_gemm(transa="T", transb="N", m=homo(1)*virtual(1), n=homo(1)*virtual(1), &
                            k=dimen_RI, alpha=alpha, &
                            matrix_a=fm_mat_S_ia_bse(1), matrix_b=fm_mat_S_ia_bse(1), &
                            beta=0.0_dp, matrix_c=fm_B)
      END IF
      IF (unit_nr > 0 .AND. mp2_env%bse%bse_debug_print) THEN
         WRITE (unit_nr, '(T2,A10,T13,A16)') 'BSE|DEBUG|', 'Allocated B_iajb'
      END IF
      ! v_ia,jb = \sum_P B^P_ia B^P_jb
      CALL parallel_gemm(transa="T", transb="N", m=homo*virtual, n=homo*virtual, k=dimen_RI, alpha=alpha, &
                         matrix_a=fm_mat_S_ia_bse, matrix_b=fm_mat_S_ia_bse, beta=0.0_dp, &
                         matrix_c=fm_B)
-      ! W^sigma_ib,aj = sum_P barB^P_ib B^P_aj on sigma-diagonal blocks only (offsets place them).
+      ! If infinite screening is applied, fm_W is simply 0 - Otherwise it needs to be computed from 3c integrals
      ! reordering [1,4,3,2] maps W_ib,ja -> B_ia,jb. For nspins=1: offsets(1)=0 (original code).
      IF (mp2_env%bse%screening_method /= bse_screening_rpa) THEN
-         DO isp = 1, nspins
+         ! W_ib,aj = \sum_P \bar{B}^P_ib B^P_aj
-            NULLIFY (fm_struct_W)
+         CALL parallel_gemm(transa="T", transb="N", m=homo*virtual, n=homo*virtual, k=dimen_RI, alpha=alpha_screening, &
-            CALL cp_fm_struct_create(fm_struct_W, &
+                            matrix_a=fm_mat_S_bar_ia_bse, matrix_b=fm_mat_S_ia_bse, beta=0.0_dp, &
-                                     context=fm_mat_S_ia_bse(isp)%matrix_struct%context, &
+                            matrix_c=fm_W)
-                                     nrow_global=homo(isp)*virtual(isp), &
+
-                                     ncol_global=homo(isp)*virtual(isp), &
+         ! from W_ib,ja to A_ia,jb (formally: W_ib,aj, but our internal indexorder is different)
-                                     para_env=fm_mat_S_ia_bse(isp)%matrix_struct%para_env)
+         ! Writing -1.0_dp * W_ib,ja to A_ia,jb, i.e. beta = -1.0_dp,
-            CALL cp_fm_create(fm_W, fm_struct_W, name="fm_W_ibaj")
+         ! W_ib,ja: nrow_secidx_in  = virtual,    ncol_secidx_in  = virtual
-            CALL cp_fm_set_all(fm_W, 0.0_dp)
+         ! A_ia,jb: nrow_secidx_out = virtual, ncol_secidx_out = virtual
-            CALL parallel_gemm(transa="T", transb="N", m=homo(isp)*virtual(isp), &
+         reordering = [1, 4, 3, 2]
-                               n=homo(isp)*virtual(isp), k=dimen_RI, alpha=alpha_screening, &
+         CALL fm_general_add_bse(fm_B, fm_W, -1.0_dp, virtual, virtual, &
-                               matrix_a=fm_mat_S_bar_ia_bse(isp), matrix_b=fm_mat_S_ia_bse(isp), &
+                                 virtual, virtual, unit_nr, reordering, mp2_env)
                               beta=0.0_dp, matrix_c=fm_W)
            reordering = [1, 4, 3, 2]
            CALL fm_general_add_bse(fm_B, fm_W, -1.0_dp, virtual(isp), virtual(isp), &
                                    virtual(isp), virtual(isp), unit_nr, reordering, mp2_env, &
                                    row_offset=offsets(isp), col_offset=offsets(isp))
            CALL cp_fm_release(fm_W)
            CALL cp_fm_struct_release(fm_struct_W)
         END DO
      END IF
-      CALL cp_fm_struct_release(fm_struct_B)
+      CALL cp_fm_release(fm_W)
-      DEALLOCATE (n_ov, offsets)
+      CALL cp_fm_struct_release(fm_struct_v)
      CALL timestop(handle)
   END SUBROUTINE create_B
@ -449,18 +364,20 @@ CONTAINS
 !> \param fm_C ...
 !> \param fm_sqrt_A_minus_B ...
 !> \param fm_inv_sqrt_A_minus_B ...
 !> \param homo ...
 !> \param virtual ...
 !> \param unit_nr ...
 !> \param mp2_env ...
 !> \param diag_est ...
 ! **************************************************************************************************
   SUBROUTINE create_hermitian_form_of_ABBA(fm_A, fm_B, fm_C, &
                                            fm_sqrt_A_minus_B, fm_inv_sqrt_A_minus_B, &
-                                            unit_nr, mp2_env, diag_est)
+                                            homo, virtual, unit_nr, mp2_env, diag_est)
      TYPE(cp_fm_type), INTENT(IN)                       :: fm_A, fm_B
      TYPE(cp_fm_type), INTENT(INOUT)                    :: fm_C, fm_sqrt_A_minus_B, &
                                                            fm_inv_sqrt_A_minus_B
-      INTEGER, INTENT(IN)                                :: unit_nr
+      INTEGER, INTENT(IN)                                :: homo, virtual, unit_nr
      TYPE(mp2_type), INTENT(INOUT)                      :: mp2_env
      REAL(KIND=dp), INTENT(IN)                          :: diag_est
@ -529,7 +446,7 @@ CONTAINS
      ! We keep fm_inv_sqrt_A_minus_B for print of singleparticle transitions of ABBA
      ! We further create (A-B)^0.5 for the singleparticle transitions of ABBA
      ! Create (A-B)^0.5= (A-B)^-0.5 * (A-B) (EQ.Ia)
-      CALL cp_fm_get_info(fm_A, nrow_global=dim_mat)
+      dim_mat = homo*virtual
      CALL parallel_gemm("N", "N", dim_mat, dim_mat, dim_mat, 1.0_dp, fm_inv_sqrt_A_minus_B, fm_A_minus_B, 0.0_dp, &
                         fm_sqrt_A_minus_B)
@ -577,7 +494,7 @@ CONTAINS
                            unit_nr, diag_est, mp2_env, qs_env, mo_coeff)
      TYPE(cp_fm_type), INTENT(INOUT)                    :: fm_C
-      INTEGER, DIMENSION(:), INTENT(IN)                  :: homo, virtual, homo_irred
+      INTEGER, INTENT(IN)                                :: homo, virtual, homo_irred
      TYPE(cp_fm_type), INTENT(INOUT)                    :: fm_sqrt_A_minus_B, fm_inv_sqrt_A_minus_B
      INTEGER, INTENT(IN)                                :: unit_nr
      REAL(KIND=dp), INTENT(IN)                          :: diag_est
@ -587,7 +504,7 @@ CONTAINS
      CHARACTER(LEN=*), PARAMETER                        :: routineN = 'diagonalize_C'
-      INTEGER                                            :: diag_info, handle, n_ov_joint, nspins
+      INTEGER                                            :: diag_info, handle
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: Exc_ens
      TYPE(cp_fm_type)                                   :: fm_eigvec_X, fm_eigvec_Y, fm_eigvec_Z, &
                                                            fm_mat_eigvec_transform_diff, &
@ -595,9 +512,6 @@ CONTAINS
      CALL timeset(routineN, handle)
      nspins = SIZE(homo)
      n_ov_joint = SUM(homo*virtual)
      IF (unit_nr > 0) THEN
         WRITE (unit_nr, '(T2,A4,T7,A17,A22,ES6.0,A3)') 'BSE|', 'Diagonalizing C. ', &
            'This will take around ', diag_est, ' s.'
@ -607,7 +521,7 @@ CONTAINS
      !Now: Diagonalize it
      CALL cp_fm_create(fm_eigvec_Z, fm_C%matrix_struct)
-      ALLOCATE (Exc_ens(n_ov_joint))
+      ALLOCATE (Exc_ens(homo*virtual))
      CALL choose_eigv_solver(fm_C, fm_eigvec_Z, Exc_ens, diag_info)
@ -639,7 +553,7 @@ CONTAINS
      ! First, Eq. I from (A10) from Furche: (X+Y)_n = (Ω_n)^-0.5 (A-B)^0.5 T_n
      CALL cp_fm_create(fm_mat_eigvec_transform_sum, fm_C%matrix_struct)
      CALL cp_fm_set_all(fm_mat_eigvec_transform_sum, 0.0_dp)
-      CALL parallel_gemm(transa="N", transb="N", m=n_ov_joint, n=n_ov_joint, k=n_ov_joint, alpha=1.0_dp, &
+      CALL parallel_gemm(transa="N", transb="N", m=homo*virtual, n=homo*virtual, k=homo*virtual, alpha=1.0_dp, &
                         matrix_a=fm_sqrt_A_minus_B, matrix_b=fm_eigvec_Z, beta=0.0_dp, &
                         matrix_c=fm_mat_eigvec_transform_sum)
      CALL cp_fm_release(fm_sqrt_A_minus_B)
@ -649,7 +563,7 @@ CONTAINS
      ! Second, Eq. II from (A10) from Furche: (X-Y)_n = (Ω_n)^0.5 (A-B)^-0.5 T_n
      CALL cp_fm_create(fm_mat_eigvec_transform_diff, fm_C%matrix_struct)
      CALL cp_fm_set_all(fm_mat_eigvec_transform_diff, 0.0_dp)
-      CALL parallel_gemm(transa="N", transb="N", m=n_ov_joint, n=n_ov_joint, k=n_ov_joint, alpha=1.0_dp, &
+      CALL parallel_gemm(transa="N", transb="N", m=homo*virtual, n=homo*virtual, k=homo*virtual, alpha=1.0_dp, &
                         matrix_a=fm_inv_sqrt_A_minus_B, matrix_b=fm_eigvec_Z, beta=0.0_dp, &
                         matrix_c=fm_mat_eigvec_transform_diff)
      CALL cp_fm_release(fm_inv_sqrt_A_minus_B)
@ -674,15 +588,9 @@ CONTAINS
      CALL cp_fm_release(fm_mat_eigvec_transform_diff)
      CALL cp_fm_release(fm_mat_eigvec_transform_sum)
-      IF (nspins == 1) THEN
+      CALL postprocess_bse(Exc_ens, fm_eigvec_X, mp2_env, qs_env, mo_coeff, &
-         CALL postprocess_bse(Exc_ens, fm_eigvec_X, mp2_env, qs_env, mo_coeff, &
+                           homo, virtual, homo_irred, unit_nr, &
-                              homo(1), virtual(1), homo_irred(1), unit_nr, &
+                           .FALSE., fm_eigvec_Y)
                              .FALSE., fm_eigvec_Y)
      ELSE
         ! Open-shell ABBA: helper forms X+Y internally and prints amplitudes (X and Y).
         CALL bse_open_shell_optical(Exc_ens, fm_eigvec_X, homo, virtual, homo_irred, &
                                     .FALSE., qs_env, mo_coeff, mp2_env, unit_nr, fm_eigvec_Y)
      END IF
      DEALLOCATE (Exc_ens)
      CALL cp_fm_release(fm_eigvec_X)
@ -708,8 +616,7 @@ CONTAINS
                            unit_nr, diag_est, mp2_env, qs_env, mo_coeff)
      TYPE(cp_fm_type), INTENT(INOUT)                    :: fm_A
-      INTEGER, DIMENSION(:), INTENT(IN)                  :: homo, virtual, homo_irred
+      INTEGER, INTENT(IN)                                :: homo, virtual, homo_irred, unit_nr
      INTEGER, INTENT(IN)                                :: unit_nr
      REAL(KIND=dp), INTENT(IN)                          :: diag_est
      TYPE(mp2_type), INTENT(INOUT)                      :: mp2_env
      TYPE(qs_environment_type), POINTER                 :: qs_env
@ -717,23 +624,23 @@ CONTAINS
      CHARACTER(LEN=*), PARAMETER                        :: routineN = 'diagonalize_A'
-      INTEGER                                            :: diag_info, handle, n_ov_joint, nspins
+      INTEGER                                            :: diag_info, handle
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: Exc_ens
      TYPE(cp_fm_type)                                   :: fm_eigvec
      CALL timeset(routineN, handle)
-      nspins = SIZE(homo)
+      !Continue with formatting of subroutine create_A
      n_ov_joint = SUM(homo*virtual)
      IF (unit_nr > 0) THEN
         WRITE (unit_nr, '(T2,A4,T7,A17,A22,ES6.0,A3)') 'BSE|', 'Diagonalizing A. ', &
            'This will take around ', diag_est, ' s.'
      END IF
      !We have now the full matrix A_iajb, distributed over all ranks
      !Now: Diagonalize it
      CALL cp_fm_create(fm_eigvec, fm_A%matrix_struct)
-      ALLOCATE (Exc_ens(n_ov_joint))
+      ALLOCATE (Exc_ens(homo*virtual))
      CALL choose_eigv_solver(fm_A, fm_eigvec, Exc_ens, diag_info)
@ -742,13 +649,8 @@ CONTAINS
                       "Diagonalization of A failed in TDA-BSE")
      END IF
-      IF (nspins == 1) THEN
+      CALL postprocess_bse(Exc_ens, fm_eigvec, mp2_env, qs_env, mo_coeff, &
-         CALL postprocess_bse(Exc_ens, fm_eigvec, mp2_env, qs_env, mo_coeff, &
+                           homo, virtual, homo_irred, unit_nr, .TRUE.)
                              homo(1), virtual(1), homo_irred(1), unit_nr, .TRUE.)
      ELSE
         CALL bse_open_shell_optical(Exc_ens, fm_eigvec, homo, virtual, homo_irred, &
                                     .TRUE., qs_env, mo_coeff, mp2_env, unit_nr)
      END IF
      CALL cp_fm_release(fm_eigvec)
      DEALLOCATE (Exc_ens)
@ -757,154 +659,6 @@ CONTAINS
   END SUBROUTINE diagonalize_A
 ! **************************************************************************************************
 !> \brief Open-shell (UKS) spin-summed post-processing for the joint spin-block space: joint
 !>   excitation energies, per-spin transition amplitudes, and oscillator strengths. Mirrors
 !>   postprocess_bse but spin-summed; exciton descriptors and NTOs are not yet implemented (CPWARN).
 !> \param Exc_ens joint excitation energies
 !> \param fm_eigvec_X joint X eigenvectors (excitations)
 !> \param homo per-spin reduced/active occupied counts
 !> \param virtual per-spin reduced/active virtual counts
 !> \param homo_irred per-spin full occupied counts (absolute-MO labels; N_e = sum)
 !> \param flag_tda .TRUE. -> TDA (coeff=X), .FALSE. -> ABBA (coeff=X+Y)
 !> \param qs_env ...
 !> \param mo_coeff per-spin MO coefficients
 !> \param mp2_env ...
 !> \param unit_nr ...
 !> \param fm_eigvec_Y joint Y eigenvectors (deexcitations; ABBA only)
 ! **************************************************************************************************
   SUBROUTINE bse_open_shell_optical(Exc_ens, fm_eigvec_X, homo, virtual, homo_irred, &
                                     flag_tda, qs_env, mo_coeff, mp2_env, unit_nr, fm_eigvec_Y)
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: Exc_ens
      TYPE(cp_fm_type), INTENT(IN)                       :: fm_eigvec_X
      INTEGER, DIMENSION(:), INTENT(IN)                  :: homo, virtual, homo_irred
      LOGICAL, INTENT(IN)                                :: flag_tda
      TYPE(qs_environment_type), POINTER                 :: qs_env
      TYPE(cp_fm_type), DIMENSION(:), INTENT(IN)         :: mo_coeff
      TYPE(mp2_type), INTENT(INOUT)                      :: mp2_env
      INTEGER, INTENT(IN)                                :: unit_nr
      TYPE(cp_fm_type), INTENT(IN), OPTIONAL             :: fm_eigvec_Y
      CHARACTER(LEN=*), PARAMETER :: routineN = 'bse_open_shell_optical'
      CHARACTER(LEN=10)                                  :: info_approximation, multiplet
      INTEGER                                            :: handle, idir, isp, jdir, n, n_ov_joint, &
                                                            nspins
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: n_ov_sp, offsets_sp
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: oscill_str_joint, ref_pt
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :)     :: pol_res_joint, trans_mom_joint
      TYPE(cp_fm_struct_type), POINTER                   :: fm_struct_dip_reord, fm_struct_sp, &
                                                            fm_struct_tmom
      TYPE(cp_fm_type)                                   :: fm_dip_reord_sp, fm_eigvec_sp, &
                                                            fm_trans_coeff
      TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:)        :: fm_dip_ab_sp, fm_dip_ai_sp, fm_dip_ij_sp
      TYPE(cp_fm_type), DIMENSION(3)                     :: fm_trans_mom_joint
      CALL timeset(routineN, handle)
      nspins = SIZE(homo)
      ALLOCATE (n_ov_sp(nspins), offsets_sp(nspins))
      CALL get_bse_spin_block_layout(homo, virtual, n_ov_sp, offsets_sp, n_ov_joint)
      ! LEN=10 locals auto-pad short literals with spaces (avoids the L-15 short-literal trap);
      ! print_excitation_energies prints A6 of these, print_optical_properties prints them as-is.
      multiplet = "UKS"
      IF (flag_tda) THEN
         info_approximation = " -TDA- "
      ELSE
         info_approximation = "-ABBA-"
      END IF
      IF (unit_nr > 0) THEN
         WRITE (unit_nr, '(T2,A4,T7,A43)') 'BSE|', 'Joint open-shell BSE excitation energies:'
      END IF
      CALL print_excitation_energies(Exc_ens, n_ov_joint, 1, flag_tda, multiplet, &
                                     info_approximation, mp2_env, unit_nr)
      ! Per-spin single-particle transition amplitudes (X via =>, Y via <=).
      CALL print_transition_amplitudes(fm_eigvec_X, homo, virtual, homo_irred, &
                                       info_approximation, mp2_env, unit_nr, fm_eigvec_Y)
      ! Transition coefficient for the spin-summed moment: X (TDA) or X+Y (ABBA).
      CALL cp_fm_create(fm_trans_coeff, fm_eigvec_X%matrix_struct)
      CALL cp_fm_to_fm(fm_eigvec_X, fm_trans_coeff)
      IF (PRESENT(fm_eigvec_Y)) CALL cp_fm_scale_and_add(1.0_dp, fm_trans_coeff, 1.0_dp, fm_eigvec_Y)
      ! Spin-summed transition moments: D^n_dir = sum_σ sum_{ia,σ} D^{dir,σ}_{ai} C_{ia,σ,n}
      ! with C = X (TDA) or X+Y (ABBA); explicit spin sum, factor 1.0.
      ALLOCATE (fm_dip_ai_sp(3), fm_dip_ij_sp(3), fm_dip_ab_sp(3), ref_pt(3))
      ALLOCATE (oscill_str_joint(n_ov_joint), trans_mom_joint(3, 1, n_ov_joint))
      ALLOCATE (pol_res_joint(3, 3, n_ov_joint))
      trans_mom_joint(:, :, :) = 0.0_dp
      NULLIFY (fm_struct_dip_reord, fm_struct_sp, fm_struct_tmom)
      CALL cp_fm_struct_create(fm_struct_tmom, fm_trans_coeff%matrix_struct%para_env, &
                               fm_trans_coeff%matrix_struct%context, 1, n_ov_joint)
      DO idir = 1, 3
         CALL cp_fm_create(fm_trans_mom_joint(idir), fm_struct_tmom)
         CALL cp_fm_set_all(fm_trans_mom_joint(idir), 0.0_dp)
      END DO
      DO isp = 1, nspins
         CALL get_multipoles_mo(fm_dip_ai_sp, fm_dip_ij_sp, fm_dip_ab_sp, &
                                qs_env, mo_coeff(isp:isp), ref_pt, 1, &
                                homo(isp), virtual(isp), fm_trans_coeff%matrix_struct%context, &
                                ispin=isp)
         NULLIFY (fm_struct_sp, fm_struct_dip_reord)
         CALL cp_fm_struct_create(fm_struct_sp, fm_trans_coeff%matrix_struct%para_env, &
                                  fm_trans_coeff%matrix_struct%context, n_ov_sp(isp), n_ov_joint)
         CALL cp_fm_create(fm_eigvec_sp, fm_struct_sp)
         CALL cp_fm_set_all(fm_eigvec_sp, 0.0_dp)
         CALL cp_fm_to_fm_submat(fm_trans_coeff, fm_eigvec_sp, n_ov_sp(isp), n_ov_joint, &
                                 offsets_sp(isp) + 1, 1, 1, 1)
         CALL cp_fm_struct_create(fm_struct_dip_reord, fm_trans_coeff%matrix_struct%para_env, &
                                  fm_trans_coeff%matrix_struct%context, 1, n_ov_sp(isp))
         DO idir = 1, 3
            CALL cp_fm_create(fm_dip_reord_sp, fm_struct_dip_reord, name="bse_dip_reord")
            CALL cp_fm_set_all(fm_dip_reord_sp, 0.0_dp)
            CALL fm_general_add_bse(fm_dip_reord_sp, fm_dip_ai_sp(idir), 1.0_dp, &
                                    1, 1, 1, virtual(isp), unit_nr, [2, 4, 3, 1], mp2_env)
            CALL parallel_gemm('N', 'N', 1, n_ov_joint, n_ov_sp(isp), 1.0_dp, &
                               fm_dip_reord_sp, fm_eigvec_sp, 1.0_dp, fm_trans_mom_joint(idir))
            CALL cp_fm_release(fm_dip_reord_sp)
            CALL cp_fm_release(fm_dip_ai_sp(idir))
            CALL cp_fm_release(fm_dip_ij_sp(idir))
            CALL cp_fm_release(fm_dip_ab_sp(idir))
         END DO
         CALL cp_fm_release(fm_eigvec_sp)
         CALL cp_fm_struct_release(fm_struct_sp)
         NULLIFY (fm_struct_sp)
         CALL cp_fm_struct_release(fm_struct_dip_reord)
         NULLIFY (fm_struct_dip_reord)
      END DO
      DO idir = 1, 3
         CALL cp_fm_get_submatrix(fm_trans_mom_joint(idir), trans_mom_joint(idir, :, :))
         CALL cp_fm_release(fm_trans_mom_joint(idir))
      END DO
      CALL cp_fm_struct_release(fm_struct_tmom)
      DO n = 1, n_ov_joint
         DO idir = 1, 3
            DO jdir = 1, 3
               pol_res_joint(idir, jdir, n) = 2.0_dp*Exc_ens(n)*trans_mom_joint(idir, 1, n) &
                                              *trans_mom_joint(jdir, 1, n)
            END DO
         END DO
         oscill_str_joint(n) = 2.0_dp/3.0_dp*Exc_ens(n)*SUM(ABS(trans_mom_joint(:, 1, n))**2)
      END DO
      CALL print_optical_properties(Exc_ens, oscill_str_joint, trans_mom_joint, pol_res_joint, &
                                    n_ov_joint, 1, SUM(homo_irred), flag_tda, info_approximation, &
                                    mp2_env, unit_nr, open_shell=.TRUE.)
      ! Open-shell post-processing is partial: energies, amplitudes, spin-summed oscillator strengths.
      CALL cp_warn(__LOCATION__, &
                   "Open-shell (UKS) BSE: exciton descriptors and NTO analysis are not yet "// &
                   "implemented and have been skipped.")
      CALL cp_fm_release(fm_trans_coeff)
      DEALLOCATE (fm_dip_ai_sp, fm_dip_ij_sp, fm_dip_ab_sp, ref_pt)
      DEALLOCATE (n_ov_sp, offsets_sp, oscill_str_joint, trans_mom_joint, pol_res_joint)
      CALL timestop(handle)
   END SUBROUTINE bse_open_shell_optical
 ! **************************************************************************************************
 !> \brief Prints the success message (incl. energies) for full diag of BSE (TDA/full ABBA via flag)
 !> \param Exc_ens ...
@ -1029,7 +783,7 @@ CONTAINS
                                     info_approximation, mp2_env, unit_nr)
      ! Print single particle transition amplitudes, i.e. components of eigenvectors X and Y
-      CALL print_transition_amplitudes(fm_eigvec_X, [homo], [virtual], [homo_irred], &
+      CALL print_transition_amplitudes(fm_eigvec_X, homo, virtual, homo_irred, &
                                       info_approximation, mp2_env, unit_nr, fm_eigvec_Y)
      ! Prints optical properties, if state is a singlet
--- a/src/bse_main.F
+++ b/src/bse_main.F
@ -23,16 +23,12 @@ MODULE bse_main
   USE bse_print,                       ONLY: print_BSE_start_flag
   USE bse_util,                        ONLY: adapt_BSE_input_params,&
                                              deallocate_matrices_bse,&
                                              determine_bse_combined_window,&
                                              estimate_BSE_resources,&
                                              get_bse_spin_block_layout,&
                                              mult_B_with_W,&
                                              truncate_BSE_matrices
   USE cp_control_types,                ONLY: dft_control_type,&
                                              tddfpt2_control_type
-   USE cp_fm_types,                     ONLY: cp_fm_create,&
+   USE cp_fm_types,                     ONLY: cp_fm_release,&
                                              cp_fm_release,&
                                              cp_fm_to_fm,&
                                              cp_fm_type
   USE cp_log_handling,                 ONLY: cp_get_default_logger,&
                                              cp_logger_type
@ -88,14 +84,13 @@ CONTAINS
                                    homo, virtual, dimen_RI, dimen_RI_red, bse_lev_virt, &
                                    gd_array, color_sub, mp2_env, qs_env, mo_coeff, unit_nr)
-      TYPE(cp_fm_type), DIMENSION(:), INTENT(IN)         :: fm_mat_S_ia_bse, fm_mat_S_ij_bse, &
+      TYPE(cp_fm_type), INTENT(IN)                       :: fm_mat_S_ia_bse, fm_mat_S_ij_bse, &
                                                            fm_mat_S_ab_bse
      TYPE(cp_fm_type), INTENT(INOUT)                    :: fm_mat_Q_static_bse_gemm
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :), &
         INTENT(IN)                                      :: Eigenval, Eigenval_scf
      INTEGER, DIMENSION(:), INTENT(IN)                  :: homo, virtual
-      INTEGER, INTENT(IN)                                :: dimen_RI, dimen_RI_red
+      INTEGER, INTENT(IN)                                :: dimen_RI, dimen_RI_red, bse_lev_virt
      INTEGER, DIMENSION(:), INTENT(IN)                  :: bse_lev_virt
      TYPE(group_dist_d1_type), INTENT(IN)               :: gd_array
      INTEGER, INTENT(IN)                                :: color_sub
      TYPE(mp2_type)                                     :: mp2_env
@ -105,24 +100,16 @@ CONTAINS
      CHARACTER(LEN=*), PARAMETER :: routineN = 'start_bse_calculation'
-      INTEGER                                            :: first_active_mo, handle, ispin, &
+      INTEGER                                            :: handle, homo_red, virtual_red
                                                            last_active_mo, n_ov_joint, nspins
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: homo_red_arr, n_ov_arr, offsets_arr, &
                                                            virt_red_arr
      LOGICAL                                            :: my_do_abba, my_do_fulldiag, &
                                                            my_do_iterat_diag, my_do_tda
      REAL(KIND=dp)                                      :: diag_runtime_est
-      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: Eigenval_reduced, Eigenval_reduced_1, &
+      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: Eigenval_reduced
                                                            Eigenval_reduced_2, &
                                                            Eigenval_reduced_joint
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :)     :: B_abQ_bse_local, B_bar_iaQ_bse_local, &
                                                            B_bar_ijQ_bse_local, B_iaQ_bse_local
-      TYPE(cp_fm_type)                                   :: fm_A_BSE, fm_B_BSE, fm_C_BSE, &
+      TYPE(cp_fm_type) :: fm_A_BSE, fm_B_BSE, fm_C_BSE, fm_inv_sqrt_A_minus_B, fm_mat_S_ab_trunc, &
-                                                            fm_inv_sqrt_A_minus_B, fm_Q_copy, &
+         fm_mat_S_bar_ia_bse, fm_mat_S_bar_ij_bse, fm_mat_S_ia_trunc, fm_mat_S_ij_trunc, &
-                                                            fm_sqrt_A_minus_B
+         fm_sqrt_A_minus_B
      TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: fm_mat_S_ab_trunc_arr, &
         fm_mat_S_bar_ia_bse_arr, fm_mat_S_bar_ij_bse_arr, fm_mat_S_ia_trunc_arr, &
         fm_mat_S_ij_trunc_arr
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(dft_control_type), POINTER                    :: dft_control
      TYPE(mp_para_env_type), POINTER                    :: para_env
@ -130,8 +117,7 @@ CONTAINS
      CALL timeset(routineN, handle)
-      nspins = SIZE(homo)
+      para_env => fm_mat_S_ia_bse%matrix_struct%para_env
      para_env => fm_mat_S_ia_bse(1)%matrix_struct%para_env
      my_do_fulldiag = .FALSE.
      my_do_iterat_diag = .FALSE.
@ -165,202 +151,117 @@ CONTAINS
         mp2_env%bse%bse_debug_print = .TRUE.
      END IF
-      CALL fm_mat_S_ia_bse(1)%matrix_struct%para_env%sync()
+      CALL fm_mat_S_ia_bse%matrix_struct%para_env%sync()
-
+      ! We apply the BSE cutoffs using the DFT Eigenenergies
-      ALLOCATE (homo_red_arr(nspins), virt_red_arr(nspins))
+      ! Reduce matrices in case of energy cutoff for occupied and unoccupied in A/B-BSE-matrices
-      ALLOCATE (fm_mat_S_ia_trunc_arr(nspins), fm_mat_S_ij_trunc_arr(nspins), fm_mat_S_ab_trunc_arr(nspins))
+      CALL truncate_BSE_matrices(fm_mat_S_ia_bse, fm_mat_S_ij_bse, fm_mat_S_ab_bse, &
-      ALLOCATE (fm_mat_S_bar_ia_bse_arr(nspins), fm_mat_S_bar_ij_bse_arr(nspins))
+                                 fm_mat_S_ia_trunc, fm_mat_S_ij_trunc, fm_mat_S_ab_trunc, &
-
+                                 Eigenval_scf(:, 1, 1), Eigenval(:, 1, 1), Eigenval_reduced, &
-      IF (nspins > 1) THEN
+                                 homo(1), virtual(1), dimen_RI, unit_nr, &
-         CALL cp_warn(__LOCATION__, &
+                                 bse_lev_virt, &
-                      "Open-shell (UKS/LSD) BSE is a recent addition and has not been "// &
+                                 homo_red, virtual_red, &
-                      "extensively validated. Verify results carefully before using them "// &
+                                 mp2_env)
-                      "for production calculations.")
+      ! \bar{B}^P_rs = \sum_R W_PR B^R_rs where B^R_rs = \sum_T [1/sqrt(v)]_RT (T|rs)
-         ! === Open-shell path: combined-window cutoff, per-spin truncation, joint A (+B for ABBA) ===
+      ! r,s: MO-index, P,R,T: RI-index
-         ! Determine union of per-spin active MO windows
+      ! B: fm_mat_S_..., W: fm_mat_Q_...
-         CALL determine_bse_combined_window(Eigenval_scf(:, 1, :), homo, virtual, &
+      CALL mult_B_with_W(fm_mat_S_ij_trunc, fm_mat_S_ia_trunc, fm_mat_S_bar_ia_bse, &
-                                            mp2_env%bse%bse_cutoff_occ, &
+                         fm_mat_S_bar_ij_bse, fm_mat_Q_static_bse_gemm, &
-                                            mp2_env%bse%bse_cutoff_empty, &
+                         dimen_RI_red, homo_red, virtual_red)
                                            first_active_mo, last_active_mo)
         DO ispin = 1, nspins
            CALL truncate_BSE_matrices(fm_mat_S_ia_bse(ispin), fm_mat_S_ij_bse(ispin), &
                                       fm_mat_S_ab_bse(ispin), &
                                       fm_mat_S_ia_trunc_arr(ispin), fm_mat_S_ij_trunc_arr(ispin), &
                                       fm_mat_S_ab_trunc_arr(ispin), &
                                       Eigenval_scf(:, 1, ispin), Eigenval(:, 1, ispin), &
                                       Eigenval_reduced, homo(ispin), virtual(ispin), dimen_RI, &
                                       unit_nr, bse_lev_virt(ispin), homo_red_arr(ispin), &
                                       virt_red_arr(ispin), mp2_env, &
                                       homo_incl_in=first_active_mo, &
                                       virt_incl_in=last_active_mo - homo(ispin))
            IF (ispin == 1) THEN
               ALLOCATE (Eigenval_reduced_1(SIZE(Eigenval_reduced)))
               Eigenval_reduced_1(:) = Eigenval_reduced(:)
            ELSE
               ALLOCATE (Eigenval_reduced_2(SIZE(Eigenval_reduced)))
               Eigenval_reduced_2(:) = Eigenval_reduced(:)
            END IF
            DEALLOCATE (Eigenval_reduced)
         END DO
         ! Flat eigenvalue layout: [sigma=1 levels, sigma=2 levels]
         ALLOCATE (Eigenval_reduced_joint(SIZE(Eigenval_reduced_1) + SIZE(Eigenval_reduced_2)))
         Eigenval_reduced_joint(1:SIZE(Eigenval_reduced_1)) = Eigenval_reduced_1
         Eigenval_reduced_joint(SIZE(Eigenval_reduced_1) + 1:) = Eigenval_reduced_2
         DEALLOCATE (Eigenval_reduced_1, Eigenval_reduced_2)
         ALLOCATE (n_ov_arr(nspins), offsets_arr(nspins))
         CALL get_bse_spin_block_layout(homo_red_arr, virt_red_arr, n_ov_arr, offsets_arr, n_ov_joint)
         CALL adapt_BSE_input_params(n_ov_joint, 1, unit_nr, mp2_env, qs_env)
         ! W: mult_B_with_W modifies Q in-place (Cholesky); copy the original Q for each spin call
         DO ispin = 1, nspins
            CALL cp_fm_create(fm_Q_copy, fm_mat_Q_static_bse_gemm%matrix_struct)
            CALL cp_fm_to_fm(fm_mat_Q_static_bse_gemm, fm_Q_copy)
            CALL mult_B_with_W(fm_mat_S_ij_trunc_arr(ispin), fm_mat_S_ia_trunc_arr(ispin), &
                               fm_mat_S_bar_ia_bse_arr(ispin), fm_mat_S_bar_ij_bse_arr(ispin), &
                               fm_Q_copy, dimen_RI_red, homo_red_arr(ispin), virt_red_arr(ispin))
            CALL cp_fm_release(fm_Q_copy)
         END DO
         CALL cp_fm_release(fm_mat_Q_static_bse_gemm)
         IF (my_do_fulldiag) THEN
            CALL estimate_BSE_resources(n_ov_joint, unit_nr, my_do_abba, para_env, diag_runtime_est)
            IF (mp2_env%bse%screening_method == bse_screening_tdhf .OR. &
                mp2_env%bse%screening_method == bse_screening_alpha) THEN
               CALL create_A(fm_mat_S_ia_trunc_arr, fm_mat_S_ij_trunc_arr, fm_mat_S_ab_trunc_arr, &
                             fm_A_BSE, Eigenval_reduced_joint, unit_nr, &
                             homo_red_arr, virt_red_arr, dimen_RI, mp2_env, para_env, qs_env)
            ELSE
               CALL create_A(fm_mat_S_ia_trunc_arr, fm_mat_S_bar_ij_bse_arr, fm_mat_S_ab_trunc_arr, &
                             fm_A_BSE, Eigenval_reduced_joint, unit_nr, &
                             homo_red_arr, virt_red_arr, dimen_RI, mp2_env, para_env, qs_env)
            END IF
            IF (my_do_abba) THEN
               IF (mp2_env%bse%screening_method == bse_screening_tdhf .OR. &
                   mp2_env%bse%screening_method == bse_screening_alpha) THEN
                  CALL create_B(fm_mat_S_ia_trunc_arr, fm_mat_S_ia_trunc_arr, fm_B_BSE, &
                                homo_red_arr, virt_red_arr, dimen_RI, unit_nr, mp2_env)
               ELSE
                  CALL create_B(fm_mat_S_ia_trunc_arr, fm_mat_S_bar_ia_bse_arr, fm_B_BSE, &
                                homo_red_arr, virt_red_arr, dimen_RI, unit_nr, mp2_env)
               END IF
               CALL create_hermitian_form_of_ABBA(fm_A_BSE, fm_B_BSE, fm_C_BSE, &
                                                  fm_sqrt_A_minus_B, fm_inv_sqrt_A_minus_B, &
                                                  unit_nr, mp2_env, diag_runtime_est)
               CALL cp_fm_release(fm_B_BSE)
            END IF
            NULLIFY (dft_control, tddfpt_control)
            CALL get_qs_env(qs_env, dft_control=dft_control)
            tddfpt_control => dft_control%tddfpt2_control
            ! 4th arg (homo_irred) = full per-spin occupied counts: per-spin absolute-MO labels for
            ! the amplitude table, and N_e = SUM(homo_irred) for the TRK print.
            IF (my_do_tda .AND. (.NOT. tddfpt_control%do_bse)) THEN
               CALL diagonalize_A(fm_A_BSE, homo_red_arr, virt_red_arr, homo, &
                                  unit_nr, diag_runtime_est, mp2_env, qs_env, mo_coeff)
            END IF
            CALL cp_fm_release(fm_A_BSE)
            IF (my_do_abba) THEN
               CALL diagonalize_C(fm_C_BSE, homo_red_arr, virt_red_arr, homo, &
                                  fm_sqrt_A_minus_B, fm_inv_sqrt_A_minus_B, &
                                  unit_nr, diag_runtime_est, mp2_env, qs_env, mo_coeff)
               CALL cp_fm_release(fm_C_BSE)
            END IF
         END IF
         DO ispin = 1, nspins
            CALL cp_fm_release(fm_mat_S_bar_ia_bse_arr(ispin))
            CALL cp_fm_release(fm_mat_S_bar_ij_bse_arr(ispin))
            CALL cp_fm_release(fm_mat_S_ia_trunc_arr(ispin))
            CALL cp_fm_release(fm_mat_S_ij_trunc_arr(ispin))
            CALL cp_fm_release(fm_mat_S_ab_trunc_arr(ispin))
         END DO
         IF (mp2_env%bse%do_nto_analysis) DEALLOCATE (mp2_env%bse%bse_nto_state_list_final)
         DEALLOCATE (Eigenval_reduced_joint, n_ov_arr, offsets_arr)
      ELSE
         ! === Closed-shell n_spin=1 path (bit-identical) ===
         CALL truncate_BSE_matrices(fm_mat_S_ia_bse(1), fm_mat_S_ij_bse(1), fm_mat_S_ab_bse(1), &
                                    fm_mat_S_ia_trunc_arr(1), fm_mat_S_ij_trunc_arr(1), &
                                    fm_mat_S_ab_trunc_arr(1), &
                                    Eigenval_scf(:, 1, 1), Eigenval(:, 1, 1), Eigenval_reduced, &
                                    homo(1), virtual(1), dimen_RI, unit_nr, &
                                    bse_lev_virt(1), homo_red_arr(1), virt_red_arr(1), mp2_env)
         CALL mult_B_with_W(fm_mat_S_ij_trunc_arr(1), fm_mat_S_ia_trunc_arr(1), &
                            fm_mat_S_bar_ia_bse_arr(1), fm_mat_S_bar_ij_bse_arr(1), &
                            fm_mat_Q_static_bse_gemm, dimen_RI_red, homo_red_arr(1), virt_red_arr(1))
         IF (my_do_iterat_diag) THEN
            CALL fill_local_3c_arrays(fm_mat_S_ab_trunc_arr(1), fm_mat_S_ia_trunc_arr(1), &
                                      fm_mat_S_bar_ia_bse_arr(1), fm_mat_S_bar_ij_bse_arr(1), &
                                      B_bar_ijQ_bse_local, B_abQ_bse_local, B_bar_iaQ_bse_local, &
                                      B_iaQ_bse_local, dimen_RI_red, homo_red_arr(1), &
                                      virt_red_arr(1), gd_array, color_sub, para_env)
         END IF
         CALL adapt_BSE_input_params(homo_red_arr(1), virt_red_arr(1), unit_nr, mp2_env, qs_env)
         IF (my_do_fulldiag) THEN
            n_ov_joint = homo_red_arr(1)*virt_red_arr(1)
            CALL estimate_BSE_resources(n_ov_joint, unit_nr, my_do_abba, para_env, diag_runtime_est)
            IF (mp2_env%bse%screening_method == bse_screening_tdhf .OR. &
                mp2_env%bse%screening_method == bse_screening_alpha) THEN
               CALL create_A(fm_mat_S_ia_trunc_arr, fm_mat_S_ij_trunc_arr, fm_mat_S_ab_trunc_arr, &
                             fm_A_BSE, Eigenval_reduced, unit_nr, &
                             homo_red_arr, virt_red_arr, dimen_RI, mp2_env, para_env, qs_env)
            ELSE
               CALL create_A(fm_mat_S_ia_trunc_arr, fm_mat_S_bar_ij_bse_arr, fm_mat_S_ab_trunc_arr, &
                             fm_A_BSE, Eigenval_reduced, unit_nr, &
                             homo_red_arr, virt_red_arr, dimen_RI, mp2_env, para_env, qs_env)
            END IF
            IF (my_do_abba) THEN
               IF (mp2_env%bse%screening_method == bse_screening_tdhf .OR. &
                   mp2_env%bse%screening_method == bse_screening_alpha) THEN
                  CALL create_B(fm_mat_S_ia_trunc_arr, fm_mat_S_ia_trunc_arr, fm_B_BSE, &
                                homo_red_arr, virt_red_arr, dimen_RI, unit_nr, mp2_env)
               ELSE
                  CALL create_B(fm_mat_S_ia_trunc_arr, fm_mat_S_bar_ia_bse_arr, fm_B_BSE, &
                                homo_red_arr, virt_red_arr, dimen_RI, unit_nr, mp2_env)
               END IF
               CALL create_hermitian_form_of_ABBA(fm_A_BSE, fm_B_BSE, fm_C_BSE, &
                                                  fm_sqrt_A_minus_B, fm_inv_sqrt_A_minus_B, &
                                                  unit_nr, mp2_env, diag_runtime_est)
            END IF
            CALL cp_fm_release(fm_B_BSE)
            NULLIFY (dft_control, tddfpt_control)
            CALL get_qs_env(qs_env, dft_control=dft_control)
            tddfpt_control => dft_control%tddfpt2_control
            IF (my_do_tda .AND. (.NOT. tddfpt_control%do_bse)) THEN
               CALL diagonalize_A(fm_A_BSE, homo_red_arr, virt_red_arr, homo, &
                                  unit_nr, diag_runtime_est, mp2_env, qs_env, mo_coeff)
            END IF
            CALL cp_fm_release(fm_A_BSE)
            IF (my_do_abba) THEN
               CALL diagonalize_C(fm_C_BSE, homo_red_arr, virt_red_arr, homo, &
                                  fm_sqrt_A_minus_B, fm_inv_sqrt_A_minus_B, &
                                  unit_nr, diag_runtime_est, mp2_env, qs_env, mo_coeff)
            END IF
            CALL cp_fm_release(fm_C_BSE)
         END IF
         CALL deallocate_matrices_bse(fm_mat_S_bar_ia_bse_arr(1), fm_mat_S_bar_ij_bse_arr(1), &
                                      fm_mat_S_ia_trunc_arr(1), fm_mat_S_ij_trunc_arr(1), &
                                      fm_mat_S_ab_trunc_arr(1), fm_mat_Q_static_bse_gemm, mp2_env)
         DEALLOCATE (Eigenval_reduced)
         IF (my_do_iterat_diag) THEN
            CALL do_subspace_iterations(B_bar_ijQ_bse_local, B_abQ_bse_local, B_bar_iaQ_bse_local, &
                                        B_iaQ_bse_local, homo(1), virtual(1), &
                                        mp2_env%bse%bse_spin_config, unit_nr, &
                                        Eigenval(:, 1, 1), para_env, mp2_env)
            DEALLOCATE (B_bar_ijQ_bse_local, B_abQ_bse_local, B_bar_iaQ_bse_local, B_iaQ_bse_local)
         END IF
      IF (my_do_iterat_diag) THEN
         CALL fill_local_3c_arrays(fm_mat_S_ab_trunc, fm_mat_S_ia_trunc, &
                                   fm_mat_S_bar_ia_bse, fm_mat_S_bar_ij_bse, &
                                   B_bar_ijQ_bse_local, B_abQ_bse_local, B_bar_iaQ_bse_local, &
                                   B_iaQ_bse_local, dimen_RI_red, homo_red, virtual_red, &
                                   gd_array, color_sub, para_env)
      END IF
-      DEALLOCATE (homo_red_arr, virt_red_arr)
+      CALL adapt_BSE_input_params(homo_red, virtual_red, unit_nr, mp2_env, qs_env)
-      DEALLOCATE (fm_mat_S_ia_trunc_arr, fm_mat_S_ij_trunc_arr, fm_mat_S_ab_trunc_arr)
+
-      DEALLOCATE (fm_mat_S_bar_ia_bse_arr, fm_mat_S_bar_ij_bse_arr)
+      IF (my_do_fulldiag) THEN
         ! Quick estimate of memory consumption and runtime of diagonalizations
         CALL estimate_BSE_resources(homo_red, virtual_red, unit_nr, my_do_abba, &
                                     para_env, diag_runtime_est)
         ! Matrix A constructed from GW energies and 3c-B-matrices (cf. subroutine mult_B_with_W)
         ! A_ia,jb = (ε_a-ε_i) δ_ij δ_ab + α * v_ia,jb - W_ij,ab
         ! ε_a, ε_i are GW singleparticle energies from Eigenval_reduced
         ! α is a spin-dependent factor
         ! v_ia,jb = \sum_P B^P_ia B^P_jb (unscreened Coulomb interaction)
         ! W_ij,ab = \sum_P \bar{B}^P_ij B^P_ab (screened Coulomb interaction)
         ! For unscreened W matrix, we need fm_mat_S_ij_trunc
         IF (mp2_env%bse%screening_method == bse_screening_tdhf .OR. &
             mp2_env%bse%screening_method == bse_screening_alpha) THEN
            CALL create_A(fm_mat_S_ia_trunc, fm_mat_S_ij_trunc, fm_mat_S_ab_trunc, &
                          fm_A_BSE, Eigenval_reduced, unit_nr, &
                          homo_red, virtual_red, dimen_RI, mp2_env, &
                          para_env, qs_env)
         ELSE
            CALL create_A(fm_mat_S_ia_trunc, fm_mat_S_bar_ij_bse, fm_mat_S_ab_trunc, &
                          fm_A_BSE, Eigenval_reduced, unit_nr, &
                          homo_red, virtual_red, dimen_RI, mp2_env, &
                          para_env, qs_env)
         END IF
         IF (my_do_abba) THEN
            ! Matrix B constructed from 3c-B-matrices (cf. subroutine mult_B_with_W)
            ! B_ia,jb = α * v_ia,jb - W_ib,aj
            ! α is a spin-dependent factor
            ! v_ia,jb = \sum_P B^P_ia B^P_jb (unscreened Coulomb interaction)
            ! W_ib,aj = \sum_P \bar{B}^P_ib B^P_aj (screened Coulomb interaction)
            ! For unscreened W matrix, we need fm_mat_S_ia_trunc
            IF (mp2_env%bse%screening_method == bse_screening_tdhf .OR. &
                mp2_env%bse%screening_method == bse_screening_alpha) THEN
               CALL create_B(fm_mat_S_ia_trunc, fm_mat_S_ia_trunc, fm_B_BSE, &
                             homo_red, virtual_red, dimen_RI, unit_nr, mp2_env)
            ELSE
               CALL create_B(fm_mat_S_ia_trunc, fm_mat_S_bar_ia_bse, fm_B_BSE, &
                             homo_red, virtual_red, dimen_RI, unit_nr, mp2_env)
            END IF
            ! Construct Matrix C=(A-B)^0.5 (A+B) (A-B)^0.5 to solve full BSE matrix as a hermitian problem
            ! (cf. Eq. (A7) in F. Furche J. Chem. Phys., Vol. 114, No. 14, (2001)).
            ! We keep fm_sqrt_A_minus_B and fm_inv_sqrt_A_minus_B for print of singleparticle transitions
            ! of ABBA as described in Eq. (A10) in F. Furche J. Chem. Phys., Vol. 114, No. 14, (2001).
            CALL create_hermitian_form_of_ABBA(fm_A_BSE, fm_B_BSE, fm_C_BSE, &
                                               fm_sqrt_A_minus_B, fm_inv_sqrt_A_minus_B, &
                                               homo_red, virtual_red, unit_nr, mp2_env, diag_runtime_est)
         END IF
         CALL cp_fm_release(fm_B_BSE)
         NULLIFY (dft_control, tddfpt_control)
         CALL get_qs_env(qs_env, dft_control=dft_control)
         tddfpt_control => dft_control%tddfpt2_control
         IF ((my_do_tda) .AND. (.NOT. tddfpt_control%do_bse)) THEN
            ! Solving the hermitian eigenvalue equation A X^n = Ω^n X^n
            CALL diagonalize_A(fm_A_BSE, homo_red, virtual_red, homo(1), &
                               unit_nr, diag_runtime_est, mp2_env, qs_env, mo_coeff)
         END IF
         ! Release to avoid faulty use of changed A matrix
         CALL cp_fm_release(fm_A_BSE)
         IF (my_do_abba) THEN
            ! Solving eigenvalue equation C Z^n = (Ω^n)^2 Z^n .
            ! Here, the eigenvectors Z^n relate to X^n via
            ! Eq. (A10) in F. Furche J. Chem. Phys., Vol. 114, No. 14, (2001).
            CALL diagonalize_C(fm_C_BSE, homo_red, virtual_red, homo(1), &
                               fm_sqrt_A_minus_B, fm_inv_sqrt_A_minus_B, &
                               unit_nr, diag_runtime_est, mp2_env, qs_env, mo_coeff)
         END IF
         ! Release to avoid faulty use of changed C matrix
         CALL cp_fm_release(fm_C_BSE)
      END IF
      CALL deallocate_matrices_bse(fm_mat_S_bar_ia_bse, fm_mat_S_bar_ij_bse, &
                                   fm_mat_S_ia_trunc, fm_mat_S_ij_trunc, fm_mat_S_ab_trunc, &
                                   fm_mat_Q_static_bse_gemm, mp2_env)
      DEALLOCATE (Eigenval_reduced)
      IF (my_do_iterat_diag) THEN
         ! Contains untested Block-Davidson algorithm
         CALL do_subspace_iterations(B_bar_ijQ_bse_local, B_abQ_bse_local, B_bar_iaQ_bse_local, &
                                     B_iaQ_bse_local, homo(1), virtual(1), mp2_env%bse%bse_spin_config, unit_nr, &
                                     Eigenval(:, 1, 1), para_env, mp2_env)
         ! Deallocate local 3c-B-matrices
         DEALLOCATE (B_bar_ijQ_bse_local, B_abQ_bse_local, B_bar_iaQ_bse_local, B_iaQ_bse_local)
      END IF
      IF (unit_nr > 0) THEN
         WRITE (unit_nr, '(T2,A4,T7,A53)') 'BSE|', 'The BSE was successfully calculated. Have a nice day!'
--- a/src/bse_print.F
+++ b/src/bse_print.F
@ -17,8 +17,7 @@ MODULE bse_print
                                              cite_reference
   USE bse_properties,                  ONLY: compute_and_print_absorption_spectrum,&
                                              exciton_descr_type
-   USE bse_util,                        ONLY: filter_eigvec_contrib,&
+   USE bse_util,                        ONLY: filter_eigvec_contrib
                                              get_bse_spin_block_layout
   USE cp_fm_types,                     ONLY: cp_fm_get_info,&
                                              cp_fm_type
   USE input_constants,                 ONLY: bse_screening_alpha,&
@ -240,8 +239,8 @@ CONTAINS
            WRITE (unit_nr, '(T2,A4,T7,A57)') 'BSE|', 'Excitation energies from solving the BSE without the TDA:'
         END IF
         WRITE (unit_nr, '(T2,A4)') 'BSE|'
-         WRITE (unit_nr, '(T2,A4,T11,A12,T30,A7,T44,A8,T55,A27)') 'BSE|', &
+         WRITE (unit_nr, '(T2,A4,T11,A12,T26,A11,T44,A8,T55,A27)') 'BSE|', &
-            'Excitation n', multiplet, 'TDA/ABBA', 'Excitation energy Ω^n (eV)'
+            'Excitation n', "Spin Config", 'TDA/ABBA', 'Excitation energy Ω^n (eV)'
      END IF
      !prints actual energies values
      IF (unit_nr > 0) THEN
@ -270,7 +269,7 @@ CONTAINS
                                          info_approximation, mp2_env, unit_nr, fm_eigvec_Y)
      TYPE(cp_fm_type), INTENT(IN)                       :: fm_eigvec_X
-      INTEGER, DIMENSION(:), INTENT(IN)                  :: homo, virtual, homo_irred
+      INTEGER, INTENT(IN)                                :: homo, virtual, homo_irred
      CHARACTER(LEN=10), INTENT(IN)                      :: info_approximation
      TYPE(mp2_type), INTENT(INOUT)                      :: mp2_env
      INTEGER, INTENT(IN)                                :: unit_nr
@ -278,15 +277,10 @@ CONTAINS
      CHARACTER(LEN=*), PARAMETER :: routineN = 'print_transition_amplitudes'
-      INTEGER                                            :: handle, i_exc, isp, n_ov_joint, nspins
+      INTEGER                                            :: handle, i_exc
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: n_ov, offsets
      CALL timeset(routineN, handle)
      nspins = SIZE(homo)
      ALLOCATE (n_ov(nspins), offsets(nspins))
      CALL get_bse_spin_block_layout(homo, virtual, n_ov, offsets, n_ov_joint)
      IF (unit_nr > 0) THEN
         WRITE (unit_nr, '(T2,A4)') 'BSE|'
         WRITE (unit_nr, '(T2,A4,T7,A61)') &
@ -306,41 +300,27 @@ CONTAINS
            'BSE|', "i.e. |X_ia^n| > ", mp2_env%bse%eps_x, " or |Y_ia^n| > ", &
            mp2_env%bse%eps_x, ", respectively :"
-         IF (nspins == 1) THEN
+         WRITE (unit_nr, '(T2,A4,T15,A27,I5,A13,I5,A3)') 'BSE|', '-- Quick reminder: HOMO i =', &
-            WRITE (unit_nr, '(T2,A4,T15,A27,I5,A13,I5,A3)') 'BSE|', '-- Quick reminder: HOMO i =', &
+            homo_irred, ' and LUMO a =', homo_irred + 1, " --"
-               homo_irred(1), ' and LUMO a =', homo_irred(1) + 1, " --"
+         WRITE (unit_nr, '(T2,A4)') 'BSE|'
-            WRITE (unit_nr, '(T2,A4)') 'BSE|'
+         WRITE (unit_nr, '(T2,A4,T7,A12,T30,A1,T32,A5,T42,A1,T49,A8,T64,A17)') &
-            WRITE (unit_nr, '(T2,A4,T7,A12,T30,A1,T32,A5,T42,A1,T49,A8,T64,A17)') &
+            "BSE|", "Excitation n", "i", "=>/<=", "a", 'TDA/ABBA', "|X_ia^n|/|Y_ia^n|"
               "BSE|", "Excitation n", "i", "=>/<=", "a", 'TDA/ABBA', "|X_ia^n|/|Y_ia^n|"
         ELSE
            ! bare A (no width) for sigma-bearing literals: explicit widths count bytes, and the
            ! 2-byte UTF-8 sigma would otherwise truncate.
            DO isp = 1, nspins
               WRITE (unit_nr, '(T2,A4,T15,A,I2,A,I5,A,I5,A)') 'BSE|', &
                  '-- Quick reminder: σ =', isp, ', HOMO i =', homo_irred(isp), &
                  ' and LUMO a =', homo_irred(isp) + 1, " --"
            END DO
            WRITE (unit_nr, '(T2,A4)') 'BSE|'
            WRITE (unit_nr, '(T2,A4,T7,A12,T22,A,T30,A1,T32,A5,T42,A1,T49,A8,T64,A)') &
               "BSE|", "Excitation n", "σ", "i", "=>/<=", "a", 'TDA/ABBA', "|X_iaσ^n|/|Y_iaσ^n|"
         END IF
      END IF
-      DO i_exc = 1, MIN(n_ov_joint, mp2_env%bse%num_print_exc)
+      DO i_exc = 1, MIN(homo*virtual, mp2_env%bse%num_print_exc)
         IF (unit_nr > 0) THEN
            WRITE (unit_nr, '(T2,A4)') 'BSE|'
         END IF
         !Iterate through eigenvector and print values above threshold
         CALL print_transition_amplitudes_core(fm_eigvec_X, "=>", info_approximation, &
                                               i_exc, virtual, homo, homo_irred, &
-                                               unit_nr, mp2_env, offsets)
+                                               unit_nr, mp2_env)
         IF (PRESENT(fm_eigvec_Y)) THEN
            CALL print_transition_amplitudes_core(fm_eigvec_Y, "<=", info_approximation, &
                                                  i_exc, virtual, homo, homo_irred, &
-                                                  unit_nr, mp2_env, offsets)
+                                                  unit_nr, mp2_env)
         END IF
      END DO
      DEALLOCATE (n_ov, offsets)
      CALL timestop(handle)
   END SUBROUTINE print_transition_amplitudes
@ -358,11 +338,10 @@ CONTAINS
 !> \param info_approximation ...
 !> \param mp2_env ...
 !> \param unit_nr ...
 !> \param open_shell if .TRUE., print spin-summed (UKS) dipole formula instead of the sqrt(2) one
 ! **************************************************************************************************
   SUBROUTINE print_optical_properties(Exc_ens, oscill_str, trans_mom_bse, polarizability_residues, &
                                       homo, virtual, homo_irred, flag_TDA, &
-                                       info_approximation, mp2_env, unit_nr, open_shell)
+                                       info_approximation, mp2_env, unit_nr)
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: Exc_ens, oscill_str
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :)     :: trans_mom_bse, polarizability_residues
@ -371,18 +350,13 @@ CONTAINS
      CHARACTER(LEN=10), INTENT(IN)                      :: info_approximation
      TYPE(mp2_type), INTENT(INOUT)                      :: mp2_env
      INTEGER, INTENT(IN)                                :: unit_nr
      LOGICAL, INTENT(IN), OPTIONAL                      :: open_shell
      CHARACTER(LEN=*), PARAMETER :: routineN = 'print_optical_properties'
      INTEGER                                            :: handle, i_exc
      LOGICAL                                            :: my_open_shell
      CALL timeset(routineN, handle)
      my_open_shell = .FALSE.
      IF (PRESENT(open_shell)) my_open_shell = open_shell
      ! Discriminate between singlet and triplet, since triplet state can't couple to light
      ! and therefore calculations of dipoles etc are not necessary
      IF (mp2_env%bse%bse_spin_config == 0) THEN
@ -393,22 +367,12 @@ CONTAINS
            WRITE (unit_nr, '(T2,A4,T7,A67)') &
               'BSE|', "and oscillator strength f^n of excitation level n are obtained from"
            WRITE (unit_nr, '(T2,A4)') 'BSE|'
-            IF (my_open_shell) THEN
+            IF (flag_TDA) THEN
-               IF (flag_TDA) THEN
+               WRITE (unit_nr, '(T2,A4,T10,A)') &
-                  WRITE (unit_nr, '(T2,A4,T10,A)') &
+                  'BSE|', "d_r^n = sqrt(2) sum_ia < ψ_i | r | ψ_a >  X_ia^n"
                     'BSE|', "d_r^n = sum_σ sum_ia < ψ_iσ | r | ψ_aσ >  X_iaσ^n"
               ELSE
                  WRITE (unit_nr, '(T2,A4,T10,A)') &
                     'BSE|', "d_r^n = sum_σ sum_ia < ψ_iσ | r | ψ_aσ > ( X_iaσ^n + Y_iaσ^n )"
               END IF
            ELSE
-               IF (flag_TDA) THEN
+               WRITE (unit_nr, '(T2,A4,T10,A)') &
-                  WRITE (unit_nr, '(T2,A4,T10,A)') &
+                  'BSE|', "d_r^n = sum_ia sqrt(2) < ψ_i | r | ψ_a > ( X_ia^n + Y_ia^n )"
                     'BSE|', "d_r^n = sqrt(2) sum_ia < ψ_i | r | ψ_a >  X_ia^n"
               ELSE
                  WRITE (unit_nr, '(T2,A4,T10,A)') &
                     'BSE|', "d_r^n = sum_ia sqrt(2) < ψ_i | r | ψ_a > ( X_ia^n + Y_ia^n )"
               END IF
            END IF
            WRITE (unit_nr, '(T2,A4)') 'BSE|'
            WRITE (unit_nr, '(T2,A4,T14,A)') &
@ -451,10 +415,8 @@ CONTAINS
            WRITE (unit_nr, '(T2,A4,T35,A15)') 'BSE|', &
               'N_e = Σ_n f^n'
            WRITE (unit_nr, '(T2,A4)') 'BSE|'
            ! Open shell: caller passes homo_irred = n_alpha + n_beta (total electrons).
            ! Closed shell: homo_irred = n_occ, i.e. 2 electrons per occupied orbital.
            WRITE (unit_nr, '(T2,A4,T7,A24,T65,I16)') 'BSE|', &
-               'Number of electrons N_e:', MERGE(homo_irred, homo_irred*2, my_open_shell)
+               'Number of electrons N_e:', homo_irred*2
            WRITE (unit_nr, '(T2,A4,T7,A40,T66,F16.3)') 'BSE|', &
               'Sum over oscillator strengths Σ_n f^n :', SUM(oscill_str)
            WRITE (unit_nr, '(T2,A4)') 'BSE|'
@ -496,58 +458,36 @@ CONTAINS
 !> \param homo_irred ...
 !> \param unit_nr ...
 !> \param mp2_env ...
 !> \param offsets ...
 ! **************************************************************************************************
   SUBROUTINE print_transition_amplitudes_core(fm_eigvec, direction_excitation, info_approximation, &
                                               i_exc, virtual, homo, homo_irred, &
-                                               unit_nr, mp2_env, offsets)
+                                               unit_nr, mp2_env)
      TYPE(cp_fm_type), INTENT(IN)                       :: fm_eigvec
      CHARACTER(LEN=2), INTENT(IN)                       :: direction_excitation
      CHARACTER(LEN=10), INTENT(IN)                      :: info_approximation
-      INTEGER, INTENT(IN)                                :: i_exc
+      INTEGER                                            :: i_exc, virtual, homo, homo_irred
      INTEGER, DIMENSION(:), INTENT(IN)                  :: virtual, homo, homo_irred
      INTEGER, INTENT(IN)                                :: unit_nr
      TYPE(mp2_type), INTENT(INOUT)                      :: mp2_env
      INTEGER, DIMENSION(:), INTENT(IN)                  :: offsets
      CHARACTER(LEN=*), PARAMETER :: routineN = 'print_transition_amplitudes_core'
      CHARACTER(LEN=2), DIMENSION(2), PARAMETER          :: spin_label = ["α", "β"]
-      INTEGER                                            :: handle, isp, k, num_entries
+      INTEGER                                            :: handle, k, num_entries
-      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: idx_homo, idx_spin, idx_virt
+      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: idx_homo, idx_virt
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: eigvec_entries
 ! 2-byte UTF-8 glyphs (LEN=1 would truncate both alpha/beta to the shared 0xCE byte)
      CALL timeset(routineN, handle)
      CALL filter_eigvec_contrib(fm_eigvec, idx_homo, idx_virt, eigvec_entries, &
                                 i_exc, virtual, num_entries, mp2_env)
      ! direction_excitation can be either => (means excitation; from fm_eigvec_X)
      ! or <= (means deexcitation; from fm_eigvec_Y)
-      IF (SIZE(homo) == 1) THEN
+      IF (unit_nr > 0) THEN
-         CALL filter_eigvec_contrib(fm_eigvec, idx_homo, idx_virt, eigvec_entries, &
+         DO k = 1, num_entries
-                                    i_exc, virtual(1), num_entries, mp2_env)
+            WRITE (unit_nr, '(T2,A4,T14,I5,T26,I5,T35,A2,T38,I5,T51,A6,T65,F16.4)') &
-         IF (unit_nr > 0) THEN
+               "BSE|", i_exc, homo_irred - homo + idx_homo(k), direction_excitation, &
-            DO k = 1, num_entries
+               homo_irred + idx_virt(k), info_approximation, ABS(eigvec_entries(k))
-               WRITE (unit_nr, '(T2,A4,T14,I5,T26,I5,T35,A2,T38,I5,T51,A6,T65,F16.4)') &
+         END DO
                  "BSE|", i_exc, homo_irred(1) - homo(1) + idx_homo(k), direction_excitation, &
                  homo_irred(1) + idx_virt(k), info_approximation, ABS(eigvec_entries(k))
            END DO
         END IF
      ELSE
         CALL filter_eigvec_contrib(fm_eigvec, idx_homo, idx_virt, eigvec_entries, &
                                    i_exc, virtual(1), num_entries, mp2_env, &
                                    offsets=offsets, virtual_per_spin=virtual, idx_spin=idx_spin)
         IF (unit_nr > 0) THEN
            DO k = 1, num_entries
               isp = idx_spin(k)
               WRITE (unit_nr, '(T2,A4,T14,I5,T22,A2,T26,I5,T35,A2,T38,I5,T51,A6,T65,F16.4)') &
                  "BSE|", i_exc, spin_label(isp), &
                  homo_irred(isp) - homo(isp) + idx_homo(k), direction_excitation, &
                  homo_irred(isp) + idx_virt(k), info_approximation, ABS(eigvec_entries(k))
            END DO
         END IF
         DEALLOCATE (idx_spin)
      END IF
      DEALLOCATE (idx_homo)
      DEALLOCATE (idx_virt)
@ -647,7 +587,7 @@ CONTAINS
               'where c_n = < 𝚿_n | 𝚿_n > = 1 within TDA.'
         ELSE
            WRITE (unit_nr, '(T2,A4,T7,A)') prefix_output, &
-               'where c_n = < 𝚿_n | 𝚿_n > ≥ 1 without TDA.'
+               'where c_n = < 𝚿_n | 𝚿_n > deviates from 1 without TDA.'
         END IF
         WRITE (unit_nr, '(T2,A4)') prefix_output
         WRITE (unit_nr, '(T2,A4)') prefix_output
--- a/src/bse_util.F
+++ b/src/bse_util.F
@ -92,8 +92,7 @@ MODULE bse_util
             deallocate_matrices_bse, comp_eigvec_coeff_BSE, sort_excitations, &
             estimate_BSE_resources, filter_eigvec_contrib, truncate_BSE_matrices, &
             determine_cutoff_indices, adapt_BSE_input_params, get_multipoles_mo, &
-             reshuffle_eigvec, print_bse_nto_cubes, trace_exciton_descr, &
+             reshuffle_eigvec, print_bse_nto_cubes, trace_exciton_descr
             get_bse_spin_block_layout, determine_bse_combined_window, assemble_joint_ov_slab
 CONTAINS
@ -194,12 +193,9 @@ CONTAINS
 !> \param unit_nr ...
 !> \param reordering ...
 !> \param mp2_env ...
 !> \param row_offset ...
 !> \param col_offset ...
 ! **************************************************************************************************
   SUBROUTINE fm_general_add_bse(fm_out, fm_in, beta, nrow_secidx_in, ncol_secidx_in, &
-                                 nrow_secidx_out, ncol_secidx_out, unit_nr, reordering, mp2_env, &
+                                 nrow_secidx_out, ncol_secidx_out, unit_nr, reordering, mp2_env)
                                 row_offset, col_offset)
      TYPE(cp_fm_type), INTENT(INOUT)                    :: fm_out
      TYPE(cp_fm_type), INTENT(IN)                       :: fm_in
@ -209,14 +205,13 @@ CONTAINS
      INTEGER                                            :: unit_nr
      INTEGER, DIMENSION(4)                              :: reordering
      TYPE(mp2_type), INTENT(IN)                         :: mp2_env
      INTEGER, INTENT(IN), OPTIONAL                      :: row_offset, col_offset
      CHARACTER(LEN=*), PARAMETER :: routineN = 'fm_general_add_bse'
      INTEGER :: col_idx_loc, dummy, handle, handle2, i_entry_rec, idx_col_out, idx_row_out, ii, &
-         iproc, jj, my_col_offset, my_row_offset, ncol_block_in, ncol_block_out, ncol_local_in, &
+         iproc, jj, ncol_block_in, ncol_block_out, ncol_local_in, ncol_local_out, nprocs, &
-         ncol_local_out, nprocs, nrow_block_in, nrow_block_out, nrow_local_in, nrow_local_out, &
+         nrow_block_in, nrow_block_out, nrow_local_in, nrow_local_out, proc_send, row_idx_loc, &
-         proc_send, row_idx_loc, send_pcol, send_prow
+         send_pcol, send_prow
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: entry_counter, num_entries_rec, &
                                                            num_entries_send
      INTEGER, DIMENSION(4)                              :: indices_in
@ -227,14 +222,6 @@ CONTAINS
      TYPE(mp_para_env_type), POINTER                    :: para_env_out
      TYPE(mp_request_type), DIMENSION(:, :), POINTER    :: req_array
 ! Offsets place the reshuffled block into a sub-block of fm_out (open-shell joint matrix);
 ! both default 0, recovering the closed-shell single-block placement bit-identically.
      my_row_offset = 0
      my_col_offset = 0
      IF (PRESENT(row_offset)) my_row_offset = row_offset
      IF (PRESENT(col_offset)) my_col_offset = col_offset
      CALL timeset(routineN, handle)
      CALL timeset(routineN//"_1_setup", handle2)
@ -293,8 +280,8 @@ CONTAINS
            indices_in(3) = (col_indices_in(col_idx_loc) - 1)/ncol_secidx_in + 1
            indices_in(4) = MOD(col_indices_in(col_idx_loc) - 1, ncol_secidx_in) + 1
-            idx_row_out = my_row_offset + indices_in(reordering(2)) + (indices_in(reordering(1)) - 1)*nrow_secidx_out
+            idx_row_out = indices_in(reordering(2)) + (indices_in(reordering(1)) - 1)*nrow_secidx_out
-            idx_col_out = my_col_offset + indices_in(reordering(4)) + (indices_in(reordering(3)) - 1)*ncol_secidx_out
+            idx_col_out = indices_in(reordering(4)) + (indices_in(reordering(3)) - 1)*ncol_secidx_out
            send_prow = fm_out%matrix_struct%g2p_row(idx_row_out)
            send_pcol = fm_out%matrix_struct%g2p_col(idx_col_out)
@ -373,8 +360,8 @@ CONTAINS
            indices_in(3) = (col_indices_in(col_idx_loc) - 1)/ncol_secidx_in + 1
            indices_in(4) = MOD(col_indices_in(col_idx_loc) - 1, ncol_secidx_in) + 1
-            idx_row_out = my_row_offset + indices_in(reordering(2)) + (indices_in(reordering(1)) - 1)*nrow_secidx_out
+            idx_row_out = indices_in(reordering(2)) + (indices_in(reordering(1)) - 1)*nrow_secidx_out
-            idx_col_out = my_col_offset + indices_in(reordering(4)) + (indices_in(reordering(3)) - 1)*ncol_secidx_out
+            idx_col_out = indices_in(reordering(4)) + (indices_in(reordering(3)) - 1)*ncol_secidx_out
            send_prow = fm_out%matrix_struct%g2p_row(idx_row_out)
            send_pcol = fm_out%matrix_struct%g2p_col(idx_col_out)
@ -856,24 +843,20 @@ CONTAINS
   END SUBROUTINE comp_eigvec_coeff_BSE
 ! **************************************************************************************************
-!> \brief Sorts excitation entries by ascending primary index, reordering the secondary index,
+!> \brief ...
-!>        the eigenvector coefficients and - open shell - the spin index alongside
+!> \param idx_prim ...
-!> \param idx_prim Primary index of each entry; sorted in place and used as the sort key
+!> \param idx_sec ...
-!> \param idx_sec Secondary index of each entry, reordered to follow idx_prim
+!> \param eigvec_entries ...
 !> \param eigvec_entries Eigenvector coefficients of each entry, reordered to follow idx_prim
 !> \param idx_spin Optional spin index of each entry (open shell), reordered to follow idx_prim
 ! **************************************************************************************************
-   SUBROUTINE sort_excitations(idx_prim, idx_sec, eigvec_entries, idx_spin)
+   SUBROUTINE sort_excitations(idx_prim, idx_sec, eigvec_entries)
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: idx_prim, idx_sec
      REAL(kind=dp), ALLOCATABLE, DIMENSION(:)           :: eigvec_entries
      INTEGER, ALLOCATABLE, DIMENSION(:), OPTIONAL       :: idx_spin
      CHARACTER(LEN=*), PARAMETER                        :: routineN = 'sort_excitations'
      INTEGER                                            :: handle, ii, kk, num_entries, num_mults
-      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: idx_prim_work, idx_sec_work, &
+      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: idx_prim_work, idx_sec_work, tmp_index
                                                            idx_spin_work, tmp_index
      LOGICAL                                            :: unique_entries
      REAL(kind=dp), ALLOCATABLE, DIMENSION(:)           :: eigvec_entries_work
@ -887,12 +870,10 @@ CONTAINS
      ALLOCATE (idx_sec_work(num_entries))
      ALLOCATE (eigvec_entries_work(num_entries))
      IF (PRESENT(idx_spin)) ALLOCATE (idx_spin_work(num_entries))
      DO ii = 1, num_entries
         idx_sec_work(ii) = idx_sec(tmp_index(ii))
         eigvec_entries_work(ii) = eigvec_entries(tmp_index(ii))
         IF (PRESENT(idx_spin)) idx_spin_work(ii) = idx_spin(tmp_index(ii))
      END DO
      DEALLOCATE (tmp_index)
@ -901,10 +882,6 @@ CONTAINS
      CALL MOVE_ALLOC(idx_sec_work, idx_sec)
      CALL MOVE_ALLOC(eigvec_entries_work, eigvec_entries)
      IF (PRESENT(idx_spin)) THEN
         DEALLOCATE (idx_spin)
         CALL MOVE_ALLOC(idx_spin_work, idx_spin)
      END IF
      !Now check for multiple entries in first idx to check necessity of sorting in second idx
      CALL sort_unique(idx_prim, unique_entries)
@ -923,10 +900,6 @@ CONTAINS
               ALLOCATE (eigvec_entries_work(num_mults))
               idx_sec_work(:) = idx_sec(ii:ii + num_mults - 1)
               eigvec_entries_work(:) = eigvec_entries(ii:ii + num_mults - 1)
               IF (PRESENT(idx_spin)) THEN
                  ALLOCATE (idx_spin_work(num_mults))
                  idx_spin_work(:) = idx_spin(ii:ii + num_mults - 1)
               END IF
               ALLOCATE (tmp_index(num_mults))
               CALL sort(idx_sec_work, num_mults, tmp_index)
@ -934,13 +907,11 @@ CONTAINS
               DO kk = ii, ii + num_mults - 1
                  idx_sec(kk) = idx_sec_work(kk - ii + 1)
                  eigvec_entries(kk) = eigvec_entries_work(tmp_index(kk - ii + 1))
                  IF (PRESENT(idx_spin)) idx_spin(kk) = idx_spin_work(tmp_index(kk - ii + 1))
               END DO
               !Deallocate work arrays
               DEALLOCATE (tmp_index)
               DEALLOCATE (idx_sec_work)
               DEALLOCATE (eigvec_entries_work)
               IF (PRESENT(idx_spin)) DEALLOCATE (idx_spin_work)
            END IF
            idx_prim_work(ii) = idx_prim(ii)
         END DO
@ -953,16 +924,17 @@ CONTAINS
 ! **************************************************************************************************
 !> \brief Roughly estimates the needed runtime and memory during the BSE run
-!> \param n_ov_joint ...
+!> \param homo_red ...
 !> \param virtual_red ...
 !> \param unit_nr ...
 !> \param bse_abba ...
 !> \param para_env ...
 !> \param diag_runtime_est ...
 ! **************************************************************************************************
-   SUBROUTINE estimate_BSE_resources(n_ov_joint, unit_nr, bse_abba, &
+   SUBROUTINE estimate_BSE_resources(homo_red, virtual_red, unit_nr, bse_abba, &
                                     para_env, diag_runtime_est)
-      INTEGER, INTENT(IN)                                :: n_ov_joint, unit_nr
+      INTEGER                                            :: homo_red, virtual_red, unit_nr
      LOGICAL                                            :: bse_abba
      TYPE(mp_para_env_type), POINTER                    :: para_env
      REAL(KIND=dp)                                      :: diag_runtime_est
@ -983,7 +955,7 @@ CONTAINS
         num_BSE_matrices = 10
      END IF
-      full_dim = INT(n_ov_joint, KIND=int_8)**2*INT(num_BSE_matrices, KIND=int_8)
+      full_dim = (INT(homo_red, KIND=int_8)**2*INT(virtual_red, KIND=int_8)**2)*INT(num_BSE_matrices, KIND=int_8)
      mem_est = REAL(8*full_dim, KIND=dp)/REAL(1024**3, KIND=dp)
      mem_est_per_rank = REAL(mem_est/para_env%num_pe, KIND=dp)
@ -998,7 +970,7 @@ CONTAINS
      END IF
      ! Rough estimation of diagonalization runtimes. Baseline was a full BSE Naphthalene
      ! run with 11000x11000 entries in A/B/C, which took 10s on 32 ranks
-      diag_runtime_est = REAL(INT(n_ov_joint, KIND=int_8)/11000_int_8, KIND=dp)**3* &
+      diag_runtime_est = REAL(INT(homo_red, KIND=int_8)*INT(virtual_red, KIND=int_8)/11000_int_8, KIND=dp)**3* &
                         10*32/REAL(para_env%num_pe, KIND=dp)
      CALL timestop(handle)
@ -1016,27 +988,21 @@ CONTAINS
 !> \param virtual ...
 !> \param num_entries ...
 !> \param mp2_env ...
 !> \param offsets ...
 !> \param virtual_per_spin ...
 !> \param idx_spin ...
 ! **************************************************************************************************
   SUBROUTINE filter_eigvec_contrib(fm_eigvec, idx_homo, idx_virt, eigvec_entries, &
-                                    i_exc, virtual, num_entries, mp2_env, &
+                                    i_exc, virtual, num_entries, mp2_env)
                                    offsets, virtual_per_spin, idx_spin)
      TYPE(cp_fm_type), INTENT(IN)                       :: fm_eigvec
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: idx_homo, idx_virt
      REAL(kind=dp), ALLOCATABLE, DIMENSION(:)           :: eigvec_entries
      INTEGER                                            :: i_exc, virtual, num_entries
      TYPE(mp2_type), INTENT(INOUT)                      :: mp2_env
      INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL        :: offsets, virtual_per_spin
      INTEGER, ALLOCATABLE, DIMENSION(:), OPTIONAL       :: idx_spin
      CHARACTER(LEN=*), PARAMETER :: routineN = 'filter_eigvec_contrib'
-      INTEGER                                            :: eigvec_idx, handle, ii, iproc, isp, jj, &
+      INTEGER                                            :: eigvec_idx, handle, ii, iproc, jj, kk, &
-                                                            kk, ksp, ncol_local, nrow_local, &
+                                                            ncol_local, nrow_local, &
-                                                            num_entries_local, r_local, v_local
+                                                            num_entries_local
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: num_entries_to_comm
      INTEGER, DIMENSION(:), POINTER                     :: col_indices, row_indices
      REAL(KIND=dp)                                      :: eigvec_entry
@ -1080,7 +1046,7 @@ CONTAINS
      DO iproc = 0, para_env%num_pe - 1
         ALLOCATE (buffer_entries(iproc)%msg(num_entries_to_comm(iproc)))
-         ALLOCATE (buffer_entries(iproc)%indx(num_entries_to_comm(iproc), 3))
+         ALLOCATE (buffer_entries(iproc)%indx(num_entries_to_comm(iproc), 2))
         buffer_entries(iproc)%msg = 0.0_dp
         buffer_entries(iproc)%indx = 0
      END DO
@ -1095,24 +1061,8 @@ CONTAINS
            eigvec_idx = row_indices(ii)
            eigvec_entry = fm_eigvec%local_data(ii, jj)
            IF (ABS(eigvec_entry) > mp2_env%bse%eps_x) THEN
-               ! Decode spin block from the joint row index (blocks are contiguous; sigma is the
+               buffer_entries(para_env%mepos)%indx(kk, 1) = (eigvec_idx - 1)/virtual + 1
-               ! largest offset strictly below eigvec_idx). offsets absent -> closed shell, sigma=1.
+               buffer_entries(para_env%mepos)%indx(kk, 2) = MOD(eigvec_idx - 1, virtual) + 1
               isp = 1
               r_local = eigvec_idx
               v_local = virtual
               IF (PRESENT(offsets)) THEN
                  DO ksp = SIZE(offsets), 1, -1
                     IF (eigvec_idx > offsets(ksp)) THEN
                        isp = ksp
                        EXIT
                     END IF
                  END DO
                  r_local = eigvec_idx - offsets(isp)
                  v_local = virtual_per_spin(isp)
               END IF
               buffer_entries(para_env%mepos)%indx(kk, 1) = (r_local - 1)/v_local + 1
               buffer_entries(para_env%mepos)%indx(kk, 2) = MOD(r_local - 1, v_local) + 1
               buffer_entries(para_env%mepos)%indx(kk, 3) = isp
               buffer_entries(para_env%mepos)%msg(kk) = eigvec_entry
               kk = kk + 1
            END IF
@ -1129,7 +1079,6 @@ CONTAINS
      ALLOCATE (idx_homo(num_entries))
      ALLOCATE (idx_virt(num_entries))
      ALLOCATE (eigvec_entries(num_entries))
      IF (PRESENT(idx_spin)) ALLOCATE (idx_spin(num_entries))
      kk = 1
      DO iproc = 0, para_env%num_pe - 1
@ -1137,7 +1086,6 @@ CONTAINS
            DO ii = 1, num_entries_to_comm(iproc)
               idx_homo(kk) = buffer_entries(iproc)%indx(ii, 1)
               idx_virt(kk) = buffer_entries(iproc)%indx(ii, 2)
               IF (PRESENT(idx_spin)) idx_spin(kk) = buffer_entries(iproc)%indx(ii, 3)
               eigvec_entries(kk) = buffer_entries(iproc)%msg(ii)
               kk = kk + 1
            END DO
@ -1155,12 +1103,8 @@ CONTAINS
      NULLIFY (col_indices)
      !Now sort the results according to the involved singleparticle orbitals
-      ! (homo first, then virtual). idx_spin is payload, permuted alongside the entries.
+      ! (homo first, then virtual)
-      IF (PRESENT(idx_spin)) THEN
+      CALL sort_excitations(idx_homo, idx_virt, eigvec_entries)
         CALL sort_excitations(idx_homo, idx_virt, eigvec_entries, idx_spin)
      ELSE
         CALL sort_excitations(idx_homo, idx_virt, eigvec_entries)
      END IF
      CALL timestop(handle)
@ -1176,47 +1120,35 @@ CONTAINS
 !> \param virt_red Total number of unoccupied orbitals to include after ctuoff
 !> \param homo_incl First occupied index to include after cutoff
 !> \param virt_incl Last unoccupied index to include after cutoff
-!> \param cutoff_occ ...
+!> \param mp2_env ...
 !> \param cutoff_empty ...
 ! **************************************************************************************************
   SUBROUTINE determine_cutoff_indices(Eigenval, &
                                       homo, virtual, &
                                       homo_red, virt_red, &
                                       homo_incl, virt_incl, &
-                                       cutoff_occ, cutoff_empty)
+                                       mp2_env)
      REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: Eigenval
      INTEGER, INTENT(IN)                                :: homo, virtual
      INTEGER, INTENT(OUT)                               :: homo_red, virt_red, homo_incl, virt_incl
-      REAL(KIND=dp), INTENT(IN)                          :: cutoff_occ, cutoff_empty
+      TYPE(mp2_type), INTENT(INOUT)                      :: mp2_env
      CHARACTER(LEN=*), PARAMETER :: routineN = 'determine_cutoff_indices'
-      INTEGER                                            :: handle, i_chk, i_homo, j_virt
+      INTEGER                                            :: handle, i_homo, j_virt
      CALL timeset(routineN, handle)
      ! Determine index in homo and virtual for truncation
-      ! Uses indices of outermost orbitals within energy range (-cutoff_occ,cutoff_empty)
+      ! Uses indices of outermost orbitals within energy range (-mp2_env%bse%bse_cutoff_occ,mp2_env%bse%bse_cutoff_empty)
-      IF (cutoff_occ > 0 .OR. cutoff_empty > 0) THEN
+      IF (mp2_env%bse%bse_cutoff_occ > 0 .OR. mp2_env%bse%bse_cutoff_empty > 0) THEN
-         ! The scans below EXIT at the first orbital beyond the cutoff, which only yields the correct
+         IF (-mp2_env%bse%bse_cutoff_occ < Eigenval(1) - Eigenval(homo) &
-         ! window on an ascending axis. A non-monotonic one (G0W0) stops at the first inversion and
+             .OR. mp2_env%bse%bse_cutoff_occ < 0) THEN
         ! silently drops in-window orbitals.
         DO i_chk = 2, homo + virtual
            IF (Eigenval(i_chk) < Eigenval(i_chk - 1)) THEN
               CALL cp_abort(__LOCATION__, &
                             "determine_cutoff_indices: eigenvalues are not ascending. Take the "// &
                             "energy cutoff on the DFT axis; the G0W0 axis is not ordered.")
            END IF
         END DO
         IF (-cutoff_occ < Eigenval(1) - Eigenval(homo) &
             .OR. cutoff_occ < 0) THEN
            homo_red = homo
            homo_incl = 1
         ELSE
            homo_incl = 1
            DO i_homo = 1, homo
-               IF (Eigenval(i_homo) - Eigenval(homo) > -cutoff_occ) THEN
+               IF (Eigenval(i_homo) - Eigenval(homo) > -mp2_env%bse%bse_cutoff_occ) THEN
                  homo_incl = i_homo
                  EXIT
               END IF
@ -1224,14 +1156,14 @@ CONTAINS
            homo_red = homo - homo_incl + 1
         END IF
-         IF (cutoff_empty > Eigenval(homo + virtual) - Eigenval(homo + 1) &
+         IF (mp2_env%bse%bse_cutoff_empty > Eigenval(homo + virtual) - Eigenval(homo + 1) &
-             .OR. cutoff_empty < 0) THEN
+             .OR. mp2_env%bse%bse_cutoff_empty < 0) THEN
            virt_red = virtual
            virt_incl = virtual
         ELSE
            virt_incl = homo + 1
            DO j_virt = 1, virtual
-               IF (Eigenval(homo + j_virt) - Eigenval(homo + 1) > cutoff_empty) THEN
+               IF (Eigenval(homo + j_virt) - Eigenval(homo + 1) > mp2_env%bse%bse_cutoff_empty) THEN
                  virt_incl = j_virt - 1
                  EXIT
               END IF
@ -1249,91 +1181,6 @@ CONTAINS
   END SUBROUTINE determine_cutoff_indices
 ! **************************************************************************************************
 !> \brief Spin-block layout for the open-shell (joint) BSE matrix: per-spin OV-pair counts and the
 !>        block offsets into the joint matrix of dimension n_ov_joint = sum_sigma homo*virtual.
 !> \param homo_red per-spin (reduced) number of occupied levels
 !> \param virt_red per-spin (reduced) number of virtual levels
 !> \param n_ov per-spin OV-pair count (OUT)
 !> \param offsets per-spin block offset into the joint matrix (OUT)
 !> \param n_ov_joint total joint dimension (OUT)
 ! **************************************************************************************************
   SUBROUTINE get_bse_spin_block_layout(homo_red, virt_red, n_ov, offsets, n_ov_joint)
      INTEGER, DIMENSION(:), INTENT(IN)                  :: homo_red, virt_red
      INTEGER, DIMENSION(:), INTENT(OUT)                 :: n_ov, offsets
      INTEGER, INTENT(OUT)                               :: n_ov_joint
      INTEGER                                            :: isp
      n_ov_joint = 0
      DO isp = 1, SIZE(homo_red)
         offsets(isp) = n_ov_joint
         n_ov(isp) = homo_red(isp)*virt_red(isp)
         n_ov_joint = n_ov_joint + n_ov(isp)
      END DO
   END SUBROUTINE get_bse_spin_block_layout
 ! **************************************************************************************************
 !> \brief Determine a single combined active-MO window covering all spin channels for open-shell
 !>        BSE truncation (per-spin determine_cutoff_indices, then union of bounds). Cuts on the DFT
 !>        axis, as the closed-shell path in truncate_BSE_matrices and linRTBSE's
 !>        determine_active_mo_window do, so the pipelines truncate to the same active space.
 !>        CPWARN if the per-spin cutoff candidates differ.
 !> \param Eigenval_scf per-spin SCF eigenvalues, shape (level, spin)
 !> \param homo per-spin number of occupied levels
 !> \param virtual per-spin number of virtual levels
 !> \param cutoff_occ occupied-orbital energy cutoff
 !> \param cutoff_empty empty-orbital energy cutoff
 !> \param first_active_mo combined first occupied MO index (OUT)
 !> \param last_active_mo combined last MO index (OUT)
 ! **************************************************************************************************
   SUBROUTINE determine_bse_combined_window(Eigenval_scf, homo, virtual, &
                                            cutoff_occ, cutoff_empty, &
                                            first_active_mo, last_active_mo)
      REAL(KIND=dp), DIMENSION(:, :), INTENT(IN)         :: Eigenval_scf
      INTEGER, DIMENSION(:), INTENT(IN)                  :: homo, virtual
      REAL(KIND=dp), INTENT(IN)                          :: cutoff_occ, cutoff_empty
      INTEGER, INTENT(OUT)                               :: first_active_mo, last_active_mo
      CHARACTER(LEN=*), PARAMETER :: routineN = 'determine_bse_combined_window'
      INTEGER                                            :: first_occ_prev, handle, homo_incl, &
                                                            homo_red, isp, last_virt_prev, &
                                                            virt_incl, virt_red
      LOGICAL                                            :: spins_differ
      CALL timeset(routineN, handle)
      first_active_mo = HUGE(0)
      last_active_mo = 0
      first_occ_prev = -1
      last_virt_prev = -1
      spins_differ = .FALSE.
      DO isp = 1, SIZE(homo)
         CALL determine_cutoff_indices(Eigenval_scf(:, isp), homo(isp), virtual(isp), &
                                       homo_red, virt_red, homo_incl, virt_incl, &
                                       cutoff_occ, cutoff_empty)
         IF (isp > 1) THEN
            IF (homo_incl /= first_occ_prev .OR. homo(isp) + virt_incl /= last_virt_prev) THEN
               spins_differ = .TRUE.
            END IF
         END IF
         first_occ_prev = homo_incl
         last_virt_prev = homo(isp) + virt_incl
         first_active_mo = MIN(first_active_mo, homo_incl)
         last_active_mo = MAX(last_active_mo, homo(isp) + virt_incl)
      END DO
      IF (spins_differ) THEN
         CPWARN("BSE: spin-resolved active MO cutoff candidates differ; using combined window.")
      END IF
      CALL timestop(handle)
   END SUBROUTINE determine_bse_combined_window
 ! **************************************************************************************************
 !> \brief Determines indices within the given energy cutoffs and truncates Eigenvalues and matrices
 !> \param fm_mat_S_ia_bse ...
@ -1353,8 +1200,6 @@ CONTAINS
 !> \param homo_red ...
 !> \param virt_red ...
 !> \param mp2_env ...
 !> \param homo_incl_in ...
 !> \param virt_incl_in ...
 ! **************************************************************************************************
   SUBROUTINE truncate_BSE_matrices(fm_mat_S_ia_bse, fm_mat_S_ij_bse, fm_mat_S_ab_bse, &
                                    fm_mat_S_trunc, fm_mat_S_ij_trunc, fm_mat_S_ab_trunc, &
@ -1362,8 +1207,7 @@ CONTAINS
                                    homo, virtual, dimen_RI, unit_nr, &
                                    bse_lev_virt, &
                                    homo_red, virt_red, &
-                                    mp2_env, &
+                                    mp2_env)
                                    homo_incl_in, virt_incl_in)
      TYPE(cp_fm_type), INTENT(IN)                       :: fm_mat_S_ia_bse, fm_mat_S_ij_bse, &
                                                            fm_mat_S_ab_bse
@ -1375,7 +1219,6 @@ CONTAINS
                                                            bse_lev_virt
      INTEGER, INTENT(OUT)                               :: homo_red, virt_red
      TYPE(mp2_type), INTENT(INOUT)                      :: mp2_env
      INTEGER, INTENT(IN), OPTIONAL                      :: homo_incl_in, virt_incl_in
      CHARACTER(LEN=*), PARAMETER :: routineN = 'truncate_BSE_matrices'
@ -1386,58 +1229,45 @@ CONTAINS
      CALL timeset(routineN, handle)
-      ! Determine index in homo and virtual for truncation.
+      ! Determine index in homo and virtual for truncation
-      ! When homo_incl_in/virt_incl_in are provided (combined-window path), skip per-spin
+      ! Uses indices of outermost orbitals within energy range (-mp2_env%bse%bse_cutoff_occ,mp2_env%bse%bse_cutoff_empty)
      ! determine_cutoff_indices and the print; caller already printed via determine_bse_combined_window.
      IF (PRESENT(homo_incl_in)) THEN
         homo_incl = homo_incl_in
         virt_incl = virt_incl_in
         homo_red = homo - homo_incl + 1
         virt_red = virt_incl
      ELSE
         CALL determine_cutoff_indices(Eigenval_scf, &
                                       homo, virtual, &
                                       homo_red, virt_red, &
                                       homo_incl, virt_incl, &
                                       mp2_env%bse%bse_cutoff_occ, mp2_env%bse%bse_cutoff_empty)
-         IF (unit_nr > 0) THEN
+      CALL determine_cutoff_indices(Eigenval_scf, &
-            IF (mp2_env%bse%bse_cutoff_occ > 0) THEN
+                                    homo, virtual, &
-               WRITE (unit_nr, '(T2,A4,T7,A29,T71,F10.3)') 'BSE|', 'Cutoff occupied orbitals [eV]', &
+                                    homo_red, virt_red, &
-                  mp2_env%bse%bse_cutoff_occ*evolt
+                                    homo_incl, virt_incl, &
-            ELSE
+                                    mp2_env)
-               WRITE (unit_nr, '(T2,A4,T7,A37)') 'BSE|', 'No cutoff given for occupied orbitals'
+
-            END IF
+      IF (unit_nr > 0) THEN
-            IF (mp2_env%bse%bse_cutoff_empty > 0) THEN
+         IF (mp2_env%bse%bse_cutoff_occ > 0) THEN
-               WRITE (unit_nr, '(T2,A4,T7,A26,T71,F10.3)') 'BSE|', 'Cutoff empty orbitals [eV]', &
+            WRITE (unit_nr, '(T2,A4,T7,A29,T71,F10.3)') 'BSE|', 'Cutoff occupied orbitals [eV]', &
-                  mp2_env%bse%bse_cutoff_empty*evolt
+               mp2_env%bse%bse_cutoff_occ*evolt
-            ELSE
+         ELSE
-               WRITE (unit_nr, '(T2,A4,T7,A34)') 'BSE|', 'No cutoff given for empty orbitals'
+            WRITE (unit_nr, '(T2,A4,T7,A37)') 'BSE|', 'No cutoff given for occupied orbitals'
            END IF
            WRITE (unit_nr, '(T2,A4,T7,A20,T71,I10)') 'BSE|', 'First occupied index', homo_incl
            WRITE (unit_nr, '(T2,A4,T7,A32,T71,I10)') 'BSE|', 'Last empty index (not MO index!)', virt_incl
            WRITE (unit_nr, '(T2,A4,T7,A35,T71,F10.3)') 'BSE|', 'Energy of first occupied index [eV]', &
               Eigenval(homo_incl)*evolt
            WRITE (unit_nr, '(T2,A4,T7,A31,T71,F10.3)') 'BSE|', 'Energy of last empty index [eV]', &
               Eigenval(homo + virt_incl)*evolt
            WRITE (unit_nr, '(T2,A4,T7,A54,T71,F10.3)') 'BSE|', &
               'Energy difference of first occupied index to HOMO [eV]', &
               -(Eigenval(homo_incl) - Eigenval(homo))*evolt
            WRITE (unit_nr, '(T2,A4,T7,A50,T71,F10.3)') 'BSE|', &
               'Energy difference of last empty index to LUMO [eV]', &
               (Eigenval(homo + virt_incl) - Eigenval(homo + 1))*evolt
            WRITE (unit_nr, '(T2,A4,T7,A35,T71,I10)') 'BSE|', 'Number of GW-corrected occupied MOs', &
               mp2_env%ri_g0w0%corr_mos_occ
            WRITE (unit_nr, '(T2,A4,T7,A32,T71,I10)') 'BSE|', 'Number of GW-corrected empty MOs', &
               bse_lev_virt
            WRITE (unit_nr, '(T2,A4)') 'BSE|'
         END IF
         IF (mp2_env%bse%bse_cutoff_empty > 0) THEN
            WRITE (unit_nr, '(T2,A4,T7,A26,T71,F10.3)') 'BSE|', 'Cutoff empty orbitals [eV]', &
               mp2_env%bse%bse_cutoff_empty*evolt
         ELSE
            WRITE (unit_nr, '(T2,A4,T7,A34)') 'BSE|', 'No cutoff given for empty orbitals'
         END IF
         WRITE (unit_nr, '(T2,A4,T7,A20,T71,I10)') 'BSE|', 'First occupied index', homo_incl
         WRITE (unit_nr, '(T2,A4,T7,A32,T71,I10)') 'BSE|', 'Last empty index (not MO index!)', virt_incl
         WRITE (unit_nr, '(T2,A4,T7,A35,T71,F10.3)') 'BSE|', 'Energy of first occupied index [eV]', Eigenval(homo_incl)*evolt
         WRITE (unit_nr, '(T2,A4,T7,A31,T71,F10.3)') 'BSE|', 'Energy of last empty index [eV]', Eigenval(homo + virt_incl)*evolt
         WRITE (unit_nr, '(T2,A4,T7,A54,T71,F10.3)') 'BSE|', 'Energy difference of first occupied index to HOMO [eV]', &
            -(Eigenval(homo_incl) - Eigenval(homo))*evolt
         WRITE (unit_nr, '(T2,A4,T7,A50,T71,F10.3)') 'BSE|', 'Energy difference of last empty index to LUMO [eV]', &
            (Eigenval(homo + virt_incl) - Eigenval(homo + 1))*evolt
         WRITE (unit_nr, '(T2,A4,T7,A35,T71,I10)') 'BSE|', 'Number of GW-corrected occupied MOs', mp2_env%ri_g0w0%corr_mos_occ
         WRITE (unit_nr, '(T2,A4,T7,A32,T71,I10)') 'BSE|', 'Number of GW-corrected empty MOs', mp2_env%ri_g0w0%corr_mos_virt
         WRITE (unit_nr, '(T2,A4)') 'BSE|'
      END IF
      IF (unit_nr > 0) THEN
         IF (homo - homo_incl + 1 > mp2_env%ri_g0w0%corr_mos_occ) THEN
            CPABORT("Number of GW-corrected occupied MOs too small for chosen BSE cutoff")
         END IF
-         IF (virt_incl > bse_lev_virt) THEN
+         IF (virt_incl > mp2_env%ri_g0w0%corr_mos_virt) THEN
            CPABORT("Number of GW-corrected virtual MOs too small for chosen BSE cutoff")
         END IF
      END IF
@ -1651,7 +1481,7 @@ CONTAINS
                                        cell, dft_control, particle_set, pw_env)
            IF (iset == 1) THEN
               WRITE (filename, '(A6,I3.3,A5,I2.2,a11)') "_NEXC_", istate, "_NTO_", i, "_Hole_State"
-            ELSE IF (iset == 2) THEN
+            ELSEIF (iset == 2) THEN
               WRITE (filename, '(A6,I3.3,A5,I2.2,a15)') "_NEXC_", istate, "_NTO_", i, "_Particle_State"
            END IF
            info_approx_trunc = TRIM(ADJUSTL(info_approximation))
@ -1663,7 +1493,7 @@ CONTAINS
                                                log_filename=.FALSE., ignore_should_output=.TRUE., mpi_io=mpi_io)
            IF (iset == 1) THEN
               WRITE (title, *) "Natural Transition Orbital Hole State", i
-            ELSE IF (iset == 2) THEN
+            ELSEIF (iset == 2) THEN
               WRITE (title, *) "Natural Transition Orbital Particle State", i
            END IF
            CALL cp_pw_to_cube(wf_r, unit_nr_cube, title, particles=particles, stride=stride, mpi_io=mpi_io)
@ -1878,11 +1708,10 @@ CONTAINS
 !> \param homo_red ...
 !> \param virtual_red ...
 !> \param context_BSE ...
 !> \param ispin spin channel whose mo_set supplies homo/nao (default 1); open-shell beta needs 2
 ! **************************************************************************************************
   SUBROUTINE get_multipoles_mo(fm_multipole_ai_trunc, fm_multipole_ij_trunc, fm_multipole_ab_trunc, &
                                qs_env, mo_coeff, rpoint, n_moments, &
-                                homo_red, virtual_red, context_BSE, ispin)
+                                homo_red, virtual_red, context_BSE)
      TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:), &
         INTENT(INOUT)                                   :: fm_multipole_ai_trunc, &
@ -1893,12 +1722,11 @@ CONTAINS
      REAL(dp), ALLOCATABLE, DIMENSION(:), INTENT(INOUT) :: rpoint
      INTEGER, INTENT(IN)                                :: n_moments, homo_red, virtual_red
      TYPE(cp_blacs_env_type), POINTER                   :: context_BSE
      INTEGER, INTENT(IN), OPTIONAL                      :: ispin
      CHARACTER(LEN=*), PARAMETER                        :: routineN = 'get_multipoles_mo'
-      INTEGER                                            :: handle, idir, my_ispin, n_multipole, &
+      INTEGER                                            :: handle, idir, n_multipole, n_occ, &
-                                                            n_occ, n_virt, nao, nmo_mp2
+                                                            n_virt, nao, nmo_mp2
      REAL(KIND=dp), DIMENSION(:), POINTER               :: ref_point
      TYPE(cp_fm_struct_type), POINTER :: fm_struct_mp_ab_trunc, fm_struct_mp_ai_trunc, &
         fm_struct_mp_ij_trunc, fm_struct_multipoles_ao, fm_struct_nao_nmo, fm_struct_nmo_nmo
@ -1912,9 +1740,6 @@ CONTAINS
      CALL timeset(routineN, handle)
      my_ispin = 1
      IF (PRESENT(ispin)) my_ispin = ispin
      !First, we calculate the AO dipoles
      NULLIFY (sab_orb, matrix_s)
      CALL get_qs_env(qs_env, &
@ -1923,7 +1748,7 @@ CONTAINS
                      sab_orb=sab_orb)
      ! Use the same blacs environment as for the MO coefficients to ensure correct multiplication dbcsr x fm later on
-      fm_struct_multipoles_ao => mos(my_ispin)%mo_coeff%matrix_struct
+      fm_struct_multipoles_ao => mos(1)%mo_coeff%matrix_struct
      ! BSE has different contexts and blacsenvs
      para_env_BSE => context_BSE%para_env
      ! Get size of multipole tensor
@ -1949,7 +1774,7 @@ CONTAINS
      ! n_occ is the number of occupied MOs, nao the number of all AOs
      ! Writing homo to n_occ instead if nmo,
      ! takes care of ADDED_MOS, which would overwrite nmo of qs_env-mos, if invoked
-      CALL get_mo_set(mo_set=mos(my_ispin), homo=n_occ, nao=nao)
+      CALL get_mo_set(mo_set=mos(1), homo=n_occ, nao=nao)
      ! Takes into account removed nullspace values from SVD
      nmo_mp2 = mo_coeff(1)%matrix_struct%ncol_global
      n_virt = nmo_mp2 - n_occ
@ -2098,32 +1923,4 @@ CONTAINS
   END SUBROUTINE trace_exciton_descr
 ! **************************************************************************************************
 !> \brief Column-concatenate per-spin ia-slabs into the joint dimen_RI x n_ov_joint slab.
 !>   Sigma-block of spin isp occupies columns offsets(isp)+1 .. offsets(isp)+n_ov(isp).
 !>   fm_S_joint must be pre-created and zeroed by the caller.
 !> \param fm_S_ia per-spin ia-slabs, shape (dimen_RI, n_ov(isp)) per spin
 !> \param offsets per-spin column offsets into fm_S_joint (0-based)
 !> \param n_ov per-spin OV-pair counts
 !> \param dimen_RI RI auxiliary basis dimension (row count)
 !> \param fm_S_joint pre-created output slab (dimen_RI x n_ov_joint)
 ! **************************************************************************************************
   SUBROUTINE assemble_joint_ov_slab(fm_S_ia, offsets, n_ov, dimen_RI, fm_S_joint)
      TYPE(cp_fm_type), DIMENSION(:), INTENT(IN)         :: fm_S_ia
      INTEGER, DIMENSION(:), INTENT(IN)                  :: offsets, n_ov
      INTEGER, INTENT(IN)                                :: dimen_RI
      TYPE(cp_fm_type), INTENT(INOUT)                    :: fm_S_joint
      CHARACTER(LEN=*), PARAMETER :: routineN = 'assemble_joint_ov_slab'
      INTEGER                                            :: handle, isp
      CALL timeset(routineN, handle)
      DO isp = 1, SIZE(fm_S_ia)
         CALL cp_fm_to_fm_submat(fm_S_ia(isp), fm_S_joint, dimen_RI, n_ov(isp), 1, 1, 1, offsets(isp) + 1)
      END DO
      CALL timestop(handle)
   END SUBROUTINE assemble_joint_ov_slab
 END MODULE bse_util
--- a/src/bsse.F
+++ b/src/bsse.F
@ -370,10 +370,10 @@ CONTAINS
      iw = cp_print_key_unit_nr(logger, bsse_section, "PRINT%PROGRAM_RUN_INFO", &
                                extension=".log")
      IF (iw > 0) THEN
-         WRITE (conf_s, fmt="(1000I0)", iostat=istat) conf
+         WRITE (conf_s, fmt="(1000I0)", iostat=istat) conf;
         IF (istat /= 0) conf_s = "exceeded"
         CALL compress(conf_s, full=.TRUE.)
-         WRITE (conf_loc_s, fmt="(1000I0)", iostat=istat) conf_loc
+         WRITE (conf_loc_s, fmt="(1000I0)", iostat=istat) conf_loc;
         IF (istat /= 0) conf_loc_s = "exceeded"
         CALL compress(conf_loc_s, full=.TRUE.)
@ -429,17 +429,15 @@ CONTAINS
      IF (explicit) THEN
         DO i = 1, nconf
            CALL section_vals_val_get(configurations, "GLB_CONF", i_rep_section=i, i_vals=glb_conf)
-            IF (SIZE(glb_conf) /= SIZE(conf)) THEN
+            IF (SIZE(glb_conf) /= SIZE(conf)) &
               CALL cp_abort(__LOCATION__, &
                             "GLB_CONF requires a binary description of the configuration. Number of integer "// &
                             "different from the number of fragments defined!")
            END IF
            CALL section_vals_val_get(configurations, "SUB_CONF", i_rep_section=i, i_vals=sub_conf)
-            IF (SIZE(sub_conf) /= SIZE(conf)) THEN
+            IF (SIZE(sub_conf) /= SIZE(conf)) &
               CALL cp_abort(__LOCATION__, &
                             "SUB_CONF requires a binary description of the configuration. Number of integer "// &
                             "different from the number of fragments defined!")
            END IF
            IF (ALL(conf == glb_conf) .AND. ALL(conf_loc == sub_conf)) THEN
               CALL section_vals_val_get(configurations, "CHARGE", i_rep_section=i, &
                                         i_val=present_charge)
--- a/src/cell_methods.F
+++ b/src/cell_methods.F
@ -461,12 +461,11 @@ CONTAINS
      CALL section_vals_val_get(cell_section, "CELL_FILE_NAME", explicit=cell_read_file)
      IF (cell_read_file) THEN ! Case 1
         tmp_comb_cell = (cell_read_abc .OR. (cell_read_a .OR. (cell_read_b .OR. cell_read_c)))
-         IF (tmp_comb_cell) THEN
+         IF (tmp_comb_cell) &
            CALL cp_warn(__LOCATION__, &
                         "Cell Information provided through A, B, C, or ABC in conjunction "// &
                         "with CELL_FILE_NAME. The definition in external file will override "// &
                         "other ones.")
         END IF
         CALL section_vals_val_get(cell_section, "CELL_FILE_NAME", c_val=cell_file_name)
         CALL section_vals_val_get(cell_section, "CELL_FILE_FORMAT", i_val=cell_file_format)
         SELECT CASE (cell_file_format)
@ -492,11 +491,10 @@ CONTAINS
            read_len = cell_par
            CALL section_vals_val_get(cell_section, "ALPHA_BETA_GAMMA", r_vals=cell_par)
            read_ang = cell_par
-            IF (cell_read_a .OR. cell_read_b .OR. cell_read_c) THEN
+            IF (cell_read_a .OR. cell_read_b .OR. cell_read_c) &
               CALL cp_warn(__LOCATION__, &
                            "Cell information provided through vectors A, B or C in conjunction with ABC. "// &
                            "The definition of the ABC keyword will override the one provided by A, B and C.")
            END IF
         ELSE ! Case 3
            tmp_comb_abc = ((cell_read_a .EQV. cell_read_b) .AND. (cell_read_b .EQV. cell_read_c))
            IF (tmp_comb_abc) THEN
@ -506,11 +504,10 @@ CONTAINS
               read_mat(:, 2) = cell_par(:)
               CALL section_vals_val_get(cell_section, "C", r_vals=cell_par)
               read_mat(:, 3) = cell_par(:)
-               IF (cell_read_alpha_beta_gamma) THEN
+               IF (cell_read_alpha_beta_gamma) &
                  CALL cp_warn(__LOCATION__, &
                               "The keyword ALPHA_BETA_GAMMA is ignored because it was used without the "// &
                               "keyword ABC.")
               END IF
            ELSE
               CALL cp_abort(__LOCATION__, &
                             "Neither of the keywords CELL_FILE_NAME or ABC are specified, "// &
@ -725,11 +722,10 @@ CONTAINS
      CPASSERT(ASSOCIATED(cell))
      ! Abort, if one of the value is set to zero
-      IF (ANY(multiple_unit_cell <= 0)) THEN
+      IF (ANY(multiple_unit_cell <= 0)) &
         CALL cp_abort(__LOCATION__, &
                       "CELL%MULTIPLE_UNIT_CELL accepts only integer values larger than 0! "// &
                       "A value of 0 or negative is meaningless!")
      END IF
      ! Scale abc according to user request
      cell%hmat(:, 1) = cell%hmat(:, 1)*multiple_unit_cell(1)
@ -782,9 +778,8 @@ CONTAINS
      IF (.NOT. found) THEN
         CALL parser_search_string(parser, "_cell.length_a", ignore_case=.FALSE., found=found, &
                                   begin_line=.FALSE., search_from_begin_of_file=.TRUE.)
-         IF (.NOT. found) THEN
+         IF (.NOT. found) &
            CPABORT("The field _cell_length_a or _cell.length_a was not found in CIF file! ")
         END IF
      END IF
      CALL cif_get_real(parser, cell_lengths(1))
      cell_lengths(1) = cp_unit_to_cp2k(cell_lengths(1), "angstrom")
@ -795,9 +790,8 @@ CONTAINS
      IF (.NOT. found) THEN
         CALL parser_search_string(parser, "_cell.length_b", ignore_case=.FALSE., found=found, &
                                   begin_line=.FALSE., search_from_begin_of_file=.TRUE.)
-         IF (.NOT. found) THEN
+         IF (.NOT. found) &
            CPABORT("The field _cell_length_b or _cell.length_b was not found in CIF file! ")
         END IF
      END IF
      CALL cif_get_real(parser, cell_lengths(2))
      cell_lengths(2) = cp_unit_to_cp2k(cell_lengths(2), "angstrom")
@ -808,9 +802,8 @@ CONTAINS
      IF (.NOT. found) THEN
         CALL parser_search_string(parser, "_cell.length_c", ignore_case=.FALSE., found=found, &
                                   begin_line=.FALSE., search_from_begin_of_file=.TRUE.)
-         IF (.NOT. found) THEN
+         IF (.NOT. found) &
            CPABORT("The field _cell_length_c or _cell.length_c was not found in CIF file! ")
         END IF
      END IF
      CALL cif_get_real(parser, cell_lengths(3))
      cell_lengths(3) = cp_unit_to_cp2k(cell_lengths(3), "angstrom")
@ -821,9 +814,8 @@ CONTAINS
      IF (.NOT. found) THEN
         CALL parser_search_string(parser, "_cell.angle_alpha", ignore_case=.FALSE., found=found, &
                                   begin_line=.FALSE., search_from_begin_of_file=.TRUE.)
-         IF (.NOT. found) THEN
+         IF (.NOT. found) &
            CPABORT("The field _cell_angle_alpha or _cell.angle_alpha was not found in CIF file! ")
         END IF
      END IF
      CALL cif_get_real(parser, cell_angles(1))
      cell_angles(1) = cp_unit_to_cp2k(cell_angles(1), "deg")
@ -834,9 +826,8 @@ CONTAINS
      IF (.NOT. found) THEN
         CALL parser_search_string(parser, "_cell.angle_beta", ignore_case=.FALSE., found=found, &
                                   begin_line=.FALSE., search_from_begin_of_file=.TRUE.)
-         IF (.NOT. found) THEN
+         IF (.NOT. found) &
            CPABORT("The field _cell_angle_beta or _cell.angle_beta was not found in CIF file! ")
         END IF
      END IF
      CALL cif_get_real(parser, cell_angles(2))
      cell_angles(2) = cp_unit_to_cp2k(cell_angles(2), "deg")
@ -847,9 +838,8 @@ CONTAINS
      IF (.NOT. found) THEN
         CALL parser_search_string(parser, "_cell.angle_gamma", ignore_case=.FALSE., found=found, &
                                   begin_line=.FALSE., search_from_begin_of_file=.TRUE.)
-         IF (.NOT. found) THEN
+         IF (.NOT. found) &
            CPABORT("The field _cell_angle_gamma or _cell.angle_gamma was not found in CIF file! ")
         END IF
      END IF
      CALL cif_get_real(parser, cell_angles(3))
      cell_angles(3) = cp_unit_to_cp2k(cell_angles(3), "deg")
@ -1202,9 +1192,8 @@ CONTAINS
      CALL parser_search_string(parser, "CRYST1", ignore_case=.FALSE., found=found, &
                                begin_line=.TRUE., search_from_begin_of_file=.TRUE.)
-      IF (.NOT. found) THEN
+      IF (.NOT. found) &
         CPABORT("The line <CRYST1> was not found in PDB file! ")
      END IF
      periodic = 1
      READ (parser%input_line, *, IOSTAT=ios) cryst, cell_lengths(:), cell_angles(:)
--- a/src/colvar_methods.F
+++ b/src/colvar_methods.F
@ -618,12 +618,11 @@ CONTAINS
         ALLOCATE (colvar%combine_cvs_param%variables(SIZE(my_par)))
         colvar%combine_cvs_param%variables = my_par
         ! Check that the number of COLVAR provided is equal to the number of variables..
-         IF (SIZE(my_par) /= ncol) THEN
+         IF (SIZE(my_par) /= ncol) &
            CALL cp_abort(__LOCATION__, &
                          "Number of defined COLVAR for COMBINE_COLVAR is different from the "// &
                          "number of variables! It is not possible to define COLVARs in a COMBINE_COLVAR "// &
                          "and avoid their usage in the combininig function!")
         END IF
         ! Parameters
         ALLOCATE (colvar%combine_cvs_param%c_parameters(0))
         CALL section_vals_val_get(combine_section, "PARAMETERS", n_rep_val=ncol)
@ -727,9 +726,8 @@ CONTAINS
         ! Read the specification of the two planes
         plane_sections => section_vals_get_subs_vals(plane_plane_angle_section, "PLANE")
         CALL section_vals_get(plane_sections, n_repetition=n_var)
-         IF (n_var /= 2) THEN
+         IF (n_var /= 2) &
            CPABORT("PLANE_PLANE_ANGLE Colvar section: Two PLANE sections must be provided!")
         END IF
         ! Plane 1
         CALL section_vals_val_get(plane_sections, "DEF_TYPE", i_rep_section=1, &
                                   i_val=colvar%plane_plane_angle_param%plane1%type_of_def)
@ -738,9 +736,8 @@ CONTAINS
                                      r_vals=s1)
            colvar%plane_plane_angle_param%plane1%normal_vec = s1
            IF (PRESENT(cell)) THEN
-               IF (ASSOCIATED(cell)) THEN
+               IF (ASSOCIATED(cell)) &
                  CALL cell_transform_input_cartesian(cell, colvar%plane_plane_angle_param%plane1%normal_vec)
               END IF
            END IF
         ELSE
            CALL section_vals_val_get(plane_sections, "ATOMS", i_rep_section=1, &
@ -756,9 +753,8 @@ CONTAINS
                                      r_vals=s1)
            colvar%plane_plane_angle_param%plane2%normal_vec = s1
            IF (PRESENT(cell)) THEN
-               IF (ASSOCIATED(cell)) THEN
+               IF (ASSOCIATED(cell)) &
                  CALL cell_transform_input_cartesian(cell, colvar%plane_plane_angle_param%plane2%normal_vec)
               END IF
            END IF
         ELSE
            CALL section_vals_val_get(plane_sections, "ATOMS", i_rep_section=2, &
@ -867,10 +863,9 @@ CONTAINS
                  weights(ndim + 1:ndim + SIZE(wei)) = wei
                  ndim = ndim + SIZE(wei)
               END DO
-               IF (ndim /= colvar%rmsd_param%n_atoms) THEN
+               IF (ndim /= colvar%rmsd_param%n_atoms) &
                  CALL cp_abort(__LOCATION__, "CV RMSD: list of atoms and list of "// &
                                "weights need to contain same number of entries. ")
               END IF
               DO i = 1, ndim
                  ii = colvar%rmsd_param%i_rmsd(i)
                  colvar%rmsd_param%weights(ii) = weights(i)
@ -952,13 +947,11 @@ CONTAINS
                                   i_val=colvar%ring_puckering_param%iq)
         ! test the validity of the parameters
         ndim = colvar%ring_puckering_param%nring
-         IF (ndim <= 3) THEN
+         IF (ndim <= 3) &
            CPABORT("CV Ring Puckering: Ring size has to be 4 or larger. ")
         END IF
         ii = colvar%ring_puckering_param%iq
-         IF (ABS(ii) == 1 .OR. ii < -(ndim - 1)/2 .OR. ii > ndim/2) THEN
+         IF (ABS(ii) == 1 .OR. ii < -(ndim - 1)/2 .OR. ii > ndim/2) &
            CPABORT("CV Ring Puckering: Invalid coordinate number.")
         END IF
      ELSE IF (my_subsection(23)) THEN
         ! Minimum Distance
         wrk_section => mindist_section
@ -1333,7 +1326,7 @@ CONTAINS
            IF (colvar%ring_puckering_param%iq == 0) THEN
               WRITE (iw, '( A,T40,A)') ' COLVARS| Ring Puckering      >>> coordinate', &
                  ' Total Puckering Amplitude'
-            ELSE IF (colvar%ring_puckering_param%iq > 0) THEN
+            ELSEIF (colvar%ring_puckering_param%iq > 0) THEN
               WRITE (iw, '( A,T35,A,T57,I8)') ' COLVARS| Ring Puckering      >>> coordinate', &
                  ' Puckering Amplitude', &
                  colvar%ring_puckering_param%iq
@ -2196,12 +2189,11 @@ CONTAINS
               CALL put_derivative(colvar, iatom, fi)
            END DO
         ELSE
-            IF (force_env%in_use /= use_mixed_force) THEN
+            IF (force_env%in_use /= use_mixed_force) &
               CALL cp_abort(__LOCATION__, &
                             'ASSERTION (cond) failed at line '//cp_to_string(__LINE__)// &
                             ' A combination of mixed force_eval energies has been requested as '// &
                             ' collective variable, but the MIXED env is not in use! Aborting.')
            END IF
            CALL force_env_get(force_env, force_env_section=force_env_section)
            mapping_section => section_vals_get_subs_vals(force_env_section, "MIXED%MAPPING")
            NULLIFY (values, parameters, subsystems, particles, global_forces, map_index, glob_natoms)
@ -2691,8 +2683,8 @@ CONTAINS
      ss = ss - NINT(ss)
      xkj = MATMUL(cell%hmat, ss)
      ! evaluation of the angle..
-      a = NORM2(xij)
+      a = SQRT(DOT_PRODUCT(xij, xij))
-      b = NORM2(xkj)
+      b = SQRT(DOT_PRODUCT(xkj, xkj))
      t0 = 1.0_dp/(a*b)
      t1 = 1.0_dp/(a**3.0_dp*b)
      t2 = 1.0_dp/(a*b**3.0_dp)
@ -2842,8 +2834,8 @@ CONTAINS
      ss = ss - NINT(ss)
      xkj = MATMUL(cell%hmat, ss)
      ! Evaluation of the angle..
-      a = NORM2(xij)
+      a = SQRT(DOT_PRODUCT(xij, xij))
-      b = NORM2(xkj)
+      b = SQRT(DOT_PRODUCT(xkj, xkj))
      t0 = 1.0_dp/(a*b)
      t1 = 1.0_dp/(a**3.0_dp*b)
      t2 = 1.0_dp/(a*b**3.0_dp)
@ -3145,6 +3137,10 @@ CONTAINS
      TYPE(particle_list_type), POINTER                  :: particles_i
      TYPE(particle_type), DIMENSION(:), POINTER         :: my_particles
      ! settings for numerical derivatives
      !REAL(KIND=dp) :: ri_step, dx_bond_j, dy_bond_j, dz_bond_j
      !INTEGER :: idel
      n_atoms_to = colvar%qparm_param%n_atoms_to
      n_atoms_from = colvar%qparm_param%n_atoms_from
      rcut = colvar%qparm_param%rcut
@ -3163,6 +3159,10 @@ CONTAINS
      CPASSERT(r1cut < rcut)
      denominator_tolerance = 1.0E-8_dp
      !ri_step=0.1
      !DO idel=-50, 50
      !ftmp(:) = 0.0_dp
      qparm = 0.0_dp
      inv_n_atoms_from = 1.0_dp/REAL(n_atoms_from, KIND=dp)
      DO ii = 1, n_atoms_from
@ -3200,10 +3200,11 @@ CONTAINS
                     shift(:) = 0.0_dp
                     shift(idim) = 1.0_dp
                     xij_shift = MATMUL(cell%hmat, shift)
-                     rij_shift = NORM2(xij_shift)
+                     rij_shift = SQRT(DOT_PRODUCT(xij_shift, xij_shift))
                     ncells(idim) = FLOOR(rcut/rij_shift - 0.5)
                  END DO !idim
                  !IF (mm.eq.0) WRITE(*,'(A8,3I3,A3,I10)') "Ncells:", ncells, "J:", j
                  shift(1:3) = 0.0_dp
                  DO aa = -ncells(1), ncells(1)
                     DO bb = -ncells(2), ncells(2)
@ -3214,7 +3215,12 @@ CONTAINS
                           shift(2) = REAL(bb, KIND=dp)
                           shift(3) = REAL(cc, KIND=dp)
                           xij = MATMUL(cell%hmat, ss0(:) + shift(:))
-                           rij = NORM2(xij)
+                           rij = SQRT(DOT_PRODUCT(xij, xij))
                           !IF (rij > rcut) THEN
                           !   IF (mm==0) WRITE(*,'(A8,4F10.5)') " --", shift, rij
                           !ELSE
                           !   IF (mm==0) WRITE(*,'(A8,4F10.5)') " ++", shift, rij
                           !ENDIF
                           IF (rij > rcut) CYCLE
                           ! update qlm
@ -3230,7 +3236,7 @@ CONTAINS
                  IF (i == j) CYCLE jloop
                  xij(:) = xpj(:) - xpi(:)
-                  rij = NORM2(xij)
+                  rij = SQRT(DOT_PRODUCT(xij, xij))
                  IF (rij > rcut) CYCLE jloop
                  ! update qlm
@ -3245,6 +3251,11 @@ CONTAINS
            ! this factor is necessary if one whishes to sum over m=0,L
            ! instead of m=-L,+L. This is off now because it is cheap and safe
            fact = 1.0_dp
            !IF (ABS(mm) > 0) THEN
            !   fact = 2.0_dp
            !ELSE
            !   fact = 1.0_dp
            !ENDIF
            IF (nbond < denominator_tolerance) THEN
               CPWARN("QPARM: number of neighbors is very close to zero!")
@ -3263,6 +3274,7 @@ CONTAINS
         END DO ! loop over m
         pre_fac = (4.0_dp*pi)/(2.0_dp*l + 1)
         !WRITE(*,'(A8,2F10.5)') "  si = ", SQRT(pre_fac*ql)
         qparm = qparm + SQRT(pre_fac*ql)
         ftmp(:) = 0.5_dp*SQRT(pre_fac/ql)*d_ql_dxi(:)
         ! multiply by -1 because aparently we have to save the force, not the gradient
@ -3275,6 +3287,10 @@ CONTAINS
      colvar%ss = qparm*inv_n_atoms_from
      colvar%dsdr(:, :) = colvar%dsdr(:, :)*inv_n_atoms_from
      !WRITE(*,'(A15,3E20.10)') "COLVAR+DER = ", ri_step*idel, colvar%ss, -ftmp(1)
      !ENDDO ! numercal derivative
   END SUBROUTINE qparm_colvar
 ! **************************************************************************************************
@ -3307,6 +3323,7 @@ CONTAINS
                                                            exp_fac, fi, plm, pre_fac, sqrt_c1
      REAL(KIND=dp), DIMENSION(3)                        :: dcosTheta, dfi
      !bond = 1.0_dp/(1.0_dp+EXP(alpha*(rij-rcut)))
      ! RZK: infinitely differentiable smooth cutoff function
      ! that is precisely 1.0 below r1cut and precisely 0.0 above rcut
      IF (rij > rcut) THEN
@ -3349,10 +3366,18 @@ CONTAINS
      sqrt_c1 = SQRT(((2*ll + 1)*fac(ll - ABS(mm)))/(4*pi*fac(ll + ABS(mm))))
      pre_fac = bond*sqrt_c1
      dylm = pre_fac*dplm
      !WHY? IF (plm < 0.0_dp) THEN
      !WHY?    dylm = -pre_fac*dplm
      !WHY? ELSE
      !WHY?    dylm = pre_fac*dplm
      !WHY? ENDIF
      re_qlm = re_qlm + pre_fac*plm*COS(mm*fi)
      im_qlm = im_qlm + pre_fac*plm*SIN(mm*fi)
      !WRITE(*,'(A8,2I4,F10.5)') "  Qlm = ", mm, j, bond
      !WRITE(*,'(A8,2I4,2F10.5)') "  Qlm = ", mm, j, re_qlm, im_qlm
      dcosTheta(:) = xij(:)*xij(3)/(rij**3)
      dcosTheta(3) = dcosTheta(3) - 1.0_dp/rij
      ! use tangent half-angle formula to compute d_fi/d_xi
@ -4570,7 +4595,7 @@ CONTAINS
      IF (colvar%reaction_path_param%dist_rmsd) THEN
         CALL rpath_dist_rmsd(colvar, my_particles)
-      ELSE IF (colvar%reaction_path_param%rmsd) THEN
+      ELSEIF (colvar%reaction_path_param%rmsd) THEN
         CALL rpath_rmsd(colvar, my_particles)
      ELSE
         CALL rpath_colvar(colvar, cell, my_particles)
@ -4923,7 +4948,7 @@ CONTAINS
      IF (colvar%reaction_path_param%dist_rmsd) THEN
         CALL dpath_dist_rmsd(colvar, my_particles)
-      ELSE IF (colvar%reaction_path_param%rmsd) THEN
+      ELSEIF (colvar%reaction_path_param%rmsd) THEN
         CALL dpath_rmsd(colvar, my_particles)
      ELSE
         CALL dpath_colvar(colvar, cell, my_particles)
@ -5839,12 +5864,11 @@ CONTAINS
               DO j = 1, natom
                  ! Atom coordinates
                  CALL parser_get_next_line(parser, 1, at_end=my_end)
-                  IF (my_end) THEN
+                  IF (my_end) &
                     CALL cp_abort(__LOCATION__, &
                                   "Number of lines in XYZ format not equal to the number of atoms."// &
                                   " Error in XYZ format for COORD_A (CV rmsd). Very probably the"// &
                                   " line with title is missing or is empty. Please check the XYZ file and rerun your job!")
                  END IF
                  READ (parser%input_line, *) dummy_char, rptr(1:3)
                  r_ref((j - 1)*3 + 1, i) = cp_unit_to_cp2k(rptr(1), "angstrom")
                  r_ref((j - 1)*3 + 2, i) = cp_unit_to_cp2k(rptr(2), "angstrom")
@ -5942,7 +5966,12 @@ CONTAINS
            iamin = wcai(i)
         END IF
      END DO
 !     zero=0.0_dp
 !     CALL put_derivative(colvar, 1, zero)
 !     CALL put_derivative(colvar, 2,zero)
 !     CALL put_derivative(colvar, 3, zero)
 !     write(*,'(2(i0,1x),4(f16.8,1x))')idmin,iamin,wc(1)%WannierHamDiag(idmin),wc(1)%WannierHamDiag(iamin),dmin,amin
      colvar%ss = wc(1)%WannierHamDiag(idmin) - wc(1)%WannierHamDiag(iamin)
      DEALLOCATE (wcai)
      DEALLOCATE (wcdi)
@ -5959,7 +5988,7 @@ CONTAINS
         s = MATMUL(cell%h_inv, rij)
         s = s - NINT(s)
         xv = MATMUL(cell%hmat, s)
-         distance = NORM2(xv)
+         distance = SQRT(DOT_PRODUCT(xv, xv))
      END FUNCTION distance
   END SUBROUTINE Wc_colvar
@ -5978,8 +6007,8 @@ CONTAINS
      TYPE(cell_type), POINTER                 :: cell
      TYPE(cp_subsys_type), OPTIONAL, POINTER  :: subsys
      TYPE(particle_type), DIMENSION(:), &
-         OPTIONAL, POINTER                     :: particles
+         OPTIONAL, POINTER                      :: particles
-      TYPE(qs_environment_type), OPTIONAL, POINTER       :: qs_env
+      TYPE(qs_environment_type), POINTER, OPTIONAL       :: qs_env ! optional just because I am lazy... but I should get rid of it...
      INTEGER                                  :: Od, H, Oa
      REAL(dp)                                 :: rOd(3), rOa(3), rH(3), &
@ -6076,7 +6105,7 @@ CONTAINS
         s = MATMUL(cell%h_inv, rij)
         s = s - NINT(s)
         xv = MATMUL(cell%hmat, s)
-         distance = NORM2(xv)
+         distance = SQRT(DOT_PRODUCT(xv, xv))
      END FUNCTION distance
   END SUBROUTINE HBP_colvar
--- a/src/common/array_sort.fypp
+++ b/src/common/array_sort.fypp
@ -97,9 +97,9 @@
            ! Merge will be performed directly in arr. Need backup of first sublist.
            tmp_arr(1:m) = arr(1:m)
            tmp_idx(1:m) = indices(1:m)
-            i = 1 ! number of elements consumed from 1st sublist
+            i = 1; ! number of elemens consumed from 1st sublist
-            j = 1 ! number of elements consumed from 2nd sublist
+            j = 1; ! number of elemens consumed from 2nd sublist
-            k = 1 ! number of elements already merged
+            k = 1; ! number of elemens already merged
            DO WHILE (i <= m .and. j <= size(arr) - m)
               IF (${prefix}$_less_than(arr(m + j), tmp_arr(i))) THEN
--- a/src/common/bibliography.F
+++ b/src/common/bibliography.F
@ -66,7 +66,7 @@ MODULE bibliography
                            Kantorovich2008a, Wellendorff2012, Niklasson2014, Borstnik2014, &
                            Rayson2009, Grimme2011, Fattebert2002, Andreussi2012, &
                            Khaliullin2007, Khaliullin2008, Merlot2014, Lin2009, Lin2013, Lin2016ACE, &
-                            Batzner2022, Batatia2022, DelBen2015, Souza2002, Umari2002, Stengel2009, &
+                            Batzner2022, DelBen2015, Souza2002, Umari2002, Stengel2009, &
                            Luber2014, Berghold2011, DelBen2015b, Campana2009, &
                            Schiffmann2015, Bruck2014, Rappe1992, Ceriotti2012, &
                            Ceriotti2010, Walewski2014, Monkhorst1976, MacDonald1978, Worlton1972, &
@ -97,7 +97,7 @@ MODULE bibliography
                            FuHo1983, MethfesselPaxton1989, Marzari1999, dosSantos2023, Mermin1965, &
                            KuhneHeskeProdan2020, Schreder2021, Schreder2024_1, Schreder2024_2, &
                            Shiga2022, Lindh1995, Chai2024a, Rullan2026, Sundararaman2017, Andreussi2019, &
-                            Chai2025a, Neugebauer2023
+                            Chai2025a
 CONTAINS
@ -164,13 +164,6 @@ CONTAINS
                         source="Nat. Commun.", volume="13", pages="2453", &
                         year=2022, doi="10.1038/s41467-022-29939-5")
      CALL add_reference(key=Batatia2022, &
                         authors=s2a("I. Batatia", "D. P. Kovacs", "G. N. C. Simm", "C. Ortner", "G. Csanyi"), &
                         title="MACE: Higher order equivariant message passing neural networks "// &
                         "for fast and accurate force fields", &
                         source="Adv. Neural Inf. Process. Syst.", volume="35", pages="11423-11436", &
                         year=2022, doi="10.48550/arXiv.2206.07697")
      CALL add_reference(key=VandenCic2006, &
                         authors=s2a("E. Vanden-Eijnden", "G. Ciccotti"), &
                         title="Second-order integrators for Langevin equations with holonomic constraints", &
@ -796,13 +789,6 @@ CONTAINS
                         source="J. Chem. Theory Comput.", volume="15", pages="1652-1671", &
                         year=2019, doi="10.1021/acs.jctc.8b01176")
      CALL add_reference(key=Neugebauer2023, &
                         authors=s2a("H. Neugebauer", "B. Baedorf", "S. Ehlert", "A. Hansen", "S. Grimme"), &
                         title="High-throughput screening of spin states for transition metal complexes "// &
                         "with spin-polarized extended tight-binding methods", &
                         source="J. Comput. Chem.", volume="44", pages="2120-2129", &
                         year=2023, doi="10.1002/jcc.27185")
      CALL add_reference(key=Katbashev2025, &
                         authors=s2a("A. Katbashev", "M. Stahn", "T. Rose", "V. Alizadeh", &
                                     "M. Friede", "C. Plett", "P. Steinbach", "S. Ehlert"), &
--- a/src/common/cp_array_utils.F
+++ b/src/common/cp_array_utils.F
@ -152,9 +152,8 @@ CONTAINS
                  WRITE (unit=unit_nr, fmt="(',')", advance="no")
               END IF
            END DO
-            IF (SIZE(array) > 0) THEN
+            IF (SIZE(array) > 0) &
               WRITE (unit=unit_nr, fmt=el_format, advance="no") array(SIZE(array))
            END IF
         ELSE
            DO i = 1, SIZE(array) - 1
               WRITE (unit=unit_nr, fmt=defaultFormat, advance="no") array(i)
@ -164,9 +163,8 @@ CONTAINS
                  WRITE (unit=unit_nr, fmt="(',')", advance="no")
               END IF
            END DO
-            IF (SIZE(array) > 0) THEN
+            IF (SIZE(array) > 0) &
               WRITE (unit=unit_nr, fmt=defaultFormat, advance="no") array(SIZE(array))
            END IF
         END IF
         WRITE (unit=unit_nr, fmt="(' )')")
         call m_flush(unit_nr)
@ -291,7 +289,8 @@ CONTAINS
 !> \note
 !>      the array should be ordered in growing order
 ! **************************************************************************************************
-      FUNCTION cp_1d_${nametype1}$_bsearch(array, el, l_index, u_index) result(res)
+      FUNCTION cp_1d_${nametype1}$_bsearch(array, el, l_index, u_index) &
         result(res)
         ${type1}$, intent(in) :: array(:)
         ${type1}$, intent(in) :: el
         INTEGER, INTENT(in), OPTIONAL :: l_index, u_index
--- a/src/common/cp_error_handling.F
+++ b/src/common/cp_error_handling.F
@ -63,9 +63,8 @@ CONTAINS
      CALL delay_non_master() ! cleaner output if all ranks abort simultaneously
      unit_nr = cp_logger_get_default_io_unit()
-      IF (unit_nr <= 0) THEN
+      IF (unit_nr <= 0) &
-         unit_nr = default_output_unit
+         unit_nr = default_output_unit ! fall back to stdout
      END IF ! fall back to stdout
      CALL print_abort_message(message, location, unit_nr)
      CALL print_stack(unit_nr)
@ -126,9 +125,8 @@ CONTAINS
      ! we (ab)use the logger to determine the first MPI rank
      unit_nr = cp_logger_get_default_io_unit()
-      IF (unit_nr <= 0) THEN
+      IF (unit_nr <= 0) &
-         wait_time = wait_time + 1.0_dp
+         wait_time = wait_time + 1.0_dp ! rank-0 gets a head start of one second.
      END IF ! rank-0 gets a head start of one second.
 !$    IF (omp_get_thread_num() /= 0) &
 !$       wait_time = wait_time + 1.0_dp ! master threads gets another second
--- a/src/common/cp_log_handling.F
+++ b/src/common/cp_log_handling.F
@ -303,9 +303,8 @@ CONTAINS
      logger%ref_count = 1
      IF (PRESENT(template_logger)) THEN
-         IF (template_logger%ref_count < 1) THEN
+         IF (template_logger%ref_count < 1) &
            CPABORT(routineP//" template_logger%ref_count<1")
         END IF
         logger%print_level = template_logger%print_level
         logger%default_global_unit_nr = template_logger%default_global_unit_nr
         logger%close_local_unit_on_dealloc = template_logger%close_local_unit_on_dealloc
@ -340,19 +339,16 @@ CONTAINS
         logger%suffix = ""
      END IF
      IF (PRESENT(para_env)) logger%para_env => para_env
-      IF (.NOT. ASSOCIATED(logger%para_env)) THEN
+      IF (.NOT. ASSOCIATED(logger%para_env)) &
         CPABORT(routineP//" para env not associated")
-      END IF
+      IF (.NOT. logger%para_env%is_valid()) &
      IF (.NOT. logger%para_env%is_valid()) THEN
         CPABORT(routineP//" para_env%ref_count<1")
      END IF
      CALL logger%para_env%retain()
      IF (PRESENT(print_level)) logger%print_level = print_level
-      IF (PRESENT(default_global_unit_nr)) THEN
+      IF (PRESENT(default_global_unit_nr)) &
         logger%default_global_unit_nr = default_global_unit_nr
      END IF
      IF (PRESENT(global_filename)) THEN
         logger%global_filename = global_filename
         logger%close_global_unit_on_dealloc = .TRUE.
@ -366,9 +362,8 @@ CONTAINS
         END IF
      END IF
-      IF (PRESENT(default_local_unit_nr)) THEN
+      IF (PRESENT(default_local_unit_nr)) &
         logger%default_local_unit_nr = default_local_unit_nr
      END IF
      IF (PRESENT(local_filename)) THEN
         logger%local_filename = local_filename
         logger%close_local_unit_on_dealloc = .TRUE.
@ -412,9 +407,8 @@ CONTAINS
      CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_retain', &
         routineP = moduleN//':'//routineN
-      IF (logger%ref_count < 1) THEN
+      IF (logger%ref_count < 1) &
         CPABORT(routineP//" logger%ref_count<1")
      END IF
      logger%ref_count = logger%ref_count + 1
   END SUBROUTINE cp_logger_retain
@ -432,9 +426,8 @@ CONTAINS
         routineP = moduleN//':'//routineN
      IF (ASSOCIATED(logger)) THEN
-         IF (logger%ref_count < 1) THEN
+         IF (logger%ref_count < 1) &
            CPABORT(routineP//" logger%ref_count<1")
         END IF
         logger%ref_count = logger%ref_count - 1
         IF (logger%ref_count == 0) THEN
            IF (logger%close_global_unit_on_dealloc .AND. &
@ -483,9 +476,8 @@ CONTAINS
      lggr => logger
      IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
-      IF (lggr%ref_count < 1) THEN
+      IF (lggr%ref_count < 1) &
         CPABORT(routineP//" logger%ref_count<1")
      END IF
      res = level >= lggr%print_level
   END FUNCTION cp_logger_would_log
@ -555,9 +547,8 @@ CONTAINS
      CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_set_log_level', &
         routineP = moduleN//':'//routineN
-      IF (logger%ref_count < 1) THEN
+      IF (logger%ref_count < 1) &
         CPABORT(routineP//" logger%ref_count<1")
      END IF
      logger%print_level = level
   END SUBROUTINE cp_logger_set_log_level
@ -593,9 +584,8 @@ CONTAINS
         NULLIFY (lggr)
      END IF
      IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
-      IF (lggr%ref_count < 1) THEN
+      IF (lggr%ref_count < 1) &
         CPABORT(routineP//" logger%ref_count<1")
      END IF
      IF (PRESENT(local)) loc = local
      IF (PRESENT(skip_not_ionode)) skip = skip_not_ionode
@ -702,9 +692,8 @@ CONTAINS
      lggr => logger
      IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
-      IF (lggr%ref_count < 1) THEN
+      IF (lggr%ref_count < 1) &
         CPABORT(routineP//" logger%ref_count<1")
      END IF
      IF (PRESENT(local)) loc = local
      IF (loc) THEN
         res = TRIM(root)//TRIM(lggr%suffix)//'_p'// &
--- a/src/common/cp_result_methods.F
+++ b/src/common/cp_result_methods.F
@ -178,16 +178,14 @@ CONTAINS
         n_rep = nrep
      END IF
-      IF (nrep <= 0) THEN
+      IF (nrep <= 0) &
         CALL cp_abort(__LOCATION__, &
                       " Trying to access result ("//TRIM(description)//") which was never stored!")
      END IF
      DO i = 1, nlist
         IF (TRIM(results%result_label(i)) == TRIM(description)) THEN
-            IF (results%result_value(i)%value%type_in_use /= result_type_real) THEN
+            IF (results%result_value(i)%value%type_in_use /= result_type_real) &
               CPABORT("Attempt to retrieve a RESULT which is not a REAL!")
            END IF
            size_res = SIZE(results%result_value(i)%value%real_type)
            EXIT
@ -253,16 +251,14 @@ CONTAINS
         n_rep = nrep
      END IF
-      IF (nrep <= 0) THEN
+      IF (nrep <= 0) &
         CALL cp_abort(__LOCATION__, &
                       " Trying to access result ("//TRIM(description)//") which was never stored!")
      END IF
      DO i = 1, nlist
         IF (TRIM(results%result_label(i)) == TRIM(description)) THEN
-            IF (results%result_value(i)%value%type_in_use /= result_type_real) THEN
+            IF (results%result_value(i)%value%type_in_use /= result_type_real) &
               CPABORT("Attempt to retrieve a RESULT which is not a REAL!")
            END IF
            size_res = SIZE(results%result_value(i)%value%real_type)
            EXIT
--- a/src/common/cp_units.F
+++ b/src/common/cp_units.F
@ -650,11 +650,10 @@ CONTAINS
            CPABORT("unknown electric field unit:"//TRIM(cp_to_string(basic_unit)))
         END SELECT
      CASE (cp_ukind_none)
-         IF (basic_unit /= cp_units_none) THEN
+         IF (basic_unit /= cp_units_none) &
            CALL cp_abort(__LOCATION__, &
                          "if the kind of the unit is none also unit must be undefined,not:" &
                          //TRIM(cp_to_string(basic_unit)))
         END IF
      CASE default
         CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
      END SELECT
@ -680,11 +679,10 @@ CONTAINS
      my_power = 1
      IF (PRESENT(power)) my_power = power
      IF (basic_unit == cp_units_none .AND. basic_kind /= cp_ukind_undef) THEN
-         IF (basic_kind /= cp_units_none) THEN
+         IF (basic_kind /= cp_units_none) &
            CALL cp_abort(__LOCATION__, &
                          "unit not yet fully specified, unit of kind "// &
                          TRIM(cp_to_string(basic_unit)))
         END IF
      END IF
      SELECT CASE (basic_kind)
      CASE (cp_ukind_undef)
@ -864,10 +862,9 @@ CONTAINS
      IF (accept_undefined) my_accept_undefined = accept_undefined
      IF (PRESENT(power)) my_power = power
      IF (basic_unit == cp_units_none) THEN
-         IF (.NOT. my_accept_undefined .AND. basic_kind == cp_units_none) THEN
+         IF (.NOT. my_accept_undefined .AND. basic_kind == cp_units_none) &
            CALL cp_abort(__LOCATION__, "unit not yet fully specified, unit of kind "// &
                          TRIM(cp_to_string(basic_kind)))
         END IF
      END IF
      SELECT CASE (basic_kind)
      CASE (cp_ukind_undef)
@ -903,11 +900,10 @@ CONTAINS
            res = "K_e"
         CASE (cp_units_none)
            res = "energy"
-            IF (.NOT. my_accept_undefined) THEN
+            IF (.NOT. my_accept_undefined) &
               CALL cp_abort(__LOCATION__, &
                             "unit not yet fully specified, unit of kind "// &
                             TRIM(res))
            END IF
         CASE default
            CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
         END SELECT
@ -935,11 +931,10 @@ CONTAINS
            res = "au_temp"
         CASE (cp_units_none)
            res = "temperature"
-            IF (.NOT. my_accept_undefined) THEN
+            IF (.NOT. my_accept_undefined) &
               CALL cp_abort(__LOCATION__, &
                             "unit not yet fully specified, unit of kind "// &
                             TRIM(res))
            END IF
         CASE default
            CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
         END SELECT
@ -961,11 +956,10 @@ CONTAINS
            res = "au_p"
         CASE (cp_units_none)
            res = "pressure"
-            IF (.NOT. my_accept_undefined) THEN
+            IF (.NOT. my_accept_undefined) &
               CALL cp_abort(__LOCATION__, &
                             "unit not yet fully specified, unit of kind "// &
                             TRIM(res))
            END IF
         CASE default
            CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
         END SELECT
@ -977,11 +971,10 @@ CONTAINS
            res = "deg"
         CASE (cp_units_none)
            res = "angle"
-            IF (.NOT. my_accept_undefined) THEN
+            IF (.NOT. my_accept_undefined) &
               CALL cp_abort(__LOCATION__, &
                             "unit not yet fully specified, unit of kind "// &
                             TRIM(res))
            END IF
         CASE default
            CPABORT("unknown angle unit:"//TRIM(cp_to_string(basic_unit)))
         END SELECT
@ -999,11 +992,10 @@ CONTAINS
            res = "wavenumber_t"
         CASE (cp_units_none)
            res = "time"
-            IF (.NOT. my_accept_undefined) THEN
+            IF (.NOT. my_accept_undefined) &
               CALL cp_abort(__LOCATION__, &
                             "unit not yet fully specified, unit of kind "// &
                             TRIM(res))
            END IF
         CASE default
            CPABORT("unknown time unit:"//TRIM(cp_to_string(basic_unit)))
         END SELECT
@ -1017,11 +1009,10 @@ CONTAINS
            res = "m_e"
         CASE (cp_units_none)
            res = "mass"
-            IF (.NOT. my_accept_undefined) THEN
+            IF (.NOT. my_accept_undefined) &
               CALL cp_abort(__LOCATION__, &
                             "unit not yet fully specified, unit of kind "// &
                             TRIM(res))
            END IF
         CASE default
            CPABORT("unknown mass unit:"//TRIM(cp_to_string(basic_unit)))
         END SELECT
@ -1033,11 +1024,10 @@ CONTAINS
            res = "au_pot"
         CASE (cp_units_none)
            res = "potential"
-            IF (.NOT. my_accept_undefined) THEN
+            IF (.NOT. my_accept_undefined) &
               CALL cp_abort(__LOCATION__, &
                             "unit not yet fully specified, unit of kind "// &
                             TRIM(res))
            END IF
         CASE default
            CPABORT("unknown potential unit:"//TRIM(cp_to_string(basic_unit)))
         END SELECT
@ -1051,11 +1041,10 @@ CONTAINS
            res = "au_f"
         CASE (cp_units_none)
            res = "force"
-            IF (.NOT. my_accept_undefined) THEN
+            IF (.NOT. my_accept_undefined) &
               CALL cp_abort(__LOCATION__, &
                             "unit not yet fully specified, unit of kind "// &
                             TRIM(res))
            END IF
         CASE default
            CPABORT("unknown potential unit:"//TRIM(cp_to_string(basic_unit)))
         END SELECT
@ -1071,11 +1060,10 @@ CONTAINS
            res = "au_efield"
         CASE (cp_units_none)
            res = "electric field"
-            IF (.NOT. my_accept_undefined) THEN
+            IF (.NOT. my_accept_undefined) &
               CALL cp_abort(__LOCATION__, &
                             "unit not yet fully specified, unit of kind "// &
                             TRIM(res))
            END IF
         CASE default
            CPABORT("unknown efield unit:"//TRIM(cp_to_string(basic_unit)))
         END SELECT
--- a/src/common/distribution_1d_types.F
+++ b/src/common/distribution_1d_types.F
@ -104,9 +104,8 @@ CONTAINS
      CALL para_env%retain()
      distribution_1d%listbased_distribution = .FALSE.
-      IF (PRESENT(listbased_distribution)) THEN
+      IF (PRESENT(listbased_distribution)) &
         distribution_1d%listbased_distribution = listbased_distribution
      END IF
      ALLOCATE (distribution_1d%n_el(my_n_lists), distribution_1d%list(my_n_lists))
--- a/src/common/fparser.F
+++ b/src/common/fparser.F
@ -407,10 +407,10 @@ CONTAINS
      DO j = b, e
         IF (Func(j:j) == '(') THEN
            ParCnt = ParCnt + 1
-         ELSE IF (Func(j:j) == ')') THEN
+         ELSEIF (Func(j:j) == ')') THEN
            ParCnt = ParCnt - 1
            IF (ParCnt == 0) EXIT
-         ELSE IF (ParCnt == 1 .AND. Func(j:j) == ',') THEN
+         ELSEIF (ParCnt == 1 .AND. Func(j:j) == ',') THEN
            ArgPos = j
            ArgCnt = ArgCnt + 1
         END IF
@ -748,7 +748,7 @@ CONTAINS
         DO j = b + 1, e - 1
            IF (F(j:j) == '(') THEN
               k = k + 1
-            ELSE IF (F(j:j) == ')') THEN
+            ELSEIF (F(j:j) == ')') THEN
               k = k - 1
            END IF
            IF (k < 0) EXIT
@ -792,11 +792,11 @@ CONTAINS
 !      WRITE(*,*)'1. F(b:e) = "+..."'
         CALL CompileSubstr(i, F, b + 1, e, Var)
         RETURN
-      ELSE IF (CompletelyEnclosed(F, b, e)) THEN ! Case 2: F(b:e) = '(...)'
+      ELSEIF (CompletelyEnclosed(F, b, e)) THEN ! Case 2: F(b:e) = '(...)'
 !      WRITE(*,*)'2. F(b:e) = "(...)"'
         CALL CompileSubstr(i, F, b + 1, e - 1, Var)
         RETURN
-      ELSE IF (SCAN(F(b:b), calpha) > 0) THEN
+      ELSEIF (SCAN(F(b:b), calpha) > 0) THEN
         n = MathFunctionIndex(F(b:e))
         IF (n > 0) THEN
            b2 = b + INDEX(F(b:e), '(') - 1
@ -807,13 +807,13 @@ CONTAINS
               RETURN
            END IF
         END IF
-      ELSE IF (F(b:b) == '-') THEN
+      ELSEIF (F(b:b) == '-') THEN
         IF (CompletelyEnclosed(F, b + 1, e)) THEN ! Case 4: F(b:e) = '-(...)'
 !         WRITE(*,*)'4. F(b:e) = "-(...)"'
            CALL CompileSubstr(i, F, b + 2, e - 1, Var)
            CALL AddCompiledByte(i, cNeg)
            RETURN
-         ELSE IF (SCAN(F(b + 1:b + 1), calpha) > 0) THEN
+         ELSEIF (SCAN(F(b + 1:b + 1), calpha) > 0) THEN
            n = MathFunctionIndex(F(b + 1:e))
            IF (n > 0) THEN
               b2 = b + INDEX(F(b + 1:e), '(')
@ -835,7 +835,7 @@ CONTAINS
         DO j = e, b, -1
            IF (F(j:j) == ')') THEN
               k = k + 1
-            ELSE IF (F(j:j) == '(') THEN
+            ELSEIF (F(j:j) == '(') THEN
               k = k - 1
            END IF
            IF (k == 0 .AND. F(j:j) == Ops(io) .AND. IsBinaryOp(j, F)) THEN
@ -900,9 +900,9 @@ CONTAINS
      DO j = b, e
         IF (F(j:j) == '(') THEN
            ParCnt = ParCnt + 1
-         ELSE IF (F(j:j) == ')') THEN
+         ELSEIF (F(j:j) == ')') THEN
            ParCnt = ParCnt - 1
-         ELSE IF (ParCnt == 0 .AND. F(j:j) == ',') THEN
+         ELSEIF (ParCnt == 0 .AND. F(j:j) == ',') THEN
            CALL CompileSubstr(i, F, b2, j - 1, Var)
            b2 = j + 1
         END IF
@ -938,17 +938,17 @@ CONTAINS
      IF (F(j:j) == '+' .OR. F(j:j) == '-') THEN ! Plus or minus sign:
         IF (j == 1) THEN ! - leading unary operator ?
            res = .FALSE.
-         ELSE IF (SCAN(F(j - 1:j - 1), '+-*/^(,') > 0) THEN ! - other unary operator ?
+         ELSEIF (SCAN(F(j - 1:j - 1), '+-*/^(,') > 0) THEN ! - other unary operator ?
            res = .FALSE.
-         ELSE IF (SCAN(F(j + 1:j + 1), '0123456789') > 0 .AND. & ! - in exponent of real number ?
+         ELSEIF (SCAN(F(j + 1:j + 1), '0123456789') > 0 .AND. & ! - in exponent of real number ?
-                  SCAN(F(j - 1:j - 1), 'eEdD') > 0) THEN
+                 SCAN(F(j - 1:j - 1), 'eEdD') > 0) THEN
            Dflag = .FALSE.; Pflag = .FALSE.
            k = j - 1
            DO WHILE (k > 1) !   step to the left in mantissa
               k = k - 1
               IF (SCAN(F(k:k), '0123456789') > 0) THEN
                  Dflag = .TRUE.
-               ELSE IF (F(k:k) == '.') THEN
+               ELSEIF (F(k:k) == '.') THEN
                  IF (Pflag) THEN
                     EXIT !   * EXIT: 2nd appearance of '.'
                  ELSE
@ -1011,7 +1011,7 @@ CONTAINS
         CASE ('+', '-') ! Permitted only
            IF (Bflag) THEN
               InMan = .TRUE.; Bflag = .FALSE. ! - at beginning of mantissa
-            ELSE IF (Eflag) THEN
+            ELSEIF (Eflag) THEN
               InExp = .TRUE.; Eflag = .FALSE. ! - at beginning of exponent
            ELSE
               EXIT ! - otherwise STOP
@ -1019,7 +1019,7 @@ CONTAINS
         CASE ('0':'9') ! Mark
            IF (Bflag) THEN
               InMan = .TRUE.; Bflag = .FALSE. ! - beginning of mantissa
-            ELSE IF (Eflag) THEN
+            ELSEIF (Eflag) THEN
               InExp = .TRUE.; Eflag = .FALSE. ! - beginning of exponent
            END IF
            IF (InMan) DInMan = .TRUE. ! Mantissa contains digit
@ -1028,7 +1028,7 @@ CONTAINS
            IF (Bflag) THEN
               Pflag = .TRUE. ! - mark 1st appearance of '.'
               InMan = .TRUE.; Bflag = .FALSE. !   mark beginning of mantissa
-            ELSE IF (InMan .AND. .NOT. Pflag) THEN
+            ELSEIF (InMan .AND. .NOT. Pflag) THEN
               Pflag = .TRUE. ! - mark 1st appearance of '.'
            ELSE
               EXIT ! - otherwise STOP
--- a/src/common/gfun.F
+++ b/src/common/gfun.F
@ -62,7 +62,7 @@ CONTAINS
      IF (t <= 12.0_dp) THEN
         ! downward recursion
-         g(nmax) = gfun_taylor(nmax, t)
+         g(nmax) = gfun_taylor(nmax, t);
         DO i = nmax, 1, -1
            g(i - 1) = (1.0_dp - 2.0_dp*t*g(i))/(2.0_dp*i - 1.0_dp)
         END DO
--- a/src/common/hash_map.fypp
+++ b/src/common/hash_map.fypp
@ -81,13 +81,11 @@
            initial_capacity_ = 11
         END IF
-         IF (initial_capacity_ < 1) THEN
+         IF (initial_capacity_ < 1) &
            CPABORT("initial_capacity < 1")
         END IF
-         IF (ASSOCIATED(hash_map%buckets)) THEN
+         IF (ASSOCIATED(hash_map%buckets)) &
            CPABORT("hash map is already initialized.")
         END IF
         ALLOCATE (hash_map%buckets(initial_capacity_))
         hash_map%size = 0
--- a/src/common/list.fypp
+++ b/src/common/list.fypp
@ -87,18 +87,15 @@
         initial_capacity_ = 11
         If (PRESENT(initial_capacity)) initial_capacity_ = initial_capacity
-         IF (initial_capacity_ < 0) THEN
+         IF (initial_capacity_ < 0) &
            CPABORT("list_${valuetype}$_create: initial_capacity < 0")
         END IF
-         IF (ASSOCIATED(list%arr)) THEN
+         IF (ASSOCIATED(list%arr)) &
            CPABORT("list_${valuetype}$_create: list is already initialized.")
         END IF
         ALLOCATE (list%arr(initial_capacity_), stat=stat)
-         IF (stat /= 0) THEN
+         IF (stat /= 0) &
            CPABORT("list_${valuetype}$_init: allocation failed")
         END IF
         list%size = 0
      END SUBROUTINE list_${valuetype}$_init
@ -115,9 +112,8 @@
      SUBROUTINE list_${valuetype}$_destroy(list)
         TYPE(list_${valuetype}$_type), intent(inout)  :: list
         INTEGER :: i
-         IF (.not. ASSOCIATED(list%arr)) THEN
+         IF (.not. ASSOCIATED(list%arr)) &
            CPABORT("list_${valuetype}$_destroy: list is not initialized.")
         END IF
         do i = 1, list%size
            deallocate (list%arr(i)%p)
@ -141,15 +137,12 @@
         TYPE(list_${valuetype}$_type), intent(inout)  :: list
         ${valuetype_in}$, intent(in) :: value
         INTEGER, intent(in) :: pos
-         IF (.not. ASSOCIATED(list%arr)) THEN
+         IF (.not. ASSOCIATED(list%arr)) &
            CPABORT("list_${valuetype}$_set: list is not initialized.")
-         END IF
+         IF (pos < 1) &
         IF (pos < 1) THEN
            CPABORT("list_${valuetype}$_set: pos < 1")
-         END IF
+         IF (pos > list%size) &
         IF (pos > list%size) THEN
            CPABORT("list_${valuetype}$_set: pos > size")
         END IF
         list%arr(pos)%p%value ${value_assign}$value
      END SUBROUTINE list_${valuetype}$_set
@ -166,18 +159,15 @@
         ${valuetype_in}$, intent(in)                  :: value
         INTEGER                                     :: stat
-         IF (.not. ASSOCIATED(list%arr)) THEN
+         IF (.not. ASSOCIATED(list%arr)) &
            CPABORT("list_${valuetype}$_push: list is not initialized.")
-         END IF
+         if (list%size == size(list%arr)) &
-         IF (list%size == size(list%arr)) THEN
+            call change_capacity_${valuetype}$ (list, 2*size(list%arr) + 1)
            CALL change_capacity_${valuetype}$ (list, 2*size(list%arr) + 1)
         END IF
         list%size = list%size + 1
         ALLOCATE (list%arr(list%size)%p, stat=stat)
-         IF (stat /= 0) THEN
+         IF (stat /= 0) &
            CPABORT("list_${valuetype}$_push: allocation failed")
         END IF
         list%arr(list%size)%p%value ${value_assign}$value
      END SUBROUTINE list_${valuetype}$_push
@ -197,19 +187,15 @@
         INTEGER, intent(in) :: pos
         INTEGER :: i, stat
-         IF (.not. ASSOCIATED(list%arr)) THEN
+         IF (.not. ASSOCIATED(list%arr)) &
            CPABORT("list_${valuetype}$_insert: list is not initialized.")
-         END IF
+         IF (pos < 1) &
         IF (pos < 1) THEN
            CPABORT("list_${valuetype}$_insert: pos < 1")
-         END IF
+         IF (pos > list%size + 1) &
         IF (pos > list%size + 1) THEN
            CPABORT("list_${valuetype}$_insert: pos > size+1")
         END IF
-         if (list%size == size(list%arr)) THEN
+         if (list%size == size(list%arr)) &
            call change_capacity_${valuetype}$ (list, 2*size(list%arr) + 1)
         END IF
         list%size = list%size + 1
         do i = list%size, pos + 1, -1
@ -217,9 +203,8 @@
         end do
         ALLOCATE (list%arr(pos)%p, stat=stat)
-         IF (stat /= 0) THEN
+         IF (stat /= 0) &
            CPABORT("list_${valuetype}$_insert: allocation failed.")
         END IF
         list%arr(pos)%p%value ${value_assign}$value
      END SUBROUTINE list_${valuetype}$_insert
@ -236,12 +221,10 @@
         TYPE(list_${valuetype}$_type), intent(inout)  :: list
         ${valuetype_out}$  :: value
-         IF (.not. ASSOCIATED(list%arr)) THEN
+         IF (.not. ASSOCIATED(list%arr)) &
            CPABORT("list_${valuetype}$_peek: list is not initialized.")
-         END IF
+         IF (list%size < 1) &
         IF (list%size < 1) THEN
            CPABORT("list_${valuetype}$_peek: list is empty.")
         END IF
         value ${value_assign}$list%arr(list%size)%p%value
      END FUNCTION list_${valuetype}$_peek
@ -262,12 +245,10 @@
         TYPE(list_${valuetype}$_type), intent(inout)  :: list
         ${valuetype_out}$  :: value
-         IF (.NOT. ASSOCIATED(list%arr)) THEN
+         IF (.not. ASSOCIATED(list%arr)) &
            CPABORT("list_${valuetype}$_pop: list is not initialized.")
-         END IF
+         IF (list%size < 1) &
         IF (list%size < 1) THEN
            CPABORT("list_${valuetype}$_pop: list is empty.")
         END IF
         value ${value_assign}$list%arr(list%size)%p%value
         deallocate (list%arr(list%size)%p)
@ -285,13 +266,12 @@
         TYPE(list_${valuetype}$_type), intent(inout)  :: list
         INTEGER :: i
-         IF (.not. ASSOCIATED(list%arr)) THEN
+         IF (.not. ASSOCIATED(list%arr)) &
            CPABORT("list_${valuetype}$_clear: list is not initialized.")
         END IF
-         DO i = 1, list%size
+         do i = 1, list%size
            deallocate (list%arr(i)%p)
-         END DO
+         end do
         list%size = 0
      END SUBROUTINE list_${valuetype}$_clear
@ -310,15 +290,12 @@
         INTEGER, intent(in) :: pos
         ${valuetype_out}$ :: value
-         IF (.NOT. ASSOCIATED(list%arr)) THEN
+         IF (.not. ASSOCIATED(list%arr)) &
            CPABORT("list_${valuetype}$_get: list is not initialized.")
-         END IF
+         IF (pos < 1) &
         IF (pos < 1) THEN
            CPABORT("list_${valuetype}$_get: pos < 1")
-         END IF
+         IF (pos > list%size) &
         IF (pos > list%size) THEN
            CPABORT("list_${valuetype}$_get: pos > size")
         END IF
         value ${value_assign}$list%arr(pos)%p%value
@ -337,20 +314,17 @@
         INTEGER, intent(in) :: pos
         INTEGER :: i
-         IF (.NOT. ASSOCIATED(list%arr)) THEN
+         IF (.not. ASSOCIATED(list%arr)) &
            CPABORT("list_${valuetype}$_del: list is not initialized.")
-         END IF
+         IF (pos < 1) &
         IF (pos < 1) THEN
            CPABORT("list_${valuetype}$_det: pos < 1")
-         END IF
+         IF (pos > list%size) &
         IF (pos > list%size) THEN
            CPABORT("list_${valuetype}$_det: pos > size")
         END IF
         deallocate (list%arr(pos)%p)
-         DO i = pos, list%size - 1
+         do i = pos, list%size - 1
            list%arr(i)%p => list%arr(i + 1)%p
-         END DO
+         end do
         list%size = list%size - 1
@ -368,9 +342,8 @@
         TYPE(list_${valuetype}$_type), intent(in)  :: list
         INTEGER :: size
-         IF (.NOT. ASSOCIATED(list%arr)) THEN
+         IF (.not. ASSOCIATED(list%arr)) &
            CPABORT("list_${valuetype}$_size: list is not initialized.")
         END IF
         size = list%size
      END FUNCTION list_${valuetype}$_size
@ -390,34 +363,29 @@
         TYPE(private_item_p_type_${valuetype}$), DIMENSION(:), POINTER :: old_arr
         new_cap = new_capacity
-         IF (new_cap < 0) THEN
+         IF (new_cap < 0) &
            CPABORT("list_${valuetype}$_change_capacity: new_capacity < 0")
-         END IF
+         IF (new_cap < list%size) &
         IF (new_cap < list%size) THEN
            CPABORT("list_${valuetype}$_change_capacity: new_capacity < size")
         END IF
         IF (new_cap > HUGE(i)) THEN
-            IF (size(list%arr) == HUGE(i)) THEN
+            IF (size(list%arr) == HUGE(i)) &
               CPABORT("list_${valuetype}$_change_capacity: list has reached integer limit.")
            END IF
            new_cap = HUGE(i) ! grow as far as possible
         END IF
         old_arr => list%arr
         allocate (list%arr(new_cap), stat=stat)
-         IF (stat /= 0) THEN
+         IF (stat /= 0) &
            CPABORT("list_${valuetype}$_change_capacity: allocation failed")
         END IF
-         DO i = 1, list%size
+         do i = 1, list%size
            allocate (list%arr(i)%p, stat=stat)
-            IF (stat /= 0) THEN
+            IF (stat /= 0) &
               CPABORT("list_${valuetype}$_change_capacity: allocation failed")
            END IF
            list%arr(i)%p%value ${value_assign}$old_arr(i)%p%value
-            DEALLOCATE (old_arr(i)%p)
+            deallocate (old_arr(i)%p)
-         END DO
+         end do
-         DEALLOCATE (old_arr)
+         deallocate (old_arr)
      END SUBROUTINE change_capacity_${valuetype}$
   #:enddef
--- a/src/common/mathlib.F
+++ b/src/common/mathlib.F
@ -187,8 +187,8 @@ CONTAINS
      REAL(KIND=dp)                                      :: length_of_a, length_of_b
      REAL(KIND=dp), DIMENSION(SIZE(a, 1))               :: a_norm, b_norm
-      length_of_a = NORM2(a)
+      length_of_a = SQRT(DOT_PRODUCT(a, a))
-      length_of_b = NORM2(b)
+      length_of_b = SQRT(DOT_PRODUCT(b, b))
      IF ((length_of_a > eps_geo) .AND. (length_of_b > eps_geo)) THEN
         a_norm(:) = a(:)/length_of_a
@ -997,9 +997,8 @@ CONTAINS
      ! set singular values that are too small to zero
      DO i = 1, n
         IF (sig(i) > rskip*MAXVAL(sig)) THEN
-            IF (PRESENT(determinant)) THEN
+            IF (PRESENT(determinant)) &
               determinant = determinant*sig(i)
            END IF
            sig_plus(i, i) = 1._dp/sig(i)
         ELSE
            sig_plus(i, i) = 0.0_dp
@ -1976,14 +1975,12 @@ CONTAINS
      IF (n /= SIZE(C_out, 2)) CPABORT("Incompatible (cols) result array 3 (C).")
      IF (.NOT. (A_trans == 'N' .OR. A_trans == 'n' .OR. &
                 A_trans == 'T' .OR. A_trans == 't' .OR. &
-                 A_trans == 'C' .OR. A_trans == 'c')) THEN
+                 A_trans == 'C' .OR. A_trans == 'c')) &
         CPABORT("Unknown transpose character for array 1 (A).")
      END IF
      IF (.NOT. (B_trans == 'N' .OR. B_trans == 'n' .OR. &
                 B_trans == 'T' .OR. B_trans == 't' .OR. &
-                 B_trans == 'C' .OR. B_trans == 'c')) THEN
+                 B_trans == 'C' .OR. B_trans == 'c')) &
         CPABORT("Unknown transpose character for array 2 (B).")
      END IF
      CALL timeset(routineN, handle)
@ -2021,14 +2018,12 @@ CONTAINS
      IF (n /= SIZE(C_out, 2)) CPABORT("Incompatible (cols) result array 3 (C).")
      IF (.NOT. (A_trans == 'N' .OR. A_trans == 'n' .OR. &
                 A_trans == 'T' .OR. A_trans == 't' .OR. &
-                 A_trans == 'C' .OR. A_trans == 'c')) THEN
+                 A_trans == 'C' .OR. A_trans == 'c')) &
         CPABORT("Unknown transpose character for array 1 (A).")
      END IF
      IF (.NOT. (B_trans == 'N' .OR. B_trans == 'n' .OR. &
                 B_trans == 'T' .OR. B_trans == 't' .OR. &
-                 B_trans == 'C' .OR. B_trans == 'c')) THEN
+                 B_trans == 'C' .OR. B_trans == 'c')) &
         CPABORT("Unknown transpose character for array 2 (B).")
      END IF
      CALL timeset(routineN, handle)
@ -2073,19 +2068,16 @@ CONTAINS
      IF (n /= SIZE(D_out, 2)) CPABORT("Incompatible (cols) result array 4 (D).")
      IF (.NOT. (A_trans == 'N' .OR. A_trans == 'n' .OR. &
                 A_trans == 'T' .OR. A_trans == 't' .OR. &
-                 A_trans == 'C' .OR. A_trans == 'c')) THEN
+                 A_trans == 'C' .OR. A_trans == 'c')) &
         CPABORT("Unknown transpose character for array 1 (A).")
      END IF
      IF (.NOT. (B_trans == 'N' .OR. B_trans == 'n' .OR. &
                 B_trans == 'T' .OR. B_trans == 't' .OR. &
-                 B_trans == 'C' .OR. B_trans == 'c')) THEN
+                 B_trans == 'C' .OR. B_trans == 'c')) &
         CPABORT("Unknown transpose character for array 2 (B).")
      END IF
      IF (.NOT. (C_trans == 'N' .OR. C_trans == 'n' .OR. &
                 C_trans == 'T' .OR. C_trans == 't' .OR. &
-                 C_trans == 'C' .OR. C_trans == 'c')) THEN
+                 C_trans == 'C' .OR. C_trans == 'c')) &
         CPABORT("Unknown transpose character for array 3 (C).")
      END IF
      CALL timeset(routineN, handle)
@ -2135,19 +2127,16 @@ CONTAINS
      IF (n /= SIZE(D_out, 2)) CPABORT("Incompatible (cols) result array 4 (D).")
      IF (.NOT. (A_trans == 'N' .OR. A_trans == 'n' .OR. &
                 A_trans == 'T' .OR. A_trans == 't' .OR. &
-                 A_trans == 'C' .OR. A_trans == 'c')) THEN
+                 A_trans == 'C' .OR. A_trans == 'c')) &
         CPABORT("Unknown transpose character for array 1 (A).")
      END IF
      IF (.NOT. (B_trans == 'N' .OR. B_trans == 'n' .OR. &
                 B_trans == 'T' .OR. B_trans == 't' .OR. &
-                 B_trans == 'C' .OR. B_trans == 'c')) THEN
+                 B_trans == 'C' .OR. B_trans == 'c')) &
         CPABORT("Unknown transpose character for array 2 (B).")
      END IF
      IF (.NOT. (C_trans == 'N' .OR. C_trans == 'n' .OR. &
                 C_trans == 'T' .OR. C_trans == 't' .OR. &
-                 C_trans == 'C' .OR. C_trans == 'c')) THEN
+                 C_trans == 'C' .OR. C_trans == 'c')) &
         CPABORT("Unknown transpose character for array 3 (C).")
      END IF
      CALL timeset(routineN, handle)
--- a/src/common/memory_utilities_unittest.F
+++ b/src/common/memory_utilities_unittest.F
@ -32,13 +32,11 @@ CONTAINS
      CALL reallocate(real_arr, 1, 20)
-      IF (.NOT. ALL(real_arr(1:10) == [(idx, idx=1, 10)])) THEN
+      IF (.NOT. ALL(real_arr(1:10) == [(idx, idx=1, 10)])) &
         ERROR STOP "check_real_rank1_allocated: reallocating changed the initial values"
      END IF
-      IF (.NOT. ALL(real_arr(11:20) == 0.)) THEN
+      IF (.NOT. ALL(real_arr(11:20) == 0.)) &
         ERROR STOP "check_real_rank1_allocated: reallocation failed to initialise new values with 0."
      END IF
      DEALLOCATE (real_arr)
@ -55,9 +53,8 @@ CONTAINS
      CALL reallocate(real_arr, 1, 20)
-      IF (.NOT. ALL(real_arr(1:20) == 0.)) THEN
+      IF (.NOT. ALL(real_arr(1:20) == 0.)) &
         ERROR STOP "check_real_rank1_unallocated: reallocation failed to initialise new values with 0."
      END IF
      DEALLOCATE (real_arr)
@ -76,13 +73,11 @@ CONTAINS
      CALL reallocate(real_arr, 1, 10, 1, 5)
-      IF (.NOT. (ALL(real_arr(1:5, 1) == [(idx, idx=1, 5)]) .AND. ALL(real_arr(1:5, 2) == [(idx, idx=6, 10)]))) THEN
+      IF (.NOT. (ALL(real_arr(1:5, 1) == [(idx, idx=1, 5)]) .AND. ALL(real_arr(1:5, 2) == [(idx, idx=6, 10)]))) &
         ERROR STOP "check_real_rank2_allocated: reallocating changed the initial values"
      END IF
-      IF (.NOT. (ALL(real_arr(6:10, 1:2) == 0.) .AND. ALL(real_arr(1:10, 3:5) == 0.))) THEN
+      IF (.NOT. (ALL(real_arr(6:10, 1:2) == 0.) .AND. ALL(real_arr(1:10, 3:5) == 0.))) &
         ERROR STOP "check_real_rank2_allocated: reallocation failed to initialise new values with 0."
      END IF
      DEALLOCATE (real_arr)
@ -99,9 +94,8 @@ CONTAINS
      CALL reallocate(real_arr, 1, 10, 1, 5)
-      IF (.NOT. ALL(real_arr(1:10, 1:5) == 0.)) THEN
+      IF (.NOT. ALL(real_arr(1:10, 1:5) == 0.)) &
         ERROR STOP "check_real_rank2_unallocated: reallocation failed to initialise new values with 0."
      END IF
      DEALLOCATE (real_arr)
@ -120,13 +114,11 @@ CONTAINS
      CALL reallocate(str_arr, 1, 20)
-      IF (.NOT. ALL(str_arr(1:10) == [("hello, there", idx=1, 10)])) THEN
+      IF (.NOT. ALL(str_arr(1:10) == [("hello, there", idx=1, 10)])) &
         ERROR STOP "check_string_rank1_allocated: reallocating changed the initial values"
      END IF
-      IF (.NOT. ALL(str_arr(11:20) == "")) THEN
+      IF (.NOT. ALL(str_arr(11:20) == "")) &
         ERROR STOP "check_string_rank1_allocated: reallocation failed to initialise new values with ''."
      END IF
      DEALLOCATE (str_arr)
@ -143,9 +135,8 @@ CONTAINS
      CALL reallocate(str_arr, 1, 20)
-      IF (.NOT. ALL(str_arr(1:20) == "")) THEN
+      IF (.NOT. ALL(str_arr(1:20) == "")) &
         ERROR STOP "check_string_rank1_allocated: reallocation failed to initialise new values with ''."
      END IF
      DEALLOCATE (str_arr)
--- a/src/common/parallel_rng_types.F
+++ b/src/common/parallel_rng_types.F
@ -512,9 +512,8 @@ CONTAINS
      LOGICAL, INTENT(IN), OPTIONAL                      :: antithetic, extended_precision
      TYPE(rng_stream_type)                              :: rng_stream
-      IF (LEN_TRIM(name) > rng_name_length) THEN
+      IF (LEN_TRIM(name) > rng_name_length) &
         CPABORT("given random number generator name is too long")
      END IF
      rng_stream%name = TRIM(name)
@ -631,16 +630,14 @@ CONTAINS
      LOGICAL, INTENT(OUT), OPTIONAL                     :: buffer_filled
      IF (PRESENT(name)) name = self%name
-      IF (PRESENT(distribution_type)) THEN
+      IF (PRESENT(distribution_type)) &
         distribution_type = self%distribution_type
      END IF
      IF (PRESENT(bg)) bg = self%bg
      IF (PRESENT(cg)) cg = self%cg
      IF (PRESENT(ig)) ig = self%ig
      IF (PRESENT(antithetic)) antithetic = self%antithetic
-      IF (PRESENT(extended_precision)) THEN
+      IF (PRESENT(extended_precision)) &
         extended_precision = self%extended_precision
      END IF
      IF (PRESENT(buffer)) buffer = self%buffer
      IF (PRESENT(buffer_filled)) buffer_filled = self%buffer_filled
   END SUBROUTINE get
@ -1134,9 +1131,8 @@ CONTAINS
      my_write_all = .FALSE.
-      IF (PRESENT(write_all)) THEN
+      IF (PRESENT(write_all)) &
         my_write_all = write_all
      END IF
      WRITE (UNIT=output_unit, FMT="(/,T2,A,/)") &
         "Random number stream <"//TRIM(self%name)//">:"
--- a/src/common/parallel_rng_types_unittest.F
+++ b/src/common/parallel_rng_types_unittest.F
@ -32,16 +32,14 @@ PROGRAM parallel_rng_types_TEST
   nsamples = 1000
   nargs = command_argument_count()
-   IF (nargs > 1) then
+   IF (nargs > 1) &
      ERROR STOP "Usage: parallel_rng_types_TEST [<int:nsamples>]"
   end if
   IF (nargs == 1) THEN
      CALL get_command_argument(1, arg)
      READ (arg, *, iostat=stat) nsamples
-      IF (stat /= 0) then
+      IF (stat /= 0) &
         ERROR STOP "Usage: parallel_rng_types_TEST [<int:nsamples>]"
      end if
   END IF
   CALL mp_world_init(mpi_comm)
@ -62,9 +60,8 @@ PROGRAM parallel_rng_types_TEST
                                distribution_type=UNIFORM, &
                                extended_precision=.TRUE.)
-   IF (ionode) then
+   IF (ionode) &
      CALL rng_stream%write(default_output_unit)
   end if
   tmax = -HUGE(0.0_dp)
   tmin = +HUGE(0.0_dp)
@ -97,9 +94,8 @@ PROGRAM parallel_rng_types_TEST
                                distribution_type=GAUSSIAN, &
                                extended_precision=.TRUE.)
-   IF (ionode) then
+   IF (ionode) &
      CALL rng_stream%write(default_output_unit)
   end if
   tmax = -HUGE(0.0_dp)
   tmin = +HUGE(0.0_dp)
@ -166,9 +162,8 @@ CONTAINS
      CALL rng_stream%get(ig=ig, cg=cg, bg=bg, name=name)
      IF (ANY(ig /= ig_orig) .OR. ANY(cg /= cg_orig) .OR. ANY(bg /= bg_orig) &
-          .OR. (name /= name_orig)) then
+          .OR. (name /= name_orig)) &
         ERROR STOP "Stream dump and load roundtrip failed"
      end if
      WRITE (UNIT=default_output_unit, FMT="(T4,A)") &
         "Roundtrip successful"
@ -190,9 +185,8 @@ CONTAINS
      WRITE (UNIT=default_output_unit, FMT="(T4,A10,A433)") &
         "GENERATED:", rng_record
-      IF (rng_record /= serialized_string) then
+      IF (rng_record /= serialized_string) &
         ERROR STOP "Serialized record does not match the expected output"
      end if
      WRITE (UNIT=default_output_unit, FMT="(T4,A)") &
         "Serialized record matches the expected output"
@ -220,22 +214,19 @@ CONTAINS
      arr = orig
      CALL rng_stream%shuffle(arr)
-      IF (ALL(arr == orig)) then
+      IF (ALL(arr == orig)) &
         ERROR STOP "shuffle failed: array was left untouched"
      end if
      WRITE (UNIT=default_output_unit, FMT="(A)", ADVANCE="no") "."
-      IF (ANY(arr /= orig(arr))) then
+      IF (ANY(arr /= orig(arr))) &
         ERROR STOP "shuffle failed: the shuffled original is not the shuffled original"
      end if
      WRITE (UNIT=default_output_unit, FMT="(A)", ADVANCE="no") "."
      ! sort and compare to orig
      mask = .TRUE.
      DO idx = 1, size(orig)
-         IF (MINVAL(arr, mask) /= orig(idx)) then
+         IF (MINVAL(arr, mask) /= orig(idx)) &
            ERROR STOP "shuffle failed: there is at least one unknown index"
         end if
         mask(MINLOC(arr, mask)) = .FALSE.
      END DO
      WRITE (UNIT=default_output_unit, FMT="(A)", ADVANCE="no") "."
@ -244,9 +235,8 @@ CONTAINS
      CALL rng_stream%reset()
      CALL rng_stream%shuffle(arr2)
-      IF (ANY(arr2 /= arr)) then
+      IF (ANY(arr2 /= arr)) &
         ERROR STOP "shuffle failed: array was shuffled differently with same rng state"
      end if
      WRITE (UNIT=default_output_unit, FMT="(A)", ADVANCE="no") "."
      WRITE (UNIT=default_output_unit, FMT="(T4,A)") &
--- a/src/common/reference_manager.F
+++ b/src/common/reference_manager.F
@ -332,18 +332,14 @@ CONTAINS
         WRITE (unit, '(T3,A)') '<SOURCE>'//thebib(i)%ref%source//'</SOURCE>'
         ! DOI, volume, pages, year, month.
-         IF (ALLOCATED(thebib(i)%ref%doi)) THEN
+         IF (ALLOCATED(thebib(i)%ref%doi)) &
            WRITE (unit, '(T3,A)') '<DOI>'//TRIM(substitute_special_xml_tokens(thebib(i)%ref%doi))//'</DOI>'
-         END IF
+         IF (ALLOCATED(thebib(i)%ref%volume)) &
         IF (ALLOCATED(thebib(i)%ref%volume)) THEN
            WRITE (unit, '(T3,A)') '<VOLUME>'//thebib(i)%ref%volume//'</VOLUME>'
-         END IF
+         IF (ALLOCATED(thebib(i)%ref%pages)) &
         IF (ALLOCATED(thebib(i)%ref%pages)) THEN
            WRITE (unit, '(T3,A)') '<PAGES>'//thebib(i)%ref%pages//'</PAGES>'
-         END IF
+         IF (thebib(i)%ref%year > 0) &
         IF (thebib(i)%ref%year > 0) THEN
            WRITE (unit, '(T3,A,I4.4,A)') '<YEAR>', thebib(i)%ref%year, '</YEAR>'
         END IF
         WRITE (unit, '(T2,A)') '</REFERENCE>'
      END DO
--- a/src/common/spherical_harmonics.F
+++ b/src/common/spherical_harmonics.F
@ -1805,42 +1805,30 @@ CONTAINS
      REAL(KIND=dp)                                      :: sumk, t
      ! Check validity of the input parameters
-      IF (j1 < 0.0_dp) THEN
+      IF (j1 < 0.0_dp) &
         CPABORT("The angular momentum quantum number j1 has to be nonnegative")
-      END IF
+      IF (.NOT. (is_integer(j1) .OR. is_integer(2.0_dp*j1))) &
      IF (.NOT. (is_integer(j1) .OR. is_integer(2.0_dp*j1))) THEN
         CPABORT("The angular momentum quantum number j1 has to be integer or half-integer")
-      END IF
+      IF (j2 < 0.0_dp) &
      IF (j2 < 0.0_dp) THEN
         CPABORT("The angular momentum quantum number j2 has to be nonnegative")
-      END IF
+      IF (.NOT. (is_integer(j2) .OR. is_integer(2.0_dp*j2))) &
      IF (.NOT. (is_integer(j2) .OR. is_integer(2.0_dp*j2))) THEN
         CPABORT("The angular momentum quantum number j2 has to be integer or half-integer")
-      END IF
+      IF (J < 0.0_dp) &
      IF (J < 0.0_dp) THEN
         CPABORT("The angular momentum quantum number J has to be nonnegative")
-      END IF
+      IF (.NOT. (is_integer(J) .OR. is_integer(2.0_dp*J))) &
      IF (.NOT. (is_integer(J) .OR. is_integer(2.0_dp*J))) THEN
         CPABORT("The angular momentum quantum number J has to be integer or half-integer")
-      END IF
+      IF ((ABS(m1) - j1) > EPSILON(m1)) &
      IF ((ABS(m1) - j1) > EPSILON(m1)) THEN
         CPABORT("The angular momentum quantum number m1 has to satisfy -j1 <= m1 <= j1")
-      END IF
+      IF (.NOT. (is_integer(m1) .OR. is_integer(2.0_dp*m1))) &
      IF (.NOT. (is_integer(m1) .OR. is_integer(2.0_dp*m1))) THEN
         CPABORT("The angular momentum quantum number m1 has to be integer or half-integer")
-      END IF
+      IF ((ABS(m2) - j2) > EPSILON(m2)) &
      IF ((ABS(m2) - j2) > EPSILON(m2)) THEN
         CPABORT("The angular momentum quantum number m2 has to satisfy -j2 <= m1 <= j2")
-      END IF
+      IF (.NOT. (is_integer(m2) .OR. is_integer(2.0_dp*m2))) &
      IF (.NOT. (is_integer(m2) .OR. is_integer(2.0_dp*m2))) THEN
         CPABORT("The angular momentum quantum number m2 has to be integer or half-integer")
-      END IF
+      IF ((ABS(M) - J) > EPSILON(M)) &
      IF ((ABS(M) - J) > EPSILON(M)) THEN
         CPABORT("The angular momentum quantum number M has to satisfy -J <= M <= J")
-      END IF
+      IF (.NOT. (is_integer(M) .OR. is_integer(2.0_dp*M))) &
      IF (.NOT. (is_integer(M) .OR. is_integer(2.0_dp*M))) THEN
         CPABORT("The angular momentum quantum number M has to be integer or half-integer")
      END IF
      IF (is_integer(j1 + j2 + J) .AND. &
          is_integer(j1 + m1) .AND. &
@ -1884,8 +1872,8 @@ CONTAINS
 ! **************************************************************************************************
 !> \brief Compute the Wigner 3-j symbol
-!>        ( j1 j2 j3 )
+!>        / j1 j2 j3 \
-!>        ( m1 m2 m3 )
+!>        \ m1 m2 m3 /
 !>        using the Clebsch-Gordon coefficients
 !> \param j1 Angular momentum quantum number of the first state | j1 m1 >
 !> \param m1 Magnetic quantum number of the first first state | j1 m1 >
--- a/src/common/splines.F
+++ b/src/common/splines.F
@ -311,21 +311,21 @@ CONTAINS
      i1 = 1
      IF (n < 2) THEN
         CALL stop_error("error in iix: n < 2")
-      ELSE IF (n == 2) THEN
+      ELSEIF (n == 2) THEN
         i1 = 1
-      ELSE IF (n == 3) THEN
+      ELSEIF (n == 3) THEN
         IF (x <= xi(2)) THEN ! first element
            i1 = 1
         ELSE
            i1 = 2
         END IF
-      ELSE IF (x <= xi(1)) THEN ! left end
+      ELSEIF (x <= xi(1)) THEN ! left end
         i1 = 1
-      ELSE IF (x <= xi(2)) THEN ! first element
+      ELSEIF (x <= xi(2)) THEN ! first element
         i1 = 1
-      ELSE IF (x <= xi(3)) THEN ! second element
+      ELSEIF (x <= xi(3)) THEN ! second element
         i1 = 2
-      ELSE IF (x >= xi(n)) THEN ! right end
+      ELSEIF (x >= xi(n)) THEN ! right end
         i1 = n - 1
      ELSE
         ! bisection: xi(i1) <= x < xi(i2)
--- a/src/common/timings.F
+++ b/src/common/timings.F
@ -96,9 +96,8 @@ CONTAINS
      IF (PRESENT(timer_env)) timer_env_ => timer_env
      IF (.NOT. PRESENT(timer_env)) CALL timer_env_create(timer_env_)
-      IF (.NOT. ASSOCIATED(timer_env_)) THEN
+      IF (.NOT. ASSOCIATED(timer_env_)) &
         CPABORT("add_timer_env: not associated")
      END IF
      CALL timer_env_retain(timer_env_)
      IF (.NOT. list_isready(timers_stack)) CALL list_init(timers_stack)
@ -158,12 +157,10 @@ CONTAINS
   SUBROUTINE timer_env_retain(timer_env)
      TYPE(timer_env_type), POINTER                      :: timer_env
-      IF (.NOT. ASSOCIATED(timer_env)) THEN
+      IF (.NOT. ASSOCIATED(timer_env)) &
         CPABORT("timer_env_retain: not associated")
-      END IF
+      IF (timer_env%ref_count < 0) &
      IF (timer_env%ref_count < 0) THEN
         CPABORT("timer_env_retain: negativ ref_count")
      END IF
      timer_env%ref_count = timer_env%ref_count + 1
   END SUBROUTINE timer_env_retain
@ -179,12 +176,10 @@ CONTAINS
      TYPE(callgraph_item_type), DIMENSION(:), POINTER   :: ct_items
      TYPE(routine_stat_type), POINTER                   :: r_stat
-      IF (.NOT. ASSOCIATED(timer_env)) THEN
+      IF (.NOT. ASSOCIATED(timer_env)) &
         CPABORT("timer_env_release: not associated")
-      END IF
+      IF (timer_env%ref_count < 0) &
      IF (timer_env%ref_count < 0) THEN
         CPABORT("timer_env_release: negativ ref_count")
      END IF
      timer_env%ref_count = timer_env%ref_count - 1
      IF (timer_env%ref_count > 0) RETURN
@ -442,12 +437,10 @@ CONTAINS
      TYPE(timer_env_type), POINTER                      :: timer_env
      ! catch edge cases where timer_env is not yet/anymore available
-      IF (.NOT. list_isready(timers_stack)) THEN
+      IF (.NOT. list_isready(timers_stack)) &
         RETURN
-      END IF
+      IF (list_size(timers_stack) == 0) &
      IF (list_size(timers_stack) == 0) THEN
         RETURN
      END IF
      timer_env => list_peek(timers_stack)
      WRITE (unit_nr, '(/,A,/)') " ===== Routine Calling Stack ===== "
--- a/src/common/timings_report.F
+++ b/src/common/timings_report.F
@ -77,9 +77,8 @@ CONTAINS
      CALL list_init(reports)
      CALL collect_reports_from_ranks(reports, cost_type, para_env)
-      IF (list_size(reports) > 0 .AND. iw > 0) THEN
+      IF (list_size(reports) > 0 .AND. iw > 0) &
         CALL print_reports(reports, iw, r_timings, sort_by_self_time, cost_type, report_maxloc, para_env)
      END IF
      ! deallocate reports
      DO WHILE (list_size(reports) > 0)
@ -112,9 +111,8 @@ CONTAINS
      TYPE(timer_env_type), POINTER                      :: timer_env
      NULLIFY (r_stat, r_report, timer_env)
-      IF (.NOT. list_isready(reports)) THEN
+      IF (.NOT. list_isready(reports)) &
         CPABORT("BUG")
      END IF
      timer_env => get_timer_env()
@ -234,9 +232,8 @@ CONTAINS
      TYPE(routine_report_type), POINTER                 :: r_report_i, r_report_j
      NULLIFY (r_report_i, r_report_j)
-      IF (.NOT. list_isready(reports)) THEN
+      IF (.NOT. list_isready(reports)) &
         CPABORT("BUG")
      END IF
      ! are we printing timing or energy ?
      SELECT CASE (cost_type)
--- a/src/common/util.F
+++ b/src/common/util.F
@ -174,7 +174,7 @@ CONTAINS
    IF (j == 1) THEN
       DO i = 1, isize
          INDEX(i) = i
-       END DO
+       ENDDO
    END IF
    ! Allocate scratch arrays
--- a/src/commutator_rpnl.F
+++ b/src/commutator_rpnl.F
@ -217,7 +217,7 @@ CONTAINS
               nprj_ppnl => gpotential(kkind)%gth_potential%nprj_ppnl
               ppnl_radius = gpotential(kkind)%gth_potential%ppnl_radius
               vprj_ppnl => gpotential(kkind)%gth_potential%vprj_ppnl
-            ELSE IF (spot) THEN
+            ELSEIF (spot) THEN
               CPABORT('SGP not implemented')
            ELSE
               CPABORT('PPNL unknown')
@ -868,304 +868,282 @@ CONTAINS
                        IF (my_rxrv) THEN
                           ! x-component (y [z,Vnl] - z [y, Vnl])
                           ! with LAPACK
                           ! CALL dgemm("N", "T", na, nb, np, 1.0_dp, achint(1, 1, 9), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rxrv(1)%block, SIZE(blocks_rxrv(1)%block, 1)) ! yzV
                           ! CALL dgemm("N", "T", na, nb, np, -1.0_dp, achint(1, 1, 3), na, &
                           !            bcint(1, 1, 4), nb, 1.0_dp, blocks_rxrv(1)%block, SIZE(blocks_rxrv(1)%block, 1)) ! -yVz
                           ! CALL dgemm("N", "T", na, nb, np, -1.0_dp, achint(1, 1, 9), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rxrv(1)%block, SIZE(blocks_rxrv(1)%block, 1)) ! -zyV
                           ! CALL dgemm("N", "T", na, nb, np, 1.0_dp, achint(1, 1, 4), na, &
                           !            bcint(1, 1, 3), nb, 1.0_dp, blocks_rxrv(1)%block, SIZE(blocks_rxrv(1)%block, 1)) ! zVy
                           ! with MATMUL
                           IF (iatom <= jatom) THEN
                              ! yzV
                              blocks_rxrv(1)%block(1:na, 1:nb) = blocks_rxrv(1)%block(1:na, 1:nb) + &
-                                                                 MATMUL(achint(1:na, 1:np, 9), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                 MATMUL(achint(1:na, 1:np, 9), TRANSPOSE(bcint(1:nb, 1:np, 1)))    ! yzV
                              ! -yVz
                              blocks_rxrv(1)%block(1:na, 1:nb) = blocks_rxrv(1)%block(1:na, 1:nb) - &
-                                                                 MATMUL(achint(1:na, 1:np, 3), TRANSPOSE(bcint(1:nb, 1:np, 4)))
+                                                                 MATMUL(achint(1:na, 1:np, 3), TRANSPOSE(bcint(1:nb, 1:np, 4)))    ! -yVz
                              ! -zyV
                              blocks_rxrv(1)%block(1:na, 1:nb) = blocks_rxrv(1)%block(1:na, 1:nb) - &
-                                                                 MATMUL(achint(1:na, 1:np, 9), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                 MATMUL(achint(1:na, 1:np, 9), TRANSPOSE(bcint(1:nb, 1:np, 1)))    ! -zyV
                              ! zVy
                              blocks_rxrv(1)%block(1:na, 1:nb) = blocks_rxrv(1)%block(1:na, 1:nb) + &
-                                                                 MATMUL(achint(1:na, 1:np, 4), TRANSPOSE(bcint(1:nb, 1:np, 3)))
+                                                                 MATMUL(achint(1:na, 1:np, 4), TRANSPOSE(bcint(1:nb, 1:np, 3)))    ! zVy
                           ELSE
                              ! yzV
                              blocks_rxrv(1)%block(1:nb, 1:na) = blocks_rxrv(1)%block(1:nb, 1:na) + &
-                                                                 MATMUL(bchint(1:nb, 1:np, 9), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 9), TRANSPOSE(acint(1:na, 1:np, 1)))    ! yzV
                              ! -yVz
                              blocks_rxrv(1)%block(1:nb, 1:na) = blocks_rxrv(1)%block(1:nb, 1:na) - &
-                                                                 MATMUL(bchint(1:nb, 1:np, 3), TRANSPOSE(acint(1:na, 1:np, 4)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 3), TRANSPOSE(acint(1:na, 1:np, 4)))    ! -yVz
                              ! -zyV
                              blocks_rxrv(1)%block(1:nb, 1:na) = blocks_rxrv(1)%block(1:nb, 1:na) - &
-                                                                 MATMUL(bchint(1:nb, 1:np, 9), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 9), TRANSPOSE(acint(1:na, 1:np, 1)))    ! -zyV
                              ! zVy
                              blocks_rxrv(1)%block(1:nb, 1:na) = blocks_rxrv(1)%block(1:nb, 1:na) + &
-                                                                 MATMUL(bchint(1:nb, 1:np, 4), TRANSPOSE(acint(1:na, 1:np, 3)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 4), TRANSPOSE(acint(1:na, 1:np, 3)))    ! zVy
                           END IF
                           ! y-component (z [x,Vnl] - x [z, Vnl])
                           ! with LAPACK
                           ! CALL dgemm("N", "T", na, nb, np, 1.0_dp, achint(1, 1, 7), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rxrv(2)%block, SIZE(blocks_rxrv(2)%block, 1)) ! zxV
                           ! CALL dgemm("N", "T", na, nb, np, -1.0_dp, achint(1, 1, 4), na, &
                           !            bcint(1, 1, 2), nb, 1.0_dp, blocks_rxrv(2)%block, SIZE(blocks_rxrv(2)%block, 1)) ! -zVx
                           ! CALL dgemm("N", "T", na, nb, np, -1.0_dp, achint(1, 1, 7), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rxrv(2)%block, SIZE(blocks_rxrv(2)%block, 1)) ! -xzV
                           ! CALL dgemm("N", "T", na, nb, np, 1.0_dp, achint(1, 1, 2), na, &
                           !            bcint(1, 1, 4), nb, 1.0_dp, blocks_rxrv(2)%block, SIZE(blocks_rxrv(2)%block, 1)) ! xVz
                           ! with MATMUL
                           IF (iatom <= jatom) THEN
                              ! zxV
                              blocks_rxrv(2)%block(1:na, 1:nb) = blocks_rxrv(2)%block(1:na, 1:nb) + &
-                                                                 MATMUL(achint(1:na, 1:np, 7), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                 MATMUL(achint(1:na, 1:np, 7), TRANSPOSE(bcint(1:nb, 1:np, 1)))    ! zxV
                              ! -zVx
                              blocks_rxrv(2)%block(1:na, 1:nb) = blocks_rxrv(2)%block(1:na, 1:nb) - &
-                                                                 MATMUL(achint(1:na, 1:np, 4), TRANSPOSE(bcint(1:nb, 1:np, 2)))
+                                                                 MATMUL(achint(1:na, 1:np, 4), TRANSPOSE(bcint(1:nb, 1:np, 2)))    ! -zVx
                              ! -xzV
                              blocks_rxrv(2)%block(1:na, 1:nb) = blocks_rxrv(2)%block(1:na, 1:nb) - &
-                                                                 MATMUL(achint(1:na, 1:np, 7), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                 MATMUL(achint(1:na, 1:np, 7), TRANSPOSE(bcint(1:nb, 1:np, 1)))    ! -xzV
                              ! xVz
                              blocks_rxrv(2)%block(1:na, 1:nb) = blocks_rxrv(2)%block(1:na, 1:nb) + &
-                                                                 MATMUL(achint(1:na, 1:np, 2), TRANSPOSE(bcint(1:nb, 1:np, 4)))
+                                                                 MATMUL(achint(1:na, 1:np, 2), TRANSPOSE(bcint(1:nb, 1:np, 4)))    ! xVz
                           ELSE
                              ! zxV
                              blocks_rxrv(2)%block(1:nb, 1:na) = blocks_rxrv(2)%block(1:nb, 1:na) + &
-                                                                 MATMUL(bchint(1:nb, 1:np, 7), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 7), TRANSPOSE(acint(1:na, 1:np, 1)))    ! zxV
                              ! -zVx
                              blocks_rxrv(2)%block(1:nb, 1:na) = blocks_rxrv(2)%block(1:nb, 1:na) - &
-                                                                 MATMUL(bchint(1:nb, 1:np, 4), TRANSPOSE(acint(1:na, 1:np, 2)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 4), TRANSPOSE(acint(1:na, 1:np, 2)))    ! -zVx
                              ! -xzV
                              blocks_rxrv(2)%block(1:nb, 1:na) = blocks_rxrv(2)%block(1:nb, 1:na) - &
-                                                                 MATMUL(bchint(1:nb, 1:np, 7), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 7), TRANSPOSE(acint(1:na, 1:np, 1)))    ! -xzV
                              ! xVz
                              blocks_rxrv(2)%block(1:nb, 1:na) = blocks_rxrv(2)%block(1:nb, 1:na) + &
-                                                                 MATMUL(bchint(1:nb, 1:np, 2), TRANSPOSE(acint(1:na, 1:np, 4)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 2), TRANSPOSE(acint(1:na, 1:np, 4)))    ! xVz
                           END IF
                           ! z-component (x [y,Vnl] - y [x, Vnl])
                           ! with LAPACK
                           ! CALL dgemm("N", "T", na, nb, np, 1.0_dp, achint(1, 1, 6), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rxrv(3)%block, SIZE(blocks_rxrv(3)%block, 1)) ! xyV
                           ! CALL dgemm("N", "T", na, nb, np, -1.0_dp, achint(1, 1, 2), na, &
                           !            bcint(1, 1, 3), nb, 1.0_dp, blocks_rxrv(3)%block, SIZE(blocks_rxrv(3)%block, 1)) ! -xVy
                           ! CALL dgemm("N", "T", na, nb, np, -1.0_dp, achint(1, 1, 6), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rxrv(3)%block, SIZE(blocks_rxrv(3)%block, 1)) ! -yxV
                           ! CALL dgemm("N", "T", na, nb, np, 1.0_dp, achint(1, 1, 3), na, &
                           !            bcint(1, 1, 2), nb, 1.0_dp, blocks_rxrv(3)%block, SIZE(blocks_rxrv(3)%block, 1)) ! yVx
                           ! with MATMUL
                           IF (iatom <= jatom) THEN
                              ! xyV
                              blocks_rxrv(3)%block(1:na, 1:nb) = blocks_rxrv(3)%block(1:na, 1:nb) + &
-                                                                 MATMUL(achint(1:na, 1:np, 6), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                 MATMUL(achint(1:na, 1:np, 6), TRANSPOSE(bcint(1:nb, 1:np, 1)))    ! xyV
                              ! -xVy
                              blocks_rxrv(3)%block(1:na, 1:nb) = blocks_rxrv(3)%block(1:na, 1:nb) - &
-                                                                 MATMUL(achint(1:na, 1:np, 2), TRANSPOSE(bcint(1:nb, 1:np, 3)))
+                                                                 MATMUL(achint(1:na, 1:np, 2), TRANSPOSE(bcint(1:nb, 1:np, 3)))    ! -xVy
                              ! -yxV
                              blocks_rxrv(3)%block(1:na, 1:nb) = blocks_rxrv(3)%block(1:na, 1:nb) - &
-                                                                 MATMUL(achint(1:na, 1:np, 6), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                 MATMUL(achint(1:na, 1:np, 6), TRANSPOSE(bcint(1:nb, 1:np, 1)))    ! -yxV
                              ! zVx
                              blocks_rxrv(3)%block(1:na, 1:nb) = blocks_rxrv(3)%block(1:na, 1:nb) + &
-                                                                 MATMUL(achint(1:na, 1:np, 3), TRANSPOSE(bcint(1:nb, 1:np, 2)))
+                                                                 MATMUL(achint(1:na, 1:np, 3), TRANSPOSE(bcint(1:nb, 1:np, 2)))    ! zVx
                           ELSE
                              ! xyV
                              blocks_rxrv(3)%block(1:nb, 1:na) = blocks_rxrv(3)%block(1:nb, 1:na) + &
-                                                                 MATMUL(bchint(1:nb, 1:np, 6), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 6), TRANSPOSE(acint(1:na, 1:np, 1)))    ! xyV
                              ! -xVy
                              blocks_rxrv(3)%block(1:nb, 1:na) = blocks_rxrv(3)%block(1:nb, 1:na) - &
-                                                                 MATMUL(bchint(1:nb, 1:np, 2), TRANSPOSE(acint(1:na, 1:np, 3)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 2), TRANSPOSE(acint(1:na, 1:np, 3)))    ! -xVy
                              ! -yxV
                              blocks_rxrv(3)%block(1:nb, 1:na) = blocks_rxrv(3)%block(1:nb, 1:na) - &
-                                                                 MATMUL(bchint(1:nb, 1:np, 6), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 6), TRANSPOSE(acint(1:na, 1:np, 1)))    ! -yxV
                              ! zVx
                              blocks_rxrv(3)%block(1:nb, 1:na) = blocks_rxrv(3)%block(1:nb, 1:na) + &
-                                                                 MATMUL(bchint(1:nb, 1:np, 3), TRANSPOSE(acint(1:na, 1:np, 2)))
+                                                                 MATMUL(bchint(1:nb, 1:np, 3), TRANSPOSE(acint(1:na, 1:np, 2)))    ! zVx
                           END IF
                        END IF
                        IF (my_rrv) THEN
                           ! r_alpha * r_beta * Vnl
                           ! with LAPACK
                           ! CALL dgemm("N", "T", na, nb, np, 1._dp, achint(1, 1, 5), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rrv(1)%block, SIZE(blocks_rrv(1)%block, 1)) ! xxV
                           ! CALL dgemm("N", "T", na, nb, np, 1._dp, achint(1, 1, 6), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rrv(2)%block, SIZE(blocks_rrv(2)%block, 1)) ! xyV
                           ! CALL dgemm("N", "T", na, nb, np, 1._dp, achint(1, 1, 7), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rrv(3)%block, SIZE(blocks_rrv(3)%block, 1)) ! xzV
                           ! CALL dgemm("N", "T", na, nb, np, 1._dp, achint(1, 1, 8), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rrv(4)%block, SIZE(blocks_rrv(4)%block, 1)) ! yyV
                           ! CALL dgemm("N", "T", na, nb, np, 1._dp, achint(1, 1, 9), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rrv(5)%block, SIZE(blocks_rrv(5)%block, 1)) ! yzV
                           ! CALL dgemm("N", "T", na, nb, np, 1._dp, achint(1, 1, 10), na, &
                           !            bcint(1, 1, 1), nb, 1.0_dp, blocks_rrv(6)%block, SIZE(blocks_rrv(6)%block, 1)) ! zzV
                           ! with MATMUL
                           IF (iatom <= jatom) THEN
                              ! xxV
                              blocks_rrv(1)%block(1:na, 1:nb) = blocks_rrv(1)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 5), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                MATMUL(achint(1:na, 1:np, 5), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! xxV
                              ! xyV
                              blocks_rrv(2)%block(1:na, 1:nb) = blocks_rrv(2)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 6), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                MATMUL(achint(1:na, 1:np, 6), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! xyV
                              ! xzV
                              blocks_rrv(3)%block(1:na, 1:nb) = blocks_rrv(3)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 7), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                MATMUL(achint(1:na, 1:np, 7), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! xzV
                              ! yyV
                              blocks_rrv(4)%block(1:na, 1:nb) = blocks_rrv(4)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 8), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                MATMUL(achint(1:na, 1:np, 8), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! yyV
                              ! yzV
                              blocks_rrv(5)%block(1:na, 1:nb) = blocks_rrv(5)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 9), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                MATMUL(achint(1:na, 1:np, 9), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! yzV
                              ! zzV
                              blocks_rrv(6)%block(1:na, 1:nb) = blocks_rrv(6)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 10), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                MATMUL(achint(1:na, 1:np, 10), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! zzV
                           ELSE
                              ! xxV
                              blocks_rrv(1)%block(1:nb, 1:na) = blocks_rrv(1)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 5), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                MATMUL(bchint(1:nb, 1:np, 5), TRANSPOSE(acint(1:na, 1:np, 1)))   ! xxV
                              ! xyV
                              blocks_rrv(2)%block(1:nb, 1:na) = blocks_rrv(2)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 6), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                MATMUL(bchint(1:nb, 1:np, 6), TRANSPOSE(acint(1:na, 1:np, 1)))   ! xyV
                              ! xzV
                              blocks_rrv(3)%block(1:nb, 1:na) = blocks_rrv(3)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 7), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                MATMUL(bchint(1:nb, 1:np, 7), TRANSPOSE(acint(1:na, 1:np, 1)))   ! xzV
                              ! yyV
                              blocks_rrv(4)%block(1:nb, 1:na) = blocks_rrv(4)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 8), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                MATMUL(bchint(1:nb, 1:np, 8), TRANSPOSE(acint(1:na, 1:np, 1)))   ! yyV
                              ! yzV
                              blocks_rrv(5)%block(1:nb, 1:na) = blocks_rrv(5)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 9), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                MATMUL(bchint(1:nb, 1:np, 9), TRANSPOSE(acint(1:na, 1:np, 1)))   ! yzV
                              ! zzV
                              blocks_rrv(6)%block(1:nb, 1:na) = blocks_rrv(6)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 10), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                MATMUL(bchint(1:nb, 1:np, 10), TRANSPOSE(acint(1:na, 1:np, 1)))   ! zzV
                           END IF
                           ! - Vnl * r_alpha * r_beta
                           ! with LAPACK
                           ! CALL dgemm("N", "T", na, nb, np, -1._dp, achint(1, 1, 1), na, &
                           !            bcint(1, 1, 5), nb, 1.0_dp, blocks_rrv(1)%block, SIZE(blocks_rrv(1)%block, 1)) ! Vxx
                           ! CALL dgemm("N", "T", na, nb, np, -1._dp, achint(1, 1, 1), na, &
                           !            bcint(1, 1, 6), nb, 1.0_dp, blocks_rrv(2)%block, SIZE(blocks_rrv(2)%block, 1)) ! Vxy
                           ! CALL dgemm("N", "T", na, nb, np, -1._dp, achint(1, 1, 1), na, &
                           !            bcint(1, 1, 7), nb, 1.0_dp, blocks_rrv(3)%block, SIZE(blocks_rrv(3)%block, 1)) ! Vxz
                           ! CALL dgemm("N", "T", na, nb, np, -1._dp, achint(1, 1, 1), na, &
                           !            bcint(1, 1, 8), nb, 1.0_dp, blocks_rrv(4)%block, SIZE(blocks_rrv(4)%block, 1)) ! Vyy
                           ! CALL dgemm("N", "T", na, nb, np, -1._dp, achint(1, 1, 1), na, &
                           !            bcint(1, 1, 9), nb, 1.0_dp, blocks_rrv(5)%block, SIZE(blocks_rrv(5)%block, 1)) ! Vyz
                           ! CALL dgemm("N", "T", na, nb, np, -1._dp, achint(1, 1, 1), na, &
                           !            bcint(1, 1, 10), nb, 1.0_dp, blocks_rrv(6)%block, SIZE(blocks_rrv(6)%block, 1)) ! Vzz
                           ! with MATMUL
                           IF (iatom <= jatom) THEN
                              ! -Vxx
                              blocks_rrv(1)%block(1:na, 1:nb) = blocks_rrv(1)%block(1:na, 1:nb) - &
-                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 5)))
+                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 5)))   ! -Vxx
                              ! -Vxy
                              blocks_rrv(2)%block(1:na, 1:nb) = blocks_rrv(2)%block(1:na, 1:nb) - &
-                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 6)))
+                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 6)))   ! -Vxy
                              ! -Vxz
                              blocks_rrv(3)%block(1:na, 1:nb) = blocks_rrv(3)%block(1:na, 1:nb) - &
-                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 7)))
+                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 7)))   ! -Vxz
                              ! -Vyy
                              blocks_rrv(4)%block(1:na, 1:nb) = blocks_rrv(4)%block(1:na, 1:nb) - &
-                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 8)))
+                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 8)))   ! -Vyy
                              ! -Vyz
                              blocks_rrv(5)%block(1:na, 1:nb) = blocks_rrv(5)%block(1:na, 1:nb) - &
-                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 9)))
+                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 9)))   ! -Vyz
                              ! -Vzz
                              blocks_rrv(6)%block(1:na, 1:nb) = blocks_rrv(6)%block(1:na, 1:nb) - &
-                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 10)))
+                                                                MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 10)))   ! -Vzz
                           ELSE
                              ! -Vxx
                              blocks_rrv(1)%block(1:nb, 1:na) = blocks_rrv(1)%block(1:nb, 1:na) - &
-                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 5)))
+                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 5)))   ! -Vxx
                              ! -Vxy
                              blocks_rrv(2)%block(1:nb, 1:na) = blocks_rrv(2)%block(1:nb, 1:na) - &
-                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 6)))
+                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 6)))   ! -Vxy
                              ! -Vxz
                              blocks_rrv(3)%block(1:nb, 1:na) = blocks_rrv(3)%block(1:nb, 1:na) - &
-                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 7)))
+                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 7)))   ! -Vxz
                              ! -Vyy
                              blocks_rrv(4)%block(1:nb, 1:na) = blocks_rrv(4)%block(1:nb, 1:na) - &
-                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 8)))
+                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 8)))   ! -Vyy
                              ! -Vyz
                              blocks_rrv(5)%block(1:nb, 1:na) = blocks_rrv(5)%block(1:nb, 1:na) - &
-                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 9)))
+                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 9)))   ! -Vyz
                              ! -Vzz
                              blocks_rrv(6)%block(1:nb, 1:na) = blocks_rrv(6)%block(1:nb, 1:na) - &
-                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 10)))
+                                                                MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 10)))   ! -Vzz
                           END IF
                        END IF
                        IF (my_rvr) THEN
                           ! r_alpha * Vnl * r_beta
                           IF (iatom <= jatom) THEN
                              ! xVx
                              blocks_rvr(1)%block(1:na, 1:nb) = blocks_rvr(1)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 2), TRANSPOSE(bcint(1:nb, 1:np, 2)))
+                                                                MATMUL(achint(1:na, 1:np, 2), TRANSPOSE(bcint(1:nb, 1:np, 2)))   ! xVx
                              ! xVy
                              blocks_rvr(2)%block(1:na, 1:nb) = blocks_rvr(2)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 2), TRANSPOSE(bcint(1:nb, 1:np, 3)))
+                                                                MATMUL(achint(1:na, 1:np, 2), TRANSPOSE(bcint(1:nb, 1:np, 3)))   ! xVy
                              ! xVz
                              blocks_rvr(3)%block(1:na, 1:nb) = blocks_rvr(3)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 2), TRANSPOSE(bcint(1:nb, 1:np, 4)))
+                                                                MATMUL(achint(1:na, 1:np, 2), TRANSPOSE(bcint(1:nb, 1:np, 4)))   ! xVz
                              ! yVy
                              blocks_rvr(4)%block(1:na, 1:nb) = blocks_rvr(4)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 3), TRANSPOSE(bcint(1:nb, 1:np, 3)))
+                                                                MATMUL(achint(1:na, 1:np, 3), TRANSPOSE(bcint(1:nb, 1:np, 3)))   ! yVy
                              ! yVz
                              blocks_rvr(5)%block(1:na, 1:nb) = blocks_rvr(5)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 3), TRANSPOSE(bcint(1:nb, 1:np, 4)))
+                                                                MATMUL(achint(1:na, 1:np, 3), TRANSPOSE(bcint(1:nb, 1:np, 4)))   ! yVz
                              ! zVz
                              blocks_rvr(6)%block(1:na, 1:nb) = blocks_rvr(6)%block(1:na, 1:nb) + &
-                                                                MATMUL(achint(1:na, 1:np, 4), TRANSPOSE(bcint(1:nb, 1:np, 4)))
+                                                                MATMUL(achint(1:na, 1:np, 4), TRANSPOSE(bcint(1:nb, 1:np, 4)))   ! zVz
                           ELSE
                              ! xVx
                              blocks_rvr(1)%block(1:nb, 1:na) = blocks_rvr(1)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 2), TRANSPOSE(acint(1:na, 1:np, 2)))
+                                                                MATMUL(bchint(1:nb, 1:np, 2), TRANSPOSE(acint(1:na, 1:np, 2)))   ! xVx
                              ! xVy
                              blocks_rvr(2)%block(1:nb, 1:na) = blocks_rvr(2)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 2), TRANSPOSE(acint(1:na, 1:np, 3)))
+                                                                MATMUL(bchint(1:nb, 1:np, 2), TRANSPOSE(acint(1:na, 1:np, 3)))   ! xVy
                              ! xVz
                              blocks_rvr(3)%block(1:nb, 1:na) = blocks_rvr(3)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 2), TRANSPOSE(acint(1:na, 1:np, 4)))
+                                                                MATMUL(bchint(1:nb, 1:np, 2), TRANSPOSE(acint(1:na, 1:np, 4)))   ! xVz
                              ! yVy
                              blocks_rvr(4)%block(1:nb, 1:na) = blocks_rvr(4)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 3), TRANSPOSE(acint(1:na, 1:np, 3)))
+                                                                MATMUL(bchint(1:nb, 1:np, 3), TRANSPOSE(acint(1:na, 1:np, 3)))   ! yVy
                              ! yVz
                              blocks_rvr(5)%block(1:nb, 1:na) = blocks_rvr(5)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 3), TRANSPOSE(acint(1:na, 1:np, 4)))
+                                                                MATMUL(bchint(1:nb, 1:np, 3), TRANSPOSE(acint(1:na, 1:np, 4)))   ! yVz
                              ! zVz
                              blocks_rvr(6)%block(1:nb, 1:na) = blocks_rvr(6)%block(1:nb, 1:na) + &
-                                                                MATMUL(bchint(1:nb, 1:np, 4), TRANSPOSE(acint(1:na, 1:np, 4)))
+                                                                MATMUL(bchint(1:nb, 1:np, 4), TRANSPOSE(acint(1:na, 1:np, 4)))   ! zVz
                           END IF
                        END IF
                        IF (my_rrv_vrr) THEN
                           ! r_alpha * r_beta * Vnl
                           IF (iatom <= jatom) THEN
                              ! xxV
                              blocks_rrv_vrr(1)%block(1:na, 1:nb) = blocks_rrv_vrr(1)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 5), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                    MATMUL(achint(1:na, 1:np, 5), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! xxV
                              ! xyV
                              blocks_rrv_vrr(2)%block(1:na, 1:nb) = blocks_rrv_vrr(2)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 6), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                    MATMUL(achint(1:na, 1:np, 6), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! xyV
                              ! xzV
                              blocks_rrv_vrr(3)%block(1:na, 1:nb) = blocks_rrv_vrr(3)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 7), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                    MATMUL(achint(1:na, 1:np, 7), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! xzV
                              ! yyV
                              blocks_rrv_vrr(4)%block(1:na, 1:nb) = blocks_rrv_vrr(4)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 8), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                    MATMUL(achint(1:na, 1:np, 8), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! yyV
                              ! yzV
                              blocks_rrv_vrr(5)%block(1:na, 1:nb) = blocks_rrv_vrr(5)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 9), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                                    MATMUL(achint(1:na, 1:np, 9), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! yzV
                              ! zzV
                              blocks_rrv_vrr(6)%block(1:na, 1:nb) = blocks_rrv_vrr(6)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 10), TRANSPOSE(bcint(1:nb, 1:np, 1)))
+                                                             MATMUL(achint(1:na, 1:np, 10), TRANSPOSE(bcint(1:nb, 1:np, 1)))   ! zzV
                           ELSE
                              ! xxV
                              blocks_rrv_vrr(1)%block(1:nb, 1:na) = blocks_rrv_vrr(1)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 5), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                    MATMUL(bchint(1:nb, 1:np, 5), TRANSPOSE(acint(1:na, 1:np, 1)))   ! xxV
                              ! xyV
                              blocks_rrv_vrr(2)%block(1:nb, 1:na) = blocks_rrv_vrr(2)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 6), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                    MATMUL(bchint(1:nb, 1:np, 6), TRANSPOSE(acint(1:na, 1:np, 1)))   ! xyV
                              ! xzV
                              blocks_rrv_vrr(3)%block(1:nb, 1:na) = blocks_rrv_vrr(3)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 7), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                    MATMUL(bchint(1:nb, 1:np, 7), TRANSPOSE(acint(1:na, 1:np, 1)))   ! xzV
                              ! yyV
                              blocks_rrv_vrr(4)%block(1:nb, 1:na) = blocks_rrv_vrr(4)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 8), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                    MATMUL(bchint(1:nb, 1:np, 8), TRANSPOSE(acint(1:na, 1:np, 1)))   ! yyV
                              ! yzV
                              blocks_rrv_vrr(5)%block(1:nb, 1:na) = blocks_rrv_vrr(5)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 9), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                                    MATMUL(bchint(1:nb, 1:np, 9), TRANSPOSE(acint(1:na, 1:np, 1)))   ! yzV
                              ! zzV
                              blocks_rrv_vrr(6)%block(1:nb, 1:na) = blocks_rrv_vrr(6)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 10), TRANSPOSE(acint(1:na, 1:np, 1)))
+                                                             MATMUL(bchint(1:nb, 1:np, 10), TRANSPOSE(acint(1:na, 1:np, 1)))   ! zzV
                           END IF
                           ! + Vnl * r_alpha * r_beta
                           IF (iatom <= jatom) THEN
                              ! +Vxx
                              blocks_rrv_vrr(1)%block(1:na, 1:nb) = blocks_rrv_vrr(1)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 5)))
+                                                                    MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 5)))   ! +Vxx
                              ! +Vxy
                              blocks_rrv_vrr(2)%block(1:na, 1:nb) = blocks_rrv_vrr(2)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 6)))
+                                                                    MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 6)))   ! +Vxy
                              ! +Vxz
                              blocks_rrv_vrr(3)%block(1:na, 1:nb) = blocks_rrv_vrr(3)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 7)))
+                                                                    MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 7)))   ! +Vxz
                              ! +Vyy
                              blocks_rrv_vrr(4)%block(1:na, 1:nb) = blocks_rrv_vrr(4)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 8)))
+                                                                    MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 8)))   ! +Vyy
                              ! +Vyz
                              blocks_rrv_vrr(5)%block(1:na, 1:nb) = blocks_rrv_vrr(5)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 9)))
+                                                                    MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 9)))   ! +Vyz
                              ! +Vzz
                              blocks_rrv_vrr(6)%block(1:na, 1:nb) = blocks_rrv_vrr(6)%block(1:na, 1:nb) + &
-                                                                    MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 10)))
+                                                            MATMUL(achint(1:na, 1:np, 1), TRANSPOSE(bcint(1:nb, 1:np, 10)))   ! +Vzz
                           ELSE
                              ! +Vxx
                              blocks_rrv_vrr(1)%block(1:nb, 1:na) = blocks_rrv_vrr(1)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 5)))
+                                                                    MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 5)))   ! +Vxx
                              ! +Vxy
                              blocks_rrv_vrr(2)%block(1:nb, 1:na) = blocks_rrv_vrr(2)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 6)))
+                                                                    MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 6)))   ! +Vxy
                              ! +Vxz
                              blocks_rrv_vrr(3)%block(1:nb, 1:na) = blocks_rrv_vrr(3)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 7)))
+                                                                    MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 7)))   ! +Vxz
                              ! +Vyy
                              blocks_rrv_vrr(4)%block(1:nb, 1:na) = blocks_rrv_vrr(4)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 8)))
+                                                                    MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 8)))   ! +Vyy
                              ! +Vyz
                              blocks_rrv_vrr(5)%block(1:nb, 1:na) = blocks_rrv_vrr(5)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 9)))
+                                                                    MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 9)))   ! +Vyz
                              ! +Vzz
                              blocks_rrv_vrr(6)%block(1:nb, 1:na) = blocks_rrv_vrr(6)%block(1:nb, 1:na) + &
-                                                                    MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 10)))
+                                                            MATMUL(bchint(1:nb, 1:np, 1), TRANSPOSE(acint(1:na, 1:np, 10)))   ! +Vzz
                           END IF
                        END IF
                        ! The indices are stored in i_1, i_x, ..., i_zzz
                        ! matrix_r_rxvr(alpha, beta)
                        !  = sum_(gamma delta) epsilon_(alpha gamma delta)
                        !      (r_beta * r_gamma * V_nl * r_delta - r_beta * r_gamma * r_delta * V_nl)
                        !  = sum_(gamma delta) epsilon_(alpha gamma delta) r_beta * r_gamma * V_nl * r_delta
                        ! TODO: is this set to zero before?
                        IF (my_r_rxvr) THEN
--- a/src/constraint.F
+++ b/src/constraint.F
@ -157,51 +157,43 @@ CONTAINS
                  int_max_sigma = 0.0_dp
                  ishake_int = ishake_int + 1
                  ! 3x3
-                  IF (n3x3con /= 0) THEN
+                  IF (n3x3con /= 0) &
                     CALL shake_3x3_int(molecule, particle_set, pos, vel, dt, ishake_int, &
                                        int_max_sigma)
                  END IF
                  ! 4x6
-                  IF (n4x6con /= 0) THEN
+                  IF (n4x6con /= 0) &
                     CALL shake_4x6_int(molecule, particle_set, pos, vel, dt, ishake_int, &
                                        int_max_sigma)
                  END IF
                  ! Collective Variables
-                  IF (ncolv%ntot /= 0) THEN
+                  IF (ncolv%ntot /= 0) &
                     CALL shake_colv_int(molecule, particle_set, pos, vel, dt, ishake_int, &
                                         cell, imass, int_max_sigma)
                  END IF
               END DO Shake_Intra_Loop
               max_sigma = MAX(max_sigma, int_max_sigma)
               CALL shake_int_info(log_unit, i, ishake_int, max_sigma)
               ! Virtual Site
-               IF (nvsitecon /= 0) THEN
+               IF (nvsitecon /= 0) &
                  CALL shake_vsite_int(molecule, pos)
               END IF
            END DO
         END DO MOL
         ! Intermolecular constraints
         IF (do_ext_constraint) THEN
            CALL update_temporary_set(group, pos=pos, vel=vel)
            ! 3x3
-            IF (gci%ng3x3 /= 0) THEN
+            IF (gci%ng3x3 /= 0) &
               CALL shake_3x3_ext(gci, particle_set, pos, vel, dt, ishake_ext, &
                                  max_sigma)
            END IF
            ! 4x6
-            IF (gci%ng4x6 /= 0) THEN
+            IF (gci%ng4x6 /= 0) &
               CALL shake_4x6_ext(gci, particle_set, pos, vel, dt, ishake_ext, &
                                  max_sigma)
            END IF
            ! Collective Variables
-            IF (gci%ncolv%ntot /= 0) THEN
+            IF (gci%ncolv%ntot /= 0) &
               CALL shake_colv_ext(gci, particle_set, pos, vel, dt, ishake_ext, &
                                   cell, imass, max_sigma)
            END IF
            ! Virtual Site
-            IF (gci%nvsite /= 0) THEN
+            IF (gci%nvsite /= 0) &
               CALL shake_vsite_ext(gci, pos)
            END IF
            CALL restore_temporary_set(particle_set, local_particles, pos=pos, vel=vel)
         END IF
         CALL shake_ext_info(log_unit, ishake_ext, max_sigma)
@ -291,18 +283,15 @@ CONTAINS
                  int_max_sigma = 0.0_dp
                  irattle_int = irattle_int + 1
                  ! 3x3
-                  IF (n3x3con /= 0) THEN
+                  IF (n3x3con /= 0) &
                     CALL rattle_3x3_int(molecule, particle_set, vel, dt)
                  END IF
                  ! 4x6
-                  IF (n4x6con /= 0) THEN
+                  IF (n4x6con /= 0) &
                     CALL rattle_4x6_int(molecule, particle_set, vel, dt)
                  END IF
                  ! Collective Variables
-                  IF (ncolv%ntot /= 0) THEN
+                  IF (ncolv%ntot /= 0) &
                     CALL rattle_colv_int(molecule, particle_set, vel, dt, &
                                          irattle_int, cell, imass, int_max_sigma)
                  END IF
               END DO Rattle_Intra_Loop
               max_sigma = MAX(max_sigma, int_max_sigma)
               CALL rattle_int_info(log_unit, i, irattle_int, max_sigma)
@ -312,18 +301,15 @@ CONTAINS
         IF (do_ext_constraint) THEN
            CALL update_temporary_set(group, vel=vel)
            ! 3x3
-            IF (gci%ng3x3 /= 0) THEN
+            IF (gci%ng3x3 /= 0) &
               CALL rattle_3x3_ext(gci, particle_set, vel, dt)
            END IF
            ! 4x6
-            IF (gci%ng4x6 /= 0) THEN
+            IF (gci%ng4x6 /= 0) &
               CALL rattle_4x6_ext(gci, particle_set, vel, dt)
            END IF
            ! Collective Variables
-            IF (gci%ncolv%ntot /= 0) THEN
+            IF (gci%ncolv%ntot /= 0) &
               CALL rattle_colv_ext(gci, particle_set, vel, dt, &
                                    irattle_ext, cell, imass, max_sigma)
            END IF
            CALL restore_temporary_set(particle_set, local_particles, vel=vel)
         END IF
         CALL rattle_ext_info(log_unit, irattle_ext, max_sigma)
@ -431,20 +417,17 @@ CONTAINS
                  int_max_sigma = 0.0_dp
                  ishake_int = ishake_int + 1
                  ! 3x3
-                  IF (n3x3con /= 0) THEN
+                  IF (n3x3con /= 0) &
                     CALL shake_roll_3x3_int(molecule, particle_set, pos, vel, r_shake, &
                                             v_shake, dt, ishake_int, int_max_sigma)
                  END IF
                  ! 4x6
-                  IF (n4x6con /= 0) THEN
+                  IF (n4x6con /= 0) &
                     CALL shake_roll_4x6_int(molecule, particle_set, pos, vel, r_shake, &
                                             dt, ishake_int, int_max_sigma)
                  END IF
                  ! Collective Variables
-                  IF (ncolv%ntot /= 0) THEN
+                  IF (ncolv%ntot /= 0) &
                     CALL shake_roll_colv_int(molecule, particle_set, pos, vel, r_shake, &
                                              v_shake, dt, ishake_int, cell, imass, int_max_sigma)
                  END IF
               END DO Shake_Roll_Intra_Loop
               max_sigma = MAX(max_sigma, int_max_sigma)
               CALL shake_int_info(log_unit, i, ishake_int, max_sigma)
@ -458,24 +441,20 @@ CONTAINS
         IF (do_ext_constraint) THEN
            CALL update_temporary_set(group, pos=pos, vel=vel)
            ! 3x3
-            IF (gci%ng3x3 /= 0) THEN
+            IF (gci%ng3x3 /= 0) &
               CALL shake_roll_3x3_ext(gci, particle_set, pos, vel, r_shake, &
                                       v_shake, dt, ishake_ext, max_sigma)
            END IF
            ! 4x6
-            IF (gci%ng4x6 /= 0) THEN
+            IF (gci%ng4x6 /= 0) &
               CALL shake_roll_4x6_ext(gci, particle_set, pos, vel, r_shake, &
                                       dt, ishake_ext, max_sigma)
            END IF
            ! Collective Variables
-            IF (gci%ncolv%ntot /= 0) THEN
+            IF (gci%ncolv%ntot /= 0) &
               CALL shake_roll_colv_ext(gci, particle_set, pos, vel, r_shake, &
                                        v_shake, dt, ishake_ext, cell, imass, max_sigma)
            END IF
            ! Virtual Site
-            IF (gci%nvsite /= 0) THEN
+            IF (gci%nvsite /= 0) &
               CPABORT("Virtual Site Constraint/Restraint not implemented for SHAKE_ROLL!")
            END IF
            CALL restore_temporary_set(particle_set, local_particles, pos=pos, vel=vel)
         END IF
         CALL shake_ext_info(log_unit, ishake_ext, max_sigma)
@ -585,20 +564,17 @@ CONTAINS
                  int_max_sigma = 0.0_dp
                  irattle_int = irattle_int + 1
                  ! 3x3
-                  IF (n3x3con /= 0) THEN
+                  IF (n3x3con /= 0) &
                     CALL rattle_roll_3x3_int(molecule, particle_set, vel, r_rattle, dt, &
                                              veps)
                  END IF
                  ! 4x6
-                  IF (n4x6con /= 0) THEN
+                  IF (n4x6con /= 0) &
                     CALL rattle_roll_4x6_int(molecule, particle_set, vel, r_rattle, dt, &
                                              veps)
                  END IF
                  ! Collective Variables
-                  IF (ncolv%ntot /= 0) THEN
+                  IF (ncolv%ntot /= 0) &
                     CALL rattle_roll_colv_int(molecule, particle_set, vel, r_rattle, dt, &
                                               irattle_int, veps, cell, imass, int_max_sigma)
                  END IF
               END DO Rattle_Roll_Intramolecular
               max_sigma = MAX(max_sigma, int_max_sigma)
               CALL rattle_int_info(log_unit, i, irattle_int, max_sigma)
@ -608,20 +584,17 @@ CONTAINS
         IF (do_ext_constraint) THEN
            CALL update_temporary_set(para_env, vel=vel)
            ! 3x3
-            IF (gci%ng3x3 /= 0) THEN
+            IF (gci%ng3x3 /= 0) &
               CALL rattle_roll_3x3_ext(gci, particle_set, vel, r_rattle, dt, &
                                        veps)
            END IF
            ! 4x6
-            IF (gci%ng4x6 /= 0) THEN
+            IF (gci%ng4x6 /= 0) &
               CALL rattle_roll_4x6_ext(gci, particle_set, vel, r_rattle, dt, &
                                        veps)
            END IF
            ! Collective Variables
-            IF (gci%ncolv%ntot /= 0) THEN
+            IF (gci%ncolv%ntot /= 0) &
               CALL rattle_roll_colv_ext(gci, particle_set, vel, r_rattle, dt, &
                                         irattle_ext, veps, cell, imass, max_sigma)
            END IF
            CALL restore_temporary_set(particle_set, local_particles, vel=vel)
         END IF
         CALL rattle_ext_info(log_unit, irattle_ext, max_sigma)
@ -735,7 +708,7 @@ CONTAINS
         IF (log_unit > 0) THEN
            IF (id_type == "S") THEN
               label = "Shake  Lagrangian Multipliers:"
-            ELSE IF (id_type == "R") THEN
+            ELSEIF (id_type == "R") THEN
               label = "Rattle Lagrangian Multipliers:"
            ELSE
               CPABORT("Only S for Shake or R for Rattle are supported for Lagrangian Multipliers")
@ -770,12 +743,11 @@ CONTAINS
            "Molecule Nr.:", i, " Nr. Iterations:", ishake_int, " Max. Err.:", max_sigma
      END IF
      ! Notify a not converged SHAKE
-      IF (ishake_int > Max_Shake_Iter) THEN
+      IF (ishake_int > Max_Shake_Iter) &
         CALL cp_warn(__LOCATION__, &
                      "Shake NOT converged in "//cp_to_string(Max_Shake_Iter)//" iterations in the "// &
                      "intramolecular constraint loop for Molecule nr. "//cp_to_string(i)// &
                      ". CP2K continues but results could be meaningless. ")
      END IF
   END SUBROUTINE shake_int_info
 ! **************************************************************************************************
@ -797,11 +769,10 @@ CONTAINS
            " Max. Err.:", max_sigma
      END IF
      ! Notify a not converged SHAKE
-      IF (ishake_ext > Max_Shake_Iter) THEN
+      IF (ishake_ext > Max_Shake_Iter) &
         CALL cp_warn(__LOCATION__, &
                      "Shake NOT converged in "//cp_to_string(Max_Shake_Iter)//" iterations in the "// &
                      "intermolecular constraint. CP2K continues but results could be meaningless.")
      END IF
   END SUBROUTINE shake_ext_info
 ! **************************************************************************************************
@ -823,12 +794,11 @@ CONTAINS
            "Molecule Nr.:", i, " Nr. Iterations:", irattle_int, " Max. Err.:", max_sigma
      END IF
      ! Notify a not converged RATTLE
-      IF (irattle_int > Max_shake_Iter) THEN
+      IF (irattle_int > Max_shake_Iter) &
         CALL cp_warn(__LOCATION__, &
                      "Rattle NOT converged in "//cp_to_string(Max_Shake_Iter)//" iterations in the "// &
                      "intramolecular constraint loop for Molecule nr. "//cp_to_string(i)// &
                      ". CP2K continues but results could be meaningless.")
      END IF
   END SUBROUTINE rattle_int_info
 ! **************************************************************************************************
@ -850,11 +820,10 @@ CONTAINS
            " Max. Err.:", max_sigma
      END IF
      ! Notify a not converged RATTLE
-      IF (irattle_ext > Max_shake_Iter) THEN
+      IF (irattle_ext > Max_shake_Iter) &
         CALL cp_warn(__LOCATION__, &
                      "Rattle NOT converged in "//cp_to_string(Max_Shake_Iter)//" iterations in the "// &
                      "intermolecular constraint. CP2K continues but results could be meaningless.")
      END IF
   END SUBROUTINE rattle_ext_info
 ! **************************************************************************************************
--- a/src/constraint_fxd.F
+++ b/src/constraint_fxd.F
@ -398,9 +398,8 @@ CONTAINS
                  DO k = 1, SIZE(fixd_list)
                     IF (fixd_list(k)%fixd == j) THEN
                        IF (fixd_list(k)%itype /= use_perd_xyz) CYCLE
-                        IF (.NOT. fixd_list(k)%restraint%active) THEN
+                        IF (.NOT. fixd_list(k)%restraint%active) &
                           colvar%dsdr(:, i) = 0.0_dp
                        END IF
                        EXIT
                     END IF
                  END DO
--- a/src/constraint_util.F
+++ b/src/constraint_util.F
@ -554,8 +554,8 @@ CONTAINS
            v_shake = MATMUL(MATMUL(u, diag), TRANSPOSE(u))
            diag = MATMUL(r_shake, v_shake)
            r_shake = diag
-         ELSE IF (.NOT. PRESENT(u) .AND. PRESENT(vector_v) .AND. &
+         ELSEIF (.NOT. PRESENT(u) .AND. PRESENT(vector_v) .AND. &
-                  PRESENT(vector_r)) THEN
+                 PRESENT(vector_r)) THEN
            DO i = 1, 3
               r_shake(i, i) = vector_r(i)*vector_v(i)
               v_shake(i, i) = vector_v(i)
@ -569,7 +569,7 @@ CONTAINS
            diag(2, 2) = vector_v(2)
            diag(3, 3) = vector_v(3)
            v_shake = MATMUL(MATMUL(u, diag), TRANSPOSE(u))
-         ELSE IF (.NOT. PRESENT(u) .AND. PRESENT(vector_v)) THEN
+         ELSEIF (.NOT. PRESENT(u) .AND. PRESENT(vector_v)) THEN
            DO i = 1, 3
               v_shake(i, i) = vector_v(i)
            END DO
--- a/src/constraint_vsite.F
+++ b/src/constraint_vsite.F
@ -94,16 +94,14 @@ CONTAINS
            molecule_kind => molecule%molecule_kind
            CALL get_molecule_kind(molecule_kind, nconstraint=nconstraint, nvsite=nvsitecon)
            IF (nconstraint == 0) CYCLE
-            IF (nvsitecon /= 0) THEN
+            IF (nvsitecon /= 0) &
               CALL force_vsite_int(molecule, particle_set)
            END IF
         END DO
      END DO MOL
      ! Intermolecular Virtual Site Constraints
      IF (do_ext_constraint) THEN
-         IF (gci%nvsite /= 0) THEN
+         IF (gci%nvsite /= 0) &
            CALL force_vsite_ext(gci, particle_set)
         END IF
      END IF
   END SUBROUTINE vsite_force_control
--- a/src/core_ppl.F
+++ b/src/core_ppl.F
@ -448,7 +448,7 @@ CONTAINS
               IF (ecp_semi_local) THEN
                  CALL get_potential(potential=sgp_potential, sl_lmax=slmax, &
                                     npot=npot, nrpot=nrpot, apot=apot, bpot=bpot)
-               ELSE IF (ecp_local) THEN
+               ELSEIF (ecp_local) THEN
                  IF (SUM(ABS(aloc(1:nloc))) < 1.0e-12_dp) CYCLE
               END IF
            ELSE
@ -498,7 +498,7 @@ CONTAINS
                              rab, dab, rac, dac, rbc, dbc, &
                              hab(:, :, iset, jset), ppl_work, pab(:, :, iset, jset), &
                              force_a, force_b, ppl_fwork)
-                        ELSE IF (libgrpp_local) THEN
+                        ELSEIF (libgrpp_local) THEN
 !$OMP CRITICAL(type1)
                           CALL libgrpp_local_forces_ref(la_max(iset), la_min(iset), npgfa(iset), &
                                                         rpgfa(:, iset), zeta(:, iset), &
@ -556,7 +556,7 @@ CONTAINS
                           CALL virial_pair_force(pv_thread, f0, force_a, rac)
                           CALL virial_pair_force(pv_thread, f0, force_b, rbc)
                        END IF
-                     ELSE IF (do_dR) THEN
+                     ELSEIF (do_dR) THEN
                        hab2_w = 0._dp
                        CALL ppl_integral( &
                           la_max(iset), la_min(iset), npgfa(iset), &
@ -584,7 +584,7 @@ CONTAINS
                              nexp_ppl, alpha_ppl, nct_ppl, cval_ppl, ppl_radius, &
                              rab, dab, rac, dac, rbc, dbc, hab(:, :, iset, jset), ppl_work)
-                        ELSE IF (libgrpp_local) THEN
+                        ELSEIF (libgrpp_local) THEN
                           !If the local part of the potential is more complex, we need libgrpp
 !$OMP CRITICAL(type1)
                           CALL libgrpp_local_integrals(la_max(iset), la_min(iset), npgfa(iset), &
--- a/src/core_ppnl.F
+++ b/src/core_ppnl.F
@ -667,7 +667,7 @@ CONTAINS
                           END IF
                           IF (do_dR) THEN
-                              i = 1; j = 2
+                              i = 1; j = 2;
                              katom = alist_ac%clist(kac)%catom
                              IF (iatom <= jatom) THEN
                                 h_block(1:na, 1:nb) = h_block(1:na, 1:nb) + &
@ -686,7 +686,7 @@ CONTAINS
                                                       MATMUL(bcint(1:nb, 1:np, j), TRANSPOSE(achint(1:na, 1:np, 1)))
                              END IF
-                              i = 2; j = 3
+                              i = 2; j = 3;
                              katom = alist_ac%clist(kac)%catom
                              IF (iatom <= jatom) THEN
                                 r_2block(1:na, 1:nb) = r_2block(1:na, 1:nb) + &
@ -705,7 +705,7 @@ CONTAINS
                                                        MATMUL(bcint(1:nb, 1:np, j), TRANSPOSE(achint(1:na, 1:np, 1)))
                              END IF
-                              i = 3; j = 4
+                              i = 3; j = 4;
                              katom = alist_ac%clist(kac)%catom
                              IF (iatom <= jatom) THEN
                                 r_3block(1:na, 1:nb) = r_3block(1:na, 1:nb) + &
--- a/src/cp2k_debug.F
+++ b/src/cp2k_debug.F
@ -98,7 +98,7 @@ CONTAINS
      REAL(KIND=dp), DIMENSION(3)                        :: dipole_moment, dipole_numer, err, &
                                                            my_maxerr, poldir
      REAL(KIND=dp), DIMENSION(3, 2)                     :: dipn
-      REAL(KIND=dp), DIMENSION(3, 3)                     :: polar_analytic, polar_numeric, polerr
+      REAL(KIND=dp), DIMENSION(3, 3)                     :: polar_analytic, polar_numeric
      REAL(KIND=dp), DIMENSION(9)                        :: pvals
      REAL(KIND=dp), DIMENSION(:, :), POINTER            :: analyt_forces, numer_forces
      TYPE(cell_type), POINTER                           :: cell
@ -569,7 +569,6 @@ CONTAINS
               polar_numeric(1:3, k) = 0.5_dp*(dipn(1:3, 2) - dipn(1:3, 1))/de
            END DO
            IF (iw > 0) THEN
               polerr = 0.0_dp
               WRITE (UNIT=iw, FMT="(/,(T2,A))") &
                  "DEBUG|========================= POLARIZABILITY ================================", &
                  "DEBUG| Coordinates     P(numerical)    P(analytical)    Difference    Error [%]"
@ -580,7 +579,6 @@ CONTAINS
                        derr = 100._dp*dd/polar_analytic(k, j)
                        WRITE (UNIT=iw, FMT="(T2,A,T12,A1,A1,T21,F16.8,T38,F16.8,T56,G12.3,T72,F9.3)") &
                           "DEBUG|", ACHAR(119 + k), ACHAR(119 + j), polar_numeric(k, j), polar_analytic(k, j), dd, derr
                        polerr(k, j) = derr
                     ELSE
                        WRITE (UNIT=iw, FMT="(T2,A,T12,A1,A1,T21,F16.8,T38,F16.8,T56,G12.3)") &
                           "DEBUG|", ACHAR(119 + k), ACHAR(119 + j), polar_numeric(k, j), polar_analytic(k, j), dd
@ -590,16 +588,6 @@ CONTAINS
               WRITE (UNIT=iw, FMT="((T2,A))") &
                  "DEBUG|========================================================================="
               WRITE (UNIT=iw, FMT="(T2,A,T61,E20.12)") ' POLAR : CheckSum  =', SUM(polar_analytic)
               IF (ANY(ABS(polerr(1:3, 1:3)) > maxerr)) THEN
                  message = "A mismatch between analytical and numerical polarizabilities "// &
                            "has been detected. Check the implementation of the "// &
                            "analytical polarizabilitie calculation"
                  IF (stop_on_mismatch) THEN
                     CPABORT(message)
                  ELSE
                     CPWARN(message)
                  END IF
               END IF
            END IF
         ELSE
            CALL cp_warn(__LOCATION__, "Debug of polarizabilities only for Quickstep code available")
@ -624,7 +612,7 @@ CONTAINS
      IF (dft_control%apply_efield) THEN
         dft_control%efield_fields(1)%efield%strength = amplitude
         dft_control%efield_fields(1)%efield%polarisation(1:3) = poldir(1:3)
-      ELSE IF (dft_control%apply_period_efield) THEN
+      ELSEIF (dft_control%apply_period_efield) THEN
         dft_control%period_efield%strength = amplitude
         dft_control%period_efield%polarisation(1:3) = poldir(1:3)
      ELSE
--- a/src/cp2k_info.F
+++ b/src/cp2k_info.F
@ -46,7 +46,7 @@ MODULE cp2k_info
 #endif
   !!! Keep version in sync with CMakeLists.txt !!!
-   CHARACTER(LEN=*), PARAMETER :: cp2k_version = "CP2K version 2026.2 (Development Version)"
+   CHARACTER(LEN=*), PARAMETER :: cp2k_version = "CP2K version 2026.2"
   CHARACTER(LEN=*), PARAMETER :: cp2k_year = "2026"
   CHARACTER(LEN=*), PARAMETER :: cp2k_home = "https://www.cp2k.org/"
--- a/src/cp_control_types.F
+++ b/src/cp_control_types.F
@ -278,7 +278,6 @@ MODULE cp_control_types
      INTEGER                              :: vdw_type = -1
      CHARACTER(LEN=default_path_length)   :: parameter_file_path = ""
      CHARACTER(LEN=default_path_length)   :: parameter_file_name = ""
      CHARACTER(LEN=default_path_length)   :: spinpol_param_file_name = ""
      !
      CHARACTER(LEN=default_path_length)   :: dispersion_parameter_file = ""
      REAL(KIND=dp)                        :: epscn = 0.0_dp
@ -297,7 +296,6 @@ MODULE cp_control_types
      !
      LOGICAL                              :: xb_interaction = .FALSE.
      LOGICAL                              :: do_nonbonded = .FALSE.
      LOGICAL                              :: do_spinpol = .FALSE.
      LOGICAL                              :: coulomb_interaction = .FALSE.
      LOGICAL                              :: coulomb_lr = .FALSE.
      LOGICAL                              :: tb3_interaction = .FALSE.
@ -312,11 +310,7 @@ MODULE cp_control_types
         DIMENSION(:, :), POINTER          :: kab_param => NULL()
      INTEGER, DIMENSION(:, :), POINTER    :: kab_types => NULL()
      INTEGER                              :: kab_nval = 0
-      REAL(KIND=dp), DIMENSION(:), POINTER :: kab_vals => NULL()
+      REAL, DIMENSION(:), POINTER          :: kab_vals => NULL()
      !
      INTEGER, DIMENSION(:), POINTER       :: spinpol_type => NULL()
      REAL(KIND=dp), DIMENSION(:, :), &
         POINTER                           :: spinpol_vals => NULL()
      !
      TYPE(pair_potential_p_type), POINTER :: nonbonded => NULL()
      REAL(KIND=dp)                        :: eps_pair = 0.0_dp
@ -897,9 +891,8 @@ CONTAINS
   SUBROUTINE mulliken_control_release(mulliken_restraint_control)
      TYPE(mulliken_restraint_type), INTENT(INOUT)       :: mulliken_restraint_control
-      IF (ASSOCIATED(mulliken_restraint_control%atoms)) THEN
+      IF (ASSOCIATED(mulliken_restraint_control%atoms)) &
         DEALLOCATE (mulliken_restraint_control%atoms)
      END IF
      mulliken_restraint_control%strength = 0.0_dp
      mulliken_restraint_control%target = 0.0_dp
      mulliken_restraint_control%natoms = 0
@ -934,12 +927,10 @@ CONTAINS
   SUBROUTINE ddapc_control_release(ddapc_restraint_control)
      TYPE(ddapc_restraint_type), INTENT(INOUT)          :: ddapc_restraint_control
-      IF (ASSOCIATED(ddapc_restraint_control%atoms)) THEN
+      IF (ASSOCIATED(ddapc_restraint_control%atoms)) &
         DEALLOCATE (ddapc_restraint_control%atoms)
-      END IF
+      IF (ASSOCIATED(ddapc_restraint_control%coeff)) &
      IF (ASSOCIATED(ddapc_restraint_control%coeff)) THEN
         DEALLOCATE (ddapc_restraint_control%coeff)
      END IF
      ddapc_restraint_control%strength = 0.0_dp
      ddapc_restraint_control%target = 0.0_dp
      ddapc_restraint_control%natoms = 0
@ -1216,21 +1207,18 @@ CONTAINS
      IF (ASSOCIATED(proj_mo_list)) THEN
         DO i = 1, SIZE(proj_mo_list)
            IF (ASSOCIATED(proj_mo_list(i)%proj_mo)) THEN
-               IF (ALLOCATED(proj_mo_list(i)%proj_mo%ref_mo_index)) THEN
+               IF (ALLOCATED(proj_mo_list(i)%proj_mo%ref_mo_index)) &
                  DEALLOCATE (proj_mo_list(i)%proj_mo%ref_mo_index)
               END IF
               IF (ALLOCATED(proj_mo_list(i)%proj_mo%mo_ref)) THEN
                  DO mo_ref_nbr = 1, SIZE(proj_mo_list(i)%proj_mo%mo_ref)
                     CALL cp_fm_release(proj_mo_list(i)%proj_mo%mo_ref(mo_ref_nbr))
                  END DO
                  DEALLOCATE (proj_mo_list(i)%proj_mo%mo_ref)
               END IF
-               IF (ALLOCATED(proj_mo_list(i)%proj_mo%td_mo_index)) THEN
+               IF (ALLOCATED(proj_mo_list(i)%proj_mo%td_mo_index)) &
                  DEALLOCATE (proj_mo_list(i)%proj_mo%td_mo_index)
-               END IF
+               IF (ALLOCATED(proj_mo_list(i)%proj_mo%td_mo_occ)) &
               IF (ALLOCATED(proj_mo_list(i)%proj_mo%td_mo_occ)) THEN
                  DEALLOCATE (proj_mo_list(i)%proj_mo%td_mo_occ)
               END IF
               DEALLOCATE (proj_mo_list(i)%proj_mo)
            END IF
         END DO
@ -1256,9 +1244,8 @@ CONTAINS
               IF (ASSOCIATED(efield_fields(i)%efield%envelop_i_vars)) THEN
                  DEALLOCATE (efield_fields(i)%efield%envelop_i_vars)
               END IF
-               IF (ASSOCIATED(efield_fields(i)%efield%polarisation)) THEN
+               IF (ASSOCIATED(efield_fields(i)%efield%polarisation)) &
                  DEALLOCATE (efield_fields(i)%efield%polarisation)
               END IF
               DEALLOCATE (efield_fields(i)%efield)
            END IF
         END DO
@ -1309,8 +1296,6 @@ CONTAINS
      NULLIFY (xtb_control%kab_types)
      NULLIFY (xtb_control%nonbonded)
      NULLIFY (xtb_control%rcpair)
      NULLIFY (xtb_control%spinpol_type)
      NULLIFY (xtb_control%spinpol_vals)
   END SUBROUTINE xtb_control_create
@ -1337,12 +1322,6 @@ CONTAINS
         IF (ASSOCIATED(xtb_control%nonbonded)) THEN
            CALL pair_potential_p_release(xtb_control%nonbonded)
         END IF
         IF (ASSOCIATED(xtb_control%spinpol_type)) THEN
            DEALLOCATE (xtb_control%spinpol_type)
         END IF
         IF (ASSOCIATED(xtb_control%spinpol_vals)) THEN
            DEALLOCATE (xtb_control%spinpol_vals)
         END IF
         DEALLOCATE (xtb_control)
      END IF
   END SUBROUTINE xtb_control_release
--- a/src/cp_control_utils.F
+++ b/src/cp_control_utils.F
@ -56,16 +56,16 @@ MODULE cp_control_utils
        do_se_is_slater, do_se_lr_ewald, do_se_lr_ewald_gks, do_se_lr_ewald_r3, do_se_lr_none, &
        gapw_1c_large, gapw_1c_medium, gapw_1c_orb, gapw_1c_small, gapw_1c_very_large, &
        gaussian_env, gfn1xtb, gfn_tblite, kg_tnadd_embed, kg_tnadd_embed_ri, no_admm_type, &
-        numerical, ramp_env, real_time_propagation, rtp_method_bse, rtp_method_bse_linearized, &
+        numerical, ramp_env, real_time_propagation, rtp_method_bse, sccs_andreussi, &
-        sccs_andreussi, sccs_derivative_cd3, sccs_derivative_cd5, sccs_derivative_cd7, &
+        sccs_derivative_cd3, sccs_derivative_cd5, sccs_derivative_cd7, sccs_derivative_fft, &
-        sccs_derivative_fft, sccs_fattebert_gygi, sccs_saa_andreussi, sic_ad, sic_eo, &
+        sccs_fattebert_gygi, sccs_saa_andreussi, sic_ad, sic_eo, sic_list_all, sic_list_unpaired, &
-        sic_list_all, sic_list_unpaired, sic_mauri_spz, sic_mauri_us, sic_none, slater, &
+        sic_mauri_spz, sic_mauri_us, sic_none, slater, tblite_cli_born_kernel_auto, &
-        tblite_cli_born_kernel_auto, tblite_cli_solution_state_gsolv, tblite_cli_solvation_alpb, &
+        tblite_cli_solution_state_gsolv, tblite_cli_solvation_alpb, tblite_cli_solvation_cpcm, &
-        tblite_cli_solvation_cpcm, tblite_cli_solvation_gb, tblite_cli_solvation_gbe, &
+        tblite_cli_solvation_gb, tblite_cli_solvation_gbe, tblite_cli_solvation_gbsa, &
-        tblite_cli_solvation_gbsa, tblite_guess_ceh, tblite_mixer_memory_inherit, &
+        tblite_guess_ceh, tblite_mixer_memory_inherit, tblite_scc_mixer_auto, &
-        tblite_scc_mixer_auto, tblite_scc_mixer_cp2k, tblite_scc_mixer_none, &
+        tblite_scc_mixer_cp2k, tblite_scc_mixer_none, tblite_scc_mixer_tblite, tblite_solver_gvd, &
-        tblite_scc_mixer_tblite, tblite_solver_gvd, tblite_solver_gvr, tddfpt_dipole_length, &
+        tblite_solver_gvr, tddfpt_dipole_length, tddfpt_kernel_stda, use_mom_ref_user, &
-        tddfpt_kernel_stda, use_mom_ref_user, xtb_vdw_type_d3, xtb_vdw_type_d4, xtb_vdw_type_none
+        xtb_vdw_type_d3, xtb_vdw_type_d4, xtb_vdw_type_none
   USE input_cp2k_check,                ONLY: xc_functionals_expand
   USE input_cp2k_dft,                  ONLY: create_dft_section
   USE input_enumeration_types,         ONLY: enum_i2c,&
@ -164,23 +164,20 @@ CONTAINS
         CALL section_vals_val_get(xc_section, "gradient_cutoff", r_val=gradient_cut)
         CALL section_vals_val_get(xc_section, "tau_cutoff", r_val=tau_cut)
         ! Perform numerical stability checks and possibly correct the issues
-         IF (density_cut <= EPSILON(0.0_dp)*100.0_dp) THEN
+         IF (density_cut <= EPSILON(0.0_dp)*100.0_dp) &
            CALL cp_warn(__LOCATION__, &
                         "DENSITY_CUTOFF lower than 100*EPSILON, where EPSILON is the machine precision. "// &
                         "This may lead to numerical problems. Setting up shake_tol to 100*EPSILON! ")
         END IF
         density_cut = MAX(EPSILON(0.0_dp)*100.0_dp, density_cut)
-         IF (gradient_cut <= EPSILON(0.0_dp)*100.0_dp) THEN
+         IF (gradient_cut <= EPSILON(0.0_dp)*100.0_dp) &
            CALL cp_warn(__LOCATION__, &
                         "GRADIENT_CUTOFF lower than 100*EPSILON, where EPSILON is the machine precision. "// &
                         "This may lead to numerical problems. Setting up shake_tol to 100*EPSILON! ")
         END IF
         gradient_cut = MAX(EPSILON(0.0_dp)*100.0_dp, gradient_cut)
-         IF (tau_cut <= EPSILON(0.0_dp)*100.0_dp) THEN
+         IF (tau_cut <= EPSILON(0.0_dp)*100.0_dp) &
            CALL cp_warn(__LOCATION__, &
                         "TAU_CUTOFF lower than 100*EPSILON, where EPSILON is the machine precision. "// &
                         "This may lead to numerical problems. Setting up shake_tol to 100*EPSILON! ")
         END IF
         tau_cut = MAX(EPSILON(0.0_dp)*100.0_dp, tau_cut)
         CALL section_vals_val_set(xc_section, "density_cutoff", r_val=density_cut)
         CALL section_vals_val_set(xc_section, "gradient_cutoff", r_val=gradient_cut)
@ -245,18 +242,7 @@ CONTAINS
            CALL uppercase(tmpstringlist(2))
            SELECT CASE (tmpstringlist(2))
            CASE ("X")
-               SELECT CASE (tmpstringlist(1))
+               isize = -1
               CASE ("X")
                  ! Do nothing
               CASE DEFAULT
                  CALL cp_abort(__LOCATION__, &
                                "AUTO_BASIS: the size <X> is invalid for the "// &
                                "type <"//TRIM(ADJUSTL(tmpstringlist(1)))//">; "// &
                                "use one of SMALL, MEDIUM, LARGE, HUGE for "// &
                                "the size. The syntax AUTO_BASIS X X is a "// &
                                "reserved case for using NO automatically "// &
                                "generated basis sets.")
               END SELECT
            CASE ("SMALL")
               isize = 0
            CASE ("MEDIUM")
@ -419,9 +405,8 @@ CONTAINS
         IF (dft_control%admm_control%purification_method == do_admm_purify_mo_diag .OR. &
             dft_control%admm_control%purification_method == do_admm_purify_mo_no_diag) THEN
-            IF (dft_control%admm_control%method /= do_admm_basis_projection) THEN
+            IF (dft_control%admm_control%method /= do_admm_basis_projection) &
               CPABORT("ADMM: Chosen purification requires BASIS_PROJECTION")
            END IF
            IF (.NOT. do_ot) CPABORT("ADMM: MO-based purification requires OT.")
         END IF
@ -444,10 +429,9 @@ CONTAINS
      CALL section_vals_val_get(dft_section, "MULTIPLICITY", i_val=dft_control%multiplicity)
      CALL section_vals_val_get(dft_section, "RELAX_MULTIPLICITY", r_val=dft_control%relax_multiplicity)
      IF (dft_control%relax_multiplicity > 0.0_dp) THEN
-         IF (.NOT. dft_control%uks) THEN
+         IF (.NOT. dft_control%uks) &
            CALL cp_abort(__LOCATION__, "The option RELAX_MULTIPLICITY is only valid for "// &
                          "unrestricted Kohn-Sham (UKS) calculations")
         END IF
      END IF
      !Read the HAIR PROBES input section if present
@ -566,8 +550,7 @@ CONTAINS
      IF (do_rtp) THEN
         ! tmp_section => section_vals_get_subs_vals(dft_section, "REAL_TIME_PROPAGATION%PRINT%POLARIZABILITY")
         ! CALL section_vals_get(tmp_section, explicit=is_present)
-         local_moment_possible = (dft_control%rtp_control%rtp_method == rtp_method_bse .OR. &
+         local_moment_possible = (dft_control%rtp_control%rtp_method == rtp_method_bse) .OR. &
                                  dft_control%rtp_control%rtp_method == rtp_method_bse_linearized) .OR. &
                                 ((.NOT. dft_control%rtp_control%periodic) .AND. dft_control%rtp_control%linear_scaling)
         IF (local_moment_possible .AND. (.NOT. ASSOCIATED(dft_control%rtp_control%print_pol_elements))) THEN
            tmp_section => section_vals_get_subs_vals(dft_section, "REAL_TIME_PROPAGATION")
@ -584,9 +567,8 @@ CONTAINS
         CALL section_vals_val_get(tmp_section, "POLARISATION", r_vals=pol)
         dft_control%period_efield%polarisation(1:3) = pol(1:3)
         IF (PRESENT(cell)) THEN
-            IF (ASSOCIATED(cell)) THEN
+            IF (ASSOCIATED(cell)) &
               CALL cell_transform_input_cartesian(cell, dft_control%period_efield%polarisation(1:3))
            END IF
         END IF
         CALL section_vals_val_get(tmp_section, "D_FILTER", r_vals=pol)
         dft_control%period_efield%d_filter(1:3) = pol(1:3)
@ -666,12 +648,7 @@ CONTAINS
         END IF
         ! periodic fields don't work with RTP
-         IF (do_rtp) THEN
+         CPASSERT(.NOT. do_rtp)
            CALL cp_abort(__LOCATION__, &
                          "Periodic efield cannot be used with RTP. When restarting a "// &
                          "run with periodic efield, set RESTART_RTP under &EXT_RESTART "// &
                          "section to .FALSE. explicitly if RESTART_DEFAULT is .TRUE.")
         END IF
         IF (dft_control%period_efield%displacement_field) THEN
            CALL cite_reference(Stengel2009)
         ELSE
@ -986,12 +963,11 @@ CONTAINS
      CHARACTER(len=*), PARAMETER                        :: routineN = 'read_qs_section'
      CHARACTER(LEN=2)                                   :: element_symbol
      CHARACTER(LEN=default_string_length)               :: cval
      CHARACTER(LEN=default_string_length), &
         DIMENSION(:), POINTER                           :: clist
      INTEGER                                            :: handle, itmp, j, jj, k, n_rep, n_var, &
-                                                            ngauss, ngp, nrep, znum
+                                                            ngauss, ngp, nrep
      INTEGER, DIMENSION(:), POINTER                     :: tmplist
      LOGICAL :: dftb_scc_mixer_explicit, dftb_tblite_mixer_explicit, explicit, &
         tblite_reference_cli, tblite_reference_cli_section, tblite_section_active, was_present, &
@ -1241,9 +1217,8 @@ CONTAINS
            jj = jj + SIZE(tmplist)
         END DO
         qs_control%mulliken_restraint_control%natoms = jj
-         IF (qs_control%mulliken_restraint_control%natoms < 1) THEN
+         IF (qs_control%mulliken_restraint_control%natoms < 1) &
            CPABORT("Need at least 1 atom to use mulliken constraints")
         END IF
         ALLOCATE (qs_control%mulliken_restraint_control%atoms(qs_control%mulliken_restraint_control%natoms))
         jj = 0
         DO k = 1, n_rep
@ -1291,11 +1266,10 @@ CONTAINS
         CALL section_vals_val_get(se_section, "INTEGRAL_SCREENING", &
                                   i_val=qs_control%se_control%integral_screening)
         IF (qs_control%method_id == do_method_pnnl) THEN
-            IF (qs_control%se_control%integral_screening /= do_se_IS_slater) THEN
+            IF (qs_control%se_control%integral_screening /= do_se_IS_slater) &
               CALL cp_warn(__LOCATION__, &
                            "PNNL semi-empirical parameterization supports only the Slater type "// &
                            "integral scheme. Revert to Slater and continue the calculation.")
            END IF
            qs_control%se_control%integral_screening = do_se_IS_slater
         END IF
         ! Global Arrays variable
@ -1360,23 +1334,21 @@ CONTAINS
            qs_control%se_control%do_ewald = .FALSE.
            qs_control%se_control%do_ewald_r3 = .FALSE.
            qs_control%se_control%do_ewald_gks = .TRUE.
-            IF (qs_control%method_id /= do_method_pnnl) THEN
+            IF (qs_control%method_id /= do_method_pnnl) &
               CALL cp_abort(__LOCATION__, &
                             "A periodic semi-empirical calculation was requested with a long-range  "// &
                             "summation on the single integral evaluation. This scheme is supported  "// &
                             "only by the PNNL parameterization.")
            END IF
         CASE (do_se_lr_ewald_r3)
            qs_control%se_control%do_ewald = .TRUE.
            qs_control%se_control%do_ewald_r3 = .TRUE.
            qs_control%se_control%do_ewald_gks = .FALSE.
-            IF (qs_control%se_control%integral_screening /= do_se_IS_kdso) THEN
+            IF (qs_control%se_control%integral_screening /= do_se_IS_kdso) &
               CALL cp_abort(__LOCATION__, &
                             "A periodic semi-empirical calculation was requested with a long-range  "// &
                             "summation for the slowly convergent part 1/R^3, which is not congruent "// &
                             "with the integral screening chosen. The only integral screening supported "// &
                             "by this periodic type calculation is the standard Klopman-Dewar-Sabelli-Ohno.")
            END IF
         END SELECT
         ! dispersion pair potentials
@ -1440,21 +1412,18 @@ CONTAINS
                                        "DFTB/TBLITE_MIXER")
         IF (qs_control%do_ls_scf) THEN
            IF (dftb_scc_mixer_explicit .AND. &
-                qs_control%dftb_control%tblite_scc_mixer /= tblite_scc_mixer_none) THEN
+                qs_control%dftb_control%tblite_scc_mixer /= tblite_scc_mixer_none) &
               CALL cp_warn(__LOCATION__, &
                            "DFTB/SCC_MIXER is reset to NONE with QS/LS_SCF; LS_SCF optimizes "// &
                            "the density matrix directly.")
-            END IF
+            IF (dftb_tblite_mixer_explicit) &
            IF (dftb_tblite_mixer_explicit) THEN
               CALL cp_warn(__LOCATION__, &
                            "DFTB/TBLITE_MIXER settings are ignored with QS/LS_SCF; LS_SCF controls "// &
                            "the density-matrix optimization.")
            END IF
            qs_control%dftb_control%tblite_scc_mixer = tblite_scc_mixer_none
         END IF
-         IF (qs_control%dftb_control%tblite_mixer_damping <= 0.0_dp) THEN
+         IF (qs_control%dftb_control%tblite_mixer_damping <= 0.0_dp) &
            CPABORT("DFTB/TBLITE_MIXER/DAMPING must be positive")
         END IF
         CALL section_vals_val_get(dftb_section, "EPS_DISP", &
                                   r_val=qs_control%dftb_control%eps_disp)
         CALL section_vals_val_get(dftb_section, "DO_EWALD", explicit=explicit)
@ -1514,9 +1483,8 @@ CONTAINS
         CALL section_vals_val_get(xtb_tblite, "_SECTION_PARAMETERS_", l_val=tblite_section_active)
         qs_control%xtb_control%do_tblite = (qs_control%xtb_control%gfn_type == gfn_tblite)
         IF (qs_control%xtb_control%do_tblite) THEN
-            IF (.NOT. tblite_section_active) THEN
+            IF (.NOT. tblite_section_active) &
               CPABORT("XTB/GFN_TYPE TBLITE requires an XTB/TBLITE section")
            END IF
            ! The CP2K-internal GFN1 defaults are still used to initialize shared xTB fields.
            qs_control%xtb_control%gfn_type = gfn1xtb
         ELSE IF (tblite_section_active) THEN
@ -1537,43 +1505,37 @@ CONTAINS
                                        qs_control%xtb_control%tblite_mixer_max_weight, &
                                        qs_control%xtb_control%tblite_mixer_weight_factor, &
                                        "XTB/TBLITE_MIXER")
-         IF (xtb_tblite_mixer_explicit) THEN
+         IF (xtb_tblite_mixer_explicit) &
            CALL section_vals_val_get(xtb_tblite_mixer, "DAMPING", &
                                      explicit=qs_control%xtb_control%tblite_mixer_damping_explicit)
         END IF
         IF ((.NOT. qs_control%xtb_control%do_tblite) .AND. &
             qs_control%xtb_control%gfn_type == 0) THEN
            IF (xtb_scc_mixer_explicit .AND. &
                qs_control%xtb_control%tblite_scc_mixer /= tblite_scc_mixer_auto .AND. &
-                qs_control%xtb_control%tblite_scc_mixer /= tblite_scc_mixer_none) THEN
+                qs_control%xtb_control%tblite_scc_mixer /= tblite_scc_mixer_none) &
               CALL cp_warn(__LOCATION__, &
                            "XTB/SCC_MIXER is reset to NONE for CP2K-internal GFN0-xTB; "// &
                            "GFN0-xTB has no SCC variables to mix.")
-            END IF
+            IF (xtb_tblite_mixer_explicit) &
            IF (xtb_tblite_mixer_explicit) THEN
               CALL cp_warn(__LOCATION__, &
                            "XTB/TBLITE_MIXER settings are ignored for CP2K-internal GFN0-xTB; "// &
                            "GFN0-xTB has no SCC variables to mix.")
            END IF
            qs_control%xtb_control%tblite_scc_mixer = tblite_scc_mixer_none
         END IF
         IF (qs_control%do_ls_scf) THEN
            IF (xtb_scc_mixer_explicit .AND. &
-                qs_control%xtb_control%tblite_scc_mixer /= tblite_scc_mixer_none) THEN
+                qs_control%xtb_control%tblite_scc_mixer /= tblite_scc_mixer_none) &
               CALL cp_warn(__LOCATION__, &
                            "XTB/SCC_MIXER is reset to NONE with QS/LS_SCF; LS_SCF optimizes "// &
                            "the density matrix directly.")
-            END IF
+            IF (xtb_tblite_mixer_explicit) &
            IF (xtb_tblite_mixer_explicit) THEN
               CALL cp_warn(__LOCATION__, &
                            "XTB/TBLITE_MIXER settings are ignored with QS/LS_SCF; LS_SCF controls "// &
                            "the density-matrix optimization.")
            END IF
            qs_control%xtb_control%tblite_scc_mixer = tblite_scc_mixer_none
         END IF
-         IF (qs_control%xtb_control%tblite_mixer_damping <= 0.0_dp) THEN
+         IF (qs_control%xtb_control%tblite_mixer_damping <= 0.0_dp) &
            CPABORT("XTB/TBLITE_MIXER/DAMPING must be positive")
         END IF
         CALL section_vals_val_get(xtb_section, "DO_EWALD", explicit=explicit)
         IF (explicit) THEN
            CALL section_vals_val_get(xtb_section, "DO_EWALD", &
@ -1581,9 +1543,6 @@ CONTAINS
         ELSE
            qs_control%xtb_control%do_ewald = (qs_control%periodicity /= 0)
         END IF
         ! Spin Polarisation
         CALL section_vals_val_get(xtb_section, "SPIN_POLARISATION", &
                                   l_val=qs_control%xtb_control%do_spinpol)
         ! vdW
         CALL section_vals_val_get(xtb_section, "VDW_POTENTIAL", explicit=explicit)
         IF (explicit) THEN
@ -1635,9 +1594,6 @@ CONTAINS
               CPABORT("GFN type")
            END SELECT
         END IF
         !
         CALL section_vals_val_get(xtb_parameter, "SPINPOL_PARAM_FILE_NAME", &
                                   c_val=qs_control%xtb_control%spinpol_param_file_name)
         ! D3 Dispersion
         CALL section_vals_val_get(xtb_parameter, "DISPERSION_RADIUS", &
                                   r_val=qs_control%xtb_control%rcdisp)
@ -1861,26 +1817,6 @@ CONTAINS
            END DO
         END IF
         ! Spin Polarisation
         CALL section_vals_val_get(xtb_parameter, "SPIN_POL_PARAM", n_rep_val=n_rep)
         IF (n_rep > 0) THEN
            ALLOCATE (qs_control%xtb_control%spinpol_type(n_rep))
            ALLOCATE (qs_control%xtb_control%spinpol_vals(6, n_rep))
            DO j = 1, n_rep
               CALL section_vals_val_get(xtb_parameter, "SPIN_POL_PARAM", i_rep_val=j, c_vals=clist)
               READ (clist(1), '(A)') cval
               element_symbol = ADJUSTL(TRIM(cval))
               CALL get_ptable_info(element_symbol, znum)
               qs_control%xtb_control%spinpol_type(j) = znum
               READ (clist(2), '(F20.8)') qs_control%xtb_control%spinpol_vals(1, j)
               READ (clist(3), '(F20.8)') qs_control%xtb_control%spinpol_vals(2, j)
               READ (clist(4), '(F20.8)') qs_control%xtb_control%spinpol_vals(3, j)
               READ (clist(5), '(F20.8)') qs_control%xtb_control%spinpol_vals(4, j)
               READ (clist(6), '(F20.8)') qs_control%xtb_control%spinpol_vals(5, j)
               READ (clist(7), '(F20.8)') qs_control%xtb_control%spinpol_vals(6, j)
            END DO
         END IF
         IF (qs_control%xtb_control%gfn_type == 0) THEN
            CALL section_vals_val_get(xtb_parameter, "SRB_PARAMETER", r_vals=scal)
            qs_control%xtb_control%ksrb = scal(1)
@ -1919,17 +1855,14 @@ CONTAINS
                                   c_val=qs_control%xtb_control%tblite_param_file)
         CALL section_vals_val_get(xtb_tblite, "ACCURACY", &
                                   r_val=qs_control%xtb_control%tblite_accuracy)
-         IF (qs_control%xtb_control%tblite_accuracy <= 0.0_dp) THEN
+         IF (qs_control%xtb_control%tblite_accuracy <= 0.0_dp) &
            CPABORT("XTB/TBLITE/ACCURACY must be positive")
-         END IF
+         IF (qs_control%xtb_control%tblite_mixer_damping <= 0.0_dp) &
         IF (qs_control%xtb_control%tblite_mixer_damping <= 0.0_dp) THEN
            CPABORT("XTB/TBLITE_MIXER/DAMPING must be positive")
         END IF
         CALL section_vals_val_get(xtb_tblite, "REFERENCE_CLI", l_val=tblite_reference_cli)
         CALL section_vals_get(xtb_tblite_ref_cli, explicit=tblite_reference_cli_section)
-         IF (tblite_reference_cli .AND. (.NOT. tblite_reference_cli_section)) THEN
+         IF (tblite_reference_cli .AND. (.NOT. tblite_reference_cli_section)) &
            CPABORT("XTB/TBLITE/REFERENCE_CLI keyword requires an XTB/TBLITE/REFERENCE_CLI section")
         END IF
         IF (tblite_reference_cli .OR. tblite_reference_cli_section) THEN
            CALL read_xtb_reference_cli_section(xtb_tblite_ref_cli, qs_control%xtb_control%reference_cli, cell)
            qs_control%xtb_control%reference_cli%enabled = .TRUE.
@ -1993,9 +1926,8 @@ CONTAINS
      IF (omega0 <= 0.0_dp) CPABORT(TRIM(section_name)//"/OMEGA0 must be positive")
      IF (min_weight <= 0.0_dp) CPABORT(TRIM(section_name)//"/MIN_WEIGHT must be positive")
      IF (max_weight <= 0.0_dp) CPABORT(TRIM(section_name)//"/MAX_WEIGHT must be positive")
-      IF (max_weight < min_weight) THEN
+      IF (max_weight < min_weight) &
         CPABORT(TRIM(section_name)//"/MAX_WEIGHT must not be smaller than MIN_WEIGHT")
      END IF
      IF (weight_factor <= 0.0_dp) CPABORT(TRIM(section_name)//"/WEIGHT_FACTOR must be positive")
   END SUBROUTINE read_tblite_mixer_section
@ -2044,13 +1976,11 @@ CONTAINS
         CALL section_vals_val_get(solvation_section, "SOLVENT", c_val=ref_cli%solvation_solvent)
         CALL section_vals_val_get(solvation_section, "BORN_KERNEL", i_val=ref_cli%solvation_born_kernel)
         CALL section_vals_val_get(solvation_section, "SOLUTION_STATE", i_val=ref_cli%solvation_state)
-         IF (LEN_TRIM(ref_cli%solvation_solvent) == 0) THEN
+         IF (LEN_TRIM(ref_cli%solvation_solvent) == 0) &
            CPABORT("REFERENCE_CLI implicit solvation needs SOLVENT")
         END IF
         IF (ref_cli%solvation_model == tblite_cli_solvation_cpcm .AND. &
-             ref_cli%solvation_born_kernel /= tblite_cli_born_kernel_auto) THEN
+             ref_cli%solvation_born_kernel /= tblite_cli_born_kernel_auto) &
            CPABORT("BORN_KERNEL is invalid with MODEL CPCM")
         END IF
         IF (ref_cli%solvation_state /= tblite_cli_solution_state_gsolv) THEN
            SELECT CASE (ref_cli%solvation_model)
            CASE (tblite_cli_solvation_alpb, tblite_cli_solvation_gbsa)
@ -2062,21 +1992,18 @@ CONTAINS
      END IF
      CALL section_vals_val_get(ref_cli_section, "ELECTRONIC_TEMPERATURE_GUESS", &
                                r_val=ref_cli%electronic_temperature_guess)
-      IF (ref_cli%electronic_temperature_guess < 0.0_dp) THEN
+      IF (ref_cli%electronic_temperature_guess < 0.0_dp) &
         CPABORT("XTB/TBLITE/REFERENCE_CLI/ELECTRONIC_TEMPERATURE_GUESS must not be negative")
-      END IF
+      IF (ref_cli%electronic_temperature_guess > 0.0_dp .AND. ref_cli%guess /= tblite_guess_ceh) &
      IF (ref_cli%electronic_temperature_guess > 0.0_dp .AND. ref_cli%guess /= tblite_guess_ceh) THEN
         CPABORT("XTB/TBLITE/REFERENCE_CLI/ELECTRONIC_TEMPERATURE_GUESS requires GUESS CEH")
      END IF
      guess_section => section_vals_get_subs_vals(ref_cli_section, "GUESS_CLI")
      CALL section_vals_get(guess_section, explicit=ref_cli%guess_cli%enabled)
      IF (ref_cli%guess_cli%enabled) THEN
         CALL section_vals_val_get(guess_section, "METHOD", i_val=ref_cli%guess_cli%method)
         CALL section_vals_val_get(guess_section, "ELECTRONIC_TEMPERATURE_GUESS", &
                                   r_val=ref_cli%guess_cli%electronic_temperature_guess)
-         IF (ref_cli%guess_cli%electronic_temperature_guess < 0.0_dp) THEN
+         IF (ref_cli%guess_cli%electronic_temperature_guess < 0.0_dp) &
            CPABORT("REFERENCE_CLI/GUESS_CLI/ELECTRONIC_TEMPERATURE_GUESS must not be negative")
         END IF
         CALL section_vals_val_get(guess_section, "SOLVER", i_val=ref_cli%guess_cli%solver)
         CALL section_vals_val_get(guess_section, "EFIELD", explicit=ref_cli%guess_cli%efield_active)
         IF (ref_cli%guess_cli%efield_active) THEN
@ -2107,12 +2034,10 @@ CONTAINS
         CALL section_vals_val_get(fit_section, "INPUT_FILE", c_val=ref_cli%fit_cli%input_file)
         CALL section_vals_val_get(fit_section, "DRY_RUN", l_val=ref_cli%fit_cli%dry_run)
         CALL section_vals_val_get(fit_section, "COPY", c_val=ref_cli%fit_cli%copy_file)
-         IF (LEN_TRIM(ref_cli%fit_cli%param_file) == 0) THEN
+         IF (LEN_TRIM(ref_cli%fit_cli%param_file) == 0) &
            CPABORT("XTB/TBLITE/REFERENCE_CLI/FIT_CLI needs PARAM_FILE")
-         END IF
+         IF (LEN_TRIM(ref_cli%fit_cli%input_file) == 0) &
         IF (LEN_TRIM(ref_cli%fit_cli%input_file) == 0) THEN
            CPABORT("XTB/TBLITE/REFERENCE_CLI/FIT_CLI needs INPUT_FILE")
         END IF
      END IF
      tagdiff_section => section_vals_get_subs_vals(ref_cli_section, "TAGDIFF_CLI")
      CALL section_vals_get(tagdiff_section, explicit=ref_cli%tagdiff_cli%enabled)
@ -2120,12 +2045,10 @@ CONTAINS
         CALL section_vals_val_get(tagdiff_section, "ACTUAL", c_val=ref_cli%tagdiff_cli%actual_file)
         CALL section_vals_val_get(tagdiff_section, "REFERENCE", c_val=ref_cli%tagdiff_cli%reference_file)
         CALL section_vals_val_get(tagdiff_section, "FIT", l_val=ref_cli%tagdiff_cli%fit)
-         IF (LEN_TRIM(ref_cli%tagdiff_cli%actual_file) == 0) THEN
+         IF (LEN_TRIM(ref_cli%tagdiff_cli%actual_file) == 0) &
            CPABORT("XTB/TBLITE/REFERENCE_CLI/TAGDIFF_CLI needs ACTUAL")
-         END IF
+         IF (LEN_TRIM(ref_cli%tagdiff_cli%reference_file) == 0) &
         IF (LEN_TRIM(ref_cli%tagdiff_cli%reference_file) == 0) THEN
            CPABORT("XTB/TBLITE/REFERENCE_CLI/TAGDIFF_CLI needs REFERENCE")
         END IF
      END IF
      CALL section_vals_val_get(ref_cli_section, "KEEP_FILES", l_val=ref_cli%keep_files)
      CALL section_vals_val_get(ref_cli_section, "ERROR_LIMIT", r_val=ref_cli%error_limit)
@ -2199,18 +2122,7 @@ CONTAINS
            CALL uppercase(tmpstringlist(2))
            SELECT CASE (tmpstringlist(2))
            CASE ("X")
-               SELECT CASE (tmpstringlist(1))
+               isize = -1
               CASE ("X")
                  ! Do nothing
               CASE DEFAULT
                  CALL cp_abort(__LOCATION__, &
                                "AUTO_BASIS: the size <X> is invalid for the "// &
                                "type <"//TRIM(ADJUSTL(tmpstringlist(1)))//">; "// &
                                "use one of SMALL, MEDIUM, LARGE, HUGE for "// &
                                "the size. The syntax AUTO_BASIS X X is a "// &
                                "reserved case for using NO automatically "// &
                                "generated basis sets.")
               END SELECT
            CASE ("SMALL")
               isize = 0
            CASE ("MEDIUM")
@ -2236,9 +2148,8 @@ CONTAINS
         END IF
      END DO
-      IF (t_control%conv < 0) THEN
+      IF (t_control%conv < 0) &
         t_control%conv = ABS(t_control%conv)
      END IF
      ! DIPOLE_MOMENTS subsection
      dipole_section => section_vals_get_subs_vals(t_section, "DIPOLE_MOMENTS")
@ -2280,10 +2191,9 @@ CONTAINS
         CALL section_vals_val_get(mgrid_section, "PROGRESSION_FACTOR", &
                                   r_val=t_control%mgrid_progression_factor, explicit=explicit)
         IF (explicit) THEN
-            IF (t_control%mgrid_progression_factor <= 1.0_dp) THEN
+            IF (t_control%mgrid_progression_factor <= 1.0_dp) &
               CALL cp_abort(__LOCATION__, &
                             "Progression factor should be greater then 1.0 to ensure multi-grid ordering")
            END IF
         ELSE
            t_control%mgrid_progression_factor = qs_control%progression_factor
         END IF
@ -2317,9 +2227,8 @@ CONTAINS
         IF (.NOT. explicit) t_control%mgrid_skip_load_balance = qs_control%skip_load_balance_distributed
         IF (ASSOCIATED(t_control%mgrid_e_cutoff)) THEN
-            IF (SIZE(t_control%mgrid_e_cutoff) /= t_control%mgrid_ngrids) THEN
+            IF (SIZE(t_control%mgrid_e_cutoff) /= t_control%mgrid_ngrids) &
               CPABORT("Inconsistent values for number of multi-grids")
            END IF
            ! sort multi-grids in descending order according to their cutoff values
            t_control%mgrid_e_cutoff = -t_control%mgrid_e_cutoff
@ -2334,9 +2243,8 @@ CONTAINS
      xc_section => section_vals_get_subs_vals(t_section, "XC")
      xc_func => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL")
      CALL section_vals_get(xc_func, explicit=explicit)
-      IF (explicit) THEN
+      IF (explicit) &
         CALL xc_functionals_expand(xc_func, xc_section)
      END IF
      ! sTDA subsection
      stda_section => section_vals_get_subs_vals(t_section, "STDA")
@ -2556,7 +2464,8 @@ CONTAINS
                  dft_control%period_efield%strength
            END IF
-            IF (NORM2(dft_control%period_efield%polarisation) < EPSILON(0.0_dp)) THEN
+            IF (SQRT(DOT_PRODUCT(dft_control%period_efield%polarisation, &
                                 dft_control%period_efield%polarisation)) < EPSILON(0.0_dp)) THEN
               CPABORT("Invalid (too small) polarisation vector specified for PERIODIC_EFIELD")
            END IF
         END IF
@ -2965,9 +2874,8 @@ CONTAINS
         ELSE
            WRITE (UNIT=output_unit, FMT="(T2,A,T71,F10.1)") &
               "QS| Density cutoff [a.u.]:", qs_control%cutoff
-            IF (qs_control%commensurate_mgrids) THEN
+            IF (qs_control%commensurate_mgrids) &
               WRITE (UNIT=output_unit, FMT="(T2,A)") "QS| Using commensurate multigrids"
            END IF
            WRITE (UNIT=output_unit, FMT="(T2,A,T71,F10.1)") &
               "QS| Multi grid cutoff [a.u.]: 1) grid level", qs_control%e_cutoff(1)
            WRITE (UNIT=output_unit, FMT="(T2,A,I3,A,T71,F10.1)") &
@ -3097,10 +3005,9 @@ CONTAINS
         IF (qs_control%ddapc_restraint) THEN
            DO i = 1, SIZE(qs_control%ddapc_restraint_control)
               ddapc_restraint_control => qs_control%ddapc_restraint_control(i)
-               IF (SIZE(qs_control%ddapc_restraint_control) > 1) THEN
+               IF (SIZE(qs_control%ddapc_restraint_control) > 1) &
                  WRITE (UNIT=output_unit, FMT="(T2,A,T3,I8)") &
-                     "QS| parameters for DDAPC restraint number", i
+                  "QS| parameters for DDAPC restraint number", i
               END IF
               WRITE (UNIT=output_unit, FMT="(T2,A,T73,ES8.1)") &
                  "QS| ddapc restraint target", ddapc_restraint_control%target
               WRITE (UNIT=output_unit, FMT="(T2,A,T73,ES8.1)") &
@ -3171,9 +3078,8 @@ CONTAINS
      IF (PRESENT(ddapc_restraint_section)) THEN
         IF (ASSOCIATED(qs_control%ddapc_restraint_control)) THEN
-            IF (SIZE(qs_control%ddapc_restraint_control) >= 2) THEN
+            IF (SIZE(qs_control%ddapc_restraint_control) >= 2) &
               CPABORT("ET_COUPLING cannot be used in combination with a normal restraint")
            END IF
         ELSE
            ddapc_section => ddapc_restraint_section
            ALLOCATE (qs_control%ddapc_restraint_control(1))
@ -3212,9 +3118,8 @@ CONTAINS
         END DO
         IF (jj < 1) CPABORT("Need at least 1 atom to use ddapc constraints")
         ddapc_restraint_control%natoms = jj
-         IF (ASSOCIATED(ddapc_restraint_control%atoms)) THEN
+         IF (ASSOCIATED(ddapc_restraint_control%atoms)) &
            DEALLOCATE (ddapc_restraint_control%atoms)
         END IF
         ALLOCATE (ddapc_restraint_control%atoms(ddapc_restraint_control%natoms))
         jj = 0
         DO k = 1, n_rep
@ -3226,9 +3131,8 @@ CONTAINS
            END DO
         END DO
-         IF (ASSOCIATED(ddapc_restraint_control%coeff)) THEN
+         IF (ASSOCIATED(ddapc_restraint_control%coeff)) &
            DEALLOCATE (ddapc_restraint_control%coeff)
         END IF
         ALLOCATE (ddapc_restraint_control%coeff(ddapc_restraint_control%natoms))
         ddapc_restraint_control%coeff = 1.0_dp
@ -3240,15 +3144,13 @@ CONTAINS
                                      i_rep_val=k, r_vals=rtmplist)
            DO j = 1, SIZE(rtmplist)
               jj = jj + 1
-               IF (jj > ddapc_restraint_control%natoms) THEN
+               IF (jj > ddapc_restraint_control%natoms) &
                  CPABORT("Need the same number of coeff as there are atoms ")
               END IF
               ddapc_restraint_control%coeff(jj) = rtmplist(j)
            END DO
         END DO
-         IF (jj < ddapc_restraint_control%natoms .AND. jj /= 0) THEN
+         IF (jj < ddapc_restraint_control%natoms .AND. jj /= 0) &
            CPABORT("Need no or the same number of coeff as there are atoms.")
         END IF
      END DO
      k = 0
      DO i = 1, SIZE(qs_control%ddapc_restraint_control)
@ -3383,8 +3285,7 @@ CONTAINS
      INTEGER                                            :: i, j, n_elems
      INTEGER, DIMENSION(:), POINTER                     :: tmp
-      LOGICAL                                            :: is_present, linearize_bse_propagation, &
+      LOGICAL                                            :: is_present, local_moment_possible
                                                            local_moment_possible
      TYPE(section_vals_type), POINTER                   :: proj_mo_section, subsection
      ALLOCATE (dft_control%rtp_control)
@ -3400,20 +3301,6 @@ CONTAINS
                                i_val=dft_control%rtp_control%rtp_method)
      CALL section_vals_val_get(rtp_section, "RTBSE%RTBSE_HAMILTONIAN", &
                                i_val=dft_control%rtp_control%rtbse_ham)
      CALL section_vals_val_get(rtp_section, "RTBSE%LINEARIZED_BSE_PROPAGATION", &
                                l_val=linearize_bse_propagation)
      ! Change rtp_method to linearized bse. The section parameter also feeds bs_env%rtp_method,
      ! which gates the W(w=0) build in the GW step - TDDFT there would dispatch the linearized
      ! propagator with no screened interaction to propagate with, so reject the combination.
      IF (linearize_bse_propagation) THEN
         IF (dft_control%rtp_control%rtp_method /= rtp_method_bse) THEN
            CALL cp_abort(__LOCATION__, &
                          "LINEARIZED_BSE_PROPAGATION requires the RTBSE section opened as "// &
                          "'&RTBSE' or '&RTBSE RTBSE', not '&RTBSE TDDFT'.")
         END IF
         dft_control%rtp_control%rtp_method = rtp_method_bse_linearized
      END IF
      CALL section_vals_val_get(rtp_section, "PROPAGATOR", &
                                i_val=dft_control%rtp_control%propagator)
      CALL section_vals_val_get(rtp_section, "EPS_ITER", &
@ -3452,20 +3339,18 @@ CONTAINS
      proj_mo_section => section_vals_get_subs_vals(rtp_section, "PRINT%PROJECTION_MO")
      CALL section_vals_get(proj_mo_section, explicit=is_present)
      IF (is_present) THEN
-         IF (dft_control%rtp_control%linear_scaling) THEN
+         IF (dft_control%rtp_control%linear_scaling) &
            CALL cp_abort(__LOCATION__, &
                          "You have defined a time dependent projection of mos, but "// &
                          "only the density matrix is propagated (DENSITY_PROPAGATION "// &
                          ".TRUE.). Please either use MO-based real time DFT or do not "// &
                          "define any PRINT%PROJECTION_MO section")
         END IF
         dft_control%rtp_control%is_proj_mo = .TRUE.
      ELSE
         dft_control%rtp_control%is_proj_mo = .FALSE.
      END IF
      ! Moment trace
-      local_moment_possible = (dft_control%rtp_control%rtp_method == rtp_method_bse .OR. &
+      local_moment_possible = (dft_control%rtp_control%rtp_method == rtp_method_bse) .OR. &
                               dft_control%rtp_control%rtp_method == rtp_method_bse_linearized) .OR. &
                              ((.NOT. dft_control%rtp_control%periodic) .AND. dft_control%rtp_control%linear_scaling)
      ! TODO : Implement for other moment operators
      subsection => section_vals_get_subs_vals(rtp_section, "PRINT%MOMENTS")
@ -3544,9 +3429,8 @@ CONTAINS
         DO i = 1, n_elems
            DO j = 1, 2
               IF (dft_control%rtp_control%print_pol_elements(i, j) > 3 .OR. &
-                   dft_control%rtp_control%print_pol_elements(i, j) < 1) THEN
+                   dft_control%rtp_control%print_pol_elements(i, j) < 1) &
                  CPABORT("Polarisation tensor element not 1,2 or 3 in at least one index")
               END IF
            END DO
         END DO
      END IF
@ -3669,9 +3553,8 @@ CONTAINS
         END DO
         dft_control%probe(i)%natoms = jj
-         IF (dft_control%probe(i)%natoms < 1) THEN
+         IF (dft_control%probe(i)%natoms < 1) &
            CPABORT("Need at least 1 atom to use hair probes formalism")
         END IF
         ALLOCATE (dft_control%probe(i)%atom_ids(dft_control%probe(i)%natoms))
         jj = 0
--- a/src/cp_dbcsr_cholesky.F
+++ b/src/cp_dbcsr_cholesky.F
@ -214,9 +214,8 @@ CONTAINS
      CALL copy_dbcsr_to_fm(matrixb, fm_matrixb)
      !CALL copy_dbcsr_to_fm(matrixout, fm_matrixout)
-      IF (op /= "SOLVE" .AND. op /= "MULTIPLY") THEN
+      IF (op /= "SOLVE" .AND. op /= "MULTIPLY") &
         CPABORT("wrong argument op")
      END IF
      IF (PRESENT(pos)) THEN
         SELECT CASE (pos)
--- a/src/cp_dbcsr_operations.F
+++ b/src/cp_dbcsr_operations.F
@ -611,9 +611,8 @@ CONTAINS
                           row_blk_size, col_blk_size_right_out)
         CALL copy_fm_to_dbcsr(fm_in, in)
-         IF (ncol /= k_out .OR. my_beta /= 0.0_dp) THEN
+         IF (ncol /= k_out .OR. my_beta /= 0.0_dp) &
            CALL copy_fm_to_dbcsr(fm_out, out)
         END IF
         CALL timeset(routineN//'_core', timing_handle_mult)
         CALL dbcsr_multiply("N", "N", my_alpha, matrix, in, my_beta, out, &
@ -649,9 +648,8 @@ CONTAINS
      n1 = SIZE(sizes1)
      n2 = SIZE(sizes2)
-      IF (n1 /= n2) THEN
+      IF (n1 /= n2) &
         CPABORT("distributions must be equal!")
      END IF
      sizes1(1:n1) = sizes2(1:n1)
      used = SUM(sizes1(1:n1))
      ! If sizes1 does not cover everything, then we increase the
@ -725,9 +723,8 @@ CONTAINS
      NULLIFY (col_dist_left)
      IF (ncol > 0) THEN
-         IF (.NOT. dbcsr_valid_index(sparse_matrix)) THEN
+         IF (.NOT. dbcsr_valid_index(sparse_matrix)) &
            CPABORT("sparse_matrix must pre-exist")
         END IF
         !
         ! Setup matrix_v
         CALL cp_fm_get_info(matrix_v, ncol_global=k)
@ -833,6 +830,25 @@ CONTAINS
            WRITE (*, *) 'PRESENT (matrix_g)', PRESENT(matrix_g)
            WRITE (*, *) 'matrix_type=', dbcsr_get_matrix_type(sparse_matrix)
            WRITE (*, *) 'norm(sm+alpha*v*g^t - fm+alpha*v*g^t)/n=', norm/REAL(nao, dp)
            IF (norm/REAL(nao, dp) > 1e-12_dp) THEN
               !WRITE(*,*) 'fm_matrix'
               !DO j=1,SIZE(fm_matrix%local_data,2)
               !   DO i=1,SIZE(fm_matrix%local_data,1)
               !      WRITE(*,'(A,I3,A,I3,A,E26.16,A)') 'a(',i,',',j,')=',fm_matrix%local_data(i,j),';'
               !   ENDDO
               !ENDDO
               !WRITE(*,*) 'mat_v'
               !CALL dbcsr_print(mat_v)
               !WRITE(*,*) 'mat_g'
               !CALL dbcsr_print(mat_g)
               !WRITE(*,*) 'sparse_matrix'
               !CALL dbcsr_print(sparse_matrix)
               !WRITE(*,*) 'sparse_matrix2 (-sm + sparse(fm))'
               !CALL dbcsr_print(sparse_matrix2)
               !WRITE(*,*) 'sparse_matrix3 (copy of sm input)'
               !CALL dbcsr_print(sparse_matrix3)
               !stop
            END IF
            CALL dbcsr_release(sparse_matrix2)
            CALL dbcsr_release(sparse_matrix3)
            CALL cp_fm_release(fm_matrix)
@ -1009,13 +1025,11 @@ CONTAINS
         estimated_blocks = max_blocks_per_bin*nbins
         ALLOCATE (blk_dist(estimated_blocks), stat=stat)
-         IF (stat /= 0) THEN
+         IF (stat /= 0) &
            CPABORT("blk_dist")
         END IF
         ALLOCATE (blk_sizes(estimated_blocks), stat=stat)
-         IF (stat /= 0) THEN
+         IF (stat /= 0) &
            CPABORT("blk_sizes")
         END IF
         element_stack = 0
         nblks = 0
         DO blk_layer = 1, max_blocks_per_bin
@ -1037,27 +1051,23 @@ CONTAINS
            block_size => blk_sizes
         ELSE
            ALLOCATE (block_distribution(nblks), stat=stat)
-            IF (stat /= 0) THEN
+            IF (stat /= 0) &
               CPABORT("blk_dist")
            END IF
            block_distribution(:) = blk_dist(1:nblks)
            DEALLOCATE (blk_dist)
            ALLOCATE (block_size(nblks), stat=stat)
-            IF (stat /= 0) THEN
+            IF (stat /= 0) &
               CPABORT("blk_sizes")
            END IF
            block_size(:) = blk_sizes(1:nblks)
            DEALLOCATE (blk_sizes)
         END IF
      ELSE
         ALLOCATE (block_distribution(0), stat=stat)
-         IF (stat /= 0) THEN
+         IF (stat /= 0) &
            CPABORT("blk_dist")
         END IF
         ALLOCATE (block_size(0), stat=stat)
-         IF (stat /= 0) THEN
+         IF (stat /= 0) &
            CPABORT("blk_sizes")
         END IF
      END IF
 1579  FORMAT(I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5, 1X, I5)
      IF (debug_mod) THEN
--- a/src/cp_ddapc_forces.F
+++ b/src/cp_ddapc_forces.F
@ -217,7 +217,7 @@ CONTAINS
            END IF
            IF (iparticle1 /= iparticle2) THEN
               ra = rvec
-               r = NORM2(ra)
+               r = SQRT(DOT_PRODUCT(ra, ra))
               t2 = -1.0_dp/(r*r)*factor
               drvec = ra/r*q1t*q2t
               d_el(1:3, iparticle1) = d_el(1:3, iparticle1) + t2*drvec
--- a/src/cp_ddapc_methods.F
+++ b/src/cp_ddapc_methods.F
@ -204,7 +204,7 @@ CONTAINS
                                                            iparticle2, istart_g, s_dim
      REAL(KIND=dp)                                      :: g2, gcut2, tmp
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: my_Am, my_Amw
-      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :)     :: gfunc_sq
+      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :)     :: gfunc_sq(:, :, :)
 !NB precalculate as many things outside of the innermost loop as possible, in particular w(ig)*gfunc(ig,igauus1)*gfunc(ig,igauss2)
@ -766,7 +766,7 @@ CONTAINS
            !
            IF (iparticle1 /= iparticle2) THEN
               ra = rvec
-               r = NORM2(ra)
+               r = SQRT(DOT_PRODUCT(ra, ra))
               my_val = factor/r
            END IF
            EwM(idim) = my_val - factor*g_ewald
--- a/Show more
+++ b/Show more