diff --git a/.github/workflows/build-CI-full.yml b/.github/workflows/build-CI-full.yml
new file mode 100644
index 00000000..8aeaf94a
--- /dev/null
+++ b/.github/workflows/build-CI-full.yml
@@ -0,0 +1,388 @@
+name: CI (full)
+
+on:
+  workflow_dispatch:
+
+env:
+  BUILD_DIR: _build
+  PIP_PACKAGES: >-
+    meson!=1.8.0
+    cmake
+    ninja
+  PIP_EXTRAS: >-
+    pkgconfig
+    numpy
+    ase
+    matplotlib
+
+jobs:
+  build:
+    runs-on: ${{ matrix.os }}
+
+    strategy:
+      fail-fast: false
+      matrix:
+        include:
+          # ---- Linux GCC + OpenBLAS — CMake debug --------------------------
+          - { os: ubuntu-latest, build-type: debug,
+              toolchain: { compiler: gcc, version: '12', build: cmake } }
+          - { os: ubuntu-latest, build-type: debug,
+              toolchain: { compiler: gcc, version: '14', build: cmake } }
+
+          # ---- Linux GCC + OpenBLAS — Meson debugoptimized -----------------
+          - { os: ubuntu-latest, build-type: debugoptimized,
+              toolchain: { compiler: gcc, version: '12', build: meson } }
+          - { os: ubuntu-latest, build-type: debugoptimized,
+              toolchain: { compiler: gcc, version: '14', build: meson } }
+
+          # ---- Linux Intel (ifx/icx) + MKL — CMake debug ------------------
+          - { os: ubuntu-latest, build-type: debug,
+              toolchain: { compiler: intel, version: '2025.1', mkl_version: '2025.1', build: cmake } }
+
+          # ---- Linux Intel (ifx/icx) + MKL — Meson debugoptimized ---------
+          - { os: ubuntu-latest, build-type: debugoptimized,
+              toolchain: { compiler: intel, version: '2025.1', mkl_version: '2025.1', build: meson } }
+
+          # ---- macOS GCC + OpenBLAS — CMake debug (GNU only) ---------------
+          - { os: macos-latest, build-type: debug,
+              toolchain: { compiler: gcc, version: '12', build: cmake } }
+          - { os: macos-latest, build-type: debug,
+              toolchain: { compiler: gcc, version: '14', build: cmake } }
+
+    defaults:
+      run:
+        shell: bash
+
+    steps:
+      # ----------------------------------------------------------------------
+      # Setup
+      # ----------------------------------------------------------------------
+      - name: Checkout code
+        uses: actions/checkout@v4
+
+      - name: Setup Python
+        uses: actions/setup-python@v5
+        with:
+          python-version: "3.10"
+
+      # ----------------------------------------------------------------------
+      # Compiler setup
+      # ----------------------------------------------------------------------
+
+      - name: Install GCC using setup-fortran
+        if: ${{ contains(matrix.toolchain.compiler, 'gcc') }}
+        uses: fortran-lang/setup-fortran@v1
+        with:
+          compiler: ${{ matrix.toolchain.compiler }}
+          version:  ${{ matrix.toolchain.version }}
+
+      - name: Install libopenblas (Linux GCC builds)
+        if: ${{ contains(matrix.os, 'ubuntu') && contains(matrix.toolchain.compiler, 'gcc') }}
+        run: |
+          sudo apt-get update
+          sudo apt-get install -y libopenblas-dev
+
+      - name: Install OpenBLAS (macOS)
+        if: ${{ contains(matrix.os, 'macos') }}
+        run: |
+          brew update
+          brew install openblas
+          echo "PKG_CONFIG_PATH=/usr/local/opt/openblas/lib/pkgconfig:/opt/homebrew/opt/openblas/lib/pkgconfig" >> $GITHUB_ENV
+          echo "LDFLAGS=-L/usr/local/opt/openblas/lib -L/opt/homebrew/opt/openblas/lib" >> $GITHUB_ENV
+          echo "CPPFLAGS=-I/usr/local/opt/openblas/include -I/opt/homebrew/opt/openblas/include" >> $GITHUB_ENV
+
+      - name: Prepare for Intel cache restore
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
+        run: |
+          sudo mkdir -p /opt/intel
+          sudo chown $USER /opt/intel
+
+      - name: Cache Intel installation
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
+        id: cache-install
+        uses: actions/cache@v4
+        with:
+          path: /opt/intel/oneapi
+          key: install-${{ matrix.toolchain.compiler }}-${{ matrix.toolchain.version }}-${{ matrix.toolchain.mkl_version }}-${{ matrix.os }}
+
+      - name: Install Intel Compiler
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
+        uses: fortran-lang/setup-fortran@v1
+        with:
+          compiler: ${{ matrix.toolchain.compiler }}
+          version:  ${{ matrix.toolchain.version }}
+
+      - name: Install Intel MKL
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
+        run: |
+          sudo apt-get install -y \
+            intel-oneapi-mkl-${{ matrix.toolchain.mkl_version }} \
+            intel-oneapi-mkl-devel-${{ matrix.toolchain.mkl_version }}
+
+      - name: Setup Intel oneAPI environment
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
+        run: |
+          source /opt/intel/oneapi/setvars.sh --force
+          printenv >> $GITHUB_ENV
+
+      - name: Set compiler environment variables
+        run: |
+          if [ ! -n "$FC" ]; then
+            if [ "${{ matrix.toolchain.compiler }}" = "gcc" ]; then
+              echo "FC=gfortran" >> $GITHUB_ENV
+              echo "CC=gcc"      >> $GITHUB_ENV
+            elif [ "${{ matrix.toolchain.compiler }}" = "intel" ]; then
+              echo "FC=ifx" >> $GITHUB_ENV
+              echo "CC=icx" >> $GITHUB_ENV
+            fi
+          fi
+          echo "COMPILER_VERSION=${{ matrix.toolchain.version }}" >> $GITHUB_ENV
+
+      # ----------------------------------------------------------------------
+      # Dependencies & submodules
+      # ----------------------------------------------------------------------
+
+      - name: Git submodules checkout
+        run: git submodule update --init
+
+      - name: Install build and test dependencies
+        run: |
+          pip3 install ${{ env.PIP_PACKAGES }} ${{ env.PIP_EXTRAS }}
+
+      # ----------------------------------------------------------------------
+      # Configure
+      # ----------------------------------------------------------------------
+
+      - name: Configure build (CMake, debug)
+        if: ${{ matrix.toolchain.build == 'cmake' && matrix.build-type == 'debug' }}
+        run: >
+          cmake -B${{ env.BUILD_DIR }}
+          -GNinja
+          -DCMAKE_BUILD_TYPE=Debug
+          -DCMAKE_INSTALL_PREFIX=$PWD/_dist
+          -DCMAKE_INSTALL_LIBDIR=lib
+
+      - name: Configure build (CMake, debugoptimized)
+        if: ${{ matrix.toolchain.build == 'cmake' && matrix.build-type == 'debugoptimized' }}
+        run: >
+          cmake -B${{ env.BUILD_DIR }}
+          -GNinja
+          -DCMAKE_BUILD_TYPE=RelWithDebInfo
+          -DCMAKE_INSTALL_PREFIX=$PWD/_dist
+          -DCMAKE_INSTALL_LIBDIR=lib
+
+      - name: Configure build (Meson, GNU)
+        if: ${{ matrix.toolchain.build == 'meson' && matrix.toolchain.compiler == 'gcc' }}
+        run: >
+          meson setup ${{ env.BUILD_DIR }}
+          --buildtype=${{ matrix.build-type }}
+          --prefix=$PWD/_dist
+          --libdir=lib
+          --warnlevel=0
+          -Dlapack=openblas
+
+      - name: Configure build (Meson, Intel)
+        if: ${{ matrix.toolchain.build == 'meson' && contains(matrix.toolchain.compiler, 'intel') }}
+        run: >
+          meson setup ${{ env.BUILD_DIR }}
+          --buildtype=${{ matrix.build-type }}
+          --prefix=$PWD/_dist
+          --libdir=lib
+          --warnlevel=0
+          --native-file=config/intel-llvm.ini
+          -Dlapack=mkl
+
+      # ----------------------------------------------------------------------
+      # Build / test / install
+      # ----------------------------------------------------------------------
+
+      - name: Build project
+        run: ninja -C ${{ env.BUILD_DIR }}
+
+      - name: Run unit tests (ctest)
+        if: ${{ matrix.toolchain.build == 'cmake' && contains(matrix.toolchain.compiler, 'gcc') }}
+        run: |
+          ctest --output-on-failure --parallel 2 -R '^crest/'
+        working-directory: ${{ env.BUILD_DIR }}
+        env:
+          OMP_NUM_THREADS: 1,2,1
+
+      - name: Install project
+        run: |
+          ninja -C ${{ env.BUILD_DIR }} install
+          echo "CREST_PREFIX=$PWD/_dist" >> $GITHUB_ENV
+
+  build-static:
+    runs-on: ${{ matrix.os }}
+
+    strategy:
+      fail-fast: false
+      matrix:
+        include:
+          # Linux x86_64 — GNU static (CMake)
+          - { os: ubuntu-latest,    build-type: static,
+              toolchain: { compiler: gcc,   version: '14',       build: cmake } }
+
+          # Linux x86_64 — Intel LLVM static (Meson; better ifx static support)
+          - { os: ubuntu-latest,    build-type: static,
+              toolchain: { compiler: intel, version: '2025.1', mkl_version: '2025.1', build: meson } }
+
+          # Linux aarch64 — GNU static (CMake; Intel oneAPI is x86-only)
+          - { os: ubuntu-24.04-arm, build-type: static,
+              toolchain: { compiler: gcc,   version: '14',       build: cmake } }
+
+          # macOS arm64 — GNU mostly-static (CMake)
+          # Note: macOS does not support fully-static executables; system libs remain dynamic.
+          - { os: macos-latest,     build-type: static,
+              toolchain: { compiler: gcc,   version: '14',       build: cmake } }
+
+    defaults:
+      run:
+        shell: bash
+
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v4
+
+      - name: Setup Python
+        uses: actions/setup-python@v5
+        with:
+          python-version: "3.10"
+
+      # --- Compiler setup ----------------------------------------------------
+
+      - name: Install GCC using setup-fortran
+        if: ${{ contains(matrix.toolchain.compiler, 'gcc') }}
+        uses: fortran-lang/setup-fortran@v1
+        with:
+          compiler: ${{ matrix.toolchain.compiler }}
+          version:  ${{ matrix.toolchain.version }}
+
+      - name: Install libopenblas (Linux GCC builds)
+        if: ${{ contains(matrix.os, 'ubuntu') && contains(matrix.toolchain.compiler, 'gcc') }}
+        run: |
+          sudo apt-get update
+          sudo apt-get install -y libopenblas-dev
+
+      - name: Install OpenBLAS (macOS)
+        if: ${{ contains(matrix.os, 'macos') }}
+        run: |
+          brew update
+          brew install openblas
+          echo "PKG_CONFIG_PATH=/usr/local/opt/openblas/lib/pkgconfig:/opt/homebrew/opt/openblas/lib/pkgconfig" >> $GITHUB_ENV
+          echo "LDFLAGS=-L/usr/local/opt/openblas/lib -L/opt/homebrew/opt/openblas/lib" >> $GITHUB_ENV
+          echo "CPPFLAGS=-I/usr/local/opt/openblas/include -I/opt/homebrew/opt/openblas/include" >> $GITHUB_ENV
+
+      - name: Prepare for Intel cache restore
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
+        run: |
+          sudo mkdir -p /opt/intel
+          sudo chown $USER /opt/intel
+
+      - name: Cache Intel installation
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
+        id: cache-install
+        uses: actions/cache@v4
+        with:
+          path: /opt/intel/oneapi
+          key: install-${{ matrix.toolchain.compiler }}-${{ matrix.toolchain.version }}-${{ matrix.toolchain.mkl_version }}-${{ matrix.os }}
+
+      - name: Install Intel Compiler
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
+        uses: fortran-lang/setup-fortran@v1
+        with:
+          compiler: ${{ matrix.toolchain.compiler }}
+          version:  ${{ matrix.toolchain.version }}
+
+      - name: Install Intel MKL
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
+        run: |
+          sudo apt-get install -y \
+            intel-oneapi-mkl-${{ matrix.toolchain.mkl_version }} \
+            intel-oneapi-mkl-devel-${{ matrix.toolchain.mkl_version }}
+
+      - name: Setup Intel oneAPI environment
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
+        run: |
+          source /opt/intel/oneapi/setvars.sh --force
+          printenv >> $GITHUB_ENV
+
+      - name: Set compiler environment variables
+        run: |
+          if [ ! -n "$FC" ]; then
+            if [ "${{ matrix.toolchain.compiler }}" = "gcc" ]; then
+              echo "FC=gfortran" >> $GITHUB_ENV
+              echo "CC=gcc"      >> $GITHUB_ENV
+            elif [ "${{ matrix.toolchain.compiler }}" = "intel" ]; then
+              echo "FC=ifx" >> $GITHUB_ENV
+              echo "CC=icx" >> $GITHUB_ENV
+            fi
+          fi
+          echo "COMPILER_VERSION=${{ matrix.toolchain.version }}" >> $GITHUB_ENV
+
+      # --- Dependencies & submodules -----------------------------------------
+
+      - name: Git submodules checkout
+        run: git submodule update --init
+
+      - name: Install build dependencies
+        run: |
+          pip3 install ${{ env.PIP_PACKAGES }} ${{ env.PIP_EXTRAS }}
+
+      # --- Configure ---------------------------------------------------------
+
+      - name: Configure build (CMake, static)
+        if: ${{ matrix.toolchain.build == 'cmake' && matrix.build-type == 'static' }}
+        run: >
+          cmake -B${{ env.BUILD_DIR }}
+          -GNinja
+          -DCMAKE_BUILD_TYPE=RelWithDebInfo
+          -DCMAKE_INSTALL_PREFIX=$PWD/_dist
+          -DCMAKE_INSTALL_LIBDIR=lib
+          -DWITH_TESTS=OFF
+          -DSTATICBUILD=ON
+
+      - name: Configure build (Meson, Intel static)
+        if: ${{ matrix.toolchain.build == 'meson' && matrix.build-type == 'static' }}
+        run: >
+          meson setup ${{ env.BUILD_DIR }}
+          --buildtype=release
+          --prefix=$PWD/_dist
+          --libdir=lib
+          --warnlevel=0
+          --native-file=config/intel-llvm.ini
+          -Dstatic=true
+          -Dlapack=mkl
+          -Dtests=false
+
+      # --- Build / install ---------------------------------------------------
+
+      - name: Build project
+        run: ninja -C ${{ env.BUILD_DIR }}
+
+      - name: Install project
+        run: |
+          ninja -C ${{ env.BUILD_DIR }} install
+          echo "CREST_PREFIX=$PWD/_dist" >> $GITHUB_ENV
+
+      - name: Create package
+        run: |
+          mkdir crest
+          cp COPYING crest/LICENSE
+          cp COPYING.LESSER crest/LICENSE.LESSER
+          cp _dist/bin/crest crest/
+          ARCH=$(uname -m)
+          UNAME_OS=$(uname -s | tr '[:upper:]' '[:lower:]')
+          COMPILER_NAME="${{ matrix.toolchain.compiler }}"
+          [ "$COMPILER_NAME" = "gcc"   ] && COMPILER_NAME="gnu"
+          [ "$COMPILER_NAME" = "intel" ] && COMPILER_NAME="intel"
+          OUTPUT="crest-${COMPILER_NAME}-${{ matrix.toolchain.version }}-${UNAME_OS}-${ARCH}.tar"
+          tar cvf "$OUTPUT" crest
+          xz -T0 "$OUTPUT"
+          echo "CREST_OUTPUT=${OUTPUT}.xz" >> $GITHUB_ENV
+
+      - name: Upload package
+        uses: actions/upload-artifact@v4
+        with:
+          name: ${{ env.CREST_OUTPUT }}
+          path: ${{ env.CREST_OUTPUT }}
diff --git a/.github/workflows/build-CI.yml b/.github/workflows/build-CI.yml
index b40f62b0..174e5def 100644
--- a/.github/workflows/build-CI.yml
+++ b/.github/workflows/build-CI.yml
@@ -2,7 +2,15 @@ name: CI
 
 on:
   push:
+    branches:
+      - master
+      - experimental
+      - '*-maintenance'
   pull_request:
+    branches:
+      - master
+      - '*-maintenance'
+  workflow_dispatch:
 
 env:
   BUILD_DIR: _build
@@ -15,11 +23,6 @@ env:
     numpy
     ase
     matplotlib
-  LINUX_INTEL_COMPONENTS: >-
-    intel-oneapi-compiler-fortran-2023.1.0
-    intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic-2023.1.0
-    intel-oneapi-mkl-2023.1.0
-    intel-oneapi-mkl-devel-2023.1.0
 
 jobs:
   build:
@@ -28,29 +31,17 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        os: [ubuntu-latest]
-        build-type: [debug]
-        toolchain:
-          - { compiler: gcc,   version: '11',       build: cmake }
-          - { compiler: gcc,   version: '12',       build: cmake }
-          - { compiler: gcc,   version: '14',       build: cmake }
-          - { compiler: intel, version: '2023.1.0', build: cmake }
-    
         include:
-          # ---- Linux GCC CMake debugoptimized build ------------------------
+          # ---- Linux GCC 14 + OpenBLAS — CMake debugoptimized --------------
           - { os: ubuntu-latest, build-type: debugoptimized,
               toolchain: { compiler: gcc, version: '14', build: cmake } }
-    
-          # ---- Linux static builds -----------------------------------------
-          - { os: ubuntu-latest, build-type: static,
-              toolchain: { compiler: gcc,   version: '12',       build: cmake } }
-          - { os: ubuntu-latest, build-type: static,
-              toolchain: { compiler: intel, version: '2023.1.0', build: meson } }
-    
-          # ---- macOS GCC CMake debug builds --------------------------------
-          - { os: macos-latest, build-type: debug,
-              toolchain: { compiler: gcc, version: '12', build: cmake } }
-          - { os: macos-latest, build-type: debug,
+
+          # ---- Linux Intel (ifx/icx) + MKL — Meson debugoptimized ---------
+          - { os: ubuntu-latest, build-type: debugoptimized,
+              toolchain: { compiler: intel, version: '2025.1', mkl_version: '2025.1', build: meson } }
+
+          # ---- macOS GCC 14 + OpenBLAS — CMake debugoptimized --------------
+          - { os: macos-latest, build-type: debugoptimized,
               toolchain: { compiler: gcc, version: '14', build: cmake } }
 
     defaults:
@@ -67,20 +58,20 @@ jobs:
       - name: Setup Python
         uses: actions/setup-python@v5
         with:
-          python-version: "3.9"
+          python-version: "3.10"
 
       # ----------------------------------------------------------------------
-      # Compiler setup (GCC via setup-fortran, Intel via oneAPI on Linux)
+      # Compiler setup
       # ----------------------------------------------------------------------
 
       - name: Install GCC using setup-fortran
         if: ${{ contains(matrix.toolchain.compiler, 'gcc') }}
         uses: fortran-lang/setup-fortran@v1
         with:
-          compiler: ${{ matrix.toolchain.compiler }}   # "gcc"
-          version:  ${{ matrix.toolchain.version }}    # e.g. "12"
+          compiler: ${{ matrix.toolchain.compiler }}
+          version:  ${{ matrix.toolchain.version }}
 
-      - name: Install libopenblas (Linux GNU builds only)
+      - name: Install libopenblas (Linux GCC builds)
         if: ${{ contains(matrix.os, 'ubuntu') && contains(matrix.toolchain.compiler, 'gcc') }}
         run: |
           sudo apt-get update
@@ -96,48 +87,49 @@ jobs:
           echo "CPPFLAGS=-I/usr/local/opt/openblas/include -I/opt/homebrew/opt/openblas/include" >> $GITHUB_ENV
 
       - name: Prepare for Intel cache restore
-        if: ${{ contains(matrix.os, 'ubuntu') && contains(matrix.toolchain.compiler, 'intel') }}
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
         run: |
           sudo mkdir -p /opt/intel
-          sudo chown "$USER" /opt/intel
+          sudo chown $USER /opt/intel
 
-      - name: Cache Intel oneAPI install
-        if: ${{ contains(matrix.os, 'ubuntu') && contains(matrix.toolchain.compiler, 'intel') }}
+      - name: Cache Intel installation
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
         id: cache-install
         uses: actions/cache@v4
         with:
           path: /opt/intel/oneapi
-          key: install-${{ matrix.toolchain.compiler }}-${{ matrix.toolchain.version }}-${{ matrix.os }}
+          key: install-${{ matrix.toolchain.compiler }}-${{ matrix.toolchain.version }}-${{ matrix.toolchain.mkl_version }}-${{ matrix.os }}
 
-      - name: Install Intel oneAPI (compiler + MKL)
-        if: ${{ contains(matrix.os, 'ubuntu') && contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
-        run: |
-          KEY=GPG-PUB-KEY-INTEL-SW-PRODUCTS-2023.PUB
-          wget https://apt.repos.intel.com/intel-gpg-keys/$KEY
-          sudo apt-key add $KEY
-          rm $KEY
+      - name: Install Intel Compiler
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
+        uses: fortran-lang/setup-fortran@v1
+        with:
+          compiler: ${{ matrix.toolchain.compiler }}
+          version:  ${{ matrix.toolchain.version }}
 
-          echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list
-          sudo apt-get update
-          sudo apt-get install -y $PKG
-        env:
-          PKG: ${{ env.LINUX_INTEL_COMPONENTS }}
+      - name: Install Intel MKL
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
+        run: |
+          sudo apt-get install -y \
+            intel-oneapi-mkl-${{ matrix.toolchain.mkl_version }} \
+            intel-oneapi-mkl-devel-${{ matrix.toolchain.mkl_version }}
 
       - name: Setup Intel oneAPI environment
-        if: ${{ contains(matrix.os, 'ubuntu') && contains(matrix.toolchain.compiler, 'intel') }}
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
         run: |
-          source /opt/intel/oneapi/setvars.sh
+          source /opt/intel/oneapi/setvars.sh --force
           printenv >> $GITHUB_ENV
 
       - name: Set compiler environment variables
         run: |
-          if [ "${{ matrix.toolchain.compiler }}" = "gcc" ]; then
-            echo "FC=gfortran" >> $GITHUB_ENV
-            echo "CC=gcc" >> $GITHUB_ENV
-          elif [ "${{ matrix.toolchain.compiler }}" = "intel" ]; then
-            # adjust to ifx/ifort if we want to change it in the future
-            echo "FC=ifort" >> $GITHUB_ENV
-            echo "CC=icx" >> $GITHUB_ENV
+          if [ ! -n "$FC" ]; then
+            if [ "${{ matrix.toolchain.compiler }}" = "gcc" ]; then
+              echo "FC=gfortran" >> $GITHUB_ENV
+              echo "CC=gcc"      >> $GITHUB_ENV
+            elif [ "${{ matrix.toolchain.compiler }}" = "intel" ]; then
+              echo "FC=ifx" >> $GITHUB_ENV
+              echo "CC=icx" >> $GITHUB_ENV
+            fi
           fi
           echo "COMPILER_VERSION=${{ matrix.toolchain.version }}" >> $GITHUB_ENV
 
@@ -156,15 +148,6 @@ jobs:
       # Configure
       # ----------------------------------------------------------------------
 
-      - name: Configure build (Meson)
-        if: ${{ matrix.toolchain.build == 'meson' }}
-        run: >
-          meson setup ${{ env.BUILD_DIR }}
-          --buildtype=debugoptimized
-          --prefix=$PWD/_dist
-          --libdir=lib
-          --warnlevel=0
-
       - name: Configure build (CMake, debug)
         if: ${{ matrix.toolchain.build == 'cmake' && matrix.build-type == 'debug' }}
         run: >
@@ -183,16 +166,26 @@ jobs:
           -DCMAKE_INSTALL_PREFIX=$PWD/_dist
           -DCMAKE_INSTALL_LIBDIR=lib
 
-      - name: Configure build (CMake, static)
-        if: ${{ matrix.toolchain.build == 'cmake' && matrix.build-type == 'static' }}
+      - name: Configure build (Meson, GNU)
+        if: ${{ matrix.toolchain.build == 'meson' && matrix.toolchain.compiler == 'gcc' }}
         run: >
-          cmake -B${{ env.BUILD_DIR }}
-          -GNinja
-          -DCMAKE_BUILD_TYPE=RelWithDebInfo
-          -DCMAKE_INSTALL_PREFIX=$PWD/_dist
-          -DCMAKE_INSTALL_LIBDIR=lib
-          -DWITH_TESTS=OFF
-          -DSTATICBUILD=ON
+          meson setup ${{ env.BUILD_DIR }}
+          --buildtype=${{ matrix.build-type }}
+          --prefix=$PWD/_dist
+          --libdir=lib
+          --warnlevel=0
+          -Dlapack=openblas
+
+      - name: Configure build (Meson, Intel)
+        if: ${{ matrix.toolchain.build == 'meson' && contains(matrix.toolchain.compiler, 'intel') }}
+        run: >
+          meson setup ${{ env.BUILD_DIR }}
+          --buildtype=${{ matrix.build-type }}
+          --prefix=$PWD/_dist
+          --libdir=lib
+          --warnlevel=0
+          --native-file=config/intel-llvm.ini
+          -Dlapack=mkl
 
       # ----------------------------------------------------------------------
       # Build / test / install
@@ -202,7 +195,7 @@ jobs:
         run: ninja -C ${{ env.BUILD_DIR }}
 
       - name: Run unit tests (ctest)
-        if: ${{ matrix.toolchain.build == 'cmake' && contains(matrix.toolchain.compiler, 'gcc') }}
+        if: ${{ matrix.toolchain.build == 'cmake' }}
         run: |
           ctest --output-on-failure --parallel 2 -R '^crest/'
         working-directory: ${{ env.BUILD_DIR }}
@@ -213,4 +206,3 @@ jobs:
         run: |
           ninja -C ${{ env.BUILD_DIR }} install
           echo "CREST_PREFIX=$PWD/_dist" >> $GITHUB_ENV
-
diff --git a/.github/workflows/build-static-experimental.yml b/.github/workflows/build-static-experimental.yml
new file mode 100644
index 00000000..74177d29
--- /dev/null
+++ b/.github/workflows/build-static-experimental.yml
@@ -0,0 +1,204 @@
+name: Static builds (experimental branch)
+
+on:
+  workflow_dispatch:
+
+env:
+  BUILD_DIR: _build
+  PIP_PACKAGES: >-
+    meson!=1.8.0
+    cmake
+    ninja
+  PIP_EXTRAS: >-
+    pkgconfig
+    numpy
+    ase
+    matplotlib
+
+jobs:
+  build-static:
+    runs-on: ${{ matrix.os }}
+
+    strategy:
+      fail-fast: false
+      matrix:
+        include:
+          # Linux x86_64 — GNU static (CMake)
+          - { os: ubuntu-latest,   build-type: static,
+              toolchain: { compiler: gcc,   version: '14',       build: cmake } }
+
+          # Linux x86_64 — Intel LLVM static (Meson; better ifx static support)
+          - { os: ubuntu-latest,   build-type: static,
+              toolchain: { compiler: intel, version: '2025.3', mkl_version: '2025.3', build: meson } }
+
+          # Linux aarch64 — GNU static (CMake; Intel oneAPI is x86-only)
+          - { os: ubuntu-24.04-arm, build-type: static,
+              toolchain: { compiler: gcc,   version: '14',       build: cmake } }
+
+          # macOS arm64 — dynamic release (CMake)
+          # macOS has no static libpthread/libSystem, so fully-static builds are
+          # not possible. This produces a dynamic binary; users need Homebrew GCC
+          # and OpenBLAS (see release notes).
+          - { os: macos-latest,    build-type: release,
+              toolchain: { compiler: gcc,   version: '14',       build: cmake } }
+
+    defaults:
+      run:
+        shell: bash
+
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v4
+
+      - name: Setup Python
+        uses: actions/setup-python@v5
+        with:
+          python-version: "3.10"
+
+      # --- Compiler setup ----------------------------------------------------
+
+      - name: Install GCC using setup-fortran
+        if: ${{ contains(matrix.toolchain.compiler, 'gcc') }}
+        uses: fortran-lang/setup-fortran@v1
+        with:
+          compiler: ${{ matrix.toolchain.compiler }}
+          version:  ${{ matrix.toolchain.version }}
+
+      - name: Install libopenblas (Linux GCC builds)
+        if: ${{ contains(matrix.os, 'ubuntu') && contains(matrix.toolchain.compiler, 'gcc') }}
+        run: |
+          sudo apt-get update
+          sudo apt-get install -y libopenblas-dev
+
+      - name: Install OpenBLAS (macOS)
+        if: ${{ contains(matrix.os, 'macos') }}
+        run: |
+          brew update
+          brew install openblas
+          echo "PKG_CONFIG_PATH=/usr/local/opt/openblas/lib/pkgconfig:/opt/homebrew/opt/openblas/lib/pkgconfig" >> $GITHUB_ENV
+          echo "LDFLAGS=-L/usr/local/opt/openblas/lib -L/opt/homebrew/opt/openblas/lib" >> $GITHUB_ENV
+          echo "CPPFLAGS=-I/usr/local/opt/openblas/include -I/opt/homebrew/opt/openblas/include" >> $GITHUB_ENV
+
+      - name: Prepare for Intel cache restore
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
+        run: |
+          sudo mkdir -p /opt/intel
+          sudo chown $USER /opt/intel
+
+      - name: Cache Intel installation
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
+        id: cache-install
+        uses: actions/cache@v4
+        with:
+          path: /opt/intel/oneapi
+          key: install-${{ matrix.toolchain.compiler }}-${{ matrix.toolchain.version }}-${{ matrix.toolchain.mkl_version }}-${{ matrix.os }}
+
+      - name: Install Intel Compiler
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
+        uses: fortran-lang/setup-fortran@v1
+        with:
+          compiler: ${{ matrix.toolchain.compiler }}
+          version:  ${{ matrix.toolchain.version }}
+
+      - name: Install Intel MKL
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
+        run: |
+          sudo apt-get install -y \
+            intel-oneapi-mkl-${{ matrix.toolchain.mkl_version }} \
+            intel-oneapi-mkl-devel-${{ matrix.toolchain.mkl_version }}
+
+      - name: Setup Intel oneAPI environment
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
+        run: |
+          source /opt/intel/oneapi/setvars.sh --force
+          printenv >> $GITHUB_ENV
+
+      - name: Set compiler environment variables
+        run: |
+          if [ ! -n "$FC" ]; then
+            if [ "${{ matrix.toolchain.compiler }}" = "gcc" ]; then
+              echo "FC=gfortran" >> $GITHUB_ENV
+              echo "CC=gcc"      >> $GITHUB_ENV
+            elif [ "${{ matrix.toolchain.compiler }}" = "intel" ]; then
+              echo "FC=ifx" >> $GITHUB_ENV
+              echo "CC=icx" >> $GITHUB_ENV
+            fi
+          fi
+          echo "COMPILER_VERSION=${{ matrix.toolchain.version }}" >> $GITHUB_ENV
+
+      # --- Dependencies & submodules -----------------------------------------
+
+      - name: Git submodules checkout
+        run: git submodule update --init
+
+      - name: Install build dependencies
+        run: |
+          pip3 install ${{ env.PIP_PACKAGES }} ${{ env.PIP_EXTRAS }}
+
+      # --- Configure ---------------------------------------------------------
+
+      - name: Configure build (CMake, static)
+        if: ${{ matrix.toolchain.build == 'cmake' && matrix.build-type == 'static' }}
+        run: >
+          cmake -B${{ env.BUILD_DIR }}
+          -GNinja
+          -DCMAKE_BUILD_TYPE=RelWithDebInfo
+          -DCMAKE_INSTALL_PREFIX=$PWD/_dist
+          -DCMAKE_INSTALL_LIBDIR=lib
+          -DWITH_TESTS=OFF
+          -DSTATICBUILD=ON
+
+      - name: Configure build (CMake, macOS dynamic release)
+        if: ${{ matrix.toolchain.build == 'cmake' && matrix.build-type == 'release' }}
+        run: >
+          cmake -B${{ env.BUILD_DIR }}
+          -GNinja
+          -DCMAKE_BUILD_TYPE=Release
+          -DCMAKE_INSTALL_PREFIX=$PWD/_dist
+          -DCMAKE_INSTALL_LIBDIR=lib
+          -DWITH_TESTS=OFF
+
+      - name: Configure build (Meson, Intel static)
+        if: ${{ matrix.toolchain.build == 'meson' && matrix.build-type == 'static' }}
+        run: >
+          meson setup ${{ env.BUILD_DIR }}
+          --buildtype=release
+          --prefix=$PWD/_dist
+          --libdir=lib
+          --warnlevel=0
+          --native-file=config/intel-llvm.ini
+          -Dstatic=true
+          -Dlapack=mkl
+          -Dtests=false
+
+      # --- Build / install ---------------------------------------------------
+
+      - name: Build project
+        run: ninja -C ${{ env.BUILD_DIR }}
+
+      - name: Install project
+        run: |
+          ninja -C ${{ env.BUILD_DIR }} install
+          echo "CREST_PREFIX=$PWD/_dist" >> $GITHUB_ENV
+
+      - name: Create package
+        run: |
+          mkdir crest
+          cp COPYING crest/LICENSE
+          cp COPYING.LESSER crest/LICENSE.LESSER
+          cp _dist/bin/crest crest/
+          ARCH=$(uname -m)
+          UNAME_OS=$(uname -s | tr '[:upper:]' '[:lower:]')
+          COMPILER_NAME="${{ matrix.toolchain.compiler }}"
+          [ "$COMPILER_NAME" = "gcc"   ] && COMPILER_NAME="gnu"
+          [ "$COMPILER_NAME" = "intel" ] && COMPILER_NAME="intel"
+          OUTPUT="crest-${COMPILER_NAME}-${{ matrix.toolchain.version }}-${UNAME_OS}-${ARCH}.tar"
+          tar cvf "$OUTPUT" crest
+          xz -T0 "$OUTPUT"
+          echo "CREST_OUTPUT=${OUTPUT}.xz" >> $GITHUB_ENV
+
+      - name: Upload package
+        uses: actions/upload-artifact@v4
+        with:
+          name: ${{ env.CREST_OUTPUT }}
+          path: ${{ env.CREST_OUTPUT }}
diff --git a/.github/workflows/build-upload.yml b/.github/workflows/build-upload.yml
index 344072d5..50ac0b9e 100644
--- a/.github/workflows/build-upload.yml
+++ b/.github/workflows/build-upload.yml
@@ -1,4 +1,4 @@
-name: Continuous release (static Linux)
+name: Continuous release (static builds)
 
 on:
   push:
@@ -16,11 +16,6 @@ env:
     numpy
     ase
     matplotlib
-  LINUX_INTEL_COMPONENTS: >-
-    intel-oneapi-compiler-fortran-2023.1.0
-    intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic-2023.1.0
-    intel-oneapi-mkl-2023.1.0
-    intel-oneapi-mkl-devel-2023.1.0
 
 jobs:
   build-static:
@@ -29,13 +24,25 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        os: [ubuntu-latest]
-        build-type: [static]
-        toolchain:
-          # GNU static CMake build
-          - { compiler: gcc,   version: '12',       build: cmake }
-          # Intel static Meson build
-          - { compiler: intel, version: '2023.1.0', build: meson }
+        include:
+          # Linux x86_64 — GNU static (CMake)
+          - { os: ubuntu-latest,   build-type: static,
+              toolchain: { compiler: gcc,   version: '14',       build: cmake } }
+
+          # Linux x86_64 — Intel LLVM static (Meson; better ifx static support)
+          - { os: ubuntu-latest,   build-type: static,
+              toolchain: { compiler: intel, version: '2025.3', mkl_version: '2025.3', build: meson } }
+
+          # Linux aarch64 — GNU static (CMake; Intel oneAPI is x86-only)
+          - { os: ubuntu-24.04-arm, build-type: static,
+              toolchain: { compiler: gcc,   version: '14',       build: cmake } }
+
+          # macOS arm64 — dynamic release (CMake)
+          # macOS has no static libpthread/libSystem, so fully-static builds are
+          # not possible. This produces a dynamic binary; users need Homebrew GCC
+          # and OpenBLAS (see release notes).
+          - { os: macos-latest,    build-type: release,
+              toolchain: { compiler: gcc,   version: '14',       build: cmake } }
 
     defaults:
       run:
@@ -48,69 +55,80 @@ jobs:
       - name: Setup Python
         uses: actions/setup-python@v5
         with:
-          python-version: "3.9"
+          python-version: "3.10"
 
       # --- Compiler setup ----------------------------------------------------
 
-      - name: Install GCC (Linux) using setup-fortran
+      - name: Install GCC using setup-fortran
         if: ${{ contains(matrix.toolchain.compiler, 'gcc') }}
         uses: fortran-lang/setup-fortran@v1
         with:
           compiler: ${{ matrix.toolchain.compiler }}
           version:  ${{ matrix.toolchain.version }}
 
-      - name: Install libopenblas (Linux GNU builds only)
-        if: ${{ contains(matrix.toolchain.compiler, 'gcc') }}
+      - name: Install libopenblas (Linux GCC builds)
+        if: ${{ contains(matrix.os, 'ubuntu') && contains(matrix.toolchain.compiler, 'gcc') }}
         run: |
           sudo apt-get update
           sudo apt-get install -y libopenblas-dev
 
+      - name: Install OpenBLAS (macOS)
+        if: ${{ contains(matrix.os, 'macos') }}
+        run: |
+          brew update
+          brew install openblas
+          echo "PKG_CONFIG_PATH=/usr/local/opt/openblas/lib/pkgconfig:/opt/homebrew/opt/openblas/lib/pkgconfig" >> $GITHUB_ENV
+          echo "LDFLAGS=-L/usr/local/opt/openblas/lib -L/opt/homebrew/opt/openblas/lib" >> $GITHUB_ENV
+          echo "CPPFLAGS=-I/usr/local/opt/openblas/include -I/opt/homebrew/opt/openblas/include" >> $GITHUB_ENV
+
       - name: Prepare for Intel cache restore
         if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
         run: |
           sudo mkdir -p /opt/intel
-          sudo chown "$USER" /opt/intel
+          sudo chown $USER /opt/intel
 
-      - name: Cache Intel oneAPI install
+      - name: Cache Intel installation
         if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
         id: cache-install
         uses: actions/cache@v4
         with:
           path: /opt/intel/oneapi
-          key: install-${{ matrix.toolchain.compiler }}-${{ matrix.toolchain.version }}-${{ matrix.os }}
+          key: install-${{ matrix.toolchain.compiler }}-${{ matrix.toolchain.version }}-${{ matrix.toolchain.mkl_version }}-${{ matrix.os }}
 
-      - name: Install Intel oneAPI (compiler + MKL)
-        if: ${{ contains(matrix.os, 'ubuntu') && contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
-        run: |
-          KEY=GPG-PUB-KEY-INTEL-SW-PRODUCTS-2023.PUB
-          wget https://apt.repos.intel.com/intel-gpg-keys/$KEY
-          sudo apt-key add $KEY
-          rm $KEY
+      - name: Install Intel Compiler
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
+        uses: fortran-lang/setup-fortran@v1
+        with:
+          compiler: ${{ matrix.toolchain.compiler }}
+          version:  ${{ matrix.toolchain.version }}
 
-          echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list
-          sudo apt-get update
-          sudo apt-get install -y $PKG
-        env:
-          PKG: ${{ env.LINUX_INTEL_COMPONENTS }}
+      - name: Install Intel MKL
+        if: ${{ contains(matrix.toolchain.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }}
+        run: |
+          sudo apt-get install -y \
+            intel-oneapi-mkl-${{ matrix.toolchain.mkl_version }} \
+            intel-oneapi-mkl-devel-${{ matrix.toolchain.mkl_version }}
 
       - name: Setup Intel oneAPI environment
         if: ${{ contains(matrix.toolchain.compiler, 'intel') }}
         run: |
-          source /opt/intel/oneapi/setvars.sh
+          source /opt/intel/oneapi/setvars.sh --force
           printenv >> $GITHUB_ENV
 
       - name: Set compiler environment variables
         run: |
-          if [ "${{ matrix.toolchain.compiler }}" = "gcc" ]; then
-            echo "FC=gfortran" >> $GITHUB_ENV
-            echo "CC=gcc" >> $GITHUB_ENV
-          elif [ "${{ matrix.toolchain.compiler }}" = "intel" ]; then
-            echo "FC=ifort" >> $GITHUB_ENV
-            echo "CC=icx" >> $GITHUB_ENV
+          if [ ! -n "$FC" ]; then
+            if [ "${{ matrix.toolchain.compiler }}" = "gcc" ]; then
+              echo "FC=gfortran" >> $GITHUB_ENV
+              echo "CC=gcc"      >> $GITHUB_ENV
+            elif [ "${{ matrix.toolchain.compiler }}" = "intel" ]; then
+              echo "FC=ifx" >> $GITHUB_ENV
+              echo "CC=icx" >> $GITHUB_ENV
+            fi
           fi
           echo "COMPILER_VERSION=${{ matrix.toolchain.version }}" >> $GITHUB_ENV
 
-      # --- Dependencies & submodules ---------------------------------------
+      # --- Dependencies & submodules -----------------------------------------
 
       - name: Git submodules checkout
         run: git submodule update --init
@@ -119,16 +137,7 @@ jobs:
         run: |
           pip3 install ${{ env.PIP_PACKAGES }} ${{ env.PIP_EXTRAS }}
 
-      # --- Configure --------------------------------------------------------
-
-      - name: Configure build (Meson, static-ish)
-        if: ${{ matrix.toolchain.build == 'meson' }}
-        run: >
-          meson setup ${{ env.BUILD_DIR }}
-          --buildtype=debugoptimized
-          --prefix=$PWD/_dist
-          --libdir=lib
-          --warnlevel=0
+      # --- Configure ---------------------------------------------------------
 
       - name: Configure build (CMake, static)
         if: ${{ matrix.toolchain.build == 'cmake' && matrix.build-type == 'static' }}
@@ -141,7 +150,30 @@ jobs:
           -DWITH_TESTS=OFF
           -DSTATICBUILD=ON
 
-      # --- Build / (optional) test / install --------------------------------
+      - name: Configure build (CMake, macOS dynamic release)
+        if: ${{ matrix.toolchain.build == 'cmake' && matrix.build-type == 'release' }}
+        run: >
+          cmake -B${{ env.BUILD_DIR }}
+          -GNinja
+          -DCMAKE_BUILD_TYPE=Release
+          -DCMAKE_INSTALL_PREFIX=$PWD/_dist
+          -DCMAKE_INSTALL_LIBDIR=lib
+          -DWITH_TESTS=OFF
+
+      - name: Configure build (Meson, Intel static)
+        if: ${{ matrix.toolchain.build == 'meson' && matrix.build-type == 'static' }}
+        run: >
+          meson setup ${{ env.BUILD_DIR }}
+          --buildtype=release
+          --prefix=$PWD/_dist
+          --libdir=lib
+          --warnlevel=0
+          --native-file=config/intel-llvm.ini
+          -Dstatic=true
+          -Dlapack=mkl
+          -Dtests=false
+
+      # --- Build / install ---------------------------------------------------
 
       - name: Build project
         run: ninja -C ${{ env.BUILD_DIR }}
@@ -157,17 +189,16 @@ jobs:
           cp COPYING crest/LICENSE
           cp COPYING.LESSER crest/LICENSE.LESSER
           cp _dist/bin/crest crest/
+          ARCH=$(uname -m)
+          UNAME_OS=$(uname -s | tr '[:upper:]' '[:lower:]')
           COMPILER_NAME="${{ matrix.toolchain.compiler }}"
-          # Map GCC → gnu for backwards-compatible file names
-          if [ "$COMPILER_NAME" = "gcc" ]; then
-            COMPILER_NAME="gnu"
-          fi
-          OUTPUT="crest-${COMPILER_NAME}-${{ matrix.toolchain.version }}-${{ matrix.os }}.tar"
+          [ "$COMPILER_NAME" = "gcc"   ] && COMPILER_NAME="gnu"
+          [ "$COMPILER_NAME" = "intel" ] && COMPILER_NAME="intel"
+          OUTPUT="crest-${COMPILER_NAME}-${{ matrix.toolchain.version }}-${UNAME_OS}-${ARCH}.tar"
           tar cvf "$OUTPUT" crest
           xz -T0 "$OUTPUT"
           echo "CREST_OUTPUT=${OUTPUT}.xz" >> $GITHUB_ENV
 
-
       - name: Upload package
         uses: actions/upload-artifact@v4
         with:
@@ -264,4 +295,3 @@ jobs:
               --name "$f" \
               --file "$f"
           done
-
diff --git a/.gitignore b/.gitignore
index 631e65ab..77dcaf67 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,7 +2,10 @@
 *.mod
 *.tgz
 *.i90
+*.bak
 *__genmod.f90
+.s*
+.c*
 github_bin/
 build_majestix
 build_commands
@@ -10,3 +13,7 @@ _build*
 _dist*
 src/crest
 bin/
+subprojects/.wraplock
+meson_build/
+meson_build_*
+utils/
diff --git a/.gitmodules b/.gitmodules
index ed86f56b..749a9dba 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -23,4 +23,28 @@
   branch = main
 [submodule "subprojects/pvol"]
 	path = subprojects/pvol
-	url = https://github.com/neudecker-group/libpvol.git
+  url = https://github.com/pprcht/libpvol.git
+  branch = build-update
+[submodule "subprojects/fmlip_relay"]
+	path = subprojects/fmlip_relay
+	url = https://github.com/pprcht/fmlip-relay.git
+[submodule "subprojects/dftd4"]
+	path = subprojects/dftd4
+	url = https://github.com/dftd4/dftd4
+	branch = main
+[submodule "subprojects/mctc-lib"]
+	path = subprojects/mctc-lib
+	url = https://github.com/grimme-lab/mctc-lib.git
+[submodule "subprojects/mstore"]
+	path = subprojects/mstore
+	url = https://github.com/grimme-lab/mstore
+[submodule "subprojects/multicharge"]
+	path = subprojects/multicharge
+	url = https://github.com/grimme-lab/multicharge
+[submodule "subprojects/s-dftd3"]
+	path = subprojects/s-dftd3
+	url = https://github.com/dftd3/simple-dftd3
+[submodule "subprojects/ddx"]
+	path = subprojects/ddx
+	url = https://github.com/ddsolvation/ddX.git
+	branch = main
diff --git a/BUILD.md b/BUILD.md
new file mode 100644
index 00000000..262a496a
--- /dev/null
+++ b/BUILD.md
@@ -0,0 +1,292 @@
+# Building crest with Meson
+
+## Prerequisites
+
+| Tool | Minimum version | Notes |
+|------|----------------|-------|
+| [Meson](https://mesonbuild.com) | 0.57.0 | `pip install meson` or distro package |
+| [Ninja](https://ninja-build.org) | 1.10 | usually installed alongside meson |
+| Fortran compiler | — | gfortran ≥ 10, ifort ≥ 2021, or ifx ≥ 2023 |
+| C compiler | — | gcc or the matching Intel C compiler |
+| LAPACK + BLAS | — | OpenBLAS, Intel MKL, or netlib |
+| OpenMP | — | libgomp (GNU) or libomp/libiomp5 (Intel) |
+
+Optional (auto-detected or pulled from `subprojects/`):
+
+- tblite, toml-f, GFN-FF, GFN0-xTB, libpvol, lwONIOM, fmlip-relay
+- test-drive (only for `--tests`)
+
+---
+
+## Quick start
+
+```sh
+# Configure (defaults: release build, OpenBLAS/auto LAPACK, OpenMP on, all
+# optional libs auto-detected, unit tests enabled)
+meson setup build
+
+# Compile
+ninja -C build
+
+# Run tests
+ninja -C build test
+
+# Install to /usr/local
+ninja -C build install
+```
+
+---
+
+## Compiler selection
+
+The build system auto-detects whatever Fortran/C compilers are first on
+`$PATH`. Use the native-file templates in `config/` to pin a specific
+toolchain:
+
+```sh
+# Pure GNU (gfortran + gcc)
+meson setup build --native-file config/gnu.ini
+
+# Intel LLVM (ifx + icx) — oneAPI 2023+
+source /opt/intel/oneapi/setvars.sh
+meson setup build --native-file config/intel-llvm.ini
+
+# Intel classic (ifort + icc) — oneAPI 2022 or earlier
+meson setup build --native-file config/intel-classic.ini
+
+# Mixed: Intel Fortran (ifx) + GNU C (gcc)
+meson setup build --native-file config/intel-fortran-gnu-c.ini
+```
+
+Or set compilers directly via environment variables (older style):
+
+```sh
+FC=gfortran CC=gcc meson setup build
+FC=ifort    CC=icc meson setup build
+FC=ifx      CC=icx meson setup build
+```
+
+---
+
+## Build options
+
+Pass options with `-D` at configure time, or modify with `meson configure`:
+
+| Option | Default | Description |
+|--------|---------|-------------|
+| `openmp` | `true` | Enable OpenMP parallelisation |
+| `lapack` | `auto` | LAPACK/BLAS provider: `auto`, `openblas`, `mkl`, `netlib`, `custom` |
+| `lapack_libs` | `[]` | Library names for `lapack=custom` |
+| `blas_libs` | `[]` | Library names for `lapack=custom` |
+| `static` | `false` | Link a fully static binary |
+| `tblite` | `auto` | tblite semiempirical library |
+| `toml-f` | `auto` | TOML-Fortran (file-based input) |
+| `gfn0` | `auto` | GFN0-xTB library |
+| `gfnff` | `auto` | GFN-FF library |
+| `libpvol` | `auto` | libpvol (volume computation) |
+| `lwoniom` | `auto` | lwONIOM |
+| `fmlip-relay` | `auto` | fmlip-relay ML/IP interface |
+| `tests` | `true` | Build unit tests |
+
+Feature options (`auto` / `enabled` / `disabled`):
+
+- `auto` — use it if found, silently skip if not
+- `enabled` — require it; fail the build if not found
+- `disabled` — never use it even if installed
+
+Examples:
+
+```sh
+# Disable all optional libraries (minimal build)
+meson setup build -Dtblite=disabled -Dtoml-f=disabled \
+                  -Dgfn0=disabled -Dgfnff=disabled \
+                  -Dlibpvol=disabled -Dlwoniom=disabled \
+                  -Dfmlip-relay=disabled
+
+# Require tblite (fail if not found)
+meson setup build -Dtblite=enabled
+
+# Debug build with bounds checking
+meson setup build --buildtype=debug
+
+# Change an option after configuration
+meson configure build -Dopenmp=false
+```
+
+---
+
+## LAPACK / BLAS selection
+
+### Auto (default)
+
+- For Intel compilers: tries MKL first, then OpenBLAS, then netlib
+- For GNU: tries OpenBLAS first, then MKL (with `mkl_gnu_thread`), then netlib
+
+```sh
+meson setup build -Dlapack=auto   # (this is the default)
+```
+
+### OpenBLAS
+
+```sh
+meson setup build -Dlapack=openblas
+```
+
+OpenBLAS bundles both BLAS and LAPACK. Make sure `libopenblas-dev` (Debian/Ubuntu)
+or `openblas-devel` (RHEL/Fedora) is installed, or that `pkg-config --exists openblas`
+succeeds.
+
+### Intel MKL
+
+```sh
+source /opt/intel/oneapi/setvars.sh
+meson setup build -Dlapack=mkl
+```
+
+The build system selects the correct threading layer automatically:
+
+| Fortran compiler | MKL threading layer | OpenMP runtime |
+|-----------------|---------------------|----------------|
+| gfortran | `mkl_gnu_thread` | libgomp |
+| ifort / ifx | `mkl_intel_thread` | libiomp5 / libomp |
+
+**Do not mix** `mkl_gnu_thread` with Intel OpenMP or vice versa — this causes
+silent wrong results or crashes.
+
+If `pkg-config` can see `mkl-sdl`, that single-dynamic-library interface is
+used instead and no threading-layer selection is needed.
+
+### Custom libraries
+
+For non-standard LAPACK installations (e.g. a vendor-tuned LAPACK on a
+cluster module):
+
+```sh
+meson setup build -Dlapack=custom \
+  -Dlapack_libs=lapack,blas \
+  -Dblas_libs=blas
+# or with full paths via pkg-config / LIBRARY_PATH
+```
+
+---
+
+## Fully static binary
+
+A static binary embeds all libraries including the OpenMP runtime and LAPACK.
+This is the most portable output for distribution on HPC clusters.
+
+### GNU static
+
+Requires: `libgfortran.a`, `libgomp.a`, `libopenblas.a` (or `liblapack.a` +
+`libblas.a`) to be available as static `.a` archives.  On Debian/Ubuntu
+install `gfortran-static`, `libgomp1` (usually comes with `libgomp-staticdev`),
+and `libopenblas-dev`.
+
+```sh
+meson setup build_static      \
+  --buildtype=release         \
+  --native-file config/gnu.ini \
+  -Dstatic=true               \
+  -Dlapack=openblas
+ninja -C build_static
+# Result: build_static/crest  — fully self-contained ELF
+ldd build_static/crest  # should print "not a dynamic executable"
+```
+
+### Intel classic static
+
+```sh
+source /opt/intel/oneapi/setvars.sh
+meson setup build_static               \
+  --native-file config/intel-classic.ini \
+  -Dstatic=true                         \
+  -Dlapack=mkl
+ninja -C build_static
+```
+
+Intel's `-static-intel -qopenmp-link=static` flags are applied automatically.
+The Intel static libraries (`libifcore.a`, `libimf.a`, `libsvml.a`,
+`libiomp5.a`) must be present — they are typically in
+`$ONEAPI_ROOT/compiler/latest/linux/compiler/lib/intel64_lin/`.
+
+### Intel LLVM (ifx) static
+
+```sh
+source /opt/intel/oneapi/setvars.sh
+meson setup build_static              \
+  --native-file config/intel-llvm.ini  \
+  -Dstatic=true                       \
+  -Dlapack=mkl
+ninja -C build_static
+```
+
+\`-static-intel -qopenmp-link=static\` are applied automatically for ifx.
+
+---
+
+## Subprojects
+
+Optional chemistry libraries are resolved in this order:
+
+1. **System-installed** — found via `pkg-config` or in standard library paths
+2. **Git submodule** — if `subprojects/<name>/` exists and contains a
+   `meson.build` (populate with `git submodule update --init --recursive`)
+3. **Wrap file** — `subprojects/<name>.wrap` tells Meson to clone the repo on
+   first use with `meson subprojects download`
+
+To pre-fetch all wrap-defined subprojects:
+
+```sh
+meson subprojects download
+```
+
+To update existing subproject clones:
+
+```sh
+meson subprojects update
+```
+
+---
+
+## Metadata generation
+
+At configure time Meson fills `assets/template/metadata.f90` and writes the
+result to `<builddir>/crest_metadata.fh`.  The placeholders populated are:
+
+| Placeholder | Value |
+|-------------|-------|
+| `@version@` | project version from `meson.build` |
+| `@commit@`  | short git hash (or `unknown-commit`) |
+| `@date@`    | configure timestamp |
+| `@author@`  | `$USER` / `$USERNAME` |
+| `@origin@`  | hostname |
+| `@fcid@`    | Fortran compiler name |
+| `@fcver@`   | Fortran compiler version |
+| `@ccid@`    | C compiler name |
+| `@ccver@`   | C compiler version |
+| `@bsystem@` | `meson <version>` |
+| `@tomlfvar@` | `true` / `false` |
+| `@gfn0var@` | `true` / `false` |
+| `@gfnffvar@` | `true` / `false` |
+| `@tblitevar@` | `true` / `false` |
+| `@libpvolvar@` | `true` / `false` |
+| `@lwoniomvar@` | `true` / `false` |
+
+---
+
+## Compiler / LAPACK cross-compatibility reference
+
+```
+Fortran compiler │ C compiler │ Recommended LAPACK │ OpenMP runtime
+─────────────────┼────────────┼────────────────────┼───────────────
+gfortran         │ gcc        │ OpenBLAS (default) │ libgomp
+gfortran         │ gcc        │ MKL                │ libgomp + mkl_gnu_thread
+ifort / ifx      │ icc / icx  │ MKL  ← best match │ libiomp5 / libomp
+ifort / ifx      │ gcc        │ MKL                │ libiomp5 (Intel wins link)
+ifort / ifx      │ icc / icx  │ OpenBLAS (seq.)    │ libiomp5
+```
+
+**Rule of thumb:** the compiler that drives the *final link step* owns the
+OpenMP runtime.  With mixed toolchains, the Fortran compiler always drives the
+link step here (crest is a Fortran-primary project), so use the LAPACK
+threading layer that matches the *Fortran* compiler.
diff --git a/CMakeLists.txt b/CMakeLists.txt
index 72d773cc..62064ebd 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -26,11 +26,15 @@ endif()
 # Setup the crest Project
 project(
   crest
-  LANGUAGES "C" "Fortran"
-  VERSION  3.0.2
+  LANGUAGES "C" "CXX" "Fortran"
+  VERSION  3.1.0
   DESCRIPTION "A tool for the exploration of low-energy chemical space"
 )
 
+# Apply debug flags when building in Debug mode
+set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} \
+    -g -O0 -fcheck=all -fbacktrace -finit-real=snan -finit-integer=-999")
+
 # Follow GNU conventions for installing directories
 include(GNUInstallDirs)
 
@@ -60,21 +64,34 @@ if(NOT TARGET "OpenMP::OpenMP_Fortran" AND WITH_OpenMP)
   message(STATUS "OpenMP::OpenMP_Fortran is linking the following libraries:")
   foreach(lib ${OpenMP_Fortran_LIBRARIES})
     message(STATUS "${lib}")
-  endforeach() 
+  endforeach()
+endif()
+# Propagate OpenMP link flags globally so subproject executables (e.g. pvol tests)
+# that bypass CMake target dependencies still link the OpenMP runtime correctly.
+if(WITH_OpenMP AND OpenMP_Fortran_FOUND)
+  set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${OpenMP_Fortran_FLAGS}")
 endif()
 
 # Check if we are using OpenBLAS (need a precompiler definition if yes)
-if(LAPACK_LIBRARIES)
-  string(FIND "${LAPACK_LIBRARIES}" "openblas" _openblas_in_lapack)
+# Match "libopenblas" specifically to avoid false positives from conda env
+# path names that contain "openblas" (e.g. crest-gnu-openblas/lib/libgomp.so).
+if(LAPACK_LIBRARIES OR BLAS_LIBRARIES)
+  set(_all_blas_libs "${LAPACK_LIBRARIES};${BLAS_LIBRARIES}")
+  string(FIND "${_all_blas_libs}" "libopenblas" _openblas_in_lapack)
 
   if(NOT _openblas_in_lapack EQUAL -1)
-    message(STATUS "libopenblas was found as part of LAPACK")
+    message(STATUS "libopenblas was found as part of LAPACK/BLAS")
     add_compile_definitions(WITH_OPENBLAS)
   endif()
 endif()
 
-# Fortran unit test interface (also used by other subprojects)
-if(NOT TARGET "test-drive::test-drive" AND WITH_TESTS)
+# Fortran unit test interface.  Imported unconditionally (not gated on
+# WITH_TESTS): several subprojects build their test suites without a guard and
+# pull in test-drive themselves.  By resolving the bundled subprojects/test-drive
+# here first, the `test-drive::test-drive` target already exists when those
+# subprojects look for it, so they reuse the local copy instead of falling back
+# to fetching/downloading it.
+if(NOT TARGET "test-drive::test-drive")
    find_package("test-drive" REQUIRED)
 endif()
 
@@ -86,8 +103,25 @@ endif()
 
 # tblite
 if(NOT TARGET "tblite::tblite" AND WITH_TBLITE)
-   find_package("tblite" REQUIRED)
+   find_package("mctc-lib"    REQUIRED)
+   find_package("mstore"      REQUIRED)
+   find_package("multicharge" REQUIRED)
+   find_package("dftd4"       REQUIRED)
+   find_package("s-dftd3"     REQUIRED)
+   find_package("ddx"         REQUIRED)
+   find_package("tblite"      REQUIRED)
    add_compile_definitions(WITH_TBLITE)
+   # ddX is a hard requirement of this block, so its modules are available to
+   # crest sources here; WITH_DDX guards the standalone solvation components.
+   add_compile_definitions(WITH_DDX)
+endif()
+
+# g-xTB via tblite
+if(WITH_GXTB)
+   if(NOT WITH_TBLITE)
+      message(FATAL_ERROR "WITH_GXTB requires WITH_TBLITE to be enabled")
+   endif()
+   add_compile_definitions(WITH_GXTB)
 endif()
 
 # GFN-FF
@@ -114,6 +148,11 @@ if(NOT TARGET "lwoniom::lwoniom" AND WITH_LWONIOM)
    add_compile_definitions(WITH_LWONIOM)
 endif()
 
+if(NOT TARGET "fmlip_relay:fmlip_relay" AND WITH_FMLIP_RELAY)
+  find_package("fmlip_relay" REQUIRED)
+  add_compile_definitions(WITH_FMLIP_RELAY)
+endif()
+
 # Sources: initialize program sources (prog) and library sources (srcs) empty
 set(prog)
 set(srcs)
@@ -153,6 +192,7 @@ if(WITH_OBJECT AND NOT STATICBUILD)
       $<$<BOOL:${WITH_LIBPVOL}>:pvol::pvol>
       $<$<BOOL:${WITH_TOMLF}>:toml-f::toml-f>
       $<$<BOOL:${WITH_LWONIOM}>:lwoniom::lwoniom>
+      $<$<BOOL:${WITH_FMLIP_RELAY}>:fmlip_relay::fmlip_relay> 
       $<$<BOOL:${WITH_OpenMP}>:OpenMP::OpenMP_Fortran>
    )
 
@@ -204,6 +244,7 @@ target_link_libraries(
    $<$<BOOL:${WITH_LIBPVOL}>:pvol::pvol>
    $<$<BOOL:${WITH_TOMLF}>:toml-f::toml-f>
    $<$<BOOL:${WITH_LWONIOM}>:lwoniom::lwoniom>
+   $<$<BOOL:${WITH_FMLIP_RELAY}>:fmlip_relay::fmlip_relay> 
    $<$<BOOL:${STATICBUILD}>:-static>
 )
 
@@ -249,6 +290,7 @@ if (WITH_OBJECT AND NOT STATICBUILD)
       $<$<BOOL:${WITH_LIBPVOL}>:pvol::pvol>
       $<$<BOOL:${WITH_TOMLF}>:toml-f::toml-f>
       $<$<BOOL:${WITH_LWONIOM}>:lwoniom::lwoniom>
+      $<$<BOOL:${WITH_FMLIP_RELAY}>:fmlip_relay::fmlip_relay> 
    )
 
    set_target_properties(
diff --git a/README.md b/README.md
index 86b2065c..a42484e5 100644
--- a/README.md
+++ b/README.md
@@ -88,14 +88,17 @@ The conda-forge distribution is based on a *dynamically linked* CMake/GNU build.
 
 ![CI workflow](https://github.com/crest-lab/crest/actions/workflows/build.yml/badge.svg)
 
-Working and tested builds of CREST (mostly on Ubuntu 20.04 LTS):
+Working and tested builds of CREST:
 
-| Build System | Compiler | Linear Algebra Backend | Build type     | Status     | Note |
-|--------------|----------|------------------------|:--------------:|:----------:|:----:|
-| CMake 3.30.2 | GNU (gcc 14.1.0)  | [libopenblas 0.3.27](https://anaconda.org/conda-forge/libopenblas) | dynamic | ✅ ||
-| CMake 3.30.2 | GNU (gcc 12.3.0)  | [libopenblas-dev](https://packages.debian.org/stable/libdevel/libopenblas-dev) | static  | ✅ | [![Download (GNU)](https://img.shields.io/badge/download-GNU_build_binary-green)](https://github.com/crest-lab/crest/releases/download/latest/crest-gnu-12-ubuntu-latest.tar.xz)|
-| CMake 3.28.3 | [Intel (`ifort`/`icc` 2021.9.0)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/toolkits.html)   | [MKL static (oneAPI 2023.1)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/onemkl.html) | dynamic | ⚠️  | OpenMP/MKL problem ([#285](https://github.com/crest-lab/crest/issues/285)) |
-| Meson 1.2.0 | [Intel (`ifort`/`icx` 2023.1.0)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/toolkits.html)   | [MKL static (oneAPI 2023.1)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/onemkl.html) | static  | ✅ | [![Download (ifort)](https://img.shields.io/badge/download-ifort_build_binary-blue.svg)](https://github.com/crest-lab/crest/releases/download/latest/crest-intel-2023.1.0-ubuntu-latest.tar.xz) |
+| Build System | Compiler | Linear Algebra Backend | Build type | Note |
+|--------------|----------|------------------------|:----------:|:----:|
+| CMake 3.31.6 | GNU (gcc 14.3.0, conda-forge) | [libopenblas 0.3.31](https://anaconda.org/conda-forge/libopenblas) (conda-forge) | dynamic | [![Download (GNU)](https://img.shields.io/badge/download-GNU_build_binary-green)](https://github.com/crest-lab/crest/releases/download/latest/crest-gnu-12-ubuntu-latest.tar.xz) |
+| CMake 3.31.6 | GNU (gcc 14.3.0, conda-forge) | [libopenblas 0.3.31](https://anaconda.org/conda-forge/libopenblas) (conda-forge) | static |  |
+| CMake 3.31.6 | [Intel (`ifx`/`icx` 2025.3)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/toolkits.html) | [MKL (oneAPI 2025.3)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/onemkl.html) | static | |
+| Meson 1.10.1 | GNU (gcc 14.3.0, conda-forge) | [libopenblas 0.3.31](https://anaconda.org/conda-forge/libopenblas) (conda-forge) | dynamic | |
+| Meson 1.10.1 | GNU (gcc 14.3.0, conda-forge) | [libopenblas 0.3.31](https://anaconda.org/conda-forge/libopenblas) (conda-forge) | static | |
+| Meson 1.10.1 | [Intel (`ifx`/`icx` 2025.3)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/toolkits.html) | [MKL (oneAPI 2025.3)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/onemkl.html) | dynamic | |
+| Meson 1.10.1 | [Intel (`ifx`/`icx` 2025.3)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/toolkits.html) | [MKL (oneAPI 2025.3)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/onemkl.html) | static | [![Download (ifx)](https://img.shields.io/badge/download-ifort_build_binary-blue.svg)](https://github.com/crest-lab/crest/releases/download/latest/crest-intel-2023.1.0-ubuntu-latest.tar.xz) |
 
 
 Generally, subprojects should be initialized for the *default* build options, which can be done by 
@@ -107,8 +110,8 @@ For more information about builds including subprojects see [here](./subprojects
 
 Some basic build instructions can be found in the following dropdown tabs:
 
-
-
+<table>
+<tr><td>
 <details open>
 <summary><h4><code>CMake</code> build</h4></summary>
 <!-- blank line to recover markdown format-->
@@ -126,29 +129,34 @@ make -C _build
 ```bash
 make test -C _build
 ```
-The `CMake` build typically requires access to shared libraries of LAPACK and OpenMP. They must be present in the library paths at compile and runtime.
-Alternatively, a static build can be selected by using `-DSTATICBUILD=true` in the CMake setup step. The current static build with GNU compilers is available from the [**continous release page**](https://github.com/crest-lab/crest/releases/tag/latest). 
+The `CMake` build requires shared libraries of LAPACK/BLAS (e.g. OpenBLAS) and OpenMP at compile and runtime.
+Alternatively, a static build can be selected by using `-DSTATICBUILD=true` in the CMake setup step. The current static build with GNU compilers is available from the [**continous release page**](https://github.com/crest-lab/crest/releases/tag/latest).
 </details>
-
+</td></tr>
+<tr><td>
 <details>
 <summary><h4><code>meson</code> build</h4></summary>
 <!-- blank line to recover markdown format-->
 
-For the setup an configuration of meson see also the [meson setup](https://github.com/grimme-lab/xtb/blob/master/meson/README.adoc) page hosted at the `xtb` repository.
-The chain of commands to build CREST with meson is:
+For the setup and configuration of meson see also the [meson setup](https://github.com/grimme-lab/xtb/blob/master/meson/README.adoc) page hosted at the `xtb` repository.
 
+**Intel (`ifx`/`icx`) + MKL** (recommended for static release binaries):
 ```bash
-export FC=ifort CC=icc
-meson setup _build --prefix=$PWD/_dist
+source /opt/intel/oneapi/setvars.sh
+meson setup _build -Dlapack=mkl --prefix=$PWD/_dist
 meson install -C _build
 ```
 
-The `meson` build of CREST is mainly focused on and tested with the Intel `ifort`/`icc` compilers.
-When using newer versions of Intel's oneAPI, replacing `icc` with `icx` should work. Please refrain from using `ifx` instead of `ifort`, however.
-When attempting to build with `gfortran` and `gcc`, add `-Dla_backend=mkl` to the meson setup command. Compatibility with the GNU compilers might be limited. We recommend the CMake build (see the corresponding section) in this instance.
+**GNU (`gfortran`/`gcc`) + OpenBLAS**:
+```bash
+export FC=gfortran CC=gcc
+meson setup _build -Dlapack=openblas --prefix=$PWD/_dist
+meson install -C _build
+```
 
-By default the `meson` build will create a **statically** linked binary.
 </details>
+</td></tr>
+</table>
 
 
 ---
diff --git a/assets/template/metadata.f90 b/assets/template/metadata.f90
index e9254292..3e4a5c0a 100644
--- a/assets/template/metadata.f90
+++ b/assets/template/metadata.f90
@@ -9,5 +9,7 @@
 character(len=*),parameter :: gfn0var = "@gfn0var@"
 character(len=*),parameter :: gfnffvar = "@gfnffvar@"
 character(len=*),parameter :: tblitevar = "@tblitevar@"
+character(len=*),parameter :: ddxvar = "@ddxvar@"
 character(len=*),parameter :: libpvolvar = "@libpvolvar@"
 character(len=*),parameter :: lwoniomvar = "@lwoniomvar@"
+character(len=*),parameter :: fmliprelayvar = "@fmliprelayvar@"
diff --git a/config/CMakeLists.txt b/config/CMakeLists.txt
index 7800906a..9878756f 100644
--- a/config/CMakeLists.txt
+++ b/config/CMakeLists.txt
@@ -31,11 +31,13 @@ install(
 # Options for enabling or disabling features
 option(WITH_OpenMP  "Enable OpenMP support"       TRUE)
 option(WITH_TBLITE  "Enable support for tblite"   TRUE)
+option(WITH_GXTB    "Enable g-xTB via tblite (requires WITH_TBLITE)" FALSE)
 option(WITH_TOMLF   "Enable support for toml-f"   TRUE)
 option(WITH_GFN0    "Enable support for GFN0-xTB" TRUE)
 option(WITH_GFNFF   "Enable support for GFN-FF"   TRUE)
 option(WITH_LIBPVOL "Enable support for LIBPVOL"  TRUE)
 option(WITH_LWONIOM "Enable support for lwONIOM"  TRUE)
+option(WITH_FMLIP_RELAY "Enable fmlip-relay interface"  TRUE) 
 option(WITH_TESTS   "Enable unit tests"           TRUE)
 
 option(STATICBUILD  "Attempt to link everything statically" FALSE) 
@@ -101,8 +103,11 @@ set(tomlfvar "${WITH_TOMLF}")
 set(gfn0var "${WITH_GFN0}")
 set(gfnffvar "${WITH_GFNFF}")
 set(tblitevar "${WITH_TBLITE}")
+# ddX is a hard requirement of the tblite block, so it tracks WITH_TBLITE here
+set(ddxvar "${WITH_TBLITE}")
 set(libpvolvar "${WITH_LIBPVOL}")
 set(lwoniomvar "${WITH_LWONIOM}")
+set(fmliprelayvar "${WITH_FMLIP_RELAY}")
 
 configure_file(
   "${PROJECT_SOURCE_DIR}/assets/template/metadata.f90"
diff --git a/config/gnu.ini b/config/gnu.ini
new file mode 100644
index 00000000..f003b492
--- /dev/null
+++ b/config/gnu.ini
@@ -0,0 +1,16 @@
+# machine file: gnu.ini
+# Usage:  meson setup build --native-file cross/gnu.ini
+#
+# Selects the GNU toolchain explicitly.  Useful when both GCC and Intel
+# compilers are installed and the environment default is not what you want.
+
+[binaries]
+c       = 'gcc'
+fortran = 'gfortran'
+ar      = 'ar'
+strip   = 'strip'
+
+[built-in options]
+# Fortran standard — free-form F2018 is safe for crest
+# (gfortran accepts it without an explicit flag, but being explicit helps)
+fortran_args = ['-std=f2018']
diff --git a/config/intel-classic.ini b/config/intel-classic.ini
new file mode 100644
index 00000000..76da11dc
--- /dev/null
+++ b/config/intel-classic.ini
@@ -0,0 +1,18 @@
+# machine file: intel-classic.ini
+# Usage:  meson setup build --native-file cross/intel-classic.ini
+#
+# Uses the classic Intel compilers (ifort, icc).
+# Note: icc was deprecated in oneAPI 2023 in favour of icx.
+#       For new installations prefer intel-llvm.ini instead.
+# Source the Intel environment first:
+#   source /opt/intel/oneapi/setvars.sh
+
+[binaries]
+c       = 'icc'
+fortran = 'ifort'
+ar      = 'ar'
+strip   = 'strip'
+
+#[built-in options]
+# -warn all is ifort's equivalent of -Wall
+#fortran_args = ['-warn', 'all']
diff --git a/config/intel-fortran-gnu-c.ini b/config/intel-fortran-gnu-c.ini
new file mode 100644
index 00000000..2f79e2c4
--- /dev/null
+++ b/config/intel-fortran-gnu-c.ini
@@ -0,0 +1,25 @@
+# machine file: intel-fortran-gnu-c.ini
+# Usage:  meson setup build --native-file cross/intel-fortran-gnu-c.ini
+#
+# Mixes Intel Fortran (ifx) with GNU C (gcc).
+# This is a common HPC pattern where only the Fortran compiler is licensed
+# as Intel but C utilities default to GCC.
+#
+# IMPORTANT — OpenMP runtime compatibility:
+#   ifx links against Intel's libomp (libiomp5).
+#   gcc links against GNU's libgomp.
+#   The two runtimes must NOT both be loaded in the same process.
+#   Resolution: let ifx drive the final link step so it picks up libomp.
+#   Do NOT pass -fopenmp to gcc translation units; instead use
+#   -Dopenmp=true which the build system applies only to Fortran sources.
+#
+# IMPORTANT — MKL threading layer:
+#   With this mixed toolchain, use mkl_intel_thread (not mkl_gnu_thread)
+#   because the Fortran driver (ifx/ifort) owns the OpenMP runtime.
+#   Set:  -Dlapack=mkl
+
+[binaries]
+c       = 'gcc'
+fortran = 'ifx'
+ar      = 'ar'
+strip   = 'strip'
diff --git a/config/intel-llvm.ini b/config/intel-llvm.ini
new file mode 100644
index 00000000..3865e9bb
--- /dev/null
+++ b/config/intel-llvm.ini
@@ -0,0 +1,15 @@
+# machine file: intel-llvm.ini
+# Usage:  meson setup build --native-file cross/intel-llvm.ini
+#
+# Uses the Intel LLVM-based compilers (ifx, icx) from oneAPI 2023+.
+# Source the Intel environment first:
+#   source /opt/intel/oneapi/setvars.sh
+
+[binaries]
+c       = 'icx'
+fortran = 'ifx'
+ar      = 'ar'
+strip   = 'strip'
+
+#[built-in options]
+#fortran_args = ['-warn', 'all']
diff --git a/config/meson.build b/config/meson.build
index 99616924..45554499 100644
--- a/config/meson.build
+++ b/config/meson.build
@@ -1,299 +1,256 @@
 # This file is part of crest.
 # SPDX-Identifier: LGPL-3.0-or-later
 #
-# crest is free software: you can redistribute it and/or modify it under
-# the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
+# Included from the root meson.build via subdir('config').
+# Runs in the same variable scope as the root — all variables set here
+# are visible in the root after this file returns.
 #
-# crest is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU Lesser General Public License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public License
-# along with crest.  If not, see <https://www.gnu.org/licenses/>.
+# Responsibilities:
+#   - Compiler identification and friendly display names
+#   - Per-compiler build flags (release and debug)
+#   - Static-binary link arguments
+#   - Metadata header generation (crest_metadata.fh)
+#   - inc_dirs (build include path carrying the generated header)
 
+# ═══════════════════════════════════════════════════════════════════════════════
+#  Compiler identification
+# ═══════════════════════════════════════════════════════════════════════════════
 fc = meson.get_compiler('fortran')
 cc = meson.get_compiler('c')
-fc_id = fc.get_id()
+
+fc_id = fc.get_id()   # 'gcc' | 'intel' | 'intel-llvm' | ...
 cc_id = cc.get_id()
 
-if fc.get_id() != cc.get_id()
-  warning('FC and CC are not from the same vendor')
+_fc_name_map = {
+  'gcc'        : 'GNU Fortran',
+  'intel'      : 'Intel Fortran (Classic)',
+  'intel-llvm' : 'Intel Fortran (LLVM/ifx)',
+  'flang'      : 'Flang',
+  'flang-new'  : 'Flang-new',
+}
+_cc_name_map = {
+  'gcc'        : 'GNU C',
+  'intel'      : 'Intel C (Classic)',
+  'intel-llvm' : 'Intel C (LLVM/icx)',
+  'clang'      : 'Clang',
+}
+
+fcid_str = _fc_name_map.get(fc_id, fc_id)
+ccid_str = _cc_name_map.get(cc_id, cc_id)
+
+if fc_id not in ['gcc', 'intel', 'intel-llvm']
+  warning(
+    'Unsupported Fortran compiler "@0@". Proceeding, but results may be wrong.'
+      .format(fc_id),
+  )
 endif
 
-## ========================================= ##
-## Compiler specific default arguments
-## ========================================= ##  
+# ═══════════════════════════════════════════════════════════════════════════════
+#  Compiler flags
+# ═══════════════════════════════════════════════════════════════════════════════
+_is_debug = get_option('buildtype') in ['debug', 'debugoptimized']
+
+# --- GNU (gfortran / gcc) -----------------------------------------------------
 if fc_id == 'gcc'
   add_project_arguments(
     '-ffree-line-length-none',
     '-fbacktrace',
-    '-Wno-maybe-uninitialized',
-    '-Wno-uninitialized',
-    '-Wno-unused-variable',
-    '-Wno-unused-dummy-argument',
-    '-Wno-unused-function',
-    language: 'fortran',
-  )
-elif fc_id == 'intel'
-  add_project_link_arguments(
-    '-Wl,--allow-multiple-definition',
-    language: 'fortran',
+    language : 'fortran',
   )
-  add_global_link_arguments(
-    '-Wl,--allow-multiple-definition',
-    language: 'fortran',
-  )
-  add_project_arguments(
-    '-traceback',
-    language: 'fortran',
-  )
-  add_project_arguments(
-    '-DLINUX',
-    language: 'c',
-  )
-elif fc_id == 'pgi' or fc_id == 'nvidia_hpc'
+  if _is_debug
+    add_project_arguments(
+      '-fcheck=all',
+      '-ffpe-trap=invalid,zero,overflow',
+      '-fbounds-check',
+      '-finit-real=snan',
+      '-finit-integer=-999',
+      '-Wall',
+      '-Wextra',
+      language : 'fortran',
+    )
+  endif
+endif
+
+# --- Intel classic (ifort / icc) -----------------------------------------------
+if fc_id == 'intel'
   add_project_arguments(
-    '-Mbackslash',
-    '-Mallocatable=03',
+    '-r8',                    # treat all REAL as REAL(8)
+    '-align', 'array64byte',
     '-traceback',
-    language: 'fortran',
+    language : 'fortran',
   )
-elif fc_id == 'flang'
-  add_project_arguments(
-    '-Mbackslash',
-    '-Mallocatable=03',
-    language: 'fortran',
-  )
-endif
-
-add_project_arguments('-D_Float128=__float128', language: 'c')
-
-
-## ========================================= ##
-## build type option arguments
-## ========================================= ## 
-if ( get_option('default_library') == 'static')
-  message('Static linking selected')
-  add_project_link_arguments('-static', language: 'fortran')
-  add_project_link_arguments('-static', language: 'c') # icc will do linking
-endif
-
-
-## ========================================= ##
-## OpenMP
-## ========================================= ##
-if get_option('openmp')
-  omp_dep = dependency('openmp', required: fc.get_id() != 'intel')
-  if not omp_dep.found()
-    omp_dep = declare_dependency(
-      compile_args: '-qopenmp',
-      link_args: '-fopenmp',
+  if _is_debug
+    add_project_arguments(
+      '-check', 'all',
+      '-fpe0',
+      language : 'fortran',
     )
   endif
-  exe_deps += omp_dep
 endif
 
-## ======================================== ##
-## Linear Algebra Libraries
-## ======================================== ##
-la_backend = get_option('la_backend')
-message('Linear algebra backend: '+get_option('la_backend'))
-if la_backend == 'mkl' or la_backend == 'mkl-static'
-  add_project_arguments('-DWITH_MKL', language: 'fortran')
-  if la_backend == 'mkl-static'
-    add_project_link_arguments('-static', language: 'fortran')
-    add_project_link_arguments('-static', language: 'c') # icc will do linking
-  endif
-
-  if get_option('default_library') == 'shared'
-    mkl_rt_dep = cc.find_library('mkl_rt', required: true)
-    exe_deps += mkl_rt_dep
-  else
-    if fc.get_id() == 'gcc'
-      libmkl_exe = [cc.find_library('mkl_gf_lp64')]
-      if get_option('openmp')
-        libmkl_exe += cc.find_library('mkl_gnu_thread')
-      endif
-    elif fc.get_id() == 'intel' or fc.get_id() == 'intel-cl'
-      libmkl_exe = [cc.find_library('mkl_intel_lp64')]
-      if get_option('openmp')
-        libmkl_exe += cc.find_library('mkl_intel_thread')
-      endif
-    elif fc.get_id() == 'pgi' or fc.get_id() == 'nvidia_hpc'
-      libmkl_exe = [cc.find_library('mkl_intel_lp64')]
-      if get_option('openmp')
-        libmkl_exe += cc.find_library('mkl_pgi_thread')
-      endif
-    endif
-    if not get_option('openmp')
-      libmkl_exe += cc.find_library('mkl_sequential')
-    endif
-    libmkl_exe += cc.find_library('mkl_core')
-    exe_deps += libmkl_exe
-  endif
-
-elif la_backend == 'mkl-rt'
-  add_project_arguments('-DWITH_MKL', language: 'fortran')
-
-  mkl_rt_dep = fc.find_library('mkl_rt', required: true)
-  if fc.get_id() == 'intel'
-    exe_deps += fc.find_library('ifcore')
-  endif
-
-  exe_deps += mkl_rt_dep
-
-elif la_backend == 'openblas'
-  # search for OpenBLAS
-  blas_dep = dependency('openblas', required: false)
-  if not blas_dep.found()
-    blas_dep = fc.find_library('openblas', required: true)
-  endif
-  exe_deps += blas_dep
-  # some OpenBLAS versions can provide lapack, check if we can find dsygvd
-  openblas_provides_lapack = fc.links(
-    'external dsygvd; call dsygvd(); end',
-    dependencies: blas_dep,
+# --- Intel LLVM (ifx / icx) ----------------------------------------------------
+if fc_id == 'intel-llvm'
+  add_project_arguments(
+    '-r8',
+    '-align', 'array64byte',
+    language : 'fortran',
   )
-  # otherwise we fall back to LAPACK
-  if not openblas_provides_lapack
-    lapack_dep = dependency('lapack', required: false)
-    if not lapack_dep.found()
-      lapack_dep = fc.find_library('lapack', required: true)
-    endif
-    exe_deps += lapack_dep
+  if _is_debug
+    add_project_arguments(
+      '-traceback',
+      '-check', 'all',
+      '-fpe0',
+      language : 'fortran',
+    )
   endif
+endif
 
-elif la_backend == 'custom'
-  foreach lib: get_option('custom_libraries')
-    exe_deps += fc.find_library(lib)
-  endforeach
+static_build = get_option('static')
 
-else
-  # Find BLAS (usually netlib, but in conda also OpenBLAS/MKL)
-  blas_dep = dependency('blas', required: false)
-  if not blas_dep.found()
-    blas_dep = fc.find_library('blas', required: true)
-  endif
-  exe_deps += blas_dep
-  # Find LAPACK (usually netlib, but in conda also MKL)
-  lapack_dep = dependency('lapack', required: false)
-  if not lapack_dep.found()
-    lapack_dep = fc.find_library('lapack', required: true)
+# Static subproject linking: selects static archives for subproject deps
+# (tblite, gfn0, toml-f, …) without the fully-static `-static` syslib linking.
+# A fully static build (-Dstatic) implies it.
+link_deps_static = static_build or get_option('static-deps')
+
+if fc_id == 'intel-llvm'
+  ## -lifport  : POSIX intrinsics (getcwd, chdir, …) not auto-linked by ifx.
+  ##             In static builds -static-intel already bundles libifport.a, so
+  ##             adding a bare -lifport here would cause the linker to resolve it
+  ##             to the shared library (before -static-intel takes effect).
+  ## libgcc_s  : was previously added to supply _Unwind_* symbols for libifcore's
+  ##             signal handler. No longer needed since signal registration was
+  ##             moved to crest_install_signal() via ISO_C_BINDING, bypassing
+  ##             libifcore's handler entirely.
+  _libgcc_s = run_command('gcc', '-print-file-name=libgcc_s.so',
+                           check : false).stdout().strip()
+  _gcc_s_link = (_libgcc_s != 'libgcc_s.so') ? [_libgcc_s] : []
+  if _gcc_s_link.length() == 0
+    warning('intel-llvm: libgcc_s.so not found — _Unwind_* symbols will be NULL, ' +
+            'Intel Fortran runtime will SIGSEGV at startup.')
   endif
-  exe_deps += lapack_dep
+  # For static builds libgcc_s.so is not needed (signal handler uses ISO_C_BINDING
+  # and no longer goes through libifcore's _Unwind_* path), and adding an explicit
+  # .so path would defeat -static.  Only add it for dynamic builds.
+  _lifport_arg = static_build ? [] : ['-lifport']
+  _gcc_s_arg   = static_build ? [] : _gcc_s_link
+  add_project_link_arguments(_lifport_arg + _gcc_s_arg, language : 'fortran')
 endif
 
+# ═══════════════════════════════════════════════════════════════════════════════
+#  Static-binary link arguments
+# ═══════════════════════════════════════════════════════════════════════════════
+# Injected globally so they propagate to every link step (library + executable).
+# See BUILD.md for notes on required system .a archives.
 
-## ========================================= ##
-## External subprojects
-## ========================================= ##  
+if static_build
+  if fc_id == 'gcc'
+    # Full static: bundles glibc, libgfortran, libgomp, libopenblas/lapack.
+    # Requires libgfortran-static and glibc-static system packages.
+    add_project_link_arguments('-static', language : 'fortran')
+    add_project_link_arguments('-static', language : 'c')
 
-# GFN1-xTB and GFN2-xTB via TBLITE
-if get_option('WITH_TBLITE')
- add_project_arguments('-DWITH_TBLITE', language: 'fortran')
- tblite_dep = dependency(
-   'tblite',
-   version: '>=0.2',
-   fallback: ['tblite', 'tblite_dep'],
-   default_options: ['default_library=static', 'api=false'],
- )
- exe_deps += tblite_dep
-endif
+  elif fc_id == 'intel'
+    # -static-intel  : statically links Intel runtime (ifcore, imf, svml)
+    # -qopenmp-link=static : statically links Intel OpenMP (libiomp5)
+    # -static        : forces all -l flags (including MKL) to resolve to .a
+    add_project_link_arguments(
+      '-static-intel',
+      '-qopenmp-link=static',
+      '-static',
+      language : 'fortran',
+    )
 
-# TOML-F
-if get_option('WITH_TOMLF')
- add_project_arguments('-DWITH_TOMLF', language: 'fortran')
- tomlf_dep = dependency(
-   'toml-f',
-   version: '>=0.2.0',
-   fallback: ['toml-f', 'tomlf_dep'],
-   default_options: ['default_library=static'],
- )
- exe_deps += tomlf_dep
+  elif fc_id == 'intel-llvm'
+    # -static only: with LIBRARY_PATH including the Intel compiler lib dir,
+    # the linker finds libifcore.a/libimf.a/libiomp5.a directly.
+    # -static-intel + -qopenmp-link=static are NOT used because combined with
+    # -fopenmp link args from non-Intel subprojects they cause libifcore.a vs
+    # libifcoremt.a duplicate-symbol errors (ifx 2025.3).  Allow-multiple-
+    # definition suppresses the remaining conflict (same pattern as ifort above).
+    add_project_link_arguments(
+      '-static',
+      '-Wl,--allow-multiple-definition',
+      language : 'fortran',
+    )
+  endif
 endif
 
-# GFN0-xTB
-if get_option('WITH_GFN0')
- add_project_arguments('-DWITH_GFN0', language: 'fortran')
- gfn0_dep = dependency(
-   'gfn0',
-#   version: '>=0.2',
-   fallback: ['gfn0', 'gfn0_dep'],
-   default_options: ['default_library=static','with_gbsa=true'],
- )
- exe_deps += gfn0_dep
+# ═══════════════════════════════════════════════════════════════════════════════
+#  Metadata: fill assets/template/metadata.f90 → <builddir>/crest_metadata.fh
+# ═══════════════════════════════════════════════════════════════════════════════
+_git = find_program('git', required : false)
+_commit = 'unknown-commit'
+if _git.found()
+  _r = run_command(_git, 'show', '-s', '--format=%h', check : false)
+  if _r.returncode() == 0
+    _commit = _r.stdout().strip()
+  endif
 endif
 
-# GFN-FF
-if get_option('WITH_GFNFF')
- add_project_arguments('-DWITH_GFNFF', language: 'fortran')
- gfnff_dep = dependency(
-   'gfnff',
-   fallback: ['gfnff', 'gfnff_dep'],
-   default_options: ['default_library=static','with_gbsa=true'],
- )
- exe_deps += gfnff_dep
+_py = find_program('python3', 'python', required : false)
+_date = 'unknown-date'
+if _py.found()
+  _r = run_command(
+    _py, '-c',
+    'import datetime; print(datetime.datetime.now().strftime("%a, %d %B %H:%M:%S, %m/%d/%Y"))',
+    check : false,
+  )
+  if _r.returncode() == 0
+    _date = _r.stdout().strip()
+  endif
 endif
 
-
-# LIBPVOL
-if get_option('WITH_LIBPVOL')
- add_project_arguments('-DWITH_LIBPVOL', language: 'fortran')
- libpvol_dep = dependency(
-   'libpvol',
-   fallback: ['libpvol', 'libpvol_dep'],
-   default_options: ['default_library=static'],
- )
- exe_deps += libpvol_dep
+_hostname = 'unknown-host'
+_hostname_prog = find_program('hostname', required : false)
+if _hostname_prog.found()
+  _r = run_command(_hostname_prog, check : false)
+  if _r.returncode() == 0
+    _hostname = _r.stdout().strip()
+  endif
 endif
 
-
-# lwONIOM
-if get_option('WITH_LWONIOM')
- add_project_arguments('-DWITH_LWONIOM', language: 'fortran')
- lwoniom_dep = dependency(
-   'lwoniom',
-   fallback: ['lwoniom', 'lwoniom_dep'],
-   default_options: ['default_library=static'],
- )
- exe_deps += lwoniom_dep
+_sh = find_program('sh', required : false)
+_user = 'unknown'
+if _sh.found()
+  _r = run_command(
+    _sh, '-c', 'printf "%s" "${USER:-${USERNAME:-unknown}}"',
+    check : false,
+  )
+  if _r.returncode() == 0 and _r.stdout().strip() != ''
+    _user = _r.stdout().strip()
+  endif
 endif
 
+_conf = configuration_data()
+_conf.set('version',    meson.project_version())
+_conf.set('commit',     _commit)
+_conf.set('date',       _date)
+_conf.set('author',     _user)
+_conf.set('origin',     _hostname)
+_conf.set('fcid',       fcid_str)
+_conf.set('fcver',      fc.version())
+_conf.set('ccid',       ccid_str)
+_conf.set('ccver',      cc.version())
+_conf.set('bsystem',    'meson ' + meson.version())
+# The with_* booleans are set in the root after optional deps are resolved;
+# use string placeholders here and let the root patch them in if needed.
+# In practice configure_file runs at configure-time so these are all known
+# by the time the root calls subdir('config') — see note below.
+#
+# NOTE: the with_* variables (with_tomlf, with_tblite, …) are set in the root
+# meson.build AFTER this file runs, so they are not yet available here.
+# The root therefore calls configure_file() itself using this _conf object
+# after appending the feature flags.  We expose _conf so the root can do that.
+_conf.set('tomlfvar',   'false')
+_conf.set('gfn0var',    'false')
+_conf.set('gfnffvar',   'false')
+_conf.set('tblitevar',  'false')
+_conf.set('libpvolvar', 'false')
+_conf.set('lwoniomvar', 'false')
+_conf.set('fmliprelayvar', 'false')
 
-## ========================================= ##
-## populate the data for crest_metadata.fh
-## ========================================= ##  
-commit = 'unknown commit'
-git = find_program('git', required: false)
-if git.found()
-  git_commit = run_command(git, 'show', '-s', '--format=%h',check:true)
-  if git_commit.returncode() == 0
-    commit = git_commit.stdout().strip()
-  endif
-endif
-# create configuration data
-config = configuration_data({
-  'name': meson.project_name(),
-  'version': meson.project_version(),
-  'description': 'Conformer Rotamer Ensemble Sampling Tool',
-  'commit': commit,
-  'date': run_command('date',check:true).stdout().     strip(),
-  'author': run_command('id','-u','-n', check:true).stdout().strip(),
-  'origin': run_command('hostname', check:true).stdout().strip(),
-  'fcid': fc.get_id(),
-  'fcver': fc.version(),
-  'ccid': cc.get_id(),
-  'ccver': cc.version(),
-  'bsystem': 'meson '+meson.version(),
-  'tomlfvar': get_option('WITH_TOMLF'),
-  'gfn0var': get_option('WITH_GFN0'),
-  'gfnffvar': get_option('WITH_GFNFF'), 
-  'tblitevar': get_option('WITH_TBLITE'),
-  'libpvolvar': get_option('WITH_LIBPVOL'),
-  'lwoniomvar': get_option('WITH_LWONIOM'),
-})
+# Expose _conf to the root so it can set the with_* keys and then call
+# configure_file().  The root owns the final configure_file() call.
+metadata_conf = _conf
 
 
diff --git a/config/modules/Findddx.cmake b/config/modules/Findddx.cmake
new file mode 100644
index 00000000..e5d06b3c
--- /dev/null
+++ b/config/modules/Findddx.cmake
@@ -0,0 +1,44 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+#
+# crest is free software: you can redistribute it and/or modify it under
+# the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# crest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with crest.  If not, see <https://www.gnu.org/licenses/>.
+
+set(_lib "ddx")
+set(_pkg "DDX")
+set(_url "https://github.com/ddsolvation/ddX")
+set(_branch "4d79e3d9caeae5e602683572a71cb550414f9b09")
+
+if(NOT DEFINED "${_pkg}_FIND_METHOD")
+  set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf")
+endif()
+
+include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
+
+# ddX builds its examples, tests and driver by default; only the library is
+# needed here.  The options are forced off for the subproject build.
+set(EXAMPLES OFF CACHE BOOL "Disable ddx examples" FORCE)
+set(TESTS OFF CACHE BOOL "Disable ddx tests" FORCE)
+set(WARNING_FLAGS OFF CACHE BOOL "Disable ddx warning flags" FORCE)
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
+
+set(found FALSE)
+if(TARGET "ddx::ddx")
+  set (found TRUE)
+endif()
+message(STATUS "Found ddx: ${found}")
+
+unset(_lib)
+unset(_pkg)
+unset(_url)
+unset(_branch)
diff --git a/config/modules/Finddftd4.cmake b/config/modules/Finddftd4.cmake
new file mode 100644
index 00000000..6e8e58c0
--- /dev/null
+++ b/config/modules/Finddftd4.cmake
@@ -0,0 +1,43 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+#
+# crest is free software: you can redistribute it and/or modify it under
+# the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# crest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with crest.  If not, see <https://www.gnu.org/licenses/>.
+
+set(_lib "dftd4")
+set(_pkg "DFTD4")
+set(_url "https://github.com/dftd4/dftd4")
+set(_branch "6e1f59c3f39d919a2dbef0601d2576727c8b30e8")
+
+if(NOT DEFINED "${_pkg}_FIND_METHOD")
+  set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf")
+endif()
+
+include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
+
+set(temp_with_tests ${WITH_TESTS}) # Save the current value of WITH_TESTS
+set(WITH_TESTS FALSE CACHE BOOL "Temporarily disable tests for the dftd4 subproject" FORCE)
+set(WITH_API FALSE)
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
+
+set(found FALSE)
+if(TARGET "dftd4::dftd4")
+  set (found TRUE)
+endif()
+message(STATUS "Found dftd4: ${found}")
+
+set(WITH_TESTS ${temp_with_tests} CACHE BOOL "Enable tests for the main project" FORCE)
+
+unset(_lib)
+unset(_pkg)
+unset(_url)
diff --git a/config/modules/Findfmlip_relay.cmake b/config/modules/Findfmlip_relay.cmake
new file mode 100644
index 00000000..384832b4
--- /dev/null
+++ b/config/modules/Findfmlip_relay.cmake
@@ -0,0 +1,26 @@
+set(_lib "fmlip_relay")
+set(_pkg "FMLIP_RELAY")
+set(_url "https://github.com/pprcht/fmlip-relay")
+set(_branch "06608dea8b7deb53f4a25630f6dcb8be0cdc6e76")
+
+# Discovery method order can be overridden by the parent project, e.g.:
+#   set(FMLIP_RELAY_FIND_METHOD "subproject" "cmake")
+if(NOT DEFINED "${_pkg}_FIND_METHOD")
+  set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf")
+endif()
+
+# Reuse whichever utils macro your main project already provides.
+# Replace "crest-utils" with the actual name if yours differs.
+include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
+
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
+
+set(found FALSE)
+if(TARGET "fmlip_relay::fmlip_relay")
+  set(found TRUE)
+endif()
+message(STATUS "Found fmlip_relay: ${found}")
+
+unset(_lib)
+unset(_pkg)
+unset(_url)
diff --git a/config/modules/Findgfn0.cmake b/config/modules/Findgfn0.cmake
index a44f8c8d..af60fe62 100644
--- a/config/modules/Findgfn0.cmake
+++ b/config/modules/Findgfn0.cmake
@@ -17,6 +17,7 @@
 set(_lib "gfn0")
 set(_pkg "GFN0")
 set(_url "https://github.com/pprcht/gfn0")
+set(_branch "4fbf39bf6790eaef74e06fbb49b98f676db66a2b")
 
 if(NOT DEFINED "${_pkg}_FIND_METHOD")
   set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf")
@@ -24,7 +25,7 @@ endif()
 
 include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
 
-crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}")
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
 
 set (found FALSE)
 if(TARGET "gfn0::gfn0")
diff --git a/config/modules/Findgfnff.cmake b/config/modules/Findgfnff.cmake
index faf16024..7bc54ed2 100644
--- a/config/modules/Findgfnff.cmake
+++ b/config/modules/Findgfnff.cmake
@@ -17,6 +17,7 @@
 set(_lib "gfnff")
 set(_pkg "GFNFF")
 set(_url "https://github.com/pprcht/gfnff")
+set(_branch "b846775c42526a769242be5607d0cde6983764d1")
 
 if(NOT DEFINED "${_pkg}_FIND_METHOD")
   set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf") 
@@ -24,7 +25,7 @@ endif()
 
 include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
 
-crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}")
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
 
 set(found FALSE)
 if(TARGET "gfnff::gfnff")
diff --git a/config/modules/Findlibpvol.cmake b/config/modules/Findlibpvol.cmake
index 2e756b9e..407a55f9 100644
--- a/config/modules/Findlibpvol.cmake
+++ b/config/modules/Findlibpvol.cmake
@@ -16,7 +16,8 @@
 
 set(_lib "pvol")
 set(_pkg "PVOL")
-set(_url "https://github.com/neudecker-group/libpvol.git")
+set(_url "https://github.com/pprcht/libpvol.git")
+set(_branch "010bddaa8766a03e023a977aeebaa6454629c947")
 
 if(NOT DEFINED "${_pkg}_FIND_METHOD")
   set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf" )
@@ -24,7 +25,7 @@ endif()
 
 include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
 
-crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}")
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
 
 set(found FALSE)
 if(TARGET "pvol::pvol")
diff --git a/config/modules/Findlwoniom.cmake b/config/modules/Findlwoniom.cmake
index 1f825b13..de073c21 100644
--- a/config/modules/Findlwoniom.cmake
+++ b/config/modules/Findlwoniom.cmake
@@ -17,6 +17,7 @@
 set(_lib "lwoniom")
 set(_pkg "LWONIOM")
 set(_url "https://github.com/crest-lab/lwoniom")
+set(_branch "ab66c7ebc3066328a8fc313dc783aec9b773cad2")
 
 if(NOT DEFINED "${_pkg}_FIND_METHOD")
   set("${_pkg}_FIND_METHOD"  "subproject" "cmake" "fetch" "pkgconf")
@@ -24,7 +25,7 @@ endif()
 
 include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
 
-crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}")
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
 
 set(found FALSE)
 if(TARGET "lwoniom::lwoniom")
diff --git a/config/modules/Findmctc-lib.cmake b/config/modules/Findmctc-lib.cmake
index 1ba16d81..4d704175 100644
--- a/config/modules/Findmctc-lib.cmake
+++ b/config/modules/Findmctc-lib.cmake
@@ -1,47 +1,26 @@
-# This file is part of crest.
-# SPDX-Identifier: LGPL-3.0-or-later
-#
-# crest is free software: you can redistribute it and/or modify it under
-# the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-#
-# crest is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU Lesser General Public License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public License
-# along with crest.  If not, see <https://www.gnu.org/licenses/>.
-
 set(_lib "mctc-lib")
 set(_pkg "MCTCLIB")
 set(_url "https://github.com/grimme-lab/mctc-lib")
+set(_branch "8cd0cb4489537fd28bfb2e8094f1647f3e0da284")
 
+# Discovery method order can be overridden by the parent project, e.g.:
+#   set(mctc-lib_FIND_METHOD "subproject" "cmake")
 if(NOT DEFINED "${_pkg}_FIND_METHOD")
-  if(DEFINED "${PROJECT_NAME}-dependency-method")
-    set("${_pkg}_FIND_METHOD" "${${PROJECT_NAME}-dependency-method}")
-  else()
-    set("${_pkg}_FIND_METHOD" "cmake" "pkgconf" "subproject" "fetch")
-  endif()
-  set("_${_pkg}_FIND_METHOD")
+  set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf")
 endif()
 
+# Reuse whichever utils macro your main project already provides.
+# Replace "crest-utils" with the actual name if yours differs.
 include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
 
-crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}")
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
 
+set(found FALSE)
 if(TARGET "mctc-lib::mctc-lib")
-  set (found TRUE)
-else()
-  set (found FALSE)
+  set(found TRUE)
 endif()
-message("-- Found mctc-lib: ${found}")
+message(STATUS "Found mctc-lib: ${found}")
 
-if(DEFINED "_${_pkg}_FIND_METHOD")
-  unset("${_pkg}_FIND_METHOD")
-  unset("_${_pkg}_FIND_METHOD")
-endif()
 unset(_lib)
 unset(_pkg)
 unset(_url)
diff --git a/config/modules/Findmstore.cmake b/config/modules/Findmstore.cmake
new file mode 100644
index 00000000..e857fe9e
--- /dev/null
+++ b/config/modules/Findmstore.cmake
@@ -0,0 +1,26 @@
+set(_lib "mstore")
+set(_pkg "MSTORE")
+set(_url "https://github.com/grimme-lab/mstore")
+set(_branch "10a3437b3634dd4464557580ae36c1ed72535f6c")
+
+# Discovery method order can be overridden by the parent project, e.g.:
+#   set(mstore_FIND_METHOD "subproject" "cmake")
+if(NOT DEFINED "${_pkg}_FIND_METHOD")
+  set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf")
+endif()
+
+# Reuse whichever utils macro your main project already provides.
+# Replace "crest-utils" with the actual name if yours differs.
+include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
+
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
+
+set(found FALSE)
+if(TARGET "mstore::mstore")
+  set(found TRUE)
+endif()
+message(STATUS "Found mstore: ${found}")
+
+unset(_lib)
+unset(_pkg)
+unset(_url)
diff --git a/config/modules/Findmulticharge.cmake b/config/modules/Findmulticharge.cmake
new file mode 100644
index 00000000..45b4348c
--- /dev/null
+++ b/config/modules/Findmulticharge.cmake
@@ -0,0 +1,26 @@
+set(_lib "multicharge")
+set(_pkg "MULTICHARGE")
+set(_url "https://github.com/grimme-lab/multicharge")
+set(_branch "6a5d63f9e9e29dcf13cc47cc27f33bf9015681bf")
+
+# Discovery method order can be overridden by the parent project, e.g.:
+#   set(multicharge_FIND_METHOD "subproject" "cmake")
+if(NOT DEFINED "${_pkg}_FIND_METHOD")
+  set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf")
+endif()
+
+# Reuse whichever utils macro your main project already provides.
+# Replace "crest-utils" with the actual name if yours differs.
+include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
+
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
+
+set(found FALSE)
+if(TARGET "multicharge::multicharge")
+  set(found TRUE)
+endif()
+message(STATUS "Found multicharge: ${found}")
+
+unset(_lib)
+unset(_pkg)
+unset(_url)
diff --git a/config/modules/Finds-dftd3.cmake b/config/modules/Finds-dftd3.cmake
new file mode 100644
index 00000000..e6c2561c
--- /dev/null
+++ b/config/modules/Finds-dftd3.cmake
@@ -0,0 +1,43 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+#
+# crest is free software: you can redistribute it and/or modify it under
+# the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# crest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with crest.  If not, see <https://www.gnu.org/licenses/>.
+
+set(_lib "s-dftd3")
+set(_pkg "SDFTD3")
+set(_url "https://github.com/dftd3/simple-dftd3")
+set(_branch "6f0b06fbfa8653a23ca55c453772ce3af4420706")
+
+if(NOT DEFINED "${_pkg}_FIND_METHOD")
+  set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf")
+endif()
+
+include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
+
+set(temp_with_tests ${WITH_TESTS}) # Save the current value of WITH_TESTS
+set(WITH_TESTS FALSE CACHE BOOL "Temporarily disable tests for the s-dftd3 subproject" FORCE)
+set(WITH_API FALSE)
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
+
+set(found FALSE)
+if(TARGET "s-dftd3::s-dftd3")
+  set (found TRUE)
+endif()
+message(STATUS "Found s-dftd3: ${found}")
+
+set(WITH_TESTS ${temp_with_tests} CACHE BOOL "Enable tests for the main project" FORCE)
+
+unset(_lib)
+unset(_pkg)
+unset(_url)
diff --git a/config/modules/Findtblite.cmake b/config/modules/Findtblite.cmake
index 6789f3d1..7134650d 100644
--- a/config/modules/Findtblite.cmake
+++ b/config/modules/Findtblite.cmake
@@ -17,7 +17,7 @@
 set(_lib "tblite")
 set(_pkg "TBLITE")
 set(_url "https://github.com/tblite/tblite")
-set(_branch "xtb_solvation")
+set(_branch "5dc1c97858eb585111affc6627783800bafb87cc")
 
 if(NOT DEFINED "${_pkg}_FIND_METHOD")
   set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf")
@@ -28,6 +28,7 @@ include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
 set(temp_with_tests ${WITH_TESTS}) # Save the current value of WITH_TESTS
 set(WITH_TESTS FALSE CACHE BOOL "Temporarily disable tests for the tblite subproject" FORCE)
 set(WITH_API FALSE)
+set(WITH_DDX TRUE)
 crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
 
 set(found FALSE)
diff --git a/config/modules/Findtest-drive.cmake b/config/modules/Findtest-drive.cmake
index ed96bae6..8bfd3727 100644
--- a/config/modules/Findtest-drive.cmake
+++ b/config/modules/Findtest-drive.cmake
@@ -17,6 +17,7 @@
 set(_lib "test-drive")
 set(_pkg "TEST-DRIVE")
 set(_url "https://github.com/fortran-lang/test-drive")
+set(_branch "e8b7ca492c647ed384c9845d2caed04192af7d02")
 
 if(NOT DEFINED "${_pkg}_FIND_METHOD")
   set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf")
@@ -24,7 +25,11 @@ endif()
 
 include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
 
-crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}")
+# test-drive is imported unconditionally (see CMakeLists.txt) so that other
+# subprojects reuse the bundled copy.  Disable its own test suite here so the
+# import only contributes the library target, never its self-tests.
+set(TEST_DRIVE_BUILD_TESTING OFF CACHE BOOL "Disable test-drive self-tests" FORCE)
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
 
 if(TARGET "${_lib}::${_lib}")
   set (found TRUE)
diff --git a/config/modules/Findtoml-f.cmake b/config/modules/Findtoml-f.cmake
index ca1da4cb..1258d2e2 100644
--- a/config/modules/Findtoml-f.cmake
+++ b/config/modules/Findtoml-f.cmake
@@ -17,6 +17,7 @@
 set(_lib "toml-f")
 set(_pkg "TOML-F")
 set(_url "https://github.com/toml-f/toml-f")
+set(_branch "d5e92701d28b647323ce05ecbcbf302dd19792f7")
 
 if(NOT DEFINED "${_pkg}_FIND_METHOD")
   set("${_pkg}_FIND_METHOD" "subproject" "cmake" "fetch" "pkgconf")
@@ -24,7 +25,11 @@ endif()
 
 include("${CMAKE_CURRENT_LIST_DIR}/crest-utils.cmake")
 
-crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}")
+# toml-f gates its test suite on the standard CTest BUILD_TESTING flag
+# (include(CTest) defaults it to ON); pre-set it OFF so the subproject skips
+# its tests.  crest's own tests use WITH_TESTS and are unaffected.
+set(BUILD_TESTING OFF CACHE BOOL "Disable subproject test suites" FORCE)
+crest_find_package("${_lib}" "${${_pkg}_FIND_METHOD}" "${_url}" "${_branch}")
 
 if(TARGET "toml-f::toml-f")
   set (found TRUE)
diff --git a/config/modules/crest-utils.cmake b/config/modules/crest-utils.cmake
index 340d26e4..c8475a0c 100644
--- a/config/modules/crest-utils.cmake
+++ b/config/modules/crest-utils.cmake
@@ -97,8 +97,10 @@ macro(
           "${${_pkg_uc}_BINARY_DIR}"
         )
 
-        add_library("${package}::${package}" INTERFACE IMPORTED)
-        target_link_libraries("${package}::${package}" INTERFACE "${package}")
+        if(NOT TARGET "${package}::${package}")
+          add_library("${package}::${package}" INTERFACE IMPORTED)
+          target_link_libraries("${package}::${package}" INTERFACE "${package}")
+        endif()
 
         # We need the module directory in the subproject before we finish the configure stage
         if(NOT EXISTS "${${_pkg_uc}_BINARY_DIR}/include")
@@ -122,8 +124,10 @@ macro(
       )
       FetchContent_MakeAvailable("${_pkg_lc}")
 
-      add_library("${package}::${package}" INTERFACE IMPORTED)
-      target_link_libraries("${package}::${package}" INTERFACE "${package}")
+      if(NOT TARGET "${package}::${package}")
+        add_library("${package}::${package}" INTERFACE IMPORTED)
+        target_link_libraries("${package}::${package}" INTERFACE "${package}")
+      endif()
 
       # We need the module directory in the subproject before we finish the configure stage
       FetchContent_GetProperties("${_pkg_lc}" SOURCE_DIR "${_pkg_uc}_SOURCE_DIR")
diff --git a/docs/man/crest.adoc b/docs/man/crest.adoc
index b59a4d1b..75b41ce2 100644
--- a/docs/man/crest.adoc
+++ b/docs/man/crest.adoc
@@ -14,10 +14,10 @@
 // You should have received a copy of the GNU Lesser General Public License
 // along with crest.  If not, see <https://www.gnu.org/licenses/>.
 = crest(1)
-P.Pracht; S.Grimme; Universitaet Bonn, MCTC
+P.Pracht; S.Grimme; C.Bannwarth; F.Bohle; S.Ehlert; G.Feldmann; J.Gorges; C.Plett; S.Spicher; P.Steinbach; P.Wesolowski; F.Zeller
 :doctype: manpage
 // This attribute should be set from the build system:
-:release-version: 
+:release-version:
 :man manual: User Commands
 :man source: Crest {release-version}
 :page-layout: base
@@ -28,352 +28,584 @@ crest - Conformer-Rotamer Ensemble Sampling Tool based on the GFN methods
 
 == SYNOPSIS
 
-*crest* [_INPUT_] [_OPTION_]...
+*crest* [_INPUT_] [_OPTIONS_]...
+
+*crest* *--input* _file.toml_
 
 == DESCRIPTION
 
-Conformer-Rotamer Ensemble Sampling Tool based on the GFN methods.
+CREST is a conformer/rotamer ensemble sampling tool that interfaces with
+various quantum chemistry backends to explore molecular potential energy
+surfaces.
+It supports conformational searches, protonation/tautomer workflows, solvation
+cluster growth, mass-spectral fragmentation, and various standalone utility
+tasks.
 
-Using the xTB program. Compatible with xTB version 6.4.0.
+The _INPUT_ argument can be a coordinate file in TM (*coord*, Bohr) or
+Xmol (*\*.xyz*, Angstrom) format.
+If omitted, CREST searches the working directory for a file named *coord*.
+Versions 3.0 and later also accept a TOML input file either as the first
+positional argument or via *--input*.
 
 .Cite work conducted with this code as
 [quote]
 ----
  P. Pracht, F. Bohle, S. Grimme, PCCP, 2020, 22, 7169-7192.
- 
- and  S. Grimme, JCTC, 2019, 15, 2847-2862.
- 
- with help from:
- F.Bohle, S.Ehlert, S.Grimme, P.Pracht
+ S. Grimme, JCTC, 2019, 15, 2847-2862.
+ P. Pracht et al., J. Chem. Phys., 2024, 160, 114110.
 ----
 
-This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+For QCG calculations additionally cite:
+
+[quote]
+----
+ S. Spicher, C. Plett, P. Pracht, A. Hansen, S. Grimme,
+   JCTC, 2022, 18 (5), 3174-3189.
+ C. Plett, S. Grimme,
+   Angew. Chem. Int. Ed. 2023, 62, e202214477.
+----
 
 == OPTIONS
 
-The FIRST argument CAN be a coordinate file in the TM **(coord, Bohr)** or Xmol **(*.xyz, Ang.)** format.
-If no such file is present as the first argument **crest** will automatically search for a file called "`**coord**`" in the TM format.
+=== Run modes
 
-=== General and technical options
+*--sp*::
+  Single-point energy calculation.
 
-*-v1*::
-  Use the MF-MD-GC workflow.
-  (_OUTDATED_)
+*--opt*, *--optimize*::
+  Geometry optimization.
 
-*-v2*::
-  Use the MTD-GC workflow.
-  (_OUTDATED_)
+*--hess*, *--numhess*::
+  Numerical Hessian / vibrational frequencies.
 
-*-v3* (or *-v2i*)::
-  Use the iMTD-GC workflow.
-  [_default_]
+*--md*, *--dynamics*::
+  Stand-alone molecular dynamics simulation.
 
-*-v4*::
-  Use the iMTD-sMTD workflow.
+*--v3*, *--v2i*::
+  iMTD-GC iterative conformational search.
+  [_default_ conformer search]
 
-*-entropy*::
-  The same workflow as with "`**-v4**`", specialized for the calculation of conformational entropy.
+*--v4*, *--entropy*::
+  iMTD-sMTD entropy-focused conformational search.
 
-*-xnam* _bin_::
-  Specify name of the **xtb**(1) binary that should be used.
+*--mdopt* [_file_]::
+  Optimize every structure in an ensemble file.
 
-*-niceprint*::
-  Progress bar printout for optimizations.
+*--screen* [_file_]::
+  Multi-level energy screening of an ensemble.
 
-*-dry*::
-  Perform a "`dry run`".
-  Only prints the settings that would be applied with the CMD input and stops the run before any calculations
+*--protonate*::
+  Automated protonation site search.
 
-*-T* _int_::
-  Set total number of CPUs (threads) to be used.
-  Parallel settings are then determined automatically for each step.
-  If not set by "`**-T**`", this number is read from the **OMP_NUM_THREADS** global variable.
+*--deprotonate*::
+  Automated deprotonation site search.
 
-=== Calculation options
+*--tautomerize*::
+  Automated tautomer search.
 
-*-g* _string_::
-  Use GBSA implicit solvent for solvent _string_.
+*--qcg* [_solvent_]::
+  Quantum Cluster Growth solvation workflows.
 
-*-alpb* _string_::
-  Use ALPB implicit solvent for solvent _string_.
+*--msreact*::
+  Mass-spectral fragment generator.
 
-*-chrg* _int_::
-  Set the molecules`' charge.
+*--bh*, *--GMIN*::
+  Basin-hopping global optimization.
 
-*-uhf* _int_::
-  Set _int_=**N alpha - N beta** electrons
-
-*-nozs*::
-  Do not perform z-mat sorting.
-  [_default_]
+*--sort*::
+  Ensemble sorting via CREGEN.
 
-*-opt* _lev_::
-  Set optimization level for **ALL** GFN-xTB optimizations.
-  [_default_: **vtight**]
+=== Method selection
 
-  * _lev_ = **vloose**, **loose**, **normal**, **tight**, **vtight**
+*-gfn2*::
+  Use GFN2-xTB.
+  [_default_]
 
 *-gfn1*::
   Use GFN1-xTB.
 
-*-gfn2*::
-  Use GFN2-xTB.
-  [_default_]
+*-gfn0*::
+  Use GFN0-xTB.
 
 *-gff*, *-gfnff*::
-  Use GFN-FF (requires **xtb**(1) 6.3 or newer).
-  (For GFN-FF searches bond constraints are applied automatically.)
+  Use GFN-FF.
+  Bond constraints are applied automatically for GFN-FF searches.
+
+*-gxtb*::
+  Use g-xTB (requires a special build).
 
 *-gfn2//gfnff*::
-  GFN2-xTB//GFN-FF composite mode.
+  GFN-FF trajectories with GFN2-xTB energy reweighting.
+
+*-refine* _method_::
+  Post-process conformers at a higher level of theory.
+
+*-optlev* _level_::
+  Optimization convergence level for all semiempirical calculations.
+  _level_ = *crude*, *vloose*, *loose*, *normal*, *tight*, *vtight*, *extreme*.
+
+*-dscal* [_factor_]::
+  Scale the dispersion energy in MD/MTD simulations.
+
+=== Molecular system
+
+*-T* _int_::
+  Number of CPU threads.
+  If not set, read from *OMP_NUM_THREADS*.
+
+*-chrg* _int_::
+  Molecular charge.
 
-*Adding additional constraints to the calculations:*
+*-uhf* _int_::
+  Number of unpaired electrons (N_alpha - N_beta).
+
+*-g* _solvent_, *-gbsa* _solvent_::
+  GBSA implicit solvation.
+
+*-alpb* _solvent_::
+  ALPB implicit solvation.
+
+*-efield* _Ex_ _Ey_ _Ez_::
+  Apply a homogeneous external electric field in V/Ang along x, y, z.
+
+*-charges* [_file_]::
+  Read atomic partial charges from _file_ (default: *charges*).
+
+=== Technical options
+
+*--input* _file_::
+  Specify a TOML input file with detailed settings.
+
+*-xnam* _bin_::
+  Path to the xtb executable (when using xtb as the backend).
+
+*-noopt*::
+  Skip pre-optimization of the input structure.
+
+*-niceprint*::
+  Show an animated progress bar during long runs.
+
+*-dry*::
+  Parse all arguments, print the resolved settings, then exit without
+  running any calculation.
+
+*-legacy*::
+  Force CREST < 3.0 behaviour.
 
-The user is able to include additional constraints to **ALL** xtb**(1)** calculations that are conducted by CREST.
+=== Constraints
+
+The following flags apply constraints to *all* calculations made by CREST.
 
 *-cinp* _file_::
-  Read in a file containing the constraints.
-  Constraints have to be in the same format as in xtb**(1)**.
-  (This was done previously via the "`**.constrains**`" file.)
+  Read constraints from _file_ (same format as in *xtb*(1);
+  formerly passed via *.constrains*).
+
+*-cbonds* [_fc_]::
+  Constrain all bonds globally (derived from topology).
+  Optional force constant _fc_ in Eh.
 
-*-cbonds*::
-  Define automatic bond constraints (set up from topology).
+*-cbonds_md* [_fc_]::
+  Constrain all bonds during MDs/MTDs only, not optimizations.
 
 *-nocbonds*::
-  Turn off **-cbonds**. (For GFN-FF, mainly. See above.)
+  Disable automatic bond constraints.
 
 *-fc* _float_::
-  Define force constant for defined constraints (**-cbonds**).
+  Global force constant for bond constraints.
 
-=== Options for ensemble comparisons
+=== Ensemble comparison and sorting (CREGEN)
 
-*-cregen* _file_::
-  Use **ONLY** the CREGEN subroutine to sort a given ensemble file.
+*-cregen* [_file_]::
+  Run CREGEN standalone to sort and deduplicate an ensemble file.
 
 *-ewin* _real_::
-  Set energy window in kcal/mol.
-  [_default_: **6.0** kcal/mol]
+  Energy window in kcal/mol.
+  [_default_: *6.0* kcal/mol]
 
 *-rthr* _real_::
-  Set RMSD threshold in Ang.
-  [_default_: **0.125** Ang]
+  RMSD threshold in Ang.
+  [_default_: *0.125* Ang]
 
 *-ethr* _real_::
-  Set E threshold in kcal/mol.
-  [_default_: **0.05** kcal/mol]
+  Energy threshold in kcal/mol.
+  [_default_: *0.05* kcal/mol]
 
 *-bthr* _real_::
-  Set Rot. const. threshold.
-  [_default_: **0.01** (= 1%)]
+  Rotational constant threshold.
+  [_default_: *0.01* (= 1%)]
 
 *-pthr* _real_::
-  Boltzmann population threshold.
-  [_default_: **0.05** (= 5%)]
+  Boltzmann population threshold (0-1).
+  [_default_: *0.05*]
 
 *-temp* _real_::
-  Set temperature in **CREGEN**.
-  [_default_: **298.15** K]
+  Temperature for Boltzmann weighting in K.
+  [_default_: *298.15* K]
 
-*-prsc*::
-  Create a **scoord.*** file for each conformer.
+*-topo*, *-notopo*::
+  Enable or disable the topology change check.
 
-*-nowr*::
-  Don't write new ensemble files.
+*-ezcheck*::
+  Enable E/Z double-bond isomer check.
 
-*-eqv*,*-nmr*,*-entropy*::
-  Compare nuclear equivalences (requires rotamers).
+*-heavy*::
+  Use heavy-atom-only RMSD.
+
+*-allrot*::
+  Use all three rotational constants (A, B, C) for duplicate detection.
+
+*-eqv*, *-nmr*::
+  NMR nuclear equivalence analysis (requires rotamers).
 
 *-cluster* _int_::
-  PCA and k-Means clustering of sorted ensemble.
-  Works as extenstion to the **CREGEN** sorting.
-  _int_ is the number of clusters to be formed.
+  PCA + k-Means clustering of the sorted ensemble.
+  _int_ is the number of clusters.
 
-*-notopo*::
-  Turn off any topology checks in **CREGEN**.
+*-prsc*::
+  Write *scoord.** files for each conformer.
 
-=== Options for the iMTD-GC workflows
+*-nowr*::
+  Skip writing the sorted ensemble file.
 
-*-cross*::
-  Do the GC part.
+*-osdf*::
+  Write the output ensemble in SDF format in addition to XYZ.
+
+=== Conformer search / sampling
+
+*-v3*, *-v2i*::
+  iMTD-GC (iterative MTD-GC).
   [_default_]
 
-*-nocross*::
-  Don't do the GC part.
+*-v4*, *-entropy*::
+  iMTD-sMTD, specialized for entropy/free-energy sampling.
+
+*-len* _t_[*x*], *-mdlen* _t_[*x*]::
+  MD/MTD simulation length in ps.
+  Append *x* to scale the default length by a factor instead.
+
+*-tstep* _float_::
+  MD integration timestep in fs.
+  [_default_: *5* fs]
 
 *-shake* _int_::
-  Set SHAKE mode for MD.
-  (**0**=off, **1**=H-only, **2**=all bonds)
-  [_default_: **2**]
+  SHAKE constraint mode: *0* = off, *1* = X-H bonds only, *2* = all bonds.
+  [_default_: *1*]
 
-*-tstep* _int_::
-  Set MD time step in fs.
-  [_default_: **5** fs]
+*-mdtemp* _float_::
+  Temperature for MTD simulations in K.
 
-*-mdlen/-len* _real_::
-  Set MD length (all MTDs) in ps.
-  Also possible are multiplicative factors for the default MD length with "`**x**_real_`".
+*-tnmd* _float_::
+  Temperature for additional normal (unbiased) MDs in K.
 
 *-mddump* _int_::
-  xyz dumpstep to Trajectory in fs.
-  [_default_: **100** fs]
+  Trajectory structure dump interval in fs.
+  [_default_: *100* fs]
 
 *-vbdump* _real_::
-  Set Vbias dump frequency in ps.
-  [_default_: 1.0 ps]
+  Vbias (MTD bias) dump frequency in ps.
+  [_default_: *1.0* ps]
 
-*-tnmd* _real_::
-  Set temperature for additional normal MDs.
-  [_default_: 400 K]
+*-nmtd* _int_::
+  Number of MTD simulations per search cycle.
 
-*-norotmd*::
-  Don't do the regular MDs after the second multilevel optimization step.
+*-cross*, *-nocross*::
+  Enable or disable the genetic structure crossing step.
+  [_default_: *-cross*]
 
-*-quick*::
-  Perform a search with reduced settings for a crude ensemble.
+*-gcmax* _int_::
+  Maximum number of structures fed into the genetic crossing.
 
-*-squick*::
-  Perform a even further reduced search.
+*-nozs*::
+  Disable z-matrix sorting.
+
+*-normmd* [_n_ [_T_]]::
+  Run additional unbiased MDs on the lowest-energy conformers.
 
-*-mquick*::
-  Perform a search with maximum reduced settings.
-  (Do not reduce the settings more than that.)
+*-quick*, *-squick*, *-mquick*::
+  Progressively reduced search settings for fast, approximate ensembles.
 
 *-origin*::
-  Track the step of generation for each conformer/rotamer.
+  Track the MTD step of origin for each conformer.
   [_default_]
 
 *-keepdir*::
-  Keep sub-directories of the conformer generation step.
+  Keep temporary working directories after the run.
+
+*-NCI*::
+  NCI cluster mode: flat-bottom wall potential and specialised MTD settings
+  suited for weakly-bound complexes.
 
-*-nci*::
-  Generate an ellipsoide potential around the input structure and add it to the MTD simulation.
-  This can be used to find aggregates of NCI complexes.
+*-wscal* _float_::
+  Scale the wall potential sphere radius.
 
-*-wscal* _real_::
-  Scale the ellipsoide potential axes by factor _real_.
+*-hflip*, *-noflip*::
+  Enable or disable OH proton flipping after MTD.
+  [_default_: *-noflip*]
 
-=== Thermostatistical options (used in entropy mode)
+*-maxflip* _int_::
+  Maximum number of OH flip attempts.
+  [_default_: *1000*]
 
-*-trange* _lower_ _upper_ _step_::
-  Entropies are calculated for different temperatures.
-  These are calculated in a temperature range from _lower_ to _upper_ with _step_ in between.
-  [_default_: **280**K-**380**K in **10**K steps]
+=== Thermostatistical options
+
+*-trange* _Tmin_ _Tmax_ _Tstep_::
+  Compute entropies over a temperature range.
+  [_default_: *280*-*380* K in *10* K steps]
+
+*-tread* _file_::
+  Read a list of temperatures (one per line) from _file_.
 
 *-fscal* _float_::
-  Frequency scaling factor.
-  [_default_: 1.0]
+  Vibrational frequency scaling factor.
+  [_default_: *1.0*]
 
-*-sthr* _float_::
-  Vibrational/rotational entropy interpolation threshold (tau).
-  [_default_: **25.0** cm^-1]
+*-sthr* _float_, *-rotorcut* _float_::
+  Rotor cutoff in cm^-1: modes below this are treated as free rotors.
+  [_default_: *25.0* cm^-1]
 
 *-ithr* _float_::
   Imaginary mode inversion cutoff.
-  [_default_: **-50.0** cm^-1]
+  [_default_: *-50.0* cm^-1]
 
 *-ptot* _float_::
-  Sum of population for structures considered in msRRHO average.
-  [_default_: **0.9** (= 90%)]
+  Cumulative Boltzmann population threshold for msRRHO averaging.
+  [_default_: *0.9*]
 
-=== options for MSREACT automated mass spectra fragment generator
+*-pcap* _int_::
+  Maximum number of structures used in property (Hessian) calculations.
 
-    *-msreact*::
-      start the msreact mode
+*-printpop*::
+  Print Boltzmann populations at every temperature in the range.
 
-    *-msnoattrh*::
-      deactivate attractive potential between hydrogen and LMO centers
+*-avbhess*::
+  Use a Boltzmann-averaged Hessian in the rrhoav property calculation.
 
-    *-msnshifts* _int_::  
-      perform n optimizations with randomly shifted atom postions (default 0)
+=== Quantum Cluster Growth (QCG)
 
-    *-msnshifts* _int_::  
-      perform n optimizations with randomly shifted atom postions and repulsive potential applied to bonds (default 0)
+General usage: *crest* _solute_ *-qcg* _solvent_ [_options_]
 
-    *-msnbonds* _int_::  
-      maximum number of bonds between atoms pairs for applying repulsive potential (default 3) 
+*-grow*::
+  Cluster generation run type.
 
-    *-msmolbar*::
-      sort out topological duplicates by molbar codes (requires  sourced "molbar")
+*-nsolv* _int_::
+  Number of solvent molecules to add.
 
-    *-msinchi*::
-      sort out topological duplicates by inchi codes (requires  sourced "obabel")
+*-fixsolute*::
+  Fix the solute during cluster growth (recommended for rigid molecules;
+  applied automatically for water).
 
-    *-msnfrag* _int_:: 
-        number of fragments that are printed by msreact (random selection)
-    
-    *-msiso*::
-      print only non-dissociated structures (isomers)
+*-nofix*::
+  Do not fix the solute during growth (override for water).
 
-    *-msnoiso*::
-      print only dissociated structures
+*-nopreopt*::
+  Skip pre-optimization.
 
-    *-mslargeprint*::
-        do not remove temporary files and MSDIR with constrained optimizations
+*-xtbiff*::
+  Use the xTB-IFF standalone program for solvent docking.
 
-    *-chrg* _int_:: 
-      set the molecules´ charge
-    
-    *-ewin* _float_::       
-      set energy window in for sorting out fragments kcal/mol, [default: 200.0 kcal/mol] 
-  
-=== Other tools for standalone use
+*-normdock*::
+  Perform a more extensive docking step during growth.
 
-*-zsort*::
-  Use only the **zsort** subroutine to sort the z-matrix of the input coordinate file.
+*-maxsolv*::
+  Set the convergence limit when *-nsolv* is not given.
+  [_default_: *150*]
+
+*-wscal* _float_::
+  Scaling factor for the outer wall potential.
+
+*-samerand*::
+  Use the same random seed for every xTB-IFF run.
+
+*-directed* _file_::
+  Directed solvation: place solvent at positions defined in _file_.
+
+*-fin_opt_gfn2*::
+  Perform final GFN2-xTB optimization of grow and ensemble structures.
+
+*-ensemble*::
+  Ensemble generation run type.
+
+*-qcgmtd*, *-ncimtd*::
+  NCI-MTD CREST ensemble generation.
+  [_default_]
+
+*-mtd*::
+  MTD for QCG ensemble generation.
+
+*-md*::
+  Normal MD for QCG ensemble search.
+
+*-enslvl* [_method_]::
+  Method for ensemble search (all GFN methods supported).
+
+*-clustering*::
+  Enable clustering for ensemble search (qcgmtd/ncimtd only).
+
+*-esolv*::
+  Reference cluster generation and solvation energy calculation.
+
+*-gsolv*::
+  Reference cluster generation and solvation free energy calculation.
+
+*-nclus*::
+  Number of clusters for reference generation.
+  [_default_: *4*]
+
+*-nocff*::
+  Disable the CFF algorithm.
+
+*-freqscal*::
+  Frequency scale factor (output only).
+
+*-freqlvl* [_method_]::
+  Method for frequency computation.
+
+=== Mass spectral fragment generator (MSReact)
+
+General usage: *crest* _input_ *-msreact* [_options_]
+
+*-msnoattrh*::
+  Deactivate attractive potential between H atoms and LMO centers.
+
+*-msnshifts* _int_::
+  Number of optimizations with randomly shifted atom positions.
+  [_default_: *0*]
+
+*-msnshifts2* _int_::
+  Same as *-msnshifts* but with bond-repulsive potential applied.
+  [_default_: *0*]
+
+*-msnbonds* _int_::
+  Maximum bond distance for the repulsive potential.
+  [_default_: *3*]
+
+*-msmolbar*::
+  Deduplicate fragments by molbar codes (requires *molbar* in PATH).
+
+*-msinchi*::
+  Deduplicate fragments by InChI codes (requires *obabel*(1) in PATH).
+
+*-msnfrag* _int_::
+  Number of fragments to print (random selection).
+
+*-msiso*::
+  Print only non-dissociated structures (isomers).
 
-*-mdopt* _file_::
-  Optimize along trajectory or ensemble file in the XYZ format.
-  Each point on the file is optimized.
+*-msnoiso*::
+  Print only dissociated structures.
 
-*-screen* _file_::
-  Optimize along ensemble file in the XYZ format.
-  A multilevel optimization is performed with continiously increasing thresholds.
-  After each step the ensemble file is sorted.
+*-mslargeprint*::
+  Keep all temporary files and the MSDIR directory.
+
+*-ewin* _real_::
+  Energy window for fragment sorting in kcal/mol.
+  [_default_: *200.0* kcal/mol]
+
+*-msinput* _file_::
+  Read special MSReact settings from _file_.
+
+=== Other standalone tools
+
+*-thermo* _file_::
+  Compute thermochemistry from existing Hessian data.
+  Requires a *vibspectrum* file in TM format in the working directory.
+
+*-entropy* [_T_]::
+  Compute conformational entropy from an ensemble.
+  Optional temperature _T_ in K.
+
+*-sort*::
+  Sort ensemble structures by energy (CREGEN).
+
+*-symmetries*::
+  Symmetry analysis of all structures in an ensemble.
+
+*-printboltz*::
+  Print Boltzmann population weights for each structure.
+
+*-compare* _f1_ _f2_::
+  Compare two ensembles _f1_ and _f2_ for structural overlap.
+  Both files must share the same atom ordering.
+
+  *-maxcomp* _int_:::
+    Maximum number of conformers taken from each ensemble for comparison.
+    [_default_: *10*]
+
+*-splitfile* _file_ [_i_] [_j_]::
+  Split an ensemble into per-structure directories under *SPLIT/*.
+  _i_ and _j_ optionally select a range of structures.
+
+*-rmsd* _f1_ _f2_::
+  RMSD between two structures (coordinates auto-converted to Angstrom).
+
+*-rmsdheavy* _f1_ _f2_::
+  Heavy-atom RMSD between two structures.
 
 *-protonate*::
-  Find a molecule's protomes by using a LMO pi- or LP-center approach.
+  Automated protonation site search via LMO pi/LP-center approach.
 
 *-deprotonate*::
-  Find a molecule's deprotomers.
+  Automated deprotonation site search.
 
 *-tautomerize*::
-  Combine the protonation and deprotonation to find prototropic tautomers.
+  Find prototropic tautomers (protonation + deprotonation).
 
   *-trev*:::
-    Do first the deprotonation and then the protonation in the *-tautomerize* mode, i.e., reverse of the default procedure.
+    Deprotonate first, then protonate (reverse order).
 
   *-iter* _int_:::
-    Set number of protonation/deprotonation cycles in the tautomerization script.
-    [_default_: 2]
+    Number of protonation/deprotonation cycles.
+    [_default_: *2*]
 
-*-compare* _f1_ _f2_::
-  Compare two ensembles _f1_ and _f2_.
-  Both ensembles must have the same order of atoms of the molecule and should contain rotamers.
+*-cregen* [_file_]::
+  CREGEN ensemble sorting (see also _Ensemble comparison_ above).
 
-  *-maxcomp* _int_:::
-    Select the lowest _int_ conformers out of each ensemble to be compared with "`*-compare*`".
-    [_default_: 10]
+*-zsort*::
+  Z-matrix sorting of the input coordinate file.
 
 *-testtopo* _file_::
-  Analyze some stuctural info (topology) for a given file.
+  Topology / bond connectivity analysis for a given file.
 
 *-constrain* _atoms_::
-  Write example file "`*.xcontrol.sample*`" for constraints in crest.
-  (See *-cinp* option above.)
+  Write an example constraint file *.xcontrol.sample*.
 
-*-thermo* _file_::
-  Calculate thermo data for given structure.
-  Also requires vibrational frequencies in the TM format, saved as file called "`*vibspectrum*`".
+=== TOML input files
 
-*-rmsd*,*-rmsdheavy* _file1_ _file2_::
-  Calculate RMSD or heavy atom RMSD between two structures.
-  Input coords are automatically transformed to Angstroem.
+CREST 3.0+ accepts a TOML file as a flexible alternative to CLI flags.
 
-*-splitfile* _file_ [*from*] [*to*]::
-  Split an ensemble from _file_ into seperate directories for each structure.
-  *from* and *to* can be used to select specific structures from the file.
-  The new directories are collected in the *SPLIT* directory.
+  crest structure.xyz --input settings.toml
+  crest settings.toml   # structure path given inside the file
+
+A minimal TOML input file:
+
+----
+input   = "struc.xyz"
+runtype = "iMTD-GC"
+threads = 4
+
+[calculation]
+  [[calculation.level]]
+    method = "gfn2"
+    chrg   = 0
+    gbsa   = "h2o"
+----
+
+Key root-level settings: *input*/*structure* (coordinate file),
+*runtype* (workflow), *threads* (CPU count), *preopt* (bool),
+*constraints* (constraint file path).
+
+Main blocks: *[calculation]* / *[[calculation.level]]* /
+*[[calculation.constraint]]* — method, charge, solvent, geometric
+constraints; *[dynamics]* / *[[dynamics.meta]]* — MD and metadynamics
+settings; *[cregen]* — sorting thresholds; *[thermo]* — thermochemistry.
 
 == NOTES
 
-View literature references with **--cite**.
+View full literature references with *--cite*.
+
+For the full option reference and TOML keyword documentation see:
+https://crest-lab.github.io/crest-docs/
+
+== SEE ALSO
+
+https://crest-lab.github.io/crest-docs/
diff --git a/examples/README.md b/examples/README.md
index 36bd25ad..84003904 100644
--- a/examples/README.md
+++ b/examples/README.md
@@ -1,34 +1,53 @@
 # Example applications of the CREST program
 
-This directory contains several examples for 
-standard applications of the `crest` program.
+This directory contains examples covering the most common workflows
+of the `crest` program.
 
-Each example directory contains a input structure
-(typically called `struc.xyz`) and a bash script
-called `run.sh` that includes some information about
-the example and will execute the calculation upon
-execution.
+Each example directory contains an input structure (`struc.xyz` or
+similar), a shell script `run.sh`, and a TOML input file `input.toml`.
 
-To run the example scripts simply go to the respective
-directory and execute it from the command line:
+## Running an example
+
+Go to the example directory and execute the script:
 ```bash
+cd expl-6
 ./run.sh
 ```
 
-It is assumed that the `xtb` and `crest` binaries
-are present in the *PATH* variable as such.
-The `run.sh` scripts will check for this, however.
+The `run.sh` scripts show CLI usage.  Alternatively, every example can
+be run through its TOML input file:
+```bash
+crest input.toml
+```
+
+TOML files are detected automatically by their `.toml` extension.  They
+offer the same settings as the CLI flags but in a structured, documented
+format that is easier to modify and reuse.
+
+It is assumed that the `crest` binary is available in `$PATH`.
 
 
 ## Examples
 
-0. *dry run* of the `crest` program
-1. default conformational search (iMTD-GC)
-2. example for different CMD settings
-3. sorting an ensemble file (CREGEN)
-4. constrained conformational sampling
-5. standalone optimization along a trajectory
-6. NCI sampling mode (iMTD-NCI)
-7. protonation site sampling
-8. modified protonation site sampling
-9. tautomer sampling
+| # | Topic | Molecule |
+|---|-------|---------|
+| **0** | *Dry run* — print settings without computing | 1-propanol |
+| **1** | Single-point energy | 1-propanol |
+| **2** | Geometry optimization | 1-propanol |
+| **3** | Optimization + Hessian (vibrational frequencies) | 1-propanol |
+| **4** | Standalone MD simulation | 1-propanol |
+| **5** | Default iMTD-GC conformer search | 1-propanol |
+| **6** | Two-level conformer search (GFN2//GFN-FF, A//B) | 1-propanol |
+| **7** | iMTD-GC with ALPB implicit solvation (GFN2) | 1-propanol |
+| **8** | Quick iMTD-GC conformer search (with -finalhess) | 1-propanol |
+| **9** | Standalone CREGEN ensemble sorting | 1-propanol |
+| **10** | Constrained conformer search | 1-propanol |
+| **11** | Ensemble optimization (mdopt) | 1-propanol |
+| **12** | NCI sampling mode (iMTD-NCI) | water trimer |
+| **13** | Protonation site sampling | uracil |
+| **14** | Metal/ion adducts (Cs+) | alpha-D-glucose |
+| **15** | Tautomer screening | guanine |
+| **16** | fmlip-relay: geometry optimisation with LJ potential | Ar4 cluster |
+| **17** | fmlip-relay: geometry optimisation with FairChem UMA model | caffeine |
+| **18** | fmlip-relay: geometry optimisation with MACE-OFF23 model | caffeine |
+| **19** | Implicit-solvation add-on (ddX/EEQ-BC composite, GFN2 parent) | 1-propanol |
diff --git a/examples/expl-0/run.sh b/examples/expl-0/run.sh
index 881b7737..3745edd7 100755
--- a/examples/expl-0/run.sh
+++ b/examples/expl-0/run.sh
@@ -1,27 +1,12 @@
 #!/bin/bash
+# Dry run of CREST: prints settings and thresholds without running any calculation.
+# Use this to preview the iMTD-GC setup before committing to a full run.
+# Note: -dry is a CLI-only flag; see input.toml for the equivalent full-run settings.
 
-xtbin='xtb'
-crst='crest'
+command -v crest >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary."; exit 1; }
 
-command -v $xtbin >/dev/null 2>&1 || { echo >&2 "Cannot find xtb binary. Exit."; exit 1; }
-command -v $crst >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary. Exit."; exit 1; }
+# --- CLI run ---
+crest struc.xyz -dry
 
-if [ $xtbin == 'xtb' ]
- then
-    $crst struc.xyz -dry
- else
-    $crst struc.xyz -dry -xnam $xtbin
- fi
-
-# Before starting any calculation, settings
-# can be checked with the '-dry' flag.
-# This will only print a summary about the
-# selected settings and thresholds to the
-# consol and check for the xtb binary.
-#
-# Every time the input file (struc.xyz) is
-# something else than 'coord', a file called
-# 'coord' will be (over-)written, containing
-# the atomic coordinates in Bohr. CREST will
-# then continue to use and overwrite this
-# coord file for all further calculations.
+# --- TOML run (equivalent full run without -dry) ---
+# crest input.toml
diff --git a/examples/expl-1/input.toml b/examples/expl-1/input.toml
new file mode 100644
index 00000000..8be94e2a
--- /dev/null
+++ b/examples/expl-1/input.toml
@@ -0,0 +1,6 @@
+# Single-point energy calculation
+runtype = "singlepoint"
+input   = "struc.xyz"   # input structure file (1-propanol)
+
+[[calculation.level]]
+method = "gfn2"         # GFN2-xTB semi-empirical Hamiltonian
diff --git a/examples/expl-1/run.sh b/examples/expl-1/run.sh
index 015ccee7..425cd9ca 100755
--- a/examples/expl-1/run.sh
+++ b/examples/expl-1/run.sh
@@ -1,27 +1,11 @@
 #!/bin/bash
+# Single-point GFN2-xTB energy evaluation of 1-propanol.
+# Output: energy printed to stdout; no structure files are written.
 
-xtbin='xtb'
-crst='crest'
-
-command -v $xtbin >/dev/null 2>&1 || { echo >&2 "Cannot find xtb binary. Exit."; exit 1; }
-command -v $crst >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary. Exit."; exit 1; }
-
-if [ $xtbin == 'xtb' ]
- then
-    $crst struc.xyz -ewin 2.0
- else
-    $crst struc.xyz -ewin 2.0 -xnam $xtbin
- fi
-
-
-# This will execute a conformational search with default settings
-# for the 1-propanol molecule.
-# The energy window is set to 2.0 kcal/mol with the '-ewin' flag
-# (instead of the default 6.0 kcal/mol window)
-# Within this window there should be 4 conformers for 1-propanol
-# in the gas phase.
-# The 4 unique conformers can be found in the file 'crest_conformers.xyz'.
-# All degenerate conformers (rotamers, pseudo-enantiomers) of the 4 structures
-# can be found in the file 'crest_rotamers.xyz'
+command -v crest >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary."; exit 1; }
 
+# --- CLI run ---
+crest struc.xyz -sp
 
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-10/input.toml b/examples/expl-10/input.toml
new file mode 100644
index 00000000..ba5279e7
--- /dev/null
+++ b/examples/expl-10/input.toml
@@ -0,0 +1,13 @@
+# Constrained iMTD-GC: atoms 1-4 (C-C-C-O backbone) frozen in Cartesian space;
+# only OH dihedral angles are sampled.
+runtype = "imtd-gc"
+input   = "struc.xyz"   # input structure file (1-propanol)
+
+[[calculation.level]]
+method = "gfnff"        # GFN-FF force field
+
+[calculation]
+freeze = "1-4"          # freeze atoms 1-4 at their input Cartesian coordinates
+
+[cregen]
+ewin = 2.0              # keep conformers within 2.0 kcal/mol of the lowest
diff --git a/examples/expl-10/run.sh b/examples/expl-10/run.sh
new file mode 100755
index 00000000..862d3278
--- /dev/null
+++ b/examples/expl-10/run.sh
@@ -0,0 +1,14 @@
+#!/bin/bash
+# Constrained iMTD-GC conformer search of 1-propanol:
+# the C-C-C-O backbone (atoms 1-4) is frozen; only the OH dihedral is sampled.
+
+command -v crest >/dev/null 2>&1 || {
+  echo >&2 "Cannot find crest binary."
+  exit 1
+}
+
+# --- CLI run ---
+crest struc.xyz -gfnff -freeze 1-4 -ewin 2.0 --imtdgc
+
+# --- TOML run (constraints defined directly in the input file) ---
+# crest input.toml
diff --git a/examples/expl-2.5/struc.xyz b/examples/expl-10/struc.xyz
similarity index 100%
rename from examples/expl-2.5/struc.xyz
rename to examples/expl-10/struc.xyz
diff --git a/examples/expl-11/input.toml b/examples/expl-11/input.toml
new file mode 100644
index 00000000..dabcad9f
--- /dev/null
+++ b/examples/expl-11/input.toml
@@ -0,0 +1,6 @@
+# Optimize every structure in an ensemble or trajectory file
+runtype  = "mdopt"
+ensemble = "xtb.trj"    # input trajectory or multi-structure XYZ file
+
+[[calculation.level]]
+method = "gfn2"         # GFN2-xTB for geometry optimization
diff --git a/examples/expl-11/run.sh b/examples/expl-11/run.sh
new file mode 100755
index 00000000..ac133c72
--- /dev/null
+++ b/examples/expl-11/run.sh
@@ -0,0 +1,11 @@
+#!/bin/bash
+# Optimize all structures in a trajectory/ensemble file with GFN2-xTB.
+# Output: crest_ensemble.xyz (optimized structures, not sorted)
+
+command -v crest >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary."; exit 1; }
+
+# --- CLI run ---
+crest -mdopt xtb.trj
+
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-3/xtb.trj b/examples/expl-11/xtb.trj
similarity index 100%
rename from examples/expl-3/xtb.trj
rename to examples/expl-11/xtb.trj
diff --git a/examples/expl-12/input.toml b/examples/expl-12/input.toml
new file mode 100644
index 00000000..af5fac97
--- /dev/null
+++ b/examples/expl-12/input.toml
@@ -0,0 +1,6 @@
+# Non-covalent interaction (NCI) conformer sampling
+runtype = "nci"
+input   = "struc.xyz"   # input structure file (water trimer)
+
+[[calculation.level]]
+method = "gfnff"        # GFN-FF for fast NCI sampling
diff --git a/examples/expl-12/run.sh b/examples/expl-12/run.sh
new file mode 100755
index 00000000..28a4cc08
--- /dev/null
+++ b/examples/expl-12/run.sh
@@ -0,0 +1,15 @@
+#!/bin/bash
+# Non-covalent interaction (NCI / iMTD-NCI) conformer sampling of a water trimer.
+# A wall potential is generated automatically to prevent cluster dissociation.
+# Output: crest_conformers.xyz, crest_rotamers.xyz
+
+command -v crest >/dev/null 2>&1 || {
+  echo >&2 "Cannot find crest binary."
+  exit 1
+}
+
+# --- CLI run ---
+crest struc.xyz --gfnff --imtdgc -nci
+
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-12/struc.xyz b/examples/expl-12/struc.xyz
new file mode 100644
index 00000000..5553af95
--- /dev/null
+++ b/examples/expl-12/struc.xyz
@@ -0,0 +1,11 @@
+    9
+FINAL HEAT OF FORMATION =     0.000000
+ H    -1.091354     2.083948     0.561412
+ O    -0.873213     1.360333    -0.037725
+ H    -1.126153    -0.540943     0.037240
+ H     0.094609     1.245770     0.037306
+ O     1.614744     0.076014    -0.037729
+ O    -0.741528    -1.436357    -0.037711
+ H    -1.259101    -1.987119     0.561339
+ H     2.350402    -0.096756     0.561513
+ H     1.031565    -0.704748     0.037192
diff --git a/examples/expl-13/input.toml b/examples/expl-13/input.toml
new file mode 100644
index 00000000..f4f3915f
--- /dev/null
+++ b/examples/expl-13/input.toml
@@ -0,0 +1,9 @@
+# Protonation site sampling: generates protomers by adding H+ to basic sites
+runtype = "protonate"
+input   = "struc.xyz"   # input structure file (uracil)
+
+[[calculation.level]]
+method = "gfn2"         # GFN2-xTB for protonation site ranking
+
+[protonation]
+ewin = 30.0             # energy window for protomer selection (kcal/mol)
diff --git a/examples/expl-13/run.sh b/examples/expl-13/run.sh
new file mode 100755
index 00000000..0195d57a
--- /dev/null
+++ b/examples/expl-13/run.sh
@@ -0,0 +1,12 @@
+#!/bin/bash
+# Protonation site sampling of uracil with GFN2-xTB.
+# Generates protomers by adding H+ to basic sites on the molecule.
+# Expected output: 3 major protomers in protonated.xyz within 30 kcal/mol.
+
+command -v crest >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary."; exit 1; }
+
+# --- CLI run ---
+crest struc.xyz -protonate
+
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-13/struc.xyz b/examples/expl-13/struc.xyz
new file mode 100644
index 00000000..73524a28
--- /dev/null
+++ b/examples/expl-13/struc.xyz
@@ -0,0 +1,14 @@
+12
+ energy: -24.614946947602 gnorm: 0.000456827525 xtb: 6.2.2 (89a525f)
+O           1.01382029544030     0.03880681993718     0.26260657568622
+C           2.21194959420030     0.00777551853774     0.13894624850894
+N           2.97633014247497     1.15928881874167     0.06760158128732
+C           4.33128423994495     1.14641376546424    -0.07421492522129
+C           5.02090106234646    -0.00303350704424    -0.15435476958224
+C           4.32754207903802    -1.27903972647711    -0.09166688984675
+O           4.83244816077160    -2.37420082989590    -0.15422059425404
+N           2.94450163810970    -1.14763022456257     0.05629094590508
+H           2.46829084494664     2.03038084438831     0.12488082938105
+H           4.81038312241915     2.11362921965719    -0.11757996835012
+H           6.09011013882395    -0.02137897779485    -0.26646726330202
+H           2.41547828301905    -2.01176145142300     0.10488837035251
diff --git a/examples/expl-14/input.toml b/examples/expl-14/input.toml
new file mode 100644
index 00000000..32727569
--- /dev/null
+++ b/examples/expl-14/input.toml
@@ -0,0 +1,9 @@
+# Metal-ion adduct generation: replace H+ with Cs+ to form adducts
+runtype = "protonate"
+input   = "struc.xyz"   # input structure file (alpha-D-glucose)
+
+[[calculation.level]]
+method = "gfn2"         # GFN2-xTB for adduct ranking
+
+[protonation]
+swel = "Cs+"            # replace added H+ with Cs+ ion (also accepts Na+, Li+, Ca2+, …)
diff --git a/examples/expl-14/run.sh b/examples/expl-14/run.sh
new file mode 100755
index 00000000..efce1960
--- /dev/null
+++ b/examples/expl-14/run.sh
@@ -0,0 +1,13 @@
+#!/bin/bash
+# Metal/ion adduct generation for alpha-D-glucose with GFN2-xTB.
+# Replaces H+ with Cs+ (via -swel) to generate Cs+ adducts.
+# Other ions (Na+, Li+, Ca2+, …) can be used the same way.
+# Output: protonated.xyz
+
+command -v crest >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary."; exit 1; }
+
+# --- CLI run ---
+crest struc.xyz -protonate -swel Cs+
+
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-14/struc.xyz b/examples/expl-14/struc.xyz
new file mode 100644
index 00000000..a3c58227
--- /dev/null
+++ b/examples/expl-14/struc.xyz
@@ -0,0 +1,26 @@
+   24
+FINAL HEAT OF FORMATION =     0.000000
+ O    -1.240000     0.500286     0.389534
+ O    -3.422179    -1.988021    -1.200876
+ O    -1.030343    -2.500198     1.371244
+ O    -0.269585    -1.376682    -2.050459
+ O     0.714096     0.825174    -0.948699
+ O    -4.564244     0.596025    -1.237038
+ C    -2.604750    -1.434635    -0.186435
+ C    -1.275745    -2.232516     0.002738
+ C    -2.309462     0.069148    -0.458819
+ C    -0.090913    -1.462394    -0.648941
+ C     0.038626    -0.020969    -0.037264
+ C    -3.562580     0.927621    -0.299600
+ H    -3.175049    -1.514611     0.751562
+ H    -1.394054    -3.206789    -0.495459
+ H    -1.941229     0.164323    -1.490086
+ H     0.840456    -2.024192    -0.479114
+ H     0.639496    -0.057270     0.885117
+ H    -3.985456     0.780616     0.699514
+ H    -3.317920     1.993716    -0.382206
+ H    -4.113958    -1.329897    -1.403262
+ H    -1.021769    -1.655987     1.868817
+ H     0.187245    -0.582574    -2.396515
+ H     1.659435     0.569359    -1.034662
+ H    -4.311180     0.903728    -2.134995
diff --git a/examples/expl-15/input.toml b/examples/expl-15/input.toml
new file mode 100644
index 00000000..b4f52c28
--- /dev/null
+++ b/examples/expl-15/input.toml
@@ -0,0 +1,9 @@
+# Tautomer screening via protonation/deprotonation sequences
+runtype = "tautomerize"
+input   = "struc.xyz"   # input structure file (guanine)
+
+[[calculation.level]]
+method = "gfn2"         # GFN2-xTB for tautomer ranking
+
+[cregen]
+ewin = 10.0             # energy window for tautomer selection (kcal/mol)
diff --git a/examples/expl-15/run.sh b/examples/expl-15/run.sh
new file mode 100755
index 00000000..60f8ee69
--- /dev/null
+++ b/examples/expl-15/run.sh
@@ -0,0 +1,12 @@
+#!/bin/bash
+# Tautomer screening of guanine via protonation/deprotonation sequences.
+# Explores prototropic tautomers at GFN2-xTB level.
+# Expected output: 5 major tautomers within 10 kcal/mol in tautomers.xyz.
+
+command -v crest >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary."; exit 1; }
+
+# --- CLI run ---
+crest struc.xyz -tautomerize -ewin 10.0
+
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-15/struc.xyz b/examples/expl-15/struc.xyz
new file mode 100644
index 00000000..725a04d3
--- /dev/null
+++ b/examples/expl-15/struc.xyz
@@ -0,0 +1,18 @@
+16
+ energy: -31.983681788270 gnorm: 0.000372144832 xtb: 6.2.2 (89a525f)
+N           1.46226284012671     0.18335744247169    -0.07855270314916
+C           1.31781205014203    -1.15293393777405     0.05955064599303
+C           1.54055132778996    -2.13428714261960    -0.91007075980005
+C           1.98029754954570    -1.74761862944617    -2.21865239727883
+N           2.10914370306048    -0.33402358897783    -2.27674973147307
+C           1.86775867472018     0.54390043382692    -1.26343764079100
+N           1.27680953207984    -3.36757233307534    -0.37748854905490
+C           0.91461226786592    -3.14740906594264     0.84460715972356
+N           0.91768716624572    -1.81594469141732     1.17440471889163
+O           2.23471850070944    -2.39670706107528    -3.20454497820690
+N           2.11460025487082     1.85836120568312    -1.49845077783225
+H           0.67952040591559    -1.39514835256529     2.05664466916869
+H           0.63659476510547    -3.91144927326480     1.54245387480526
+H           2.43918920019300     0.01672894983906    -3.16809193535854
+H           1.78950116764777     2.49655065642122    -0.79277065540295
+H           2.15173216814906     2.19392916334893    -2.44513710915798
diff --git a/examples/expl-16/input.toml b/examples/expl-16/input.toml
new file mode 100644
index 00000000..e5c98cc8
--- /dev/null
+++ b/examples/expl-16/input.toml
@@ -0,0 +1,12 @@
+# Geometry optimisation of an Ar4 cluster using a Lennard-Jones potential
+# served through the fmlip-relay persistent Python backend.
+# The LJ backend requires only ASE, no ML framework needed.
+runtype = "optimize"
+input   = "struc.xyz"   # input structure file (Ar4 cluster, slightly compressed)
+
+[calculation]
+optlev = "normal"       # convergence level: crude/loose/normal/tight/vtight
+
+[[calculation.level]]
+method       = "mlip"   # ML/classical potential via fmlip-relay socket server
+mlip_backend = "lj"     # Lennard-Jones backend — default Ar parameters (ε=0.0104 eV, σ=3.40 Å)
diff --git a/examples/expl-16/run.sh b/examples/expl-16/run.sh
new file mode 100755
index 00000000..3c8f4a63
--- /dev/null
+++ b/examples/expl-16/run.sh
@@ -0,0 +1,27 @@
+#!/bin/bash
+# Geometry optimisation of an Ar4 cluster using the Lennard-Jones potential
+# served through the fmlip-relay persistent Python backend.
+# fmlip-relay spawns a persistent server process; CREST communicates with it
+# over a local TCP socket, avoiding repeated Python startup overhead.
+# Output: crest_best.xyz (optimised Ar4 geometry near the LJ minimum ~3.82 Å)
+
+command -v crest >/dev/null 2>&1 || {
+  echo >&2 "Cannot find crest binary."
+  exit 1
+}
+
+# Check for the fmlip-relay server; suggest pip install if absent
+if ! command -v fmlip-relay-server >/dev/null 2>&1; then
+  echo >&2 ""
+  echo >&2 "ERROR: 'fmlip-relay-server' not found."
+  echo >&2 "Install fmlip-relay from the CREST subproject directory:"
+  echo >&2 ""
+  echo >&2 "    pip install ../../subprojects/fmlip_relay"
+  echo >&2 ""
+  echo >&2 "For a user-local install add '--user', or activate a virtual environment first."
+  exit 1
+fi
+
+# --- TOML run ---
+# (No CLI equivalent; mlip settings are TOML-only.)
+crest input.toml
diff --git a/examples/expl-16/struc.xyz b/examples/expl-16/struc.xyz
new file mode 100644
index 00000000..5de5f994
--- /dev/null
+++ b/examples/expl-16/struc.xyz
@@ -0,0 +1,6 @@
+4
+Ar4 cluster (compressed, for LJ optimization)
+Ar   0.000   0.000   0.000
+Ar   3.300   0.000   0.000
+Ar   1.650   2.860   0.000
+Ar   1.650   0.953   2.694
diff --git a/examples/expl-17/input.toml b/examples/expl-17/input.toml
new file mode 100644
index 00000000..6f262c4f
--- /dev/null
+++ b/examples/expl-17/input.toml
@@ -0,0 +1,25 @@
+# Geometry optimisation of a small molecule using Meta FAIR's UMA foundation
+# model (fairchem-core v2), served through the fmlip-relay persistent backend.
+#
+# UMA is a single multi-task model; the active domain is chosen via the task
+# head. The "omol" task (organic/inorganic molecules) honours the total charge
+# and the spin multiplicity, which CREST forwards to the server per evaluation
+# from the 'chrg' and 'mult' keys below.
+#
+# Requirements: pip install "../../subprojects/fmlip_relay[uma]"
+# The UMA checkpoints are gated on the Hugging Face Hub — request access on the
+# model page and authenticate (huggingface-cli login or $HF_TOKEN) before use.
+runtype = "optimize"
+input   = "struc.xyz"   # input structure file (caffeine, C8H10N4O2)
+
+[calculation]
+optlev = "normal"       # convergence level: crude/loose/normal/tight/vtight
+
+[[calculation.level]]
+method         = "mlip"        # ML/classical potential via fmlip-relay socket server
+mlip_backend   = "uma"         # FairChem UMA foundation model
+mlip_uma_model = "uma-s-1p2"   # checkpoint: uma-s-1 | uma-s-1p1 | uma-s-1p2 (default) | uma-m-1
+mlip_uma_task  = "omol"        # task head: omol | omat | omc | oc20 | odac
+mlip_device    = "cpu"         # torch device: cpu | cuda | cuda:0  (UMA runs best on GPU)
+chrg           = 0             # total molecular charge   (forwarded to the omol task)
+mult           = 1             # spin multiplicity 2S+1   (forwarded to the omol task)
diff --git a/examples/expl-17/run.sh b/examples/expl-17/run.sh
new file mode 100755
index 00000000..6fa30163
--- /dev/null
+++ b/examples/expl-17/run.sh
@@ -0,0 +1,28 @@
+#!/bin/bash
+# Geometry optimisation of the caffeine molecule using Meta FAIR's UMA foundation
+# model (fairchem-core v2), served through the fmlip-relay persistent backend.
+# fmlip-relay spawns a persistent server process; CREST communicates with it
+# over a local TCP socket, avoiding repeated Python startup overhead.
+# Output: crest_best.xyz (optimised geometry)
+
+command -v crest >/dev/null 2>&1 || {
+  echo >&2 "Cannot find crest binary."
+  exit 1
+}
+
+# Check for the fmlip-relay server; suggest pip install if absent
+if ! command -v fmlip-relay-server >/dev/null 2>&1; then
+  echo >&2 ""
+  echo >&2 "ERROR: 'fmlip-relay-server' not found."
+  echo >&2 "Install fmlip-relay (with UMA extras) from the CREST subproject directory:"
+  echo >&2 ""
+  echo >&2 "    pip install \"../../subprojects/fmlip_relay[uma]\""
+  echo >&2 ""
+  echo >&2 "UMA checkpoints are gated on the Hugging Face Hub: request access on the"
+  echo >&2 "model page and authenticate (huggingface-cli login or \$HF_TOKEN) first."
+  exit 1
+fi
+
+# --- TOML run ---
+# (No CLI equivalent; mlip settings are TOML-only.)
+crest input.toml
diff --git a/examples/expl-17/struc.xyz b/examples/expl-17/struc.xyz
new file mode 100644
index 00000000..a6c8f5c1
--- /dev/null
+++ b/examples/expl-17/struc.xyz
@@ -0,0 +1,26 @@
+24
+caffeine (C8H10N4O2)
+C         -3.24741       -1.13338        0.03085
+N         -2.26564       -0.07883        0.00538
+C         -2.52079        1.26675       -0.00557
+N         -1.40686        1.97296       -0.00910
+C         -0.41405        1.04003       -0.00300
+C         -0.90847       -0.22864        0.00092
+C         -0.08494       -1.38655        0.00646
+O         -0.54163       -2.52584        0.00868
+N          1.27859       -1.08004        0.00992
+C          1.83002        0.21839        0.00766
+O          3.05306        0.38762        0.01088
+N          0.93714        1.29070        0.00305
+C          1.42504        2.65762        0.00864
+C          2.22515       -2.17795        0.02143
+H         -4.24995       -0.69925        0.00482
+H         -3.11700       -1.70536        0.95309
+H         -3.09907       -1.77036       -0.84451
+H         -3.52341        1.67566       -0.00787
+H          2.51704        2.70044        0.03492
+H          1.03541        3.17325        0.89211
+H          1.07712        3.16545       -0.89652
+H          1.73595       -3.15507        0.02232
+H          2.85353       -2.09533        0.91437
+H          2.86777       -2.10333       -0.86183
diff --git a/examples/expl-18/input.toml b/examples/expl-18/input.toml
new file mode 100644
index 00000000..b43c6368
--- /dev/null
+++ b/examples/expl-18/input.toml
@@ -0,0 +1,21 @@
+# Geometry optimisation of a small molecule using the MACE-OFF23 organic
+# force field, served through the fmlip-relay persistent backend.
+#
+# MACE-OFF23 is parameterised for neutral organic molecules over 10 elements
+# (H, C, N, O, P, S, F, Cl, Br, I) in gas/liquid phase or organic crystals.
+# Unlike UMA's "omol" task it does not take a per-molecule charge/spin, so the
+# 'chrg'/'mult' keys are omitted here (neutral closed-shell systems only).
+#
+# Requirements: pip install "../../subprojects/fmlip_relay[mace]"
+# Models download automatically on first use and cache in ~/.cache/mace.
+runtype = "optimize"
+input   = "struc.xyz"   # input structure file (caffeine, C8H10N4O2)
+
+[calculation]
+optlev = "normal"       # convergence level: crude/loose/normal/tight/vtight
+
+[[calculation.level]]
+method        = "mlip"       # ML/classical potential via fmlip-relay socket server
+mlip_backend  = "mace_off"   # MACE-OFF23 organic force field
+mlip_modelsize = "medium"    # model size: small | medium (default) | large
+mlip_device   = "cpu"        # torch device: cpu | cuda | cuda:0  (GPU recommended)
diff --git a/examples/expl-18/run.sh b/examples/expl-18/run.sh
new file mode 100755
index 00000000..f5824e0c
--- /dev/null
+++ b/examples/expl-18/run.sh
@@ -0,0 +1,27 @@
+#!/bin/bash
+# Geometry optimisation of the caffeine molecule using the MACE-OFF23 organic force
+# field, served through the fmlip-relay persistent backend.
+# fmlip-relay spawns a persistent server process; CREST communicates with it
+# over a local TCP socket, avoiding repeated Python startup overhead.
+# Output: crest_best.xyz (optimised geometry)
+
+command -v crest >/dev/null 2>&1 || {
+  echo >&2 "Cannot find crest binary."
+  exit 1
+}
+
+# Check for the fmlip-relay server; suggest pip install if absent
+if ! command -v fmlip-relay-server >/dev/null 2>&1; then
+  echo >&2 ""
+  echo >&2 "ERROR: 'fmlip-relay-server' not found."
+  echo >&2 "Install fmlip-relay (with MACE extras) from the CREST subproject directory:"
+  echo >&2 ""
+  echo >&2 "    pip install \"../../subprojects/fmlip_relay[mace]\""
+  echo >&2 ""
+  echo >&2 "MACE-OFF23 checkpoints download automatically on first use (cache: ~/.cache/mace)."
+  exit 1
+fi
+
+# --- TOML run ---
+# (No CLI equivalent; mlip settings are TOML-only.)
+crest input.toml
diff --git a/examples/expl-18/struc.xyz b/examples/expl-18/struc.xyz
new file mode 100644
index 00000000..a6c8f5c1
--- /dev/null
+++ b/examples/expl-18/struc.xyz
@@ -0,0 +1,26 @@
+24
+caffeine (C8H10N4O2)
+C         -3.24741       -1.13338        0.03085
+N         -2.26564       -0.07883        0.00538
+C         -2.52079        1.26675       -0.00557
+N         -1.40686        1.97296       -0.00910
+C         -0.41405        1.04003       -0.00300
+C         -0.90847       -0.22864        0.00092
+C         -0.08494       -1.38655        0.00646
+O         -0.54163       -2.52584        0.00868
+N          1.27859       -1.08004        0.00992
+C          1.83002        0.21839        0.00766
+O          3.05306        0.38762        0.01088
+N          0.93714        1.29070        0.00305
+C          1.42504        2.65762        0.00864
+C          2.22515       -2.17795        0.02143
+H         -4.24995       -0.69925        0.00482
+H         -3.11700       -1.70536        0.95309
+H         -3.09907       -1.77036       -0.84451
+H         -3.52341        1.67566       -0.00787
+H          2.51704        2.70044        0.03492
+H          1.03541        3.17325        0.89211
+H          1.07712        3.16545       -0.89652
+H          1.73595       -3.15507        0.02232
+H          2.85353       -2.09533        0.91437
+H          2.86777       -2.10333       -0.86183
diff --git a/examples/expl-19/input.toml b/examples/expl-19/input.toml
new file mode 100644
index 00000000..ec215aa2
--- /dev/null
+++ b/examples/expl-19/input.toml
@@ -0,0 +1,25 @@
+# Single-point energy with a method-independent implicit-solvation add-on.
+#
+# The total energy is stitched from two calculation levels that CREST sums:
+#   1) a GFN2-xTB gas-phase parent potential
+#   2) an implicit-solvation contribution built from EEQ-BC atomic charges,
+#      the ddX continuum model (CPCM), and a GFN2/ALPB-parametrized nonpolar
+#      term (surface tension + charge-dependent hydrogen bonding).
+#
+# Because the solvation level only needs the geometry (it generates its own
+# charges), it can be stacked on top of *any* parent method the same way --
+# semi-empirical, force field or an ML potential.
+runtype = "singlepoint"
+input   = "struc.xyz"        # input structure file (1-propanol)
+
+[calculation]
+
+[[calculation.level]]
+method = "gfn2"              # gas-phase parent Hamiltonian
+
+[[calculation.level]]
+method       = "solvation"   # composite implicit-solvation contribution
+solvent      = "water"       # solvent name (tblite solvent database)
+solv_model   = "cpcm"        # continuum model: cosmo | cpcm | pcm
+solv_charges = "eeqbc"       # charge model:    eeq   | eeqbc
+solv_hbond   = true          # include the charge-dependent H-bond term
diff --git a/examples/expl-19/run.sh b/examples/expl-19/run.sh
new file mode 100755
index 00000000..e1919096
--- /dev/null
+++ b/examples/expl-19/run.sh
@@ -0,0 +1,12 @@
+#!/bin/bash
+# Single-point energy of 1-propanol with a method-independent implicit-solvation
+# add-on: a GFN2-xTB gas-phase parent plus a composite solvation contribution
+# (EEQ-BC charges + ddX/CPCM continuum + GFN2/ALPB nonpolar term) in water.
+#
+# The composite solvation calculator is configured through the TOML input only
+# (there is no dedicated CLI flag for it).
+
+command -v crest >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary."; exit 1; }
+
+# --- TOML run ---
+crest input.toml
diff --git a/examples/expl-19/struc.xyz b/examples/expl-19/struc.xyz
new file mode 100644
index 00000000..4297fe9a
--- /dev/null
+++ b/examples/expl-19/struc.xyz
@@ -0,0 +1,14 @@
+12
+
+C          1.00510       -0.04436        0.07729
+C          2.52196       -0.10014        0.05638
+C          3.03386       -1.52959       -0.04885
+O          4.45512       -1.53382       -0.04957
+H          0.66450        0.99293        0.15400
+H          0.60392       -0.59767        0.93240
+H          0.58435       -0.47325       -0.83778
+H          2.92490        0.36854        0.96213
+H          2.90338        0.49174       -0.78421
+H          2.68484       -2.01184       -0.96764
+H          2.69552       -2.12845        0.80244
+H          4.74911       -1.01511       -0.81774
diff --git a/examples/expl-2.5/run.sh b/examples/expl-2.5/run.sh
deleted file mode 100755
index 2215a633..00000000
--- a/examples/expl-2.5/run.sh
+++ /dev/null
@@ -1,29 +0,0 @@
-#!/bin/bash
-
-xtbin='xtb'
-crst='crest'
-
-command -v $xtbin >/dev/null 2>&1 || { echo >&2 "Cannot find xtb binary. Exit."; exit 1; }
-command -v $crst >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary. Exit."; exit 1; }
-
-if [ $xtbin == 'xtb' ]
- then
-    $crst struc.xyz -ewin 2.0 -quick -prop ohess
- else
-    $crst struc.xyz -ewin 2.0 -quick -prop ohess -xnam $xtbin
- fi
-
-# Some further calculations can be added automatically
-# after the conformer search with the '-prop' command.
-# In the above example, after searching for the
-# conformers of 1-propanol, each conformer is optimized
-# again and frequencies are calculated (ohess).
-# The conformer ensemble is then re-ranked with free
-# energies from RRHO contributions.
-#
-# There are also some different 'quick'-modes to run
-# the conformational search with reduced settings.
-# With these modes the conformational space will be
-# explored less extensively, but it will speed up
-# the calculation. ('-quick','-squick','-mquick')
-
diff --git a/examples/expl-2/input.toml b/examples/expl-2/input.toml
new file mode 100644
index 00000000..82479488
--- /dev/null
+++ b/examples/expl-2/input.toml
@@ -0,0 +1,9 @@
+# Geometry optimization
+runtype = "optimize"
+input   = "struc.xyz"   # input structure file (1-propanol)
+
+[calculation]
+optlev = "normal"       # convergence level: crude/loose/normal/tight/vtight
+
+[[calculation.level]]
+method = "gfn2"         # GFN2-xTB semi-empirical Hamiltonian
diff --git a/examples/expl-2/run.sh b/examples/expl-2/run.sh
index e2da43e9..e681d0ba 100755
--- a/examples/expl-2/run.sh
+++ b/examples/expl-2/run.sh
@@ -1,30 +1,11 @@
 #!/bin/bash
+# Geometry optimization of 1-propanol with GFN2-xTB.
+# Output: crest_best.xyz (optimized structure)
 
-xtbin='xtb'
-crst='crest'
-
-command -v $xtbin >/dev/null 2>&1 || { echo >&2 "Cannot find xtb binary. Exit."; exit 1; }
-command -v $crst >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary. Exit."; exit 1; }
-
-if [ $xtbin == 'xtb' ]
- then
-    $crst struc.xyz -ewin 2.0 -g h2o -gfn2 -T 4
- else
-    $crst struc.xyz -ewin 2.0 -g h2o -gfn2 -T 4 -xnam $xtbin
- fi
-
-
-# This will execute a conformational search with some manually changed
-# settings for the 1-propanol molecule.
-# The GBSA implicit solvation model for H2O is employed with the
-# '-g' flag.
-# Furthermore, the use of GFN2-xTB is requested explicitly ('-gfn2')
-# and the program is ordered to use 4 CPU threads ('-T').
-# For a 1-propanol the conformers in implicit solvation are the
-# same as in the gas phase, but the relative energies should
-# differ significantly.
-# Unique conformers can be found in the file 'crest_conformers.xyz'.
-# All degenerate conformers (rotamers, pseudo-enantiomers)
-# can be found in the file 'crest_rotamers.xyz'
+command -v crest >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary."; exit 1; }
 
+# --- CLI run ---
+crest struc.xyz -opt
 
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-3/input.toml b/examples/expl-3/input.toml
new file mode 100644
index 00000000..9f176ff0
--- /dev/null
+++ b/examples/expl-3/input.toml
@@ -0,0 +1,9 @@
+# Geometry optimization followed by Hessian (vibrational frequency) calculation
+runtype = "ohess"
+input   = "struc.xyz"   # input structure file (1-propanol)
+
+[calculation]
+optlev = "tight"        # tighter convergence before frequency calculation
+
+[[calculation.level]]
+method = "gfn2"         # GFN2-xTB semi-empirical Hamiltonian
diff --git a/examples/expl-3/run.sh b/examples/expl-3/run.sh
index 00d10ba9..7fb84261 100755
--- a/examples/expl-3/run.sh
+++ b/examples/expl-3/run.sh
@@ -1,24 +1,12 @@
 #!/bin/bash
+# Geometry optimization followed by numerical Hessian (vibrational frequencies)
+# of 1-propanol with GFN2-xTB.
+# Output: crest_best.xyz (optimized structure), vibspectrum (frequencies)
 
-xtbin='xtb'
-crst='crest'
+command -v crest >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary."; exit 1; }
 
-command -v $xtbin >/dev/null 2>&1 || { echo >&2 "Cannot find xtb binary. Exit."; exit 1; }
-command -v $crst >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary. Exit."; exit 1; }
-
-$crst struc.xyz -cregen xtb.trj -ewin 100.0
-
-
-# The sorting routine from the CREST conformational search can be
-# used as a standalone to sort any .xyz or .trj ensemble file.
-# The above command will sort the file xtb.trj according to
-# its energy and determine duplicate structures.
-# Two files are written analogous to 'crest_conformers.xyz'
-# and 'crest_rotamers.xyz'.
-# The new file 'crest_ensemble.xyz' will contain only unique
-# structures from xtb.trj, while the new file 'xtb.trj.sorted'
-# is just a sorted version of the original file (without the
-# -ewin flag the default 6.0 kcal/mol window will be used)
-# The routine requires a reference structure which is given
-# by 'struc.xyz'.
+# --- CLI run ---
+crest struc.xyz -ohess
 
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-3/struc.xyz b/examples/expl-3/struc.xyz
index 38692b20..4297fe9a 100644
--- a/examples/expl-3/struc.xyz
+++ b/examples/expl-3/struc.xyz
@@ -1,14 +1,14 @@
-   12
-FINAL HEAT OF FORMATION =    -1.651323
- C     1.625257    -0.262628    -0.323273
- C     0.518221     0.706221    -0.335177
- C    -0.859313    -0.005477    -0.327969
- H    -1.683026     0.654493    -0.607965
- H    -0.974493    -0.754480    -1.061658
- O    -1.171503    -0.423846     1.012985
- H    -0.837975     0.254126     1.683603
- H     0.615912     1.428650     0.457852
- H     0.597843     1.325129    -1.321583
- H     1.504113    -0.866659     0.564875
- H     2.639815     0.049302    -0.353007
- H     1.502315    -1.001480    -1.109649
+12
+
+C          1.00510       -0.04436        0.07729
+C          2.52196       -0.10014        0.05638
+C          3.03386       -1.52959       -0.04885
+O          4.45512       -1.53382       -0.04957
+H          0.66450        0.99293        0.15400
+H          0.60392       -0.59767        0.93240
+H          0.58435       -0.47325       -0.83778
+H          2.92490        0.36854        0.96213
+H          2.90338        0.49174       -0.78421
+H          2.68484       -2.01184       -0.96764
+H          2.69552       -2.12845        0.80244
+H          4.74911       -1.01511       -0.81774
diff --git a/examples/expl-4/input.toml b/examples/expl-4/input.toml
new file mode 100644
index 00000000..d1378bf1
--- /dev/null
+++ b/examples/expl-4/input.toml
@@ -0,0 +1,13 @@
+# Standalone molecular dynamics simulation
+runtype = "dynamics"
+input   = "struc.xyz"   # input structure file (1-propanol)
+
+[[calculation.level]]
+method = "gfnff"        # GFN-FF force field for fast MD
+
+[dynamics]
+length_ps   = 20.0      # total simulation length (ps)
+tstep       = 1.0       # integration timestep (fs)
+temperature = 400.0     # thermostat target temperature (K)
+dump        = 100.0     # trajectory dump interval (fs)
+shake       = 1         # constrain X-H bonds (0 = off, 1 = X-H, 2 = all bonds)
diff --git a/examples/expl-4/run.sh b/examples/expl-4/run.sh
index 7f62e3c2..91cd67ad 100755
--- a/examples/expl-4/run.sh
+++ b/examples/expl-4/run.sh
@@ -1,32 +1,15 @@
 #!/bin/bash
+# Standalone molecular dynamics (MD) simulation of 1-propanol with GFN-FF.
+# Runs a 20 ps NVT trajectory at 400 K.
+# Output: crest_dynamics.trj (trajectory), crest_property.out (energies)
 
-xtbin='xtb'
-crst='crest'
+command -v crest >/dev/null 2>&1 || {
+  echo >&2 "Cannot find crest binary."
+  exit 1
+}
 
-command -v $xtbin >/dev/null 2>&1 || { echo >&2 "Cannot find xtb binary. Exit."; exit 1; }
-command -v $crst >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary. Exit."; exit 1; }
+# --- CLI run ---
+crest struc.xyz -dyn -gfnff -mdtemp 400 -mdlen 20 -tstep 1.0
 
-if [ $xtbin == 'xtb' ]
- then
-    $crst struc.xyz -constrain 1-4
-    $crst struc.xyz -cinp .xcontrol.sample
- else
-    $crst struc.xyz -constrain 1-4
-    $crst struc.xyz -cinp .xcontorl.sample -xnam $xtbin
- fi
-
-
-# Constraint conformational sampling is possible by
-# providing the constrainment info as a file
-# via the '-cinp' flag.
-# For detailed information about the constraining
-# options see the online documentation of
-# CREST and xTB.
-# However, a dummy constraining file '.xcontrol.sample'
-# can be written by CREST with a seperate call using
-# The '-constrain <atoms>' flag.
-# In the above example the carbon atoms and the oxygen
-# atom of 1-propanol (atoms 1-4) will be constrained.
-# In the resulting "ensemble" only conformers resulting
-# from different OH dihedral angles will be present
-# (2 conformers total)
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-5/input.toml b/examples/expl-5/input.toml
new file mode 100644
index 00000000..d2b0a0e2
--- /dev/null
+++ b/examples/expl-5/input.toml
@@ -0,0 +1,9 @@
+# Default iMTD-GC conformer search
+runtype = "imtd-gc"
+input   = "struc.xyz"   # input structure file (1-propanol)
+
+[[calculation.level]]
+method = "gfnff"    # GFN-FF force field for fast conformer sampling
+
+[cregen]
+ewin = 2.0          # keep conformers within 2.0 kcal/mol of the lowest
diff --git a/examples/expl-5/run.sh b/examples/expl-5/run.sh
index f9a722ac..30ad4021 100755
--- a/examples/expl-5/run.sh
+++ b/examples/expl-5/run.sh
@@ -1,22 +1,11 @@
 #!/bin/bash
+# Default iMTD-GC conformer search of 1-propanol with GFN-FF.
+# Expected output: ~4 unique conformers in crest_conformers.xyz within 2.0 kcal/mol.
 
-xtbin='xtb'
-crst='crest'
+command -v crest >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary."; exit 1; }
 
-command -v $xtbin >/dev/null 2>&1 || { echo >&2 "Cannot find xtb binary. Exit."; exit 1; }
-command -v $crst >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary. Exit."; exit 1; }
+# --- CLI run ---
+crest struc.xyz -imtdgc -gfnff -ewin 2.0
 
-if [ $xtbin == 'xtb' ]
- then
-    $crst -mdopt xtb.trj
- else
-    $crst -mdopt xtb.trj -xnam $xtbin
- fi
-
-
-# A ensemble file (or MD trajectory) can also
-# be optimized in a standalone application
-# of CREST using the '-mdopt' flag.
-# The optimized structures are written to a
-# file called 'crest_ensemble.xyz', but will
-# not be sorted in any way.
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-5/struc.xyz b/examples/expl-5/struc.xyz
new file mode 100644
index 00000000..4297fe9a
--- /dev/null
+++ b/examples/expl-5/struc.xyz
@@ -0,0 +1,14 @@
+12
+
+C          1.00510       -0.04436        0.07729
+C          2.52196       -0.10014        0.05638
+C          3.03386       -1.52959       -0.04885
+O          4.45512       -1.53382       -0.04957
+H          0.66450        0.99293        0.15400
+H          0.60392       -0.59767        0.93240
+H          0.58435       -0.47325       -0.83778
+H          2.92490        0.36854        0.96213
+H          2.90338        0.49174       -0.78421
+H          2.68484       -2.01184       -0.96764
+H          2.69552       -2.12845        0.80244
+H          4.74911       -1.01511       -0.81774
diff --git a/examples/expl-6/input.toml b/examples/expl-6/input.toml
new file mode 100644
index 00000000..1a28eaf6
--- /dev/null
+++ b/examples/expl-6/input.toml
@@ -0,0 +1,15 @@
+# iMTD-GC conformer search with two-level (A//B) calculation:
+#   Level 1 – GFN-FF: fast force field used for MD/MTD sampling
+#   Level 2 – GFN2:   re-ranks the final ensemble with single-point energies
+runtype = "imtd-gc"
+input   = "struc.xyz"   # input structure file (1-propanol)
+
+[[calculation.level]]
+method = "gfnff"            # GFN-FF force field for fast MD sampling
+
+[[calculation.level]]
+method  = "gfn2"            # GFN2-xTB for accurate final ranking
+refine  = "singlepoint"     # apply this level as single-point re-ranking step
+
+[cregen]
+ewin = 6.0                  # keep conformers within 6.0 kcal/mol of the lowest
diff --git a/examples/expl-6/run.sh b/examples/expl-6/run.sh
index d507701b..14d1d58c 100755
--- a/examples/expl-6/run.sh
+++ b/examples/expl-6/run.sh
@@ -1,27 +1,19 @@
 #!/bin/bash
+# Two-level iMTD-GC conformer search of 1-propanol using the A//B scheme:
+# GFN-FF handles the fast MD/MTD sampling phase; GFN2 single-points
+# re-rank the final ensemble.  This gives good accuracy at reduced cost.
+# Output: crest_conformers.xyz
 
-xtbin='xtb'
-crst='crest'
+command -v crest >/dev/null 2>&1 || {
+  echo >&2 "Cannot find crest binary."
+  exit 1
+}
 
-command -v $xtbin >/dev/null 2>&1 || { echo >&2 "Cannot find xtb binary. Exit."; exit 1; }
-command -v $crst >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary. Exit."; exit 1; }
-
-if [ $xtbin == 'xtb' ]
- then
-    $crst struc.xyz -nci
- else
-    $crst struc.xyz -nci -xnam $xtbin
- fi
-
-
-# This will execute the NCI sampling mode of CREST of the
-# water trimer with default settings.
-# A wall-potential is automatically generated and added to
-# the calculation to prevent dissociation.
-# The NCI mode is a special case of the constrained sampling.
-# Just like the regular conformational search unique conformers
-# can be found in the file 'crest_conformers.xyz'.
-# All degenerate conformers (rotamers, pseudo-enantiomers)
-# can be found in the file 'crest_rotamers.xyz'
+# --- CLI run (A//B: B for sampling, A for single-point re-ranking) ---
+crest struc.xyz -imtdgc --gfn2//gfnff -ewin 6.0
 
+# Alternative: GFN-FF sampling + GFN2 geometry refinement of each conformer:
+# crest struc.xyz -imtdgc --gfnff/opt/gfn2 -ewin 6.0
 
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-6/struc.xyz b/examples/expl-6/struc.xyz
index 5553af95..4297fe9a 100644
--- a/examples/expl-6/struc.xyz
+++ b/examples/expl-6/struc.xyz
@@ -1,11 +1,14 @@
-    9
-FINAL HEAT OF FORMATION =     0.000000
- H    -1.091354     2.083948     0.561412
- O    -0.873213     1.360333    -0.037725
- H    -1.126153    -0.540943     0.037240
- H     0.094609     1.245770     0.037306
- O     1.614744     0.076014    -0.037729
- O    -0.741528    -1.436357    -0.037711
- H    -1.259101    -1.987119     0.561339
- H     2.350402    -0.096756     0.561513
- H     1.031565    -0.704748     0.037192
+12
+
+C          1.00510       -0.04436        0.07729
+C          2.52196       -0.10014        0.05638
+C          3.03386       -1.52959       -0.04885
+O          4.45512       -1.53382       -0.04957
+H          0.66450        0.99293        0.15400
+H          0.60392       -0.59767        0.93240
+H          0.58435       -0.47325       -0.83778
+H          2.92490        0.36854        0.96213
+H          2.90338        0.49174       -0.78421
+H          2.68484       -2.01184       -0.96764
+H          2.69552       -2.12845        0.80244
+H          4.74911       -1.01511       -0.81774
diff --git a/examples/expl-7/input.toml b/examples/expl-7/input.toml
new file mode 100644
index 00000000..effe947c
--- /dev/null
+++ b/examples/expl-7/input.toml
@@ -0,0 +1,11 @@
+# iMTD-GC conformer search with GFN2-xTB and ALPB implicit solvation
+runtype = "imtd-gc"
+input   = "struc.xyz"   # input structure file (1-propanol)
+threads = 4             # number of parallel threads
+
+[[calculation.level]]
+method = "gfn2"         # GFN2-xTB semi-empirical Hamiltonian
+alpb   = "h2o"          # ALPB implicit solvation model, water solvent
+
+[cregen]
+ewin = 2.0              # keep conformers within 2.0 kcal/mol of the lowest
diff --git a/examples/expl-7/run.sh b/examples/expl-7/run.sh
index d1341045..7f95eff0 100755
--- a/examples/expl-7/run.sh
+++ b/examples/expl-7/run.sh
@@ -1,21 +1,15 @@
 #!/bin/bash
+# iMTD-GC conformer search of 1-propanol with GFN2-xTB and ALPB implicit solvation (water).
+# Conformers in solution differ in relative energy from the gas phase.
+# Uses 4 CPU threads.  Output: crest_conformers.xyz
 
-xtbin='xtb'
-crst='crest'
+command -v crest >/dev/null 2>&1 || {
+  echo >&2 "Cannot find crest binary."
+  exit 1
+}
 
-command -v $xtbin >/dev/null 2>&1 || { echo >&2 "Cannot find xtb binary. Exit."; exit 1; }
-command -v $crst >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary. Exit."; exit 1; }
+# --- CLI run ---
+crest struc.xyz -gfn2 -alpb h2o -T 4 -ewin 2.0 -imtdgc
 
-if [ $xtbin == 'xtb' ]
- then
-    $crst struc.xyz -protonate
- else
-    $crst struc.xyz -protonate -xnam $xtbin
- fi
-
-
-# This command will create protomers of the uracil molecule.
-# The default energy window for this application is 30 kcal/mol
-# Only 3 structures should remain in the gas phase at the
-# default GFN2-xTB level.
-# The structures can be found in the file 'protonated.xyz'
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-7/struc.xyz b/examples/expl-7/struc.xyz
index 73524a28..4297fe9a 100644
--- a/examples/expl-7/struc.xyz
+++ b/examples/expl-7/struc.xyz
@@ -1,14 +1,14 @@
 12
- energy: -24.614946947602 gnorm: 0.000456827525 xtb: 6.2.2 (89a525f)
-O           1.01382029544030     0.03880681993718     0.26260657568622
-C           2.21194959420030     0.00777551853774     0.13894624850894
-N           2.97633014247497     1.15928881874167     0.06760158128732
-C           4.33128423994495     1.14641376546424    -0.07421492522129
-C           5.02090106234646    -0.00303350704424    -0.15435476958224
-C           4.32754207903802    -1.27903972647711    -0.09166688984675
-O           4.83244816077160    -2.37420082989590    -0.15422059425404
-N           2.94450163810970    -1.14763022456257     0.05629094590508
-H           2.46829084494664     2.03038084438831     0.12488082938105
-H           4.81038312241915     2.11362921965719    -0.11757996835012
-H           6.09011013882395    -0.02137897779485    -0.26646726330202
-H           2.41547828301905    -2.01176145142300     0.10488837035251
+
+C          1.00510       -0.04436        0.07729
+C          2.52196       -0.10014        0.05638
+C          3.03386       -1.52959       -0.04885
+O          4.45512       -1.53382       -0.04957
+H          0.66450        0.99293        0.15400
+H          0.60392       -0.59767        0.93240
+H          0.58435       -0.47325       -0.83778
+H          2.92490        0.36854        0.96213
+H          2.90338        0.49174       -0.78421
+H          2.68484       -2.01184       -0.96764
+H          2.69552       -2.12845        0.80244
+H          4.74911       -1.01511       -0.81774
diff --git a/examples/expl-8/input.toml b/examples/expl-8/input.toml
new file mode 100644
index 00000000..33d2fc84
--- /dev/null
+++ b/examples/expl-8/input.toml
@@ -0,0 +1,11 @@
+# Quick iMTD-GC conformer search with reduced MTD simulation length.
+# Uncomment finalhess to add a post-search Hessian and re-rank by Gibbs free energy.
+runtype = "mtd_search_quick"  # reduced settings; alternatives: mtd_search_squick, mtd_search_mquick
+input   = "struc.xyz"         # input structure file (1-propanol)
+# Note: -finalhess (post-search Hessian + free-energy re-ranking) is CLI-only; add it to the crest call above.
+
+[[calculation.level]]
+method = "gfnff"              # GFN-FF force field
+
+[cregen]
+ewin = 2.0                    # keep conformers within 2.0 kcal/mol of the lowest
diff --git a/examples/expl-8/run.sh b/examples/expl-8/run.sh
index d28b597c..d3b8404e 100755
--- a/examples/expl-8/run.sh
+++ b/examples/expl-8/run.sh
@@ -1,26 +1,19 @@
 #!/bin/bash
+# Quick iMTD-GC conformer search of 1-propanol with reduced MTD simulation length.
+# Useful for a fast first survey of conformational space.
+# Output: crest_conformers.xyz
+# Also available: -squick (super quick) and -mquick (mega quick) modes.
+#
+# -finalhess adds a post-search Hessian on each conformer in the final ensemble
+# and re-ranks by Gibbs free energy.
 
-xtbin='xtb'
-crst='crest'
-
-command -v $xtbin >/dev/null 2>&1 || { echo >&2 "Cannot find xtb binary. Exit."; exit 1; }
-command -v $crst >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary. Exit."; exit 1; }
-
-if [ $xtbin == 'xtb' ]
- then
-    $crst struc.xyz -protonate -swel Cs+
- else
-    $crst struc.xyz -protonate -swel Cs+ -xnam $xtbin
- fi
+command -v crest >/dev/null 2>&1 || {
+  echo >&2 "Cannot find crest binary."
+  exit 1
+}
 
-# In a modified version of the protonation tool
-# other ionization adducts can be created
-# (only mono nuclear ions)
-# To do this, the flag '-swel' (short for switch element)
-# is used to indicate the new ion and its charge,
-# e.g., Na+, Ca2+, Li+, etc.
-#
-# As a example the alpha-D-glucose-Cs+ adducts
-# will be created at the GFN2-xTB level with the above command.
-# The adducts can be found in the file 'protonated.xyz'
+# --- CLI run (quick search only) ---
+crest struc.xyz -quick -gfnff -ewin 2.0 -imtdgc -finalhess
 
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-8/struc.xyz b/examples/expl-8/struc.xyz
index a3c58227..4297fe9a 100644
--- a/examples/expl-8/struc.xyz
+++ b/examples/expl-8/struc.xyz
@@ -1,26 +1,14 @@
-   24
-FINAL HEAT OF FORMATION =     0.000000
- O    -1.240000     0.500286     0.389534
- O    -3.422179    -1.988021    -1.200876
- O    -1.030343    -2.500198     1.371244
- O    -0.269585    -1.376682    -2.050459
- O     0.714096     0.825174    -0.948699
- O    -4.564244     0.596025    -1.237038
- C    -2.604750    -1.434635    -0.186435
- C    -1.275745    -2.232516     0.002738
- C    -2.309462     0.069148    -0.458819
- C    -0.090913    -1.462394    -0.648941
- C     0.038626    -0.020969    -0.037264
- C    -3.562580     0.927621    -0.299600
- H    -3.175049    -1.514611     0.751562
- H    -1.394054    -3.206789    -0.495459
- H    -1.941229     0.164323    -1.490086
- H     0.840456    -2.024192    -0.479114
- H     0.639496    -0.057270     0.885117
- H    -3.985456     0.780616     0.699514
- H    -3.317920     1.993716    -0.382206
- H    -4.113958    -1.329897    -1.403262
- H    -1.021769    -1.655987     1.868817
- H     0.187245    -0.582574    -2.396515
- H     1.659435     0.569359    -1.034662
- H    -4.311180     0.903728    -2.134995
+12
+
+C          1.00510       -0.04436        0.07729
+C          2.52196       -0.10014        0.05638
+C          3.03386       -1.52959       -0.04885
+O          4.45512       -1.53382       -0.04957
+H          0.66450        0.99293        0.15400
+H          0.60392       -0.59767        0.93240
+H          0.58435       -0.47325       -0.83778
+H          2.92490        0.36854        0.96213
+H          2.90338        0.49174       -0.78421
+H          2.68484       -2.01184       -0.96764
+H          2.69552       -2.12845        0.80244
+H          4.74911       -1.01511       -0.81774
diff --git a/examples/expl-9/input.toml b/examples/expl-9/input.toml
new file mode 100644
index 00000000..45937e4b
--- /dev/null
+++ b/examples/expl-9/input.toml
@@ -0,0 +1,9 @@
+# Standalone CREGEN ensemble sorting
+runtype  = "cregen"
+ensemble = "xtb.trj"    # ensemble/trajectory file to sort
+
+[cregen]
+ewin  = 100.0           # energy window for conformer selection (kcal/mol)
+rthr  = 0.125           # RMSD threshold for duplicate detection (Å)
+ethr  = 0.05            # energy threshold for duplicate detection (kcal/mol)
+bthr  = 15.0            # rotational constant threshold (MHz)
diff --git a/examples/expl-9/run.sh b/examples/expl-9/run.sh
index a487ef16..ce164da2 100755
--- a/examples/expl-9/run.sh
+++ b/examples/expl-9/run.sh
@@ -1,27 +1,15 @@
 #!/bin/bash
+# Standalone CREGEN sorting of an ensemble/trajectory file.
+# Removes duplicate structures (by RMSD and energy) and sorts by energy.
+# Output: crest_conformers.xyz (unique), crest_rotamers.xyz (all), xtb.trj.sorted
 
-xtbin='xtb'
-crst='crest'
+command -v crest >/dev/null 2>&1 || {
+  echo >&2 "Cannot find crest binary."
+  exit 1
+}
 
-command -v $xtbin >/dev/null 2>&1 || { echo >&2 "Cannot find xtb binary. Exit."; exit 1; }
-command -v $crst >/dev/null 2>&1 || { echo >&2 "Cannot find crest binary. Exit."; exit 1; }
-
-if [ $xtbin == 'xtb' ]
- then
-    $crst struc.xyz -tautomerize -ewin 10.0
- else
-    $crst struc.xyz -tautomerize -ewin 10.0 -xnam $xtbin
- fi
-
-# The -tautomerize flag can be used to request
-# a screening of prototropic tautomers.
-# The structures are build from a sequence of
-# protonating and deprotonating steps of the
-# (neutral) input structure.
-# In the above example this procedure is
-# performed on the guanine molecule to get
-# the gas phase tautomers at GFN2-xTB level.
-# Within the 10 kcal/mol window 5 tautomers
-# should remain at this level.
-# The structures can be found in 'tautomers.xyz'.
+# --- CLI run ---
+crest -cregen xtb.trj -ewin 100.0
 
+# --- TOML run (equivalent settings) ---
+# crest input.toml
diff --git a/examples/expl-9/struc.xyz b/examples/expl-9/struc.xyz
index 725a04d3..38692b20 100644
--- a/examples/expl-9/struc.xyz
+++ b/examples/expl-9/struc.xyz
@@ -1,18 +1,14 @@
-16
- energy: -31.983681788270 gnorm: 0.000372144832 xtb: 6.2.2 (89a525f)
-N           1.46226284012671     0.18335744247169    -0.07855270314916
-C           1.31781205014203    -1.15293393777405     0.05955064599303
-C           1.54055132778996    -2.13428714261960    -0.91007075980005
-C           1.98029754954570    -1.74761862944617    -2.21865239727883
-N           2.10914370306048    -0.33402358897783    -2.27674973147307
-C           1.86775867472018     0.54390043382692    -1.26343764079100
-N           1.27680953207984    -3.36757233307534    -0.37748854905490
-C           0.91461226786592    -3.14740906594264     0.84460715972356
-N           0.91768716624572    -1.81594469141732     1.17440471889163
-O           2.23471850070944    -2.39670706107528    -3.20454497820690
-N           2.11460025487082     1.85836120568312    -1.49845077783225
-H           0.67952040591559    -1.39514835256529     2.05664466916869
-H           0.63659476510547    -3.91144927326480     1.54245387480526
-H           2.43918920019300     0.01672894983906    -3.16809193535854
-H           1.78950116764777     2.49655065642122    -0.79277065540295
-H           2.15173216814906     2.19392916334893    -2.44513710915798
+   12
+FINAL HEAT OF FORMATION =    -1.651323
+ C     1.625257    -0.262628    -0.323273
+ C     0.518221     0.706221    -0.335177
+ C    -0.859313    -0.005477    -0.327969
+ H    -1.683026     0.654493    -0.607965
+ H    -0.974493    -0.754480    -1.061658
+ O    -1.171503    -0.423846     1.012985
+ H    -0.837975     0.254126     1.683603
+ H     0.615912     1.428650     0.457852
+ H     0.597843     1.325129    -1.321583
+ H     1.504113    -0.866659     0.564875
+ H     2.639815     0.049302    -0.353007
+ H     1.502315    -1.001480    -1.109649
diff --git a/examples/expl-5/xtb.trj b/examples/expl-9/xtb.trj
similarity index 100%
rename from examples/expl-5/xtb.trj
rename to examples/expl-9/xtb.trj
diff --git a/meson.build b/meson.build
index 22a016de..617a24aa 100644
--- a/meson.build
+++ b/meson.build
@@ -16,70 +16,466 @@
 
 project(
   'crest',
-  'fortran', 'c',
-  version: '3.0.2',
-  license: 'LGPL-3.0-or-later',
-  meson_version: '>=0.63',
-  default_options: [
-    'buildtype=debugoptimized',
-    'default_library=static',
-    'c_link_args=-static',
-    'fortran_link_args=-static',
+  ['c', 'fortran'],
+  version         : '3.1.0',
+  license         : 'LGPL-3.0-or-later',
+  meson_version   : '>=0.57.0',
+  default_options : [
+    'buildtype=release',
+    'c_std=gnu11',
+    'warning_level=0',
   ],
 )
-install = not (meson.is_subproject() and get_option('default_library') == 'static')
 
-
-# =================================== #
-## General configuration information ##
-# =================================== #
-exe_deps = []
+# ── Compiler flags, static link args, metadata template, inc_dirs ─────────────
+# Sets: fc, cc, fc_id, cc_id, fcid_str, ccid_str, static_build, metadata_conf
 subdir('config')
 
-# create the metadata file with the configured data
-configure_file(
-  input: files('assets/template/metadata.f90'),
-  output: 'crest_metadata.fh',
-  configuration : config,
+# inc_dirs is defined here rather than in config/meson.build because
+# include_directories() rejects absolute paths inside the source/build tree,
+# and meson.current_build_dir() only resolves to the *root* build dir when
+# called from the root meson.build (subdir() shifts the current dir).
+# '.' pairs the source root with its build counterpart automatically,
+# which is where configure_file() writes crest_metadata.fh.
+inc_dirs = include_directories('include', '.')
+
+# ═══════════════════════════════════════════════════════════════════════════════
+#  OpenMP
+# ═══════════════════════════════════════════════════════════════════════════════
+# ifx (intel-llvm) triggers a Meson bug in dependency('openmp') because its
+# preprocessor output lacks the delimiter strings Meson searches for.
+# Work around it by constructing the dependency manually for that compiler.
+if fc_id == 'intel-llvm'
+  if get_option('openmp')
+    omp_dep = declare_dependency(
+      compile_args : ['-qopenmp'],
+      link_args    : ['-qopenmp'],
+    )
+  else
+    omp_dep = declare_dependency()
+  endif
+else
+  omp_dep = dependency('openmp',
+    required : get_option('openmp'),
+    language : 'fortran',
+  )
+endif
+if omp_dep.found()
+  add_project_arguments('-DWITH_OMP', language : ['c', 'fortran'])
+endif
+
+_omp_link_dep = omp_dep.found() ? [omp_dep] : []
+
+# ═══════════════════════════════════════════════════════════════════════════════
+#  LAPACK / BLAS
+# ═══════════════════════════════════════════════════════════════════════════════
+#
+# Cross-compiler compatibility matrix
+# ─────────────────────────────────────────────────────────────────────────────
+#  Fortran compiler  │  Recommended provider  │  MKL threading layer
+#  ──────────────────┼────────────────────────┼──────────────────────
+#  gfortran          │  OpenBLAS (default)    │  mkl_gnu_thread
+#  ifort / ifx       │  MKL  ← natural match  │  mkl_intel_thread
+#  ifort/ifx + gcc C │  MKL                   │  mkl_intel_thread (Fortran wins)
+# ─────────────────────────────────────────────────────────────────────────────
+# The Fortran compiler drives the final link step and therefore owns the OpenMP
+# runtime.  Choose the MKL threading layer to match the *Fortran* compiler.
+
+lapack_opt    = get_option('lapack')
+with_mkl      = false
+with_openblas = false
+lapack_dep    = []
+blas_dep      = []
+
+_prefer_mkl = (fc_id in ['intel', 'intel-llvm']) and (lapack_opt == 'auto')
+
+# ── MKL ───────────────────────────────────────────────────────────────────────
+if lapack_opt == 'mkl' or _prefer_mkl
+  _mkl = dependency('', required : false)   # not-found sentinel
+
+  # For static builds, mkl-sdl only offers libmkl_rt.so (no .a equivalent).
+  # Use run_command to get the lib dir from pkg-config WITHOUT resolving the
+  # dependency (so we can override it for subprojects below).  Then look up
+  # the real .a archives with explicit dirs:.
+  # iomp5/gomp are provided by -static-intel/-qopenmp-link=static, so we do
+  # not add them explicitly here.
+  if static_build
+    _pc = find_program('pkg-config', required : false)
+    _mkl_libdir = ''
+    if _pc.found()
+      _r = run_command(_pc, '--variable=libdir', 'mkl-sdl', check : false)
+      if _r.returncode() == 0
+        _mkl_libdir = _r.stdout().strip()
+      endif
+    endif
+    if _mkl_libdir != ''
+      _thread_lib   = (fc_id == 'gcc') ? 'mkl_gnu_thread' : 'mkl_intel_thread'
+      _mkl_sa_parts = []
+      foreach lib : ['mkl_intel_lp64', _thread_lib, 'mkl_core']
+        _l = fc.find_library(lib, dirs : [_mkl_libdir], required : false, static : true)
+        if _l.found()
+          _mkl_sa_parts += [_l]
+        endif
+      endforeach
+      if _mkl_sa_parts.length() == 3
+        _mkl = declare_dependency(
+          dependencies : _mkl_sa_parts,
+          link_args    : ['-lpthread', '-lm', '-ldl'],
+        )
+      endif
+    endif
+  endif
+
+  if not _mkl.found()
+    # Dynamic build (or static path failed): use mkl-sdl single dynamic library.
+    _mkl = dependency('mkl-sdl', required : false, static : static_build)
+  endif
+
+  if not _mkl.found()
+    _thread_lib = (fc_id == 'gcc') ? 'mkl_gnu_thread' : 'mkl_intel_thread'
+    _omp_lib    = (fc_id == 'gcc') ? 'gomp'           : 'iomp5'
+    _mkl_parts  = []
+    foreach lib : ['mkl_intel_lp64', _thread_lib, 'mkl_core', _omp_lib, 'm', 'dl']
+      _l = fc.find_library(lib, required : false, static : static_build)
+      if _l.found()
+        _mkl_parts += [_l]
+      endif
+    endforeach
+    if _mkl_parts.length() > 0
+      _mkl = declare_dependency(dependencies : _mkl_parts)
+    endif
+  endif
+
+  if _mkl.found()
+    lapack_dep = _mkl
+    blas_dep   = _mkl
+    with_mkl   = true
+    message('LAPACK/BLAS provider: Intel MKL')
+  elif lapack_opt == 'mkl'
+    error('MKL requested but not found. Set PKG_CONFIG_PATH or source setvars.sh.')
+  else
+    lapack_opt = 'auto'
+  endif
+endif
+
+# ── OpenBLAS ──────────────────────────────────────────────────────────────────
+if lapack_opt in ['auto', 'openblas'] and not with_mkl
+  _opa = dependency('openblas', required : false, static : static_build)
+  if not _opa.found()
+    _opa = dependency('blas', required : false, static : static_build)
+  endif
+  if _opa.found()
+    lapack_dep    = _opa
+    blas_dep      = _opa
+    with_openblas = true
+    message('LAPACK/BLAS provider: OpenBLAS')
+  elif lapack_opt == 'openblas'
+    error('OpenBLAS requested but not found. Install libopenblas-dev.')
+  endif
+endif
+
+# ── Netlib reference ──────────────────────────────────────────────────────────
+if lapack_opt in ['auto', 'netlib'] and not with_mkl and not with_openblas
+  _blas   = dependency('blas',   required : false, static : static_build)
+  _lapack = dependency('lapack', required : false, static : static_build)
+  if _blas.found() and _lapack.found()
+    blas_dep   = _blas
+    lapack_dep = _lapack
+    message('LAPACK/BLAS provider: netlib reference')
+  else
+    _blas   = fc.find_library('blas',   required : false, static : static_build)
+    _lapack = fc.find_library('lapack', required : false, static : static_build)
+    if _blas.found() and _lapack.found()
+      blas_dep   = declare_dependency(dependencies : [_blas])
+      lapack_dep = declare_dependency(dependencies : [_lapack])
+      message('LAPACK/BLAS provider: system libraries (direct probe)')
+    elif lapack_opt == 'netlib'
+      error('Netlib BLAS/LAPACK not found.')
+    else
+      error(
+        'No LAPACK/BLAS found. Install libopenblas-dev, intel-mkl, or '
+        + 'liblapack-dev+libblas-dev, or use -Dlapack=custom.',
+      )
+    endif
+  endif
+endif
+
+# ── Custom ────────────────────────────────────────────────────────────────────
+if lapack_opt == 'custom'
+  _ll = get_option('lapack_libs')
+  _bl = get_option('blas_libs')
+  if _ll.length() == 0 and _bl.length() == 0
+    error('lapack=custom requires lapack_libs and/or blas_libs.')
+  endif
+  _deps = []
+  foreach lib : _ll + _bl
+    _deps += [fc.find_library(lib, required : true, static : static_build)]
+  endforeach
+  lapack_dep = declare_dependency(dependencies : _deps)
+  blas_dep   = lapack_dep
+endif
+
+if with_mkl
+  add_project_arguments('-DWITH_MKL',      language : ['c', 'fortran'])
+endif
+if with_openblas
+  add_project_arguments('-DWITH_OPENBLAS', language : ['c', 'fortran'])
+endif
+
+# ── BLAS/LAPACK pinning for subprojects ───────────────────────────────────────
+# When building statically, subprojects must not resolve BLAS/LAPACK to shared
+# libraries.  With MKL the pinning is also applied to dynamic builds, so that
+# subprojects resolving the generic dependency('lapack')/dependency('blas')
+# (e.g. ddX with its 'netlib' backend) link against the same MKL instead of
+# mixing the system reference libraries into the link line.  This is safe
+# because the MKL path above never queried these dependency names itself.
+# meson.override_dependency() is global: all subsequent dependency() calls in
+# this project AND every subproject get the dep we already found.
+if static_build or with_mkl
+  meson.override_dependency('lapack', lapack_dep)
+  meson.override_dependency('blas',   blas_dep)
+  if with_openblas
+    meson.override_dependency('openblas', blas_dep)
+  endif
+  if with_mkl and static_build
+    # Override mkl-sdl so subprojects (gfnff, gfn0, …) don't reintroduce -lmkl_rt
+    # when we resolved MKL statically (dependency() was never called for mkl-sdl
+    # in the static path above, so the override is still allowed here).
+    meson.override_dependency('mkl-sdl', lapack_dep)
+  endif
+endif
+
+# libgfortran.a (Fortran runtime) references quadmath_* symbols; the GFortran
+# driver would add -lquadmath automatically, but meson uses the C linker driver
+# for the final link step, so we must add it explicitly for static GCC builds.
+_quadmath_dep = []
+if static_build and fc_id == 'gcc'
+  _qm = fc.find_library('quadmath', required : false, static : true)
+  if _qm.found()
+    _quadmath_dep = [_qm]
+  endif
+endif
+
+# ═══════════════════════════════════════════════════════════════════════════════
+#  Optional subproject / external library dependencies
+# ═══════════════════════════════════════════════════════════════════════════════
+tomlf_dep = dependency('toml-f',
+  version  : '>=0.2.4',
+  fallback : ['toml-f', 'tomlf_dep'],
+  required : get_option('toml-f'),
+  static   : link_deps_static,
+  default_options : ['tests=false'],
 )
+with_tomlf = tomlf_dep.found()
+if with_tomlf
+  add_project_arguments('-DWITH_TOMLF', language : ['c', 'fortran'])
+endif
 
+# ── ddX continuum solvation library (used by tblite) ──────────────────────────
+# Resolved explicitly *before* tblite so that crest controls the subproject
+# options: ddX's builtin MKL detection relies on fc.find_library(), which is
+# broken with ifx (meson cannot query the compiler's library search dirs).
+# The 'netlib' backend instead resolves the generic dependency('lapack') /
+# dependency('blas'), which the override above pins to the BLAS/LAPACK
+# provider crest already found.
+# NOTE: ddX's own CMake build forces -fp-model=precise for Intel compilers,
+# but its meson build does not, and meson offers no way to inject the flag
+# into a single subproject from here.  Under ifx default fast math three of
+# ddX's strict self-tests fail (ddx_core/ddx_operators/force_0) while all
+# functional solver and gradient tests pass; crest-level results match the
+# (precise) CMake build.  Known upstream issue, accepted for now.
+ddx_dep = dependency('ddx',
+  version  : '>=0.8.0',
+  fallback : ['ddx', 'ddx_dep'],
+  required : get_option('tblite'),
+  static   : link_deps_static,
+  default_options : ['default_library=static', 'lapack=netlib'],
+)
+with_ddx = ddx_dep.found()
 
-# Documentation
-#subdir('docs')
+tblite_dep = dependency('tblite',
+  version  : '>=0.3.0',
+  fallback : ['tblite', 'tblite_dep'],
+  required : get_option('tblite'),
+  static   : link_deps_static,
+  default_options: ['api=false', 'ddx=true', 'hdf5=disabled', 'trexio=disabled'],
+)
+with_tblite = tblite_dep.found()
+if with_tblite
+  add_project_arguments('-DWITH_TBLITE', language : ['c', 'fortran'])
+endif
 
-# Collect source of the project
-prog = []
+# WITH_DDX guards crest sources that use the ddX modules directly (the
+# standalone continuum-solvation components).  ddX is pulled in via tblite, so
+# it requires tblite to be present as well; this is distinct from WITH_TBLITE
+# so that a tblite built without ddX (-Dtblite:ddx=false) does not break them.
+if with_ddx and with_tblite
+  add_project_arguments('-DWITH_DDX', language : ['c', 'fortran'])
+endif
+
+with_gxtb = get_option('gxtb')
+if with_gxtb
+  if not with_tblite
+    error('gxtb requires tblite to be enabled')
+  endif
+  add_project_arguments('-DWITH_GXTB', language : ['c', 'fortran'])
+endif
+
+gfnff_dep = dependency('gfnff',
+  fallback : ['gfnff', 'gfnff_dep'],
+  required : get_option('gfnff'),
+  static   : link_deps_static,
+  default_options : ['tests=false'],
+)
+with_gfnff = gfnff_dep.found()
+if with_gfnff
+  add_project_arguments('-DWITH_GFNFF', language : ['c', 'fortran'])
+endif
+
+gfn0_dep = dependency('gfn0',
+  fallback : ['gfn0', 'gfn0_dep'],
+  required : get_option('gfn0'),
+  static   : link_deps_static,
+)
+with_gfn0 = gfn0_dep.found()
+if with_gfn0
+  add_project_arguments('-DWITH_GFN0', language : ['c', 'fortran'])
+endif
+
+libpvol_dep = dependency('libpvol',
+  fallback : ['pvol', 'libpvol_dep'],
+  required : get_option('libpvol'),
+  static   : link_deps_static,
+  default_options : ['tests=false'],
+)
+with_libpvol = libpvol_dep.found()
+if with_libpvol
+  add_project_arguments('-DWITH_LIBPVOL', language : ['c', 'fortran'])
+endif
+
+lwoniom_dep = dependency('lwoniom',
+  fallback : ['lwoniom', 'lwoniom_dep'],
+  required : get_option('lwoniom'),
+  static   : link_deps_static,
+)
+with_lwoniom = lwoniom_dep.found()
+if with_lwoniom
+  add_project_arguments('-DWITH_LWONIOM', language : ['c', 'fortran'])
+endif
+
+fmlip_dep = dependency('fmlip_relay',
+  fallback : ['fmlip_relay', 'fmlip_relay_dep'],
+  required : get_option('fmlip-relay'),
+  static   : link_deps_static,
+)
+with_fmlip = fmlip_dep.found()
+if with_fmlip
+  add_project_arguments('-DWITH_FMLIP_RELAY', language : ['c', 'fortran'])
+endif
+
+if get_option('tests')
+  testdrive_dep = dependency('test-drive',
+    version  : '>=0.4.0',
+    fallback : ['test-drive', 'testdrive_dep'],
+    required : true,
+    static   : link_deps_static,
+  )
+endif
+
+# ═══════════════════════════════════════════════════════════════════════════════
+#  Metadata header — finalise and generate
+# ═══════════════════════════════════════════════════════════════════════════════
+# config/meson.build populated metadata_conf with system/compiler info but
+# deferred the with_* feature flags (not yet known at that point).
+# Patch them in now that all deps have been resolved.
+metadata_conf.set('tomlfvar',   with_tomlf.to_string())
+metadata_conf.set('gfn0var',    with_gfn0.to_string())
+metadata_conf.set('gfnffvar',   with_gfnff.to_string())
+metadata_conf.set('tblitevar',  with_tblite.to_string())
+metadata_conf.set('ddxvar',     with_ddx.to_string())
+metadata_conf.set('libpvolvar', with_libpvol.to_string())
+metadata_conf.set('lwoniomvar', with_lwoniom.to_string())
+metadata_conf.set('fmliprelayvar', with_fmlip.to_string())
+
+configure_file(
+  input         : 'assets/template/metadata.f90',
+  output        : 'crest_metadata.fh',
+  configuration : metadata_conf,
+)
+
+# ═══════════════════════════════════════════════════════════════════════════════
+#  Source collection
+# ═══════════════════════════════════════════════════════════════════════════════
 srcs = []
+prog = []
 subdir('src')
 
+# ═══════════════════════════════════════════════════════════════════════════════
+#  Build targets
+# ═══════════════════════════════════════════════════════════════════════════════
+_optional_deps = []
+foreach d : [tblite_dep, gfn0_dep, gfnff_dep, libpvol_dep, lwoniom_dep, tomlf_dep, fmlip_dep]
+  if d.found()
+    _optional_deps += [d]
+  endif
+endforeach
 
-# Create library target
-crest_lib = library(
-  meson.project_name(),
-  sources: srcs,
-  dependencies: exe_deps,
-#  include_directories: include_directories('include'),
+lib_crest = static_library(
+  'crest',
+  sources             : srcs,
+  include_directories : inc_dirs,
+  dependencies        : [lapack_dep, blas_dep] + _omp_link_dep + _optional_deps + _quadmath_dep,
+  install             : false,
+  pic                 : true,
 )
 
-# Export as dependency
-crest_inc = crest_lib.private_dir_include()
-crest_dep = declare_dependency(
-  link_with: crest_lib,
-  include_directories: crest_inc,
-  dependencies: exe_deps,
+executable(
+  'crest',
+  sources             : prog,
+  include_directories : inc_dirs,
+  link_with           : lib_crest,
+  dependencies        : [lapack_dep, blas_dep] + _omp_link_dep + _optional_deps + _quadmath_dep,
+  link_language       : 'fortran',
+  install             : true,
 )
 
+# ═══════════════════════════════════════════════════════════════════════════════
+#  Docs, tests, install
+# ═══════════════════════════════════════════════════════════════════════════════
+subdir('docs')
 
-# Create executable target
-crest_exe = executable(
-  meson.project_name(),
-  sources: prog,
-  dependencies: crest_dep,
-  install: install,
-  link_language: 'fortran',
-)
+if get_option('tests')
+  subdir('test')
+endif
 
+add_test_setup('crest',
+  is_default     : true,
+  exclude_suites : ['ddx','toml-f'],
+)
 
+install_data(
+  'COPYING', 'COPYING.LESSER',
+  install_dir : get_option('datadir') / 'licenses' / meson.project_name(),
+)
 
-# add the testsuite separate meson.build 
-#subdir('testsuite') #has to be filled with tests, not availabel yet
+# ═══════════════════════════════════════════════════════════════════════════════
+#  Summary
+# ═══════════════════════════════════════════════════════════════════════════════
+summary({
+  'Fortran compiler' : '@0@ @1@'.format(fcid_str, fc.version()),
+  'C compiler'       : '@0@ @1@'.format(ccid_str, cc.version()),
+  'Build type'       : get_option('buildtype'),
+  'Static binary'    : static_build,
+  'OpenMP'           : omp_dep.found(),
+  'MKL'              : with_mkl,
+  'OpenBLAS'         : with_openblas,
+  'tblite'           : with_tblite,
+  'ddX (via tblite)' : with_ddx,
+  'toml-f'           : with_tomlf,
+  'GFN-FF'           : with_gfnff,
+  'GFN0-xTB'         : with_gfn0,
+  'libpvol'          : with_libpvol,
+  'lwONIOM'          : with_lwoniom,
+  'fmlip-relay'      : with_fmlip,
+  'Unit tests'       : get_option('tests'),
+}, section : 'crest build configuration')
diff --git a/meson_options.txt b/meson_options.txt
index 950190e2..acdfef5d 100644
--- a/meson_options.txt
+++ b/meson_options.txt
@@ -1,75 +1,101 @@
 # This file is part of crest.
 # SPDX-Identifier: LGPL-3.0-or-later
-#
-# crest is free software: you can redistribute it and/or modify it under
-# the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-#
-# crest is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU Lesser General Public License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public License
-# along with crest.  If not, see <https://www.gnu.org/licenses/>.
 
-option(
-  'la_backend',
-  type: 'combo',
-  value: 'mkl-static',
-  yield: true,
-  choices: ['mkl', 'mkl-rt', 'mkl-static', 'openblas', 'netlib', 'custom','none'],
-  description: 'Linear algebra backend for program.',
+# ── Parallelism ────────────────────────────────────────────────────────────────
+option('openmp',
+  type    : 'boolean',
+  value   : true,
+  description : 'Enable OpenMP parallelisation',
 )
-option(
-  'custom_libraries',
-  type: 'array',
-  value: [],
-  description: 'libraries to load for custom linear algebra backend',
+
+# ── LAPACK / BLAS provider ─────────────────────────────────────────────────────
+# auto   → try openblas, then mkl, then netlib in that order
+# openblas → OpenBLAS (bundles BLAS+LAPACK)
+# mkl    → Intel Math Kernel Library
+# netlib → Reference LAPACK + BLAS
+# custom → set lapack_libs / blas_libs manually on the meson command line
+#           using -Dlapack_libs=... -Dblas_libs=...
+option('lapack',
+  type    : 'combo',
+  choices : ['auto', 'openblas', 'mkl', 'netlib', 'custom'],
+  value   : 'auto',
+  description : 'LAPACK/BLAS provider',
 )
-option(
-  'openmp',
-  type: 'boolean',
-  value: true,
-  yield: true,
-  description: 'use OpenMP parallelisation',
+
+# Only used when lapack=custom:
+option('lapack_libs',
+  type    : 'array',
+  value   : [],
+  description : 'Extra library names to link for LAPACK (custom mode)',
 )
-option(
-  'WITH_TBLITE',
-  type: 'boolean',
-  value: true,
-  description: 'build with tblite integration',
+option('blas_libs',
+  type    : 'array',
+  value   : [],
+  description : 'Extra library names to link for BLAS (custom mode)',
 )
-option(
-  'WITH_GFN0',
-  type: 'boolean',
-  value: true,
-  description: 'build with GFN0-xTB integration',
+
+# ── Static binary ─────────────────────────────────────────────────────────────
+option('static',
+  type    : 'boolean',
+  value   : false,
+  description : 'Attempt a fully static binary (includes OpenMP + LAPACK runtime)',
 )
-option(
-  'WITH_GFNFF',
-  type: 'boolean',
-  value: true,
-  description: 'build with GFN-FF integration',
+
+# ── Static subproject linking ─────────────────────────────────────────────────
+# Link subprojects (tblite, gfn0, gfnff, pvol, lwoniom, toml-f, …) as static
+# archives without forcing a fully static binary.  System runtimes stay dynamic.
+# Implied by -Dstatic=true.
+option('static-deps',
+  type    : 'boolean',
+  value   : true,
+  description : 'Link subprojects statically without a fully static binary',
 )
-option(
-  'WITH_TOMLF',
-  type: 'boolean',
-  value: true,
-  description: 'build with toml-f integration',
+
+# ── Optional computational chemistry libraries ─────────────────────────────────
+option('tblite',
+  type    : 'feature',
+  value   : 'auto',
+  description : 'Enable tblite semiempirical library',
 )
-option(
-  'WITH_LIBPVOL',
-  type: 'boolean',
-  value: true,
-  description: 'build with libpvol integration',
+option('gxtb',
+  type    : 'boolean',
+  value   : false,
+  description : 'Enable g-xTB via tblite (requires tblite)',
 )
-
-option(
-  'WITH_LWONIOM',
-  type: 'boolean',
-  value: true,
-  description: 'build with lwONIOM integration',
+option('toml-f',
+  type    : 'feature',
+  value   : 'auto',
+  description : 'Enable TOML-Fortran library (also enables file-based input)',
+)
+option('gfn0',
+  type    : 'feature',
+  value   : 'auto',
+  description : 'Enable GFN0-xTB library',
+)
+option('gfnff',
+  type    : 'feature',
+  value   : 'auto',
+  description : 'Enable GFN-FF library',
+)
+option('libpvol',
+  type    : 'feature',
+  value   : 'auto',
+  description : 'Enable libpvol (volume computation) library',
+)
+option('lwoniom',
+  type    : 'feature',
+  value   : 'auto',
+  description : 'Enable lwONIOM library',
+)
+option('fmlip-relay',
+  type    : 'feature',
+  value   : 'auto',
+  description : 'Enable fmlip-relay ML/IP interface',
 )
 
+# ── Developer options ──────────────────────────────────────────────────────────
+option('tests',
+  type    : 'boolean',
+  value   : true,
+  description : 'Build unit tests (requires test-drive)',
+)
diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
index 49c591a2..3d22d8aa 100644
--- a/src/CMakeLists.txt
+++ b/src/CMakeLists.txt
@@ -15,6 +15,7 @@
 # along with crest.  If not, see <https://www.gnu.org/licenses/>.
 
 
+add_subdirectory("molecule")
 add_subdirectory("parsing")
 add_subdirectory("optimize")
 add_subdirectory("calculator")
@@ -23,12 +24,14 @@ add_subdirectory("dynamics")
 add_subdirectory("qcg")
 add_subdirectory("qmhelpers")
 add_subdirectory("graphs")
-add_subdirectory("rigidconf")
+add_subdirectory("molbuilder")
 add_subdirectory("discretize")
 add_subdirectory("entropy")
 add_subdirectory("legacy_algos")
 add_subdirectory("msreact")
-
+add_subdirectory("sorting")
+add_subdirectory("basinhopping")
+add_subdirectory("chelpers")
 
 set(dir "${CMAKE_CURRENT_SOURCE_DIR}")
 
@@ -37,28 +40,22 @@ list(APPEND srcs
   "${dir}/axis_module.f90"
   "${dir}/biasmerge.f90"
   "${dir}/bondconstraint.f90"
-  "${dir}/canonical.f90"
-  "${dir}/ccegen.f90"
   "${dir}/choose_settings.f90"
   "${dir}/classes.f90"
   "${dir}/cleanup.f90"
   "${dir}/cn.f90"
   "${dir}/compress.f90"
   "${dir}/confparse.f90"
-  "${dir}/cregen.f90"
   "${dir}/crest_pars.f90"
-  "${dir}/ensemblecomp.f90"
   "${dir}/eval_timer.f90"
   "${dir}/filemod.f90"
   "${dir}/flexi.F90"
   "${dir}/freqmasses.f90"
   "${dir}/geo.f90"
-  "${dir}/identifiers.f90"
   "${dir}/internals.f90"
   "${dir}/internals2.f90"
   "${dir}/iomod.F90"
   "${dir}/legacy_wrappers.f90"
-  "${dir}/ls_rmsd.f90"
   "${dir}/marqfit.f90"
   "${dir}/minitools.f90"
   "${dir}/miscdata.f90"
@@ -66,26 +63,15 @@ list(APPEND srcs
   "${dir}/ompmklset.F90"
   "${dir}/printouts.f90"
   "${dir}/prmat.f90"
-  "${dir}/propcalc.f90"
-  "${dir}/quicksort.f90"
-  "${dir}/readl.f90"
   "${dir}/restartlog.f90"
-  "${dir}/rotcompare.f90"
   "${dir}/scratch.f90"
-  "${dir}/sdfio.f90"
   "${dir}/select.f90"
-  "${dir}/signal.c"
-  "${dir}/sigterm.f90"
-  "${dir}/sortens.f90"
-  "${dir}/strucreader.f90"
-  "${dir}/symmetry2.f90"
-  "${dir}/symmetry_i.c"
+  "${dir}/sigterm.F90"
+  "${dir}/symmetry_i.f90"
   "${dir}/timer.f90"
   "${dir}/trackorigin.f90"
   "${dir}/utilmod.f90"
   "${dir}/wallsetup.f90"
-  "${dir}/zdata.f90"
-  "${dir}/ztopology.f90"
 )
 
 list(APPEND prog
diff --git a/src/algos/CMakeLists.txt b/src/algos/CMakeLists.txt
index 3df8c266..8f68ab9f 100644
--- a/src/algos/CMakeLists.txt
+++ b/src/algos/CMakeLists.txt
@@ -28,12 +28,17 @@ list(APPEND srcs
   "${dir}/search_1.f90"
   "${dir}/search_mecp.f90"
   "${dir}/setuptest.f90"
+  "${dir}/sorting.f90"
   "${dir}/protonate.f90"
-  "${dir}/hessian_tools.f90"
-  "${dir}/ConfSolv.F90"
   "${dir}/search_conformers.f90"
   "${dir}/search_entropy.f90"
   "${dir}/parallel.f90"
+  "${dir}/deform_opt_hess.f90"
+  "${dir}/queueing.f90"
+  "${dir}/alkylize.f90"
+  "${dir}/dryrun.f90"
+  "${dir}/propcalc.f90"
+  "${dir}/term_ui.f90"
 )
 
 set(srcs ${srcs} PARENT_SCOPE)
diff --git a/src/algos/ConfSolv.F90 b/src/algos/ConfSolv.F90
deleted file mode 100644
index e0818c47..00000000
--- a/src/algos/ConfSolv.F90
+++ /dev/null
@@ -1,577 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2023 Philipp Pracht
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!================================================================================!
-
-!> A data storage module for hosting ConfSolv as a http server with requests
-!> We need to know the server's PORT to create the request
-!> CREST can either try to host the server on its own, or the user
-!> must provide the PORT.
-!> All of this assumes that the ConfSolv submodule was loaded
-
-module ConfSolv_module
-  use crest_parameters
-  use crest_data
-  use strucrd
-  use iomod
-  implicit none
-  public
-
-  !> ConfSolv helper script PID
-  integer,allocatable :: cs_pid
-  !> ConfSolv helper script name
-  character(len=:),allocatable :: cs_bin
-  !> ConfSolv port server port
-  integer,allocatable :: cs_port
-  !> ConfSolv teardown instruction
-  logical :: cs_teardown = .false.
-  !> Keeping track of setup. Has it been called already?
-  logical :: cs_setup = .false.
-
-  !> ConfSolv parameter location
-  character(len=:),allocatable :: cs_param
-  !> ConfSolv solvent & smiles
-  character(len=:),allocatable :: cs_solvent
-  character(len=:),allocatable :: cs_solvfile
-  character(len=:),allocatable :: cs_smiles
-
-  !> n_threshold_mols
-  integer :: cs_n_threshold_mols = 1
-
-!========================================================================================!
-!========================================================================================!
-contains  !> MODULE PROCEDURES START HERE
-!========================================================================================!
-!========================================================================================!
-
-  subroutine cs_deallocate()
-    if (allocated(cs_pid)) deallocate (cs_pid)
-    if (allocated(cs_bin)) deallocate (cs_bin)
-    if (allocated(cs_port)) deallocate (cs_port)
-    if (allocated(cs_param)) deallocate (cs_param)
-    if (allocated(cs_solvent)) deallocate (cs_solvent)
-  end subroutine cs_deallocate
-
-!=================================================!
-
-  function cs_running() result(running)
-    implicit none
-    logical :: running
-    integer :: io
-    character(len=:),allocatable :: job
-    running = .false.
-
-    io = 0
-    if (.not.allocated(cs_bin).or. &
-    &  .not.allocated(cs_pid).or. &
-    &  .not.allocated(cs_port)) then
-      running = .false.
-      return
-    end if
-
-    job = trim(cs_bin)//' --test '//to_str(cs_port)
-
-    call command(job,io)
-
-  end function cs_running
-
-!=================================================!
-  subroutine cs_shutdown(io)
-    implicit none
-    integer,intent(out) :: io
-
-    io = 0
-    if (cs_teardown.and.allocated(cs_pid).and.allocated(cs_port)) then
-      write (stdout,'(/,a,i0)') 'Shutting down http://localhost/',cs_port
-      call kill(cs_pid,9,io)
-      deallocate (cs_pid)
-      call cs_shutdown2(io)
-    end if
-
-  end subroutine cs_shutdown
-
-!=================================================!
-  subroutine cs_shutdown2(io)
-    use iomod
-    implicit none     
-    integer,intent(out) :: io
-    integer :: ich,ro,pids
-    character(len=100) :: str
-    character(len=50) :: str2
-    call command('lsof confsolv.out > tmpcs 2>/dev/null',io)
-
-    open(newunit=ich,file='tmpcs')
-    do
-      read(ich,'(a)',iostat=ro) str
-      if(ro < 0 ) exit
-      !write(*,*) trim(str)
-      read(str,*,iostat=ro) str2,pids
-      if(ro == 0)then
-      !   write(*,*) pids
-         call kill(pids,9,io) 
-      endif
-    enddo
-    close(ich)
-
-    call remove('tmpcs') 
-  end subroutine cs_shutdown2
-
-!=================================================!
-
-  subroutine cs_deploy()
-    implicit none
-    character(len=:),allocatable :: job
-    integer :: io,ich
-    character(len=50) :: atmp
-    logical :: ex
-
-    if (.not.allocated(cs_bin)) cs_bin = 'confsolvserver'
-    !call remove('confsolv.out')
-    call remove('config_template.toml')
-
-    job = 'nohup '//trim(cs_bin)//' -l '//'> confsolv.out 2>/dev/null'//' &'
-
-    write (stdout,'(2x,a,a)') 'Hosting command: ',trim(job)
-    call command(job,io)
-
-    if (io /= 0) error stop '**ERROR** failed to host ConfSolv server'
-    !call sleep(3)
-    do
-      call sleep(1)
-      inquire (file='config_template.toml',exist=ex)
-      if (ex) exit
-    end do
-
-    !> read port and pid
-    open (newunit=ich,file='confsolv.out')
-    read (ich,*) atmp,cs_pid
-    read (ich,*) atmp,cs_port
-    close (ich)
-    cs_teardown = .true.
-    cs_setup = .false.
-    write (stdout,'(2x,2(a,i0))') 'ConfSolv server will be running at http://localhost:',cs_port,' with PID ',cs_pid
-  end subroutine cs_deploy
-
-!=================================================!
-
-  subroutine cs_write_config(ensname,threads)
-    implicit none
-    character(len=*) :: ensname
-    integer :: threads
-    integer :: i,j,k,l,ich,io
-    character(len=1024) :: atmp
-
-    call getcwd(atmp)
-    open (newunit=ich,file='config.toml')
-    call wrtoml_int(ich,'port',cs_port)
-    call wrtoml_int(ich,'pid',cs_pid)
-    call wrtoml_int(ich,'num_cores',threads)
-    if (allocated(cs_param)) then
-      call wrtoml(ich,'model_path',cs_param)
-    end if
-
-    call wrtoml(ich,'xyz_file',trim(atmp)//'/'//trim(ensname))
-    if (allocated(cs_solvfile)) then
-      call wrtoml(ich,'solvent_file',trim(atmp)//'/'//cs_solvfile)
-    else
-      call wrtoml(ich,'solvent_file',trim(atmp)//'/'//'crest_solvents.csv')
-    end if
-
-    call wrtoml_int(ich,'n_threshold_mols',cs_n_threshold_mols)
-    close (ich)
-  contains
-    subroutine wrtoml(ch,key,val)
-      integer :: ch
-      character(len=*) :: key
-      character(len=*) :: val
-      write (ch,'(a,a,a,a)') trim(key),' =  "',trim(val),'"'
-    end subroutine wrtoml
-    subroutine wrtoml_int(ch,key,val)
-      integer :: ch
-      character(len=*) :: key
-      integer :: val
-      write (ch,'(a,a,i0)') trim(key),' =  ',val
-    end subroutine wrtoml_int
-  end subroutine cs_write_config
-
-!========================================================================================!
-
-  subroutine cs_write_solvent_csv(solvent,smiles,ch)
-!**************************************************************
-!* From CREST's side it makes only sense to define ONE solvent
-!* despite ConfSolv being able to handle multiple.
-!* ConfSolv will read the solvents from a CSV file with the
-!* columns SOLVENT_NAME and SMILES
-!**************************************************************
-    implicit none
-    character(len=*),intent(in) :: solvent
-    character(len=*),intent(in),optional :: smiles
-    integer,intent(in),optional :: ch
-    integer :: ich
-    if (.not.present(ch)) then
-      open (newunit=ich,file='crest_solvents.csv')
-    else
-      ich = ch
-    end if
-    !> column names
-    write (ich,'(a,",",a)') 'SOLVENT_NAME','SMILES'
-    if (present(smiles)) then
-      write (ich,'(a,",",a)') solvent,smiles
-    else
-      !> switch case for available solvents, if no smiles was given
-      select case (lowercase(solvent))
-      case ('acetate')
-        write (ich,'(a,",",a)') solvent,'CC(=O)[O-]'
-      case ('acetic acid')
-        write (ich,'(a,",",a)') solvent,'CC(=O)O'
-      case ('acetone')
-        write (ich,'(a,",",a)') solvent,'CC(=O)C'
-      case ('acetonitrile')
-        write (ich,'(a,",",a)') solvent,'CC#N'
-      case ('ammonia')
-        write (ich,'(a,",",a)') solvent,'N'
-      case ('ammonium')
-        write (ich,'(a,",",a)') solvent,'[NH4+]'
-      case ('benzene')
-        write (ich,'(a,",",a)') solvent,'c1ccccc1'
-      case ('benzoate')
-        write (ich,'(a,",",a)') solvent,'[O-]C(=O)c1ccccc1'
-      case ('benzylacetate')
-        write (ich,'(a,",",a)') solvent,'CC(=O)OCc1ccccc1'
-      case ('butanone','2-butanone')
-        write (ich,'(a,",",a)') solvent,'CCC(=O)C'
-      case ('chloride')
-        write (ich,'(a,",",a)') solvent,'[Cl-]'
-      case ('trichlormethane')
-        write (ich,'(a,",",a)') solvent,'C(Cl)(Cl)Cl'
-      case ('cyclohexane')
-        write (ich,'(a,",",a)') solvent,'C1CCCCC1'
-      case ('dibutylamine')
-        write (ich,'(a,",",a)') solvent,'CC[C@H](C)N[C@H](C)CC'
-      case ('dichlormethane')
-        write (ich,'(a,",",a)') solvent,'C(Cl)Cl'
-      case ('diethanolamine')
-        write (ich,'(a,",",a)') solvent,'OCCNCCO'
-      case ('diethanolammonium')
-        write (ich,'(a,",",a)') solvent,'OCC[NH2+]CCO'
-      case ('diethylamine')
-        write (ich,'(a,",",a)') solvent,'CCNCC'
-      case ('diethylammonium')
-        write (ich,'(a,",",a)') solvent,'CC[NH2+]CC'
-      case ('diethylether')
-        write (ich,'(a,",",a)') solvent,'CCOCC'
-      case ('heptyloctylether')
-        write (ich,'(a,",",a)') solvent,'CCCCCCCCOCCCCCCC'
-      case ('acetamide')
-        write (ich,'(a,",",a)') solvent,'CC(=O)N(C)C'
-      case ('diethylformamide')
-        write (ich,'(a,",",a)') solvent,'CN(C)C=O'
-      case ('dmso')
-        write (ich,'(a,",",a)') solvent,'CS(=O)C'
-      case ('dioxolone','2-dioxolone')
-        write (ich,'(a,",",a)') solvent,'C1COC(=O)O1'
-      case ('ethylmethylester')
-        write (ich,'(a,",",a)') solvent,'CCOC(=O)OC'
-      case ('ethanol')
-        write (ich,'(a,",",a)') solvent,'CCO'
-      case ('ethylacetate')
-        write (ich,'(a,",",a)') solvent,'CCOC(=O)C'
-      case ('ethylamine')
-        write (ich,'(a,",",a)') solvent,'CCN'
-      case ('ethylaminium')
-        write (ich,'(a,",",a)') solvent,'CC[NH3+]'
-      case ('glycol')
-        write (ich,'(a,",",a)') solvent,'OCCO'
-      case ('formate')
-        write (ich,'(a,",",a)') solvent,'C(=O)[O-]'
-      case ('formic acid')
-        write (ich,'(a,",",a)') solvent,'C(=O)O'
-      case ('butyrolacetone')
-        write (ich,'(a,",",a)') solvent,'O=C1CCCO1'
-      case ('glycerin')
-        write (ich,'(a,",",a)') solvent,'OCC(O)CO'
-      case ('water','h2o')
-        write (ich,'(a,",",a)') solvent,'O'
-      case ('sulfuric acid')
-        write (ich,'(a,",",a)') solvent,'O=S(=O)(O)O'
-      case ('hexafluorobenzene')
-        write (ich,'(a,",",a)') solvent,'Fc1c(F)c(F)c(F)c(F)c1F'
-      case ('isooctane')
-        write (ich,'(a,",",a)') solvent,'CC(C)CC(C)(C)C'
-      case ('isopropanol')
-        write (ich,'(a,",",a)') solvent,'CC(O)C'
-      case ('methoxide')
-        write (ich,'(a,",",a)') solvent,'C[O-]'
-      case ('hexane','n-hexane')
-        write (ich,'(a,",",a)') solvent,'CCCCCC'
-      case ('1-nonadecanol','nonadecanol')
-        write (ich,'(a,",",a)') solvent,'CCCCCCCCCCCCCCCCCCCO'
-      case ('1-octanol','octanol')
-        write (ich,'(a,",",a)') solvent,'OCCCCCCCC'
-      case ('p-dichlorobenzene','dichlorobenzene')
-        write (ich,'(a,",",a)') solvent,'Clc1ccccc1Cl'
-      case ('perfluorohexane')
-        write (ich,'(a,",",a)') solvent,'C(C(C(C(F)(F)F)(F)F)(F)F)(C(C(F)(F)F)(F)F)(F)F'
-      case ('propanediol')
-        write (ich,'(a,",",a)') solvent,'C[C@@H](O)CO'
-      case ('tetraethylammoniom')
-        write (ich,'(a,",",a)') solvent,'CC[N+](CC)(CC)CC'
-      case ('thf','tetrahydrofuran')
-        write (ich,'(a,",",a)') solvent,'O1CCCC1'
-      case ('toluene')
-        write (ich,'(a,",",a)') solvent,'Cc1ccccc1'
-      case ('tributylphosphate')
-        write (ich,'(a,",",a)') solvent,'O=P(OCCCC)(OCCCC)OCCCC'
-      case ('triethanolamine','trolamine')
-        write (ich,'(a,",",a)') solvent,'OCCN(CCO)CCO'
-      case ('triethanolammonium')
-        write (ich,'(a,",",a)') solvent,'OCC[NH+](CCO)CCO'
-      case ('triethylamine','net3')
-        write (ich,'(a,",",a)') solvent,'CCN(CC)CC'
-      case ('triethylammonium')
-        write (ich,'(a,",",a)') solvent,'CC[NH+](CC)CC'
-      case ('triglyme')
-        write (ich,'(a,",",a)') solvent,'COCCOCCOCCOC'
-      case ('urea')
-        write (ich,'(a,",",a)') solvent,'NC(=O)N'
-      case default
-        write (stderr,'(2a)') '**ERROR** failed to find matching solvent SMILES for: ',solvent
-        error stop
-      end select
-    end if
-    close (ich)
-  end subroutine cs_write_solvent_csv
-
-!========================================================================================!
-
-  subroutine confsolv_select_gsoln(nall,ncol,data,gsoln,mapping)
-!************************************************
-!* From the matrix of ΔΔGsoln, select the best
-!* for each conformer and document which solvent
-!* that corresponds to
-!************************************************
-    implicit none
-    integer,intent(in)  :: nall,ncol
-    real(wp),intent(in)  :: data(ncol,nall)
-    real(wp),intent(out) :: gsoln(nall)
-    integer,intent(out)  :: mapping(nall)
-    integer :: i,j,k,l,mink
-    real(wp) :: dum
-    mapping(:) = 0
-    gsoln(:) = huge(dum)
-    if (ncol < 3) then
-!>--- ConfSolv should put out at least 3 csv columns. The first two are just IDs
-      write (stderr,'(a)') '**ERROR** dimension mismatch in ConfSolv data processing'
-      error stop
-    end if
-    do i = 1,nall
-      do j = 3,ncol
-        k = j-2
-        if (data(j,i) < gsoln(i)) then
-          mink = k
-          gsoln(i) = data(j,i)
-        end if
-      end do
-      mapping(i) = mink
-    end do
-  end subroutine confsolv_select_gsoln
-
-
-  subroutine confsolv_dump_gsoln(nall,ncol,gsoln,mapping,headers)
-!****************************************************
-!* Dump the selected ΔΔGsoln, and the corresponding
-!* solvent for each conformer
-!****************************************************
-    implicit none
-    integer,intent(in)  :: nall,ncol
-    real(wp),intent(in) :: gsoln(nall)
-    integer,intent(in)  :: mapping(nall)
-    character(len=*),intent(in) :: headers(ncol)
-    integer :: i,j,k,l,mink,ich
-    real(wp) :: dum
-    open(newunit=ich,file='confsolv.dat')
-    do i = 1,nall
-      k = mapping(i)+1
-      write(ich,'(f15.8,1x,a)') gsoln(i),trim(headers(k))
-    end do
-    close(ich)
-  end subroutine confsolv_dump_gsoln
-
-
-!========================================================================================!
-!========================================================================================!
-end module ConfSolv_module
-
-!========================================================================================!
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
-!========================================================================================!
-
-subroutine confsolv_request(ensname,nall,ncpus,gsoln,io)
-!***********************************************
-!* Interface to ConfSolv via https requests
-!*
-!* Input/Output:
-!*  ensname - ensemble file
-!*  nall    - number of structures in ensemble
-!*  ncpus   - number on cores to run on
-!*  gsoln   - ΔΔGsoln for each structure
-!*  io      - exit status
-!***********************************************
-  use crest_parameters
-  use crest_data
-  use strucrd
-  use iomod
-  use ConfSolv_module
-  use parse_csv
-  implicit none
-  !> INPUT
-  character(len=*),intent(in) :: ensname
-  integer,intent(in) :: nall
-  integer,intent(in) :: ncpus
-  !> OUTPUT
-  real(wp),intent(out) :: gsoln(nall)
-  integer,intent(out)  :: io
-  !> LOCAL
-  integer :: i,j,k,l,ich
-  logical :: pr,wr
-  character(len=:),allocatable :: job
-  real(wp),allocatable :: column(:)
-  real(wp),allocatable :: data(:,:)
-  integer,allocatable :: mapping(:)
-  character(len=:),allocatable :: headers(:) 
-  integer :: ncol,nrow
-  real(wp) :: avg
-
-  io = 0
-  gsoln(:) = 0.0_wp
-
-!>--- setup
-  if (allocated(cs_pid).and.allocated(cs_port)) then
-    !> user-provided PID and port (no automatic teardown)
-    write (stdout,'(2x,a,i0,a,i0)') 'Looking for ConfSolv server (PID: ',cs_pid,') running at '//&
-    & 'http://localhost:',cs_port
-    !cs_teardown = .false.
-  else
-    !> fallback: automatic host (not recommended)
-    allocate (cs_pid,cs_port)
-    call cs_deploy()
-  end if
-  if (allocated(cs_param)) then
-    write (stdout,'(2x,a,/,3x,a)') 'pyTorch checkpoint files located at ',cs_param
-  else
-    write (stderr,*) '**ERROR** cannot run ConfSolv without defining checkpoint file location!'
-    error stop
-  end if
-  !> pass the user-defined solvents-csv, or do a single solvent
-  if (allocated(cs_solvfile)) then
-    write (stdout,'(2x,a,a)') 'Requested ΔΔGsoln for solvents in ',cs_solvfile
-    call parse_csv_file_column(cs_solvfile,1,headers)
-  else
-    if (allocated(cs_solvent).and.allocated(cs_smiles)) then
-      write (stdout,'(2x,a,a,3a)') 'Requested ΔΔGsoln for ',cs_solvent,' (SMILES: ',trim(cs_smiles),')'
-      call cs_write_solvent_csv(cs_solvent,smiles=cs_smiles)
-    else if (allocated(cs_solvent)) then
-      write (stdout,'(2x,a,a,a)') 'Requested ΔΔGsoln for ',cs_solvent,' (trying to find SMILES ...)'
-      call cs_write_solvent_csv(cs_solvent)
-    end if
-    allocate(headers(2), source=trim(cs_solvent))
-  end if
-  write (stdout,'(2x,a,a)') 'Processing ensemble file ',trim(ensname)
-
-!>---- creating the request configuration
-  write (stdout,'(2x,a)',advance='no') 'Writing config.toml file              ...'
-  flush (stdout)
-  call cs_write_config(ensname,ncpus)
-  write (stdout,*) 'done.'
-
-  job = ''
-  job = trim(job)//' '//cs_bin//' -c config.toml'
-!>----- this should only be called once:
-  if (.not.cs_setup) then
-    write (stdout,'(2x,a)',advance='no') 'Instructing ConfSolv model setup      ...'
-    flush (stdout)
-    call command(trim(job)//' -s >> confsolv.out 2>/dev/null',io)
-    if (io /= 0) then
-      write (stdout,*)
-      write (stderr,'(a)') "**ERROR** failed request to ConfSolv server"
-      call cs_shutdown(io)
-      error stop
-    end if
-    cs_setup = .true.
-    write (stdout,*) 'done.'
-  end if
-
-!>---- and then the actual evaluation
-  call remove('confsolv.csv')
-  call remove('confsolv_uncertainty.csv')
-  write (stdout,'(2x,a)',advance='no') 'Evaluation of ConfSolv D-MPNN         ...'
-  flush (stdout)
-  call command(trim(job)//' -r >> confsolv.out 2>/dev/null',io)
-  write (stdout,*) 'done.'
-  if (io /= 0) then
-    write (stdout,*)
-    write (stderr,'(a)') "**ERROR** failed request to ConfSolv server"
-    call cs_shutdown(io)
-    error stop
-  end if
-
-!>--- read ΔΔGsoln
-  write (stdout,'(2x,a)',advance='no') 'Reading confsolv.csv                  ...'
-  flush (stdout)
-  call parse_csv_allcolumns('confsolv.csv',data,cols=ncol,rows=nrow)
-  write (stdout,*) 'done.'
-  if (nrow == nall) then
-    if(.not.allocated(mapping)) allocate(mapping(nall))
-    call confsolv_select_gsoln(nall,ncol,data,gsoln,mapping)
-    call confsolv_dump_gsoln(nall,ncol,gsoln,mapping,headers) 
-  else
-    write (stdout,'(a)') '**ERROR** dimension mismatch in confsolv_request'
-    call cs_shutdown(io)
-    error stop
-  end if
-
-!>--- read uncertainty
-  write (stdout,'(2x,a)',advance='no') 'Reading confsolv_uncertainty.csv      ...'
-  flush (stdout)
-  call parse_csv_allcolumns('confsolv_uncertainty.csv',data)
-  write (stdout,*) 'done.'
-  if (size(data,2) == nall) then
-    avg = 0.0_wp
-    do i=1,nall
-      k=mapping(i) + 2
-      avg=avg+data(k,i)
-    enddo
-    avg = avg / real(nall,wp) 
-    write (stdout,'(2x,a,f25.15)') 'Average uncertainty of ConfSolv prediction:',avg
-  else
-    write (stdout,'(a)') '**ERROR** dimension mismatch in confsolv_request'
-    call cs_shutdown(io)
-    error stop
-  end if
-
-  !call cs_shutdown2(i)
-  
-  if (allocated(headers)) deallocate(headers)
-  if (allocated(data)) deallocate(data)
-  if (allocated(mapping)) deallocate(mapping) 
-  if (allocated(column)) deallocate (column)
-  return
-end subroutine confsolv_request
-
-!========================================================================================!
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
-!========================================================================================!
diff --git a/src/algos/alkylize.f90 b/src/algos/alkylize.f90
new file mode 100644
index 00000000..479f3c27
--- /dev/null
+++ b/src/algos/alkylize.f90
@@ -0,0 +1,142 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+subroutine crest_setup_alkylize(env)
+  use crest_parameters
+  use crest_data
+  use strucrd
+  use molbuilder_classify
+  implicit none
+  type(systemdata),intent(inout) :: env
+  type(coord_classify) :: molc
+  type(coord) :: mol
+
+  integer :: ii,jj,kk,cc
+  integer :: splt(3)
+
+  call env%ref%to(mol)
+
+  call underline("Analyzing Input Structure")
+
+  call setup_classify(mol,molc)
+  call functional_group_classify(molc)
+  if (molc%nfuncs == 0) then
+    write (stdout,'(a)') 'no relevant substructures found'
+    return
+  else
+    write (stdout,'(a)') 'Found the following substructure parts'
+    call molc%print_funcgroups(stdout)
+  end if
+
+  do ii = 1,molc%nfuncs
+    associate (func => molc%funcgroups(ii))
+      if (trim(func%name) == 'alkyl') then
+
+        !> only for propane or longer
+        if (func%natms > 6) then
+          write (stdout,'(a)') 'selected alkyl group for fragment dispatching'
+          splt(:) = 0
+          splt(1) = func%attached_to
+          kk = 1
+          do while (kk < 3)
+            do jj = 1,molc%nat
+              if (molc%Ah(jj,splt(kk)) == 1.and. &
+                & .not.any(splt(:) .eq. jj).and. &
+                & any(func%ids(:) .eq. jj).and.kk < 3) then
+                kk = kk+1
+                splt(kk) = jj
+              end if
+            end do
+          end do
+          call env%addsplitqueue(splt)
+        end if
+        write (stdout,'(2x,a,5(1x,i0))') '> shared atoms:',splt(:)
+      end if
+    end associate
+  end do
+
+  write (stdout,*)
+end subroutine crest_setup_alkylize
+
+subroutine crest_proxy_nalkane(env,doreturn)
+  use crest_parameters
+  use crest_data
+  use strucrd
+  use molbuilder_classify
+  use INTERNALS_mod
+  implicit none
+  type(systemdata),intent(inout) :: env
+  logical,intent(out) :: doreturn
+  type(coord) :: mol,newmol
+  type(coord_classify) :: molc
+  integer :: ii,jj
+  integer,allocatable  :: na(:),nb(:),nc(:)
+  real(wp),allocatable :: zmat(:,:)
+  integer :: itmp(4)
+
+  doreturn = .false.
+
+  if (env%alkylize) then
+    call env%ref%to(mol)
+    call setup_classify(mol,molc)
+    call functional_group_classify(molc)
+
+    do ii = 1,molc%nfuncs
+      if (molc%funcgroups(ii)%name == 'alkane'.or.  &
+      &  (molc%funcgroups(ii)%name == 'alkyl'.and.  &
+      &   molc%funcgroups(ii)%natms >= (molc%nat-3)) &
+      &  ) then
+        write (stdout,'(a)') '> This substructure contains an n-alkane.'
+        if (env%alkylizeskip) then
+          write (stdout,'(a)') '> SKIPPING sampling and writing LINEAR structure.'
+          doreturn = .true.
+        else
+          write (stdout,'(a)') '> Writing LINEAR structure and sampling independently.' 
+        end if
+
+        call molc%get_zmat(.true.)
+        call molc%print_zmat(stdout)
+
+        !> ZMAT construction to make the molecule linear
+        do jj = 1,molc%nat
+          if (molc%ztod(jj) .ne. 0) then
+            itmp(1) = molc%at(jj)
+            itmp(2) = molc%at(molc%zmap(jj,1))
+            itmp(3) = molc%at(molc%zmap(jj,2))
+            itmp(4) = molc%at(molc%zmap(jj,3))
+            if (all(itmp(:) > 1)) then
+              !write(*,*) 'C-C bond:',molc%zmap(jj,1:2)
+              molc%zmat(3,jj) = -pi
+            end if
+          end if
+        end do
+
+        call molc%print_zmat(stdout)
+        call molc%from_zmat(newmol)
+        call newmol%write(conformerfile)
+
+        call env%ref%load(newmol)
+        exit
+      end if
+    end do
+
+  end if
+
+end subroutine crest_proxy_nalkane
+
diff --git a/src/algos/deform_opt_hess.f90 b/src/algos/deform_opt_hess.f90
new file mode 100644
index 00000000..afc2cedf
--- /dev/null
+++ b/src/algos/deform_opt_hess.f90
@@ -0,0 +1,84 @@
+subroutine deform_opt_hess(calc,mol)  
+    use crest_calculator
+    use strucrd
+    use irmsd_module
+    use bh_step_module
+    use crest_parameters
+    use optimize_module
+    use thermochem_module
+    use hr_utils
+    use optimize_maths
+    implicit none
+    type(calcdata) :: calc
+    type(coord) :: mol
+    type(coord) :: molnew,mol_reopt
+    real(wp) :: energy,stepsize,rmsdval
+    real(wp) :: grad(3,mol%nat) 
+    logical :: pr,wr 
+    integer :: io, nat3,idx
+
+    real(wp) :: etot 
+    real(wp), allocatable :: h_init(:,:)
+
+    if (allocated(calc%chess)) deallocate(calc%chess)
+
+    !allocate (calc%chess)
+    !call calc%chess%alloc(mol%nat,calc%hu_steps,calc%hguess,calc%initialize_hr_type, calc%hr_hu_type) !Maybe in future just reset the cash here, or if this works we only call this here
+
+    nat3 = 3*mol%nat
+    molnew%nat = mol%nat
+    molnew%at = mol%at
+    molnew%xyz = mol%xyz
+
+    allocate(h_init(nat3,nat3))
+
+    stepsize = calc%doh_stepsize
+
+
+    call take_fixed_stepsize_cart(molnew,stepsize,calc)
+
+    pr = .true.
+    wr = .true.
+
+    call optimize_geometry(molnew,mol_reopt,calc,energy,grad,pr,wr,io)
+
+    pr = .true.
+    wr = .true.
+
+    rmsdval = rmsd(mol,mol_reopt)
+
+    write(stdout,*) 'VALUE OF RMSD FOR REOPTIMISED STRUCTURE',rmsdval
+
+    if (rmsdval .le. 0.1_wp) then
+    
+        idx = minloc(calc%chess%order,1)
+        if (minval(calc%chess%order) .eq. 0) idx = 1
+
+        write(stdout,*)calc%chess%coords(idx,:,:) - molnew%xyz(:,:)
+        
+        call initialize_hessian(calc,calc%chess%initialize_type,molnew%xyz,molnew%nat,molnew%at,calc%chess%hess(:),calc%chess%hguess,pr)  !> This hguess is set through the hguess variable of the optimizer and needs to be hardcoded/set explicitly before initialization for benchmarking!!
+        call dhtosq(nat3,H_init,calc%chess%hess) !> maybe this should all be inside the construct bfgs function later? -> cannot due to circular import!!!
+        write(stdout,*)                                                                                                   !> Hessian type (gfnff,mod,identity) is set through input file and is already encoded into the calc object
+        write(stdout,*)"THERMO FROM INITIALIZED HESSIAN:"
+        write(stdout,*) 
+        call calc_thermo_from_hess(molnew,H_init,pr, &
+        & calc%nt,calc%temperatures,calc%ithr,calc%fscal,calc%sthr,calc%et, &
+        & calc%ht,calc%gt,calc%stot,etot)
+
+        call calc%chess%construct_hessian()
+
+        write (stdout,*)
+        write (stdout,*) "THERMO FROM RECONSTRUCTED HESSIAN:" 
+        write (stdout,*)
+
+        call calc_thermo_from_hess(molnew,calc%chess%H(:,:),pr, &
+        & calc%nt,calc%temperatures,calc%ithr,calc%fscal,calc%sthr,calc%et, &
+        & calc%ht,calc%gt,calc%stot,etot)
+
+    else 
+        write(stdout,*) "Reoptimised Geometry not equal to initial structure"
+    
+    endif
+
+
+end subroutine deform_opt_hess
\ No newline at end of file
diff --git a/src/algos/dryrun.f90 b/src/algos/dryrun.f90
new file mode 100644
index 00000000..0d6451c1
--- /dev/null
+++ b/src/algos/dryrun.f90
@@ -0,0 +1,233 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+subroutine crest_dry_run(env,tim)
+!********************************************************************
+!* Dry-run runtype. Prints a formatted summary of all CREST settings
+!* and exits cleanly without performing any calculations.
+!*
+!* Input/Output:
+!*  env  -  crest's systemdata object
+!*  tim  -  timer object
+!********************************************************************
+  use crest_parameters
+  use crest_data
+  use crest_calculator
+  use iomod
+  implicit none
+  type(systemdata),intent(inout) :: env
+  type(timer),intent(inout)      :: tim
+  character(len=512) :: dumstr
+  character(len=:),allocatable :: ctmp
+  logical :: ex
+!========================================================================================!
+
+  write (stdout,*)
+  call drawbox(stdout,'D R Y   R U N',charset=6,width=80)
+  write (stdout,'(1x,a)') 'Dry run was requested.'
+  write (stdout,'(1x,a)') 'Running CREST with the chosen arguments would result in the following settings:'
+  write (stdout,*)
+
+!========================================================================================!
+!> INPUT FILE
+!========================================================================================!
+  call drawbox(stdout,'Input',charset=4,padl=2,padr=2)
+  write (stdout,*)
+  ex = file_exists(env%inputcoords)
+  write (stdout,'(2x,a,a)',advance='no') 'Input file : ',trim(env%inputcoords)
+  if (ex) then
+    write (stdout,*)
+  else
+    write (stdout,'(1x,"( ",a," )")') colorify('NOT FOUND','red')
+  end if
+  write (stdout,*)
+
+!========================================================================================!
+!> RUNTYPE
+!========================================================================================!
+  call drawbox(stdout,'Job type',charset=4,padl=2,padr=2)
+  write (stdout,*)
+  select case (env%crestver)
+  case (crest_mfmdgc)
+    write (stdout,'(2x,a)') 'Conformational search via the MF-MD-GC algorithm ('//colorify("DEPRECATED",'red')//')'
+  case (crest_imtd)
+    write (stdout,'(2x,a)') 'Conformational search via the iMTD-GC algorithm'
+  case (crest_imtd2)
+    write (stdout,'(2x,a)') 'Conformational search via the iMTD-sMTD algorithm (-v4)'
+  case (crest_mdopt)
+    write (stdout,'(2x,a)') 'Ensemble reoptimization (-mdopt)'
+  case (crest_mdopt2)
+    write (stdout,'(2x,a)') 'Ensemble reoptimization, variant 2 (-mdopt2)'
+  case (crest_screen)
+    write (stdout,'(2x,a)') 'Ensemble screening and reoptimization (-screen)'
+  case (crest_nano)
+    write (stdout,'(2x,a)') 'GFNn-xTB nano reactor (-reactor)'
+  case (crest_sp)
+    write (stdout,'(2x,a)') 'Standalone singlepoint calculation'
+  case (crest_optimize)
+    if (.not.env%crest_ohess) then
+      write (stdout,'(2x,a)') 'Standalone geometry optimization'
+    else
+      write (stdout,'(2x,a)') 'Standalone geometry optimization followed by numerical Hessian' 
+    end if
+  case (crest_moldyn)
+    write (stdout,'(2x,a)') 'Standalone molecular dynamics simulation'
+  case (crest_s1)
+    write (stdout,'(2x,a)') 'Conformational search (crest_s1)'
+  case (crest_mecp)
+    write (stdout,'(2x,a)') 'Minimum energy crossing point (MECP) search'
+  case (crest_numhessian)
+    write (stdout,'(2x,a)') 'Numerical Hessian calculation'
+  case (crest_scanning)
+    write (stdout,'(2x,a)') 'Coordinate scan'
+  case (crest_rigcon)
+    write (stdout,'(2x,a)') 'Rule-based conformer generation'
+  case (crest_sorting)
+    write (stdout,'(2x,a)') 'Standalone ensemble sorting (CREGEN)'
+  case (crest_bh)
+    write (stdout,'(2x,a)') 'Basin-hopping conformer search'
+  case (crest_bhpt)
+    write (stdout,'(2x,a)') 'Basin-hopping with parallel tempering'
+  case (crest_none)
+    write (stdout,'(2x,a)') '<no runtype specified>'
+  case default
+    write (stdout,'(2x,a,i0,a)') '<unrecognized runtype: crestver=',env%crestver,'>'
+  end select
+  write (stdout,*)
+
+!========================================================================================!
+!> CALCULATION SETTINGS
+!========================================================================================!
+  call drawbox(stdout,'Calculation settings',charset=4,padl=2,padr=2)
+  write (stdout,*)
+  if (associated(env%calc)) then
+    if (env%calc%ncalculations > 0) then
+      call env%calc%info(stdout,printhdr=.false.)
+    else
+      write (stdout,'(2x,a)') 'Calculation object associated but no levels defined yet.'
+    end if
+  else
+    write (stdout,'(2x,a)') 'Calculation object not associated (legacy mode or not yet set up).'
+  end if
+  write (stdout,*)
+
+!========================================================================================!
+!> OPTIMIZATION SETTINGS
+!========================================================================================!
+  call drawbox(stdout,'Optimization settings',charset=4,padl=2,padr=2)
+  write (stdout,*)
+
+  write (stdout,'(2x,a,t35,": ",a,1x,"(",i0,")")') 'Optimization level',optlevflag(env%optlev),nint(env%optlev)
+  if (associated(env%calc)) then
+    block
+      use optimize_utils,only:get_optthr
+      real(wp) :: ethr,gthr
+      integer :: nat,iolev
+      nat = env%ref%nat
+      iolev = nint(env%optlev)
+      call get_optthr(nat,iolev,env%calc,ethr,gthr)
+      write (stdout,'(2x,a,t35,": ",i0)') 'Max cycles (calc obj)',env%calc%maxcycle
+      write (stdout,'(2x,a,t35,": ",es12.4)') 'Energy convergence  [Eh]',ethr
+      write (stdout,'(2x,a,t35,": ",es12.4)') 'Gradient convergence [Eh/a0]',gthr
+    end block
+  end if
+  write (stdout,*)
+
+!========================================================================================!
+!> MD / MTD SETTINGS
+!========================================================================================!
+  call drawbox(stdout,'MD / MTD settings',charset=4,padl=2,padr=2)
+  write (stdout,*)
+  if (env%mdtime > 0.0_wp) then
+    write (stdout,'(2x,a,t35,": ",f10.1,a)') 'Simulation length',env%mdtime,' ps'
+  else
+    write (stdout,'(2x,a,t35,": ",a)') 'Simulation length','<system dependent>'
+  end if
+  write (stdout,'(2x,a,t35,": ",f10.1,a)') 'Time step',env%mdstep,' fs'
+  write (stdout,'(2x,a,t35,": ",i10)') 'SHAKE mode',env%shake
+  write (stdout,'(2x,a,t35,": ",f10.2,a)') 'MD temperature',env%mdtemp,' K'
+  write (stdout,'(2x,a,t35,": ",i10,a)') 'Trajectory dump step',env%mddumpxyz,' fs'
+  write (stdout,'(2x,a,t35,": ",f10.1,a)') 'MTD Vbias dump',real(env%mddump,wp)/1000.0_wp,' ps'
+  if (env%mddat%length_ps > 0.0_wp) then
+    write (stdout,*)
+    write (stdout,'(2x,a)') 'mddata object (modern MD runtype):'
+    write (stdout,'(4x,a,t35,": ",f10.1)') 'length_ps',env%mddat%length_ps
+    write (stdout,'(4x,a,t35,": ",f10.4)') 'tstep [fs]',env%mddat%tstep
+    write (stdout,'(4x,a,t35,": ",f10.2)') 'T_soll',env%mddat%tsoll
+    write (stdout,'(4x,a,t35,": ",l6)') 'SHAKE',env%mddat%shake
+    write (stdout,'(4x,a,t35,": ",a)') 'thermostat',trim(env%mddat%thermotype)
+  end if
+  write (stdout,*)
+
+!========================================================================================!
+!> THERMODYNAMICS SETTINGS
+!========================================================================================!
+  call drawbox(stdout,'Thermodynamics settings',charset=4,padl=2,padr=2)
+  write (stdout,*)
+  select case (env%thermo%emodel)
+  case ('grimme')
+    ctmp = 'Grimme (2012)'
+  case ('truhlar')
+    ctmp = 'Truhlar (2011)'
+  end select
+  write (stdout,'(2x,a,t35,": ",a15)') 'Vibrational entropy model',ctmp
+  write (stdout,'(2x,a,t35,": ",f10.2,a)') 'Imaginary freq. threshold',env%thermo%ithr,' cm^-1'
+  write (stdout,'(2x,a,t35,": ",f10.4)') 'Frequency scaling factor',env%thermo%fscal
+  write (stdout,'(2x,a,t35,": ",f10.2,a)') 'Rot/vib interpolation threshold',env%thermo%sthr,' cm^-1'
+  write (stdout,'(2x,a,t35,": ",f6.2,a,f6.2,a,f6.2)') &
+    & 'T range [K] (start/end/step)', &
+    & env%thermo%trange(1),'/',env%thermo%trange(2),'/',env%thermo%trange(3)
+  write (stdout,'(2x,a,t35,": ",i10)') 'Number of temperature points             : ',env%thermo%ntemps
+  write (stdout,*)
+
+!========================================================================================!
+!> SORTING / CREGEN SETTINGS
+!========================================================================================!
+  call drawbox(stdout,'Sorting / CREGEN settings',charset=4,padl=2,padr=2)
+  write (stdout,*)
+  write (stdout,'(2x,a,t35,": ",f10.4,a)') 'Energy window           ',env%ewin,' kcal/mol'
+  write (stdout,'(2x,a,t35,": ",f10.4,a)') 'RTHR (RMSD threshold)  ',env%rthr,' Å'
+  write (stdout,'(2x,a,t35,": ",f10.4,a)') 'ETHR (energy threshold)',env%ethr,' kcal/mol'
+  write (stdout,'(2x,a,t35,": ",f10.2,a)') 'BTHR (rot. threshold)  ',env%bthr2*100.0d0,' %'
+  write (stdout,'(2x,a,t35,": ",f10.2)') 'Boltzmann temperature   ',env%tboltz
+  write (stdout,'(2x,a,t35,": ",l6)') 'Heavy-atom RMSD only    ',env%heavyrmsd
+  write (stdout,'(2x,a,t35,": ",l6)') 'Topology check in CREGEN',env%checktopo
+  write (stdout,*)
+
+!========================================================================================!
+!> TECHNICAL SETTINGS
+!========================================================================================!
+  call drawbox(stdout,'Technical settings',charset=4,padl=2,padr=2)
+  write (stdout,*)
+  call getcwd(dumstr)
+  write (stdout,'(2x,a,t25,": ",a)') 'Working directory',trim(dumstr)
+  write (stdout,'(2x,a,t25,": ",i0)') 'CPUs / threads',env%threads
+  write (stdout,*)
+
+!========================================================================================!
+!> CREST BINARY METADATA  (always last)
+!========================================================================================!
+  call drawbox(stdout,'CREST binary info',charset=4,padl=2,padr=2)
+  write (stdout,*)
+  call print_crest_metadata()
+  write (stdout,*)
+
+!========================================================================================!
+  call creststop(status_normal)
+end subroutine crest_dry_run
diff --git a/src/algos/dynamics.f90 b/src/algos/dynamics.f90
index ff351e92..e863b709 100644
--- a/src/algos/dynamics.f90
+++ b/src/algos/dynamics.f90
@@ -24,6 +24,7 @@ subroutine crest_moleculardynamics(env,tim)
   use strucrd
   use dynamics_module
   use shake_module
+  use iomod,only:colorify
   implicit none
   type(systemdata),intent(inout) :: env
   type(timer),intent(inout)      :: tim
@@ -39,17 +40,19 @@ subroutine crest_moleculardynamics(env,tim)
   real(wp),allocatable :: grad(:,:)
 
   character(len=80) :: atmp
-  character(len=*),parameter :: trjf='crest_dynamics.trj'
+  character(len=*),parameter :: trjf = 'crest_dynamics.trj.xyz'
 !========================================================================================!
-  write(stdout,*)
-  !call system('figlet dynamics')
-  write(stdout,*) "      _                             _           " 
-  write(stdout,*) "   __| |_   _ _ __   __ _ _ __ ___ (_) ___ ___  "
-  write(stdout,*) "  / _` | | | | '_ \ / _` | '_ ` _ \| |/ __/ __| "
-  write(stdout,*) " | (_| | |_| | | | | (_| | | | | | | | (__\__ \ "
-  write(stdout,*) "  \__,_|\__, |_| |_|\__,_|_| |_| |_|_|\___|___/ "
-  write(stdout,*) "        |___/                                   "
-  write(stdout,*)
+  write (stdout,*)
+  write (stdout,*) " ------------------------------------------------- "
+  write (stdout,*) " #####  #   # #    #   ##   #    # #  ####   ####  "
+  write (stdout,*) " #    #  # #  ##   #  #  #  ##  ## # #    # #      "
+  write (stdout,*) " #    #   #   # #  # #    # # ## # # #       ####  "
+  write (stdout,*) " #    #   #   #  # # ###### #    # # #           # "
+  write (stdout,*) " #    #   #   #   ## #    # #    # # #    # #    # "
+  write (stdout,*) " #####    #   #    # #    # #    # #  ####   ####  "
+  write (stdout,*) " ------------------------------------------------- "
+  write (stdout,*)
+
 !========================================================================================!
   call new_ompautoset(env,'max',0,T,Tn)
   call ompprint_intern()
@@ -65,9 +68,9 @@ subroutine crest_moleculardynamics(env,tim)
   !>--- default settings from env
   call env_to_mddat(env)
   mddat = env%mddat
-  calc = env%calc
+  call calc%copy(env%calc)
   !>--- check if we have any MD & calculation settings allocated
-  if (.not. mddat%requested) then
+  if (.not.mddat%requested) then
     write (stdout,*) 'MD requested, but no MD settings present.'
     env%iostatus_meta = status_config
     return
@@ -78,12 +81,12 @@ subroutine crest_moleculardynamics(env,tim)
   end if
 
   !>--- print calculation info
-  call calc%info( stdout )
+  call calc%info(stdout)
 
   !>--- init SHAKE? --> we need connectivity info
   if (mddat%shake) then
     calc%calcs(1)%rdwbo = .true.
-    if(.not.calc%calcs(1)%active) calc%calcs(1)%active=.true.
+    if (.not.calc%calcs(1)%active) calc%calcs(1)%active = .true.
     allocate (grad(3,mol%nat),source=0.0_wp)
     call engrad(mol,calc,energy,grad,io)
     deallocate (grad)
diff --git a/src/algos/hessian_tools.f90 b/src/algos/hessian_tools.f90
deleted file mode 100644
index 0b330903..00000000
--- a/src/algos/hessian_tools.f90
+++ /dev/null
@@ -1,580 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2023 Gereon Feldmann
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-! Routines were adapted from the xtb code (github.com/grimme-lab/xtb)
-! under the Open-source software LGPL-3.0 Licencse.
-!================================================================================!
-
-!========================================================================================!
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
-!> Routines for the computation of a projected mass-weighted Hessian
-!> Routines for the computation of frequencies from the Hessian
-!> Rotuines for the computation of the effective Hessian at an MECP based on: DOI:10.1039/A907723E
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
-!========================================================================================!
-
-module hessian_tools
-  use crest_parameters, only:wp,stdout
-  use crest_data
-  use crest_calculator
-  use strucrd
-  use optimize_module
-  use optimize_maths
-  use iomod
-
-  public :: frequencies
-
-!=========================================================================================!
-!=========================================================================================!
-contains  !> MODULE PROCEDURES START HERE
-!=========================================================================================!
-!=========================================================================================!
-
-
-  subroutine frequencies(nat,at,xyz,nat3,calc,prj_mw_hess,freq,io)
-!*************************************************
-!* Returns the Frequencies from a Hessian in cm-1
-!*************************************************
-    implicit none
-
-    integer,intent(in) :: nat
-    integer,intent(in) :: at(nat)
-    real(wp),intent(in) :: xyz(3,nat)
-    type(calcdata) :: calc
-    real(wp) :: prj_mw_hess(nat3,nat3)
-
-    integer :: io,nat3
-    logical :: pr
-    real(wp) :: energy
-    real(wp) :: freq(nat3)
-    real(wp),allocatable :: pmode(:,:)
-
-    integer,allocatable :: iwork(:)
-    real(wp),allocatable :: work(:)
-
-    integer :: lwork,liwork,info,i
-    !>LAPCK
-    external :: dsyevd
-
-    nat3 = nat*3
-
-    !Parameters for diagonalization
-    lwork = 1+6*nat3+2*nat3**2
-    liwork = 3+5*nat3
-
-    allocate (work(lwork),iwork(liwork))
-
-    !Diagonalization
-    call dsyevd('V','U',nat3,prj_mw_hess,nat3,freq,work,lwork,iwork,liwork,info)
-
-    deallocate (work,iwork)
-
-    !Convert eigenvalues to frequencies
-    do i = 1,nat3
-      if (freq(i) .gt. 0.0_wp) then
-        freq(i) = sqrt(freq(i))*219474.63_wp
-      else
-        freq(i) = -sqrt(abs(freq(i)))*219474.63_wp
-      end if
-    end do
-
-    return
-
-  end subroutine frequencies
-
-
-  subroutine mass_weight_hess(nat,at,nat3,hess)
-    use atmasses
-    implicit none
-
-    !> Mass weighting the Hessian
-    integer,intent(in) :: nat                   !Number of atoms
-    integer,intent(in) :: at(nat)               !atomic number of all atoms
-
-    real(wp),intent(inout) :: hess(nat3,nat3)   !Hessian matrix
-    real(wp) :: mass_in_au             !Masses of all atoms of the periodic table
-    integer :: i,j,nat3,i3,i33,j3,j33
-
-    mass_in_au = (1.66054e-27_wp/9.1094e-31_wp)**2
-
-    !amv = ams(1:118)
-
-    do i = 1,nat
-      do j = i,nat
-
-        i3 = 3*(i-1)+1
-        i33 = 3*(i-1)+3
-        j3 = 3*(j-1)+1
-        j33 = 3*(j-1)+3
-
-        hess(i3:i33,j3:j33) = 1/sqrt(ams(at(i))*ams(at(j))*mass_in_au)*hess(i3:i33,j3:j33)
-        !Hessian is symmetric hence upper triangular can be copied
-        hess(j3:j33,i3:i33) = hess(i3:i33,j3:j33)
-
-      end do
-    end do
-
-    return
-  end subroutine mass_weight_hess
-
-  subroutine dsqtoh(n,a,b)
-!****************************************************
-!* converts upper triangle of a matrix into a vector
-!****************************************************
-    implicit none
-    integer,intent(in)  :: n
-    real(wp),intent(in) :: a(n,n)
-    real(wp),intent(out)  :: b(n*(n+1)/2)
-    integer :: i,j,k
-
-    k = 0
-    do i = 1,n
-      do j = 1,i
-        k = k+1
-        b(k) = a(i,j)
-      end do
-    end do
-
-  end subroutine dsqtoh
-
-  subroutine dhtosq(n,a,b)
-!*********************************************************
-!* converts upper triangle vector into a symmetric matrix
-!*********************************************************
-    implicit none
-    integer,intent(in)  :: n
-    real(wp),intent(out) :: a(n,n)
-    real(wp),intent(in)  :: b(n*(n+1)/2)
-    integer :: i,j,k
-
-    k = 0
-    do i = 1,n
-      do j = 1,i
-        k = k+1
-        a(j,i) = b(k)
-        a(i,j) = b(k)
-      end do
-    end do
-
-    return
-  end subroutine dhtosq
-
-!=========================================================================================!
-
-  subroutine prj_mw_hess(nat,at,nat3,xyz,hess)
-!***************************************************************
-!* Projection of the translational and rotational DOF out of 
-!* the numerical Hessian plus the mass-weighting of the Hessian
-!***************************************************************
-    implicit none
-
-    integer,intent(in) :: nat,nat3
-    integer :: at(nat)
-    real(wp),intent(inout) :: hess(nat3,nat3)
-    real(wp) ::  xyz(3,nat)
-    !real(wp) ::  hess_ut(nat3*(nat3+1)/2),pmode(nat3,1)
-    real(wp),allocatable ::  hess_ut(:),pmode(:,:)
-
-    allocate(hess_ut(nat3*(nat3+1)/2), source=0.0_wp)
-    allocate(pmode(nat3,1), source=0.0_wp)
-
-    !> Transforms matrix of the upper triangle vector
-    call dsqtoh(nat3,hess,hess_ut)
-
-    !> Projection
-    call trproj(nat,nat3,xyz,hess_ut,.false.,0,pmode,1)
-
-    !> Transforms vector of the upper triangle into matrix
-    call dhtosq(nat3,hess,hess_ut)
-
-    !> Mass weighting
-    call mass_weight_hess(nat,at,nat3,hess)
-
-    deallocate(pmode,hess_ut)
-  end subroutine prj_mw_hess
-
-!=========================================================================================!
-
-  subroutine print_vib_spectrum(nat,at,nat3,xyz,freq,dir,fname)
-!*********************************************************************
-!* Prints the frequencies in Turbomoles "vibspectrum" format 
-!* The intensity is only artficially set to 1000 for every vibration!!
-!**********************************************************************
-    integer,intent(in) :: nat,nat3
-    integer :: at(nat),i
-    real(wp) ::  xyz(3,nat)
-    real(wp) ::  freq(nat3),thr
-    character(len=*) :: fname
-    character(len=*) :: dir
-
-    thr = 0.01_wp
-    if (len_trim(dir) .eq. 0) then
-      open (newunit=ich,file=fname)
-    else
-      if(directory_exist(dir))then
-      open (newunit=ich,file=dir//'/'//fname)
-      else
-      open (newunit=ich,file=fname)
-      endif
-    end if
-
-
-    write (ich,'("$vibrational spectrum")')
-    write (ich,'("#  mode    symmetry    wave number    IR intensity    selection rules")')
-    write (ich,'("#                       1/cm              km/mol         IR    RAMAN")')
-
-    do i = 1,nat3
-      if (abs(freq(i)) .lt. thr) then
-        write (ich,'(i6,9x,    f18.2,f16.5,7x," - ",5x," - ")') &
-          i,freq(i),0.0_wp
-      else
-        write (ich,'(i6,8x,"a",f18.2,f16.5,7x,"YES",5x,"YES")') &
-          i,freq(i),1000.0_wp
-      end if
-    end do
-
-    write (ich,'("$end")')
-
-    close (ich)
-
-  end subroutine print_vib_spectrum
-
-!=========================================================================================!
-
-  subroutine print_g98_fake(nat,at,nat3,xyz,freq,hess,dir,fname)
-!****************************************************************
-!* Prints the vibration spectrum of the a system as a g98.out.
-!* Routine is adapted from the xtb code.
-!****************************************************************
-    integer,intent(in) :: nat,nat3
-    integer :: at(nat)
-    integer  :: gu,i,j,ka,kb,kc,la,lb,k
-
-    real(wp) ::  xyz(3,nat)
-    real(wp),intent(in) :: hess(nat3,nat3)
-    real(wp) ::  freq(nat3),red_mass(nat3),force(nat3),ir_int(nat3),zero(1),f2(nat3),u(nat3,nat3)
-
-    character(len=2) :: irrep
-    character(len=*) :: fname
-    character(len=*) :: dir
-
-    irrep = 'a'
-
-    red_mass = 99.0
-    force = 99.0
-    ir_int = 99.0
-    zero = 0.0
-
-    k = 0
-
-    do i = 1,nat3
-      if (abs(freq(i)) .gt. 1.d-1) then
-        k = k+1
-        u(1:nat3,k) = hess(1:nat3,i)
-        f2(k) = freq(i)
-      end if
-    end do
-
-    if (len_trim(dir) .eq. 0) then
-      open (newunit=gu,file=fname)
-    else
-      if(directory_exist(dir))then
-      open (newunit=gu,file=dir//'/'//fname)
-      else
-      open (newunit=gu,file=fname) 
-      endif
-    end if
-
-    write (gu,'('' Entering Gaussian System'')')
-    write (gu,'('' *********************************************'')')
-    write (gu,'('' Gaussian 98:'')')
-    write (gu,'('' frequency output generated by the crest code'')')
-    write (gu,'('' *********************************************'')')
-
-    write (gu,*) '                        Standard orientation:'
-    write (gu,*) '---------------------------------------------', &
-        & '-----------------------'
-    write (gu,*) ' Center     Atomic     Atomic', &
-        & '              Coordinates (Angstroms)'
-    write (gu,*) ' Number     Number      Type ', &
-        & '             X           Y           Z'
-    write (gu,*) '-----------------------', &
-        & '---------------------------------------------'
-    j = 0
-    do i = 1,nat
-      write (gu,111) i,at(i),j,xyz(1:3,i)*0.52917726
-    end do
-    write (gu,*) '----------------------', &
-        & '----------------------------------------------'
-    write (gu,*) '    1 basis functions        1 primitive gaussians'
-    write (gu,*) '    1 alpha electrons        1 beta electrons'
-    write (gu,*)
-111 format(i5,i11,i14,4x,3f12.6)
-
-    write (gu,*) 'Harmonic frequencies (cm**-1), IR intensities',' (km*mol⁻¹),'
-    write (gu,*) 'Raman scattering activities (A**4/amu),', &
-        & ' Raman depolarization ratios,'
-    write (gu,*) 'reduced masses (AMU), force constants (mDyne/A)', &
-        & ' and normal coordinates:'
-
-    ka = 1
-    kc = 3
-
-60  kb = min0(kc,k)
-    write (gu,100) (j,j=ka,kb)
-    write (gu,105) (irrep,j=ka,kb)
-    write (gu,110) ' Frequencies --', (f2(j),j=ka,kb)
-    write (gu,110) ' Red. masses --', (red_mass(j),j=ka,kb)
-    write (gu,110) ' Frc consts  --', (force(j),j=ka,kb)
-    write (gu,110) ' IR Inten    --', (ir_int(j),j=ka,kb)
-    write (gu,110) ' Raman Activ --', (zero,j=ka,kb)
-    write (gu,110) ' Depolar     --', (zero,j=ka,kb)
-    write (gu,*) 'Atom AN      X      Y      Z        X      Y', &
-        & '      Z        X      Y      Z'
-    la = 1
-70  lb = nat
-    do i = la,lb
-      write (gu,130) i,at(i), (u(i*3-2,j),u(i*3-1,j),u(i*3,j),j=ka,kb)
-    end do
-    if (lb .eq. nat) go to 90
-    go to 70
-90  if (kb .eq. k) then
-      goto 200
-    end if
-
-    ka = kc+1
-    kc = kc+3
-    go to 60
-
-100 format(3(20x,i3))
-105 format(3x,3(18x,a5))
-110 format(a15,f11.4,12x,f11.4,12x,f11.4)
-130 format(2i4,3(2x,3f7.2))
-200 continue
-    write (gu,'(''end of file'')')
-    close (gu)
-
-  end subroutine print_g98_fake
-
-!=========================================================================================!
-
-
-  subroutine print_hessian(hess,nat3,dir,fname)
-!*******************************
-!* Prints the numerical hessian
-!*******************************
-    integer :: nat3,i,j,k
-    real(wp) :: hess(nat3,nat3)
-    character(len=*) :: fname
-    character(len=*) :: dir
-
-    if (len_trim(dir) .eq. 0) then
-      open (newunit=ich,file=fname)
-      write (stdout,'(1x,a)',advance='no') 'Will be written to file "'//fname//'" ...'
-    else
-      if(directory_exist(dir))then
-      open (newunit=ich,file=dir//'/'//fname)
-      write (stdout,'(1x,a)',advance='no') 'Will be written to file "'//dir//'/'//fname//'" ...'
-      else
-      open (newunit=ich,file=fname)
-      write (stdout,'(1x,a)',advance='no') 'Will be written to file "'//fname//'" ...'
-      endif
-    end if
-    flush(stdout)
-
-    write (ich,'(1x,a)') '$hessian'
-    do i = 1,nat3
-      k = 0
-      do j = 1,nat3
-        k = k+1
-        if (k .le. 4) then
-          write (ich,'(f16.8)',advance='no') hess(i,j)
-        else
-          write (ich,'(f16.8)') hess(i,j)
-          k = 0
-        end if
-      end do
-      if (k .ne. 0) then
-        write (ich,*)
-      end if
-    end do
-    write (ich,'(1x,a)') '$end'
-    close (ich)
-
-    write (stdout,*) 'done.'
-    write (stdout,*)
-
-  end subroutine print_hessian
-
-!=========================================================================================!
-
-  subroutine effective_hessian(nat,nat3,grad1_i,grad2_i,hess1,hess2,heff)
-!******************************************************************
-!* Effective Hessian at an MECP is computed via Eq. 27 and Eq. 28 
-!* in https://doi.org/10.1002/qua.25124
-!******************************************************************
-    implicit none
-    integer,intent(in) :: nat,nat3
-    integer :: i,j,ii
-    real(wp),intent(in) :: grad1_i(3,nat3),grad2_i(3,nat3)
-    real(wp) :: grad1(nat3),grad2(nat3),dot
-
-    real(wp),intent(in) :: hess1(nat3,nat3),hess2(nat3,nat3)
-
-    real(wp) :: gnorm1,gnorm2,grad_diff_norm
-    real(wp) :: grad_diff(nat3),heff_temp(nat3,nat3)
-
-    real(wp),intent(inout) :: heff(nat3,nat3)
-    real(wp),allocatable :: proj_vec(:,:)
-
-    real(wp) :: freq(nat3)
-
-    integer,allocatable :: iwork(:)
-    real(wp),allocatable :: work(:)
-
-    integer :: lwork,liwork,info
-
-    allocate (proj_vec(nat3,nat3),source=0.0_wp)
-
-    grad1 = reshape(grad1_i, (/nat3/))
-    grad2 = reshape(grad2_i, (/nat3/))
-
-    gnorm1 = norm2(grad1)
-
-    gnorm2 = norm2(grad2)
-
-    grad_diff = grad1-grad2
-
-    grad_diff_norm = norm2(grad_diff)
-
-    dot = dot_product(grad1,grad2)
-
-    if (dot .gt. 0.0_wp) then !sloped: dot > 0.0 --> -  | peaked: dot <= 0.0 --> +
-
-      write (stdout,*) 'MECI is considered as a sloped CI'
-      write (stdout,*)
-
-      heff = (gnorm1*hess2-gnorm2*hess1)/grad_diff_norm
-
-    else
-
-      write (stdout,*) 'MECI is considered as a peaked CI'
-      write (stdout,*)
-
-      heff = (gnorm1*hess2+gnorm2*hess1)/grad_diff_norm
-
-    end if
-
-    !Outer Product of grad_diff
-
-    !Building projection matrix
-
-    !proj_vec = 1 - (dg/|dg| o dg.T/|dg|) = 1 - (dg o dg.T)/|dg|**2
-
-    grad_diff_norm = grad_diff_norm**2
-
-    do i = 1,nat3
-      proj_vec(i,:) = -grad_diff(i)*grad_diff/grad_diff_norm
-      proj_vec(i,i) = proj_vec(i,i)+1
-    end do
-
-    !Projection
-    heff = matmul(matmul(proj_vec,heff),proj_vec)
-
-    !Check if hess1 and hess2 are assigned correctly, otherwise change
-    lwork = 1+6*nat3+2*nat3**2
-    liwork = 3+5*nat3
-    allocate (work(lwork),iwork(liwork))
-
-    heff_temp = heff
-
-    call dsyevd('V','U',nat3,heff_temp,nat3,freq,work,lwork,iwork,liwork,info)
-
-    deallocate (work,iwork)
-
-    if (0 .gt. sum(freq)) then
-      heff = -heff
-    end if
-
-  end subroutine effective_hessian
-
-!=========================================================================================!
-
- subroutine calculate_frequencies(calc,nat,at,xyz,freq,io,constraints)
-!*******************************************************
-!* Bundels several routines from this module to
-!* calculate the vib. frequencies for a given structure
-!* The output frequencies are in cm-1 
-!*******************************************************
-     implicit none
-     !> INPUT
-     type(calcdata),intent(inout) :: calc
-     integer,intent(in)  :: nat
-     integer,intent(in)  :: at(nat)
-     real(wp),intent(in) :: xyz(3,nat)
-     logical,intent(in),optional :: constraints
-     !> OUTPUT
-     integer,intent(out)  :: io
-     real(wp),intent(out) :: freq(3*nat)
-     !> LOCAL
-     real(wp),allocatable :: hessian(:,:)
-     real(wp),allocatable :: chess(:,:)
-     type(calcdata) :: dummycalc
-     integer :: nat3,ncalc,i
-
-     io = 0
-     freq = 0.0_wp
-     nat3 = nat*3
-     ncalc = calc%ncalculations
-
-     allocate(hessian(nat3,nat3), source = 0.0_wp)
-
-     !>--- Hessian from combined energy and gradient
-     call numhess1(nat,at,xyz, calc,hessian,io) 
-     if( io /= 0 ) return
-
-     !>--- do we consider contributions from the constraints?
-     !>    (yes, by default, they are in the hessian from numhess1,
-     !>    if we DO NOT want them, we need to take them out again)
-     if(present(constraints))then
-       if(.not.constraints)then
-         dummycalc = calc !> new dummy calculation
-         dummycalc%id = 0  !> set to zero so that ONLY constraints are considered
-         dummycalc%ncalculations = 0
-         dummycalc%pr_energies = .false.
-         allocate (chess(nat3,nat3),source=0.0_wp)
-         call numhess1(nat,at,xyz,dummycalc,chess,io)
-         hessian(:,:) = hessian(:,:) - chess(:,:)  
-         deallocate( chess )
-       endif
-     endif
-     
-     do i = 1,calc%ncalculations
-
-      !>-- Projects and mass-weights the Hessian
-      call prj_mw_hess(nat,at,nat3,xyz, hessian(:,:))
-
-      !>-- Computes the Frequencies
-      call frequencies(nat,at,xyz,nat3, calc, hessian(:,:), freq(:),io)
-     end do
-
-     deallocate( hessian )
-     return
- end subroutine calculate_frequencies
-
-!=========================================================================================!
-end module hessian_tools
diff --git a/src/algos/meson.build b/src/algos/meson.build
index 43977333..5ec15c40 100644
--- a/src/algos/meson.build
+++ b/src/algos/meson.build
@@ -26,10 +26,15 @@ srcs += files(
   'search_1.f90',
   'search_mecp.f90',
   'setuptest.f90',
+  'sorting.f90',
   'protonate.f90',
-  'hessian_tools.f90',
-  'ConfSolv.F90',
   'search_conformers.f90',
   'search_entropy.f90',
   'parallel.f90', 
+  'queueing.f90',
+  'alkylize.f90',
+  'deform_opt_hess.f90',
+  'dryrun.f90',
+  'propcalc.f90',
+  'term_ui.f90',
 )
diff --git a/src/algos/numhess.f90 b/src/algos/numhess.f90
index 84cb22df..0c098076 100644
--- a/src/algos/numhess.f90
+++ b/src/algos/numhess.f90
@@ -32,10 +32,12 @@ subroutine crest_numhess(env,tim)
   use crest_calculator
   use strucrd
   use optimize_module
-  use hessian_tools
+  use thermochem_module
   use gradreader_module
   use xtb_sc
   use oniom_hessian
+  use ir_spectrum
+  use iomod,only:colorify
   implicit none
 
   type(systemdata),intent(inout) :: env
@@ -48,19 +50,25 @@ subroutine crest_numhess(env,tim)
   real(wp) :: energy
   real(wp),allocatable :: hess(:,:,:),freq(:,:),grad(:),grad1(:,:),grad2(:,:),heff(:,:)
   real(wp),allocatable :: ohess(:,:),ofreq(:),grad0(:,:),energies0(:)
+  real(wp),allocatable :: ir_int(:)
   character(len=60) :: atmp
+
 !========================================================================================!
-  call tim%start(15,'Numerical Hessian')
-!========================================================================================!
-  !call system('figlet numhess')
+
   write (stdout,*)
-  write (stdout,*) "                       _                   "
-  write (stdout,*) " _ __  _   _ _ __ ___ | |__   ___  ___ ___ "
-  write (stdout,*) "| '_ \| | | | '_ ` _ \| '_ \ / _ \/ __/ __|"
-  write (stdout,*) "| | | | |_| | | | | | | | | |  __/\__ \__ \"
-  write (stdout,*) "|_| |_|\__,_|_| |_| |_|_| |_|\___||___/___/"
+  write (stdout,*) " ------------------------------------------------ "
+  write (stdout,*) " #    # #    # #    # #    # ######  ####   ###   "
+  write (stdout,*) " ##   # #    # ##  ## #    # #      #      #      "
+  write (stdout,*) " # #  # #    # # ## # ###### #####   ####   ####  "
+  write (stdout,*) " #  # # #    # #    # #    # #           #      # "
+  write (stdout,*) " #   ## #    # #    # #    # #      #    # #    # "
+  write (stdout,*) " #    #  ####  #    # #    # ######  ####   ####  "
+  write (stdout,*) " ------------------------------------------------ "
   write (stdout,*)
 
+!========================================================================================!
+  call tim%start(15,'Numerical Hessian')
+
   call env%ref%to(mol)
   write (stdout,*)
   write (stdout,*) 'Input structure:'
@@ -68,7 +76,7 @@ subroutine crest_numhess(env,tim)
   write (stdout,*)
 !========================================================================================!
 
-  calc = env%calc
+  call calc%copy(env%calc)
 
   !>--- print some info about the calculation
   call calc%info(stdout)
@@ -76,22 +84,21 @@ subroutine crest_numhess(env,tim)
 !========================================================================================!
 
   !>--- start with an initial single point
-  write(stdout,'(a)') repeat(":",80)
+  write (stdout,'(a)') repeat(":",80)
   write (stdout,'(1x,a)') 'Initial singlepoint calculation ...'
-  allocate(grad0(3,mol%nat),source=0.0_wp)
-  allocate(energies0( calc%ncalculations ), source=0.0_wp)
-
-  call engrad(mol,calc,energy,grad0,io)   
-  energies0 = calc%etmp  
-  
-  write(atmp,'("Energy = ",f25.15," Eh")') energy
-  call smallhead(trim(atmp)) 
-  write(stdout,'(a)') repeat(":",80)
-  write(stdout,*)
-  
-
-  deallocate(grad0)
- 
+  allocate (grad0(3,mol%nat),source=0.0_wp)
+  allocate (energies0(calc%ncalculations),source=0.0_wp)
+
+  call engrad(mol,calc,energy,grad0,io)
+  energies0 = calc%etmp
+
+  write (atmp,'("Energy = ",f25.15," Eh")') energy
+  call smallhead(trim(atmp))
+  write (stdout,'(a)') repeat(":",80)
+  write (stdout,*)
+
+  deallocate (grad0)
+
 !========================================================================================!
 
   nat3 = mol%nat*3
@@ -116,6 +123,11 @@ subroutine crest_numhess(env,tim)
     allocate (hess(nat3,nat3,calc%ncalculations),source=0.0_wp)
     allocate (freq(nat3,n_freqs),source=0.0_wp)
 
+! ── auto-enable dipole gradient for single tblite level ──────────────────────
+    if (calc%ncalculations == 1) then
+      if (calc%calcs(1)%id == jobtype%tblite) calc%calcs(1)%rddip = .true.
+    end if
+
 !*********************************************************************************
 !>--- Computes numerical Hessians and stores them individually for each level
     call numhess2(mol%nat,mol%at,mol%xyz,calc,hess,io)
@@ -146,7 +158,7 @@ subroutine crest_numhess(env,tim)
         call prj_mw_hess(mol%nat,mol%at,nat3,mol%xyz,heff)
 
         !>-- Comp. of Frequencies
-        call frequencies(mol%nat,mol%at,mol%xyz,nat3,calc,heff,freq(:,n_freqs),io)
+        call frequencies(mol%nat,mol%at,mol%xyz,nat3,heff,freq(:,n_freqs),io)
 
         !>-- Printout of vibspectrum
         call print_vib_spectrum(mol%nat,mol%at,nat3,mol%xyz,freq(:,n_freqs),'','vibspectrum')
@@ -178,34 +190,48 @@ subroutine crest_numhess(env,tim)
 
       else
 
-        write(atmp,*) i
+        !> omit numeric suffix when there is only one calculation level
+        if (calc%ncalculations == 1) then
+          atmp = ''
+        else
+          write (atmp,*) i
+          atmp = trim(adjustl(atmp))
+        end if
 
         !>-- Prints Hessian
-        call print_hessian(hess(:,:,i),nat3,'','numhess'//trim(adjustl(atmp)))
+        call print_hessian(hess(:,:,i),nat3,'','numhess'//trim(atmp))
 
         !>--- Print dipole gradients (if they exist)
-        call calc%calcs(i)%dumpdipgrad('dipgrad'//trim(adjustl(atmp)))
+        call calc%calcs(i)%dumpdipgrad('dipgrad'//trim(atmp))
 
         !>-- Projects and mass-weights the Hessian
         call prj_mw_hess(mol%nat,mol%at,nat3,mol%xyz,hess(:,:,i))
 
         !>-- Computes the Frequencies
-        call frequencies(mol%nat,mol%at,mol%xyz,nat3,calc,hess(:,:,i),freq(:,i),io)
+        call frequencies(mol%nat,mol%at,mol%xyz,nat3,hess(:,:,i),freq(:,i),io)
 
         if (io .ne. 0) then
           write (stdout,*) 'FAILED!'
         else
 
-          !>-- Prints vibspectrum with artifical intensities
+! ── project dipole gradient onto normal modes → IR intensities ───────────
+          if (allocated(calc%calcs(i)%dipgrad)) then
+            allocate (ir_int(nat3),source=0.0_wp)
+            call ir_intensities(mol%nat,mol%at,nat3,hess(:,:,i), &
+            &                   calc%calcs(i)%dipgrad,ir_int)
+          end if
+
+          !>-- Prints vibspectrum
           call print_vib_spectrum(mol%nat,mol%at,nat3,mol%xyz,freq(:,i), &
-          &    '','vibspectrum'//trim(adjustl(atmp)))
+          &    '','vibspectrum'//trim(atmp),ir_int=ir_int)
 
-          !>-- Prints g98.out format file
+          !>-- Prints g98.out format file (suffix prevents overwrite for empty calcspace)
           call print_g98_fake(mol%nat,mol%at,nat3,mol%xyz,freq(:,i),hess(:,:,i), &
-          &    calc%calcs(i)%calcspace,'g98.out')
+          &    calc%calcs(i)%calcspace,'g98'//trim(atmp)//'.out',ir_int=ir_int)
 
-          write(atmp,*) i
-          call smallhead("Thermo contributions for [[calculation.level]] "//trim(adjustl(atmp)))
+          if (allocated(ir_int)) deallocate (ir_int)
+
+          call smallhead("Thermo contributions for [[calculation.level]] "//trim(atmp))
           call numhess_thermostat(env,mol,nat3,hess(:,:,i),freq(:,i),energies0(i))
 
         end if
@@ -233,7 +259,7 @@ subroutine crest_numhess(env,tim)
     call prj_mw_hess(mol%nat,mol%at,nat3,mol%xyz,ohess(:,:))
 
     !>-- Computes the Frequencies (in cm^-1)
-    call frequencies(mol%nat,mol%at,mol%xyz,nat3,calc,ohess(:,:),ofreq(:),io)
+    call frequencies(mol%nat,mol%at,mol%xyz,nat3,ohess(:,:),ofreq(:),io)
 
     !>-- Prints vibspectrum (cm^-1) with artifical intensities
     call print_vib_spectrum(mol%nat,mol%at,nat3,mol%xyz,ofreq(:), &
@@ -250,9 +276,6 @@ subroutine crest_numhess(env,tim)
   end if
 !========================================================================================!
 
-
-
-
 !========================================================================================!
   if (allocated(hess)) deallocate (hess)
   if (allocated(freq)) deallocate (freq)
@@ -276,28 +299,30 @@ subroutine numhess_thermostat(env,mol,nat3,hess,freq,etot)
   use crest_parameters
   use crest_data
   use strucrd
+  use thermochem_module
   implicit none
   !> INPUT
   type(systemdata) :: env
-  type(coord) :: mol
+  type(coord),intent(inout) :: mol
   integer,intent(in) :: nat3
   real(wp),intent(in) :: hess(nat3,nat3)
-  real(wp),intent(in) :: freq(nat3)
+  real(wp),intent(inout) :: freq(nat3)
   real(wp),intent(in) :: etot
   !> LOCAL
   real(wp) :: ithr,fscal,sthr
-  integer :: nt,nfreq,nrt
+  character(len=:),allocatable :: emodel
+  integer :: nt,nrt
   real(wp),allocatable :: temps(:),et(:),ht(:),stot(:),gt(:)
   real(wp) :: zpve
-  character(len=*),parameter :: outfmt = &
-  &  '(10x,"::",1x,a,f24.12,1x,a,1x,"::")'
 
   !> inversion threshold
   ithr = env%thermo%ithr
   !> frequency scaling factor
   fscal = env%thermo%fscal
-  !> RR-HO interpolation
+  !> RR-HO interpolation (or cut-off)
   sthr = env%thermo%sthr
+  !> Svib model
+  emodel = env%thermo%emodel
 
   if (.not.allocated(env%thermo%temps)) then
     call env%thermo%get_temps()
@@ -308,25 +333,14 @@ subroutine numhess_thermostat(env,mol,nat3,hess,freq,etot)
   !write(*,*) temps
   nrt = minloc(temps(:),1)
   !write(*,*) nrt
-  temps = env%thermo%temps 
+  temps = env%thermo%temps
 
-  !> calcthermo wants input in Angstroem
-  call calcthermo(mol%nat,mol%at,mol%xyz*autoaa,freq,.true., &
-  & ithr,fscal,sthr,nt,temps,et,ht,gt,stot)
+  !> calcthermo wants input in Bohr
+  call calcthermo(mol%nat,mol%at,mol%xyz,freq,.true., &
+  & ithr,fscal,sthr,nt,temps,et,ht,gt,stot,emodel=emodel)
 
-  !> printout
   zpve = et(nrt)-ht(nrt)
-  write(stdout,*) 
-  write(stdout,'(10x,a)') repeat(':',50)
-  write(stdout,'(10x,"::",7x,a,f12.2,1x,a,8x,"::")') "THERMODYNAMICS at",temps(nrt),'K'
-  write(stdout,'(10x,a)') repeat(':',50)
-  write(stdout,outfmt) 'TOTAL FREE ENERGY',etot+gt(nrt),'Eh'  
-  write(stdout,'(10x,a)') '::'//repeat('-',46)//'::'
-  write(stdout,outfmt) 'total energy     ',etot,'Eh'
-  write(stdout,outfmt) 'ZPVE             ',zpve,'Eh'
-  write(stdout,outfmt) 'G(RRHO) w/o ZPVE ',gt(nrt)-zpve,'Eh'
-  write(stdout,outfmt) 'G(RRHO) total    ',gt(nrt),'Eh'
-  write(stdout,'(10x,a)') repeat(':',50)
+  call print_thermo_summary(stdout,temps(nrt),etot,zpve,gt(nrt))
 
   deallocate (stot,gt,ht,et,temps)
 end subroutine numhess_thermostat
@@ -342,6 +356,7 @@ subroutine thermo_standalone(env)
   use crest_parameters
   use crest_data
   use strucrd
+  use thermochem_module
   implicit none
   !> INPUT
   type(systemdata) :: env
@@ -352,57 +367,58 @@ subroutine thermo_standalone(env)
   real(wp),allocatable :: freq(:)
   real(wp) :: etot
   real(wp) :: ithr,fscal,sthr
-  integer :: nt,nfreq,nrt
+  character(len=:),allocatable :: emodel
+  integer :: nt,nrt
   real(wp),allocatable :: temps(:),et(:),ht(:),stot(:),gt(:)
   real(wp) :: zpve
   integer :: ich,i
-  character(len=*),parameter :: outfmt = &
-  &  '(10x,"::",1x,a,f24.12,1x,a,1x,"::")'
 
   !> header
-  write(stdout,*) " _   _                               "
-  write(stdout,*) "| |_| |__   ___ _ __ _ __ ___   ___  "
-  write(stdout,*) "| __| '_ \ / _ \ '__| '_ ` _ \ / _ \ "
-  write(stdout,*) "| |_| | | |  __/ |  | | | | | | (_) |"
-  write(stdout,*) " \__|_| |_|\___|_|  |_| |_| |_|\___/ "
-  write(stdout,*) "                                     "
-  write(stdout,*) "Molecular thermodynamics from the modified and scaled"
-  write(stdout,*) "rigid-rotor harmonic-oscillator approximation (msRRHO)"
-  write(stdout,*) "See:"
-  write(stdout,*) " • S.Grimme, Chem. Eur. J. 2012, 18, 9955–9964."
-  write(stdout,*) " • P.Pracht, S.Grimme, Chem. Sci., 2021, 12, 6551-6568."
-  write(stdout,*)
- 
+  write (stdout,'(t10,a)') " _   _                               "
+  write (stdout,'(t10,a)') "| |_| |__   ___ _ __ _ __ ___   ___  "
+  write (stdout,'(t10,a)') "| __| '_ \ / _ \ '__| '_ ` _ \ / _ \ "
+  write (stdout,'(t10,a)') "| |_| | | |  __/ |  | | | | | | (_) |"
+  write (stdout,'(t10,a)') " \__|_| |_|\___|_|  |_| |_| |_|\___/ "
+  write (stdout,'(t10,a)') "                                     "
+  write (stdout,*) "Molecular thermodynamics from the modified and scaled"
+  write (stdout,*) "rigid-rotor harmonic-oscillator approximation (msRRHO)"
+  write (stdout,*) "See:"
+  write (stdout,*) " • S.Grimme, Chem. Eur. J. 2012, 18, 9955–9964."
+  write (stdout,*) " • P.Pracht, S.Grimme, Chem. Sci., 2021, 12, 6551-6568."
+  write (stdout,*)
+
   !> input coords
-  write(stdout,'(1x,a)',advance='no') 'Reading input coords: '
-  if(allocated(env%thermo%coords))then 
+  write (stdout,'(1x,a,t30)',advance='no') 'Reading input coords:'
+  if (allocated(env%thermo%coords)) then
     call mol%open(env%thermo%coords)
-    write(stdout,'(1x,a)') trim(env%thermo%coords)
+    write (stdout,'(a)') trim(env%thermo%coords)
   else
     call mol%open(env%inputcoords)
-    write(stdout,'(1x,a)') trim(env%inputcoords)
-  endif
-  nat3 = mol%nat * 3
-  allocate(hess(nat3,nat3),freq(nat3), source=0.0_wp)
+    write (stdout,'(a)') trim(env%inputcoords)
+  end if
+  nat3 = mol%nat*3
+  allocate (freq(nat3),source=0.0_wp)
 
   !> input frequencies or hessian
-  if(allocated(env%thermo%vibfile))then
-    write(stdout,'(1x,a,a)') 'Reading frequencies from:  ',trim(env%thermo%vibfile)
-    call rdfreq(env%thermo%vibfile,nat3,freq)
+  if (allocated(env%thermo%vibfile)) then
+    write (stdout,'(1x,a,t30,a)') 'Reading frequencies from:',trim(env%thermo%vibfile)
+    call rdfreq(mol,env%thermo%vibfile,nat3,freq)
   else
-    write(stdout,'(1x,a)') 'No Hessian or vibspectrum file allocated for thermo routine!'
+    write (stdout,'(1x,a)') 'No Hessian or vibspectrum file allocated for thermo routine!'
     call creststop(status_input)
-  endif
-  write(stdout,*) 
-  
+  end if
+  write (stdout,*)
+
   !> energy (maybe read from comment line of xyz)
   etot = mol%energy
   !> inversion threshold
   ithr = env%thermo%ithr
   !> frequency scaling factor
   fscal = env%thermo%fscal
-  !> RR-HO interpolation
+  !> RR-HO interpolation (or cut-off)
   sthr = env%thermo%sthr
+  !> Svib model
+  emodel = env%thermo%emodel
 
   if (.not.allocated(env%thermo%temps)) then
     call env%thermo%get_temps()
@@ -413,38 +429,133 @@ subroutine thermo_standalone(env)
   !write(*,*) temps
   nrt = minloc(temps(:),1)
   !write(*,*) nrt
-  temps = env%thermo%temps 
+  temps = env%thermo%temps
 
-  !> calcthermo wants input in Angstroem
-  call calcthermo(mol%nat,mol%at,mol%xyz*autoaa,freq,.true., &
-  & ithr,fscal,sthr,nt,temps,et,ht,gt,stot)
+  !> calcthermo wants input in Bohr
+  call calcthermo(mol%nat,mol%at,mol%xyz,freq,.true., &
+  & ithr,fscal,sthr,nt,temps,et,ht,gt,stot,stdout,emodel=emodel)
 
-  !> printout
   zpve = et(nrt)-ht(nrt)
-  write(stdout,*) 
-  write(stdout,'(10x,a)') repeat(':',50)
-  write(stdout,'(10x,"::",7x,a,f12.2,1x,a,8x,"::")') "THERMODYNAMICS at",temps(nrt),'K'
-  write(stdout,'(10x,a)') repeat(':',50)
-  write(stdout,outfmt) 'TOTAL FREE ENERGY',etot+gt(nrt),'Eh'  
-  write(stdout,'(10x,a)') '::'//repeat('-',46)//'::'
-  write(stdout,outfmt) 'total energy     ',etot,'Eh'
-  write(stdout,outfmt) 'ZPVE             ',zpve,'Eh'
-  write(stdout,outfmt) 'G(RRHO) w/o ZPVE ',gt(nrt)-zpve,'Eh'
-  write(stdout,outfmt) 'G(RRHO) total    ',gt(nrt),'Eh'
-  write(stdout,'(10x,a)') repeat(':',50)
+  call print_thermo_summary(stdout,temps(nrt),etot,zpve,gt(nrt))
 
   !> for plotting temperature dependencies etc.
-  write(stdout,*)
-  write(stdout,*) 'Some output will be written to thermo.dump' 
-  open(newunit=ich, file='thermo.dump')
-  do i=1,nt
-   write(ich,'(f12.4,4F20.10)') temps(i),gt(i)+etot,gt(i),ht(i),stot(i)
-  enddo
-  close(ich)
+  write (stdout,*)
+  write (stdout,*) 'Some output will be written to thermo.dump'
+  open (newunit=ich,file='thermo.dump')
+  do i = 1,nt
+    write (ich,'(f12.4,4F20.10)') temps(i),gt(i)+etot,gt(i),ht(i),stot(i)
+  end do
+  close (ich)
 
   deallocate (stot,gt,ht,et,temps)
 end subroutine thermo_standalone
 
+!========================================================================================!
+
+subroutine print_thermo_summary(iunit,temp,etot,zpve,grrho)
+!**********************************************************
+!* Print the standard THERMODYNAMICS summary box.
+!* Called from numhess_thermostat and thermo_standalone.
+!**********************************************************
+  use crest_parameters,only:wp,stdout
+  implicit none
+  integer,intent(in) :: iunit
+  real(wp),intent(in) :: temp,etot,zpve,grrho
+  character(len=*),parameter :: outfmt = '(10x,"::",1x,a,f24.12,1x,a,1x,"::")'
+  write (iunit,*)
+  write (iunit,'(10x,a)') repeat(':',50)
+  write (iunit,'(10x,"::",7x,a,f12.2,1x,a,8x,"::")') "THERMODYNAMICS at",temp,'K'
+  write (iunit,'(10x,a)') repeat(':',50)
+  write (iunit,outfmt) 'TOTAL FREE ENERGY',etot+grrho,'Eh'
+  write (iunit,'(10x,a)') '::'//repeat('-',46)//'::'
+  write (iunit,outfmt) 'total energy     ',etot,'Eh'
+  write (iunit,outfmt) 'ZPVE             ',zpve,'Eh'
+  write (iunit,outfmt) 'G(RRHO) w/o ZPVE ',grrho-zpve,'Eh'
+  write (iunit,outfmt) 'G(RRHO) total    ',grrho,'Eh'
+  write (iunit,'(10x,a)') repeat(':',50)
+end subroutine print_thermo_summary
+
+!========================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!========================================================================================!
+
+subroutine crest_ensemble_hessians(env,tim)
+!***********************************************
+!* subroutine crest_ensemble_hessians
+!* Standalone runtype: numerical Hessian +
+!* thermochemistry for every structure in an
+!* ensemble file. eread is overwritten with
+!* Gibbs free energies (default temperature).
+!* Input file : env%ensemblename
+!* Output file: crest_ensemble.xyz (ensemblefile)
+!***********************************************
+  use crest_parameters,only:wp,stdout,bohr
+  use crest_data
+  use crest_calculator
+  use strucrd
+  use parallel_interface
+  use utilities,only:dumpenergies
+  implicit none
+  type(systemdata),intent(inout) :: env
+  type(timer),intent(inout)      :: tim
+  character(len=:),allocatable :: ensnam
+  integer :: nat,nall,T,Tn
+  real(wp),allocatable :: xyz(:,:,:),eread(:),etmp(:)
+  integer,allocatable  :: at(:)
+  logical :: ex
+!========================================================================================!
+  write (stdout,*)
+  inquire (file=env%ensemblename,exist=ex)
+  if (ex) then
+    ensnam = env%ensemblename
+  else
+    write (stdout,*) '**ERROR** no ensemble file provided.'
+    env%iostatus_meta = status_input
+    return
+  end if
+
+  call tim%start(14,'Ensemble Hessians')
+
+  call rdensembleparam(ensnam,nat,nall)
+  if (nall < 1) then
+    write (stdout,*) '**ERROR** empty ensemble file.'
+    env%iostatus_meta = status_input
+    return
+  end if
+  allocate (xyz(3,nat,nall),at(nat),eread(nall),etmp(nall))
+  call rdensemble(ensnam,nat,nall,at,xyz,eread)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!>--- Important: crest_hessloop requires coordinates in Bohr
+  xyz = xyz/bohr
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
 
+  call new_ompautoset(env,'auto',nall,T,Tn)
 
+!========================================================================================!
+  write (stdout,*)
+  write (stdout,'(10x,"┍",49("━"),"┑")')
+  write (stdout,'(10x,"│",16x,a,16x,"│")') "ENSEMBLE HESSIANS"
+  write (stdout,'(10x,"┕",49("━"),"┙")')
+  write (stdout,*)
+  write (stdout,'(1x,a,i0,a,1x,a)') 'Evaluating all ',nall,' structures of file ',trim(ensnam)
+
+  call crest_hessloop(env,nat,nall,at,xyz,etmp)
+  eread(:) = eread(:)+etmp(:)
+
+!========================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!>--- Back to Angstrom
+  xyz = xyz*bohr
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+  call wrensemble(ensemblefile,nat,nall,at,xyz,eread)
+  write (stdout,'(/,a,a,a)') 'Ensemble with Gibbs free energies written to <',ensemblefile,'>'
+
+  call dumpenergies('crest.energies',eread)
+  write (stdout,'(/,a,a,a)') 'List of free energies written to <','crest.energies','>'
+
+  deallocate (eread,at,xyz)
+!========================================================================================!
+  call tim%stop(14)
+  return
+end subroutine crest_ensemble_hessians
 
diff --git a/src/algos/optimization.f90 b/src/algos/optimization.f90
index 775c0414..c93ed831 100644
--- a/src/algos/optimization.f90
+++ b/src/algos/optimization.f90
@@ -21,14 +21,18 @@ subroutine crest_optimization(env,tim)
 !***********************************************
 !* subroutine crest_optimization
 !* This routine implements a standalone runtype
-!* to perform geometry optimization for the 
-!* specified input file (read from env%ref)
+!* to perform geometry optimization for the
+!* specified input file (read from env%ref).
+!* An optional inline refinement step is run
+!* after geometry optimization when refine_queue
+!* is allocated (e.g. set by --A//B or --refine).
 !***********************************************
   use crest_parameters,only:wp,stdout,bohr
   use crest_data
   use crest_calculator
   use strucrd
   use optimize_module
+  use iomod,only:colorify
   implicit none
   type(systemdata),intent(inout) :: env
   type(timer),intent(inout)      :: tim
@@ -43,6 +47,19 @@ subroutine crest_optimization(env,tim)
 
   character(len=80) :: atmp
   character(len=*),parameter :: partial = '∂E/∂'
+
+! ══════════════════════════════════════════════════════════════════════════════
+  write (stdout,*)
+  write (stdout,*) " -------------------------------------------- "
+  write (stdout,*) "  ####  #####  ##### # #    # # ###### ###### "
+  write (stdout,*) " #    # #    #   #   # ##  ## #     #  #      "
+  write (stdout,*) " #    # #    #   #   # # ## # #    #   #####  "
+  write (stdout,*) " #    # #####    #   # #    # #   #    #      "
+  write (stdout,*) " #    # #        #   # #    # #  #     #      "
+  write (stdout,*) "  ####  #        #   # #    # # ###### ###### "
+  write (stdout,*) " -------------------------------------------- "
+  write (stdout,*)
+
 !========================================================================================!
   call new_ompautoset(env,'max',0,T,Tn)
   call ompprint_intern()
@@ -57,19 +74,19 @@ subroutine crest_optimization(env,tim)
 !========================================================================================!
 
   allocate (grad(3,mol%nat),source=0.0_wp)
-  calc = env%calc
+  call calc%copy(env%calc)
 !>--- check if we have any calculation settings allocated
   if (calc%ncalculations < 1) then
     write (stdout,*) 'no calculations allocated'
     return
   else
-    call calc%info( stdout )
+    call calc%info(stdout)
   end if
-  write(stdout,'(a)') repeat('-',80)
+  write (stdout,'(a)') repeat('-',80)
 
 !>-- geometry optimization
   pr = .true. !> stdout printout
-  wr = .true. !> write crestopt.log
+  wr = .true. !> write crestopt.log.xyz
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
   call optimize_geometry(mol,molnew,calc,energy,grad,pr,wr,io)
@@ -80,7 +97,7 @@ subroutine crest_optimization(env,tim)
     write (stdout,*) 'SUCCESS!'
     write (stdout,*) 'geometry successfully optimized!'
     write (stdout,*)
-    write(stdout,'(a)') repeat('-',80)
+    write (stdout,'(a)') repeat('-',80)
 
     write (stdout,*)
     write (stdout,'(1x,a)') 'FINAL CALCULATION SUMMARY'
@@ -88,8 +105,31 @@ subroutine crest_optimization(env,tim)
     call calculation_summary(calc,mol,energy,grad,molnew)
 
     write (stdout,*)
-    write (stdout,'(a)') '> Optimized geometry written to crestopt.xyz'
     gnorm = norm2(grad)
+
+! ── optional inline refinement (e.g. --A//B or --refine) ─────────
+    if (allocated(env%refine_queue)) then
+      do i = 1,size(env%refine_queue,1)
+        select case (env%refine_queue(i))
+        case (refine%singlepoint)
+          write (stdout,'(a)') '> Running SP refinement ...'
+          calc%refine_stage = refine%singlepoint
+          call engrad(molnew,calc,energy,grad,io)
+          calc%refine_stage = 0
+          gnorm = norm2(grad)
+          if (io == 0) write (stdout,'(1x,a,f20.10,a)') 'Refined energy: ',energy,' Eh'
+        case (refine%geoopt)
+          write (stdout,'(a)') '> Re-optimizing at higher level ...'
+          mol = molnew
+          calc%refine_stage = refine%geoopt
+          call optimize_geometry(mol,molnew,calc,energy,grad,pr,wr,io)
+          calc%refine_stage = 0
+          gnorm = norm2(grad)
+        end select
+      end do
+    end if
+
+    write (stdout,'(a)') '> Optimized geometry written to crestopt.xyz'
     write (atmp,'(1x,"Etot=",f16.10,1x,"g norm=",f12.8)') energy,gnorm
     molnew%comment = trim(atmp)
 
@@ -99,7 +139,7 @@ subroutine crest_optimization(env,tim)
   else
     write (stdout,*) 'geometry optimization FAILED!'
     env%iostatus_meta = status_failed
-  endif
+  end if
 
   write (stdout,*)
   write (stdout,'(a)') repeat('=',42)
@@ -107,9 +147,9 @@ subroutine crest_optimization(env,tim)
   write (stdout,'(1x,a,f20.10,a)') 'GRADIENT NORM  ',norm2(grad),' Eh/a0'
   write (stdout,'(a)') repeat('=',42)
 
-   if(io /= 0)then
+  if (io /= 0) then
     write (stdout,*) 'WARNING: geometry optimization FAILED!'
-   endif
+  end if
 
   deallocate (grad)
 !========================================================================================!
@@ -117,12 +157,22 @@ subroutine crest_optimization(env,tim)
 
 !========================================================================================!
 !>--- append numerical hessian calculation
-  if( io == 0 .and. env%crest_ohess )then
+  if (io == 0.and.env%crest_ohess) then
     call env%ref%load(molnew)      !> load the optimized geometry
     call crest_numhess(env,tim) !> run the numerical hessian
-  endif
+  end if
+
+!========================================================================================!
 
 !========================================================================================!
+!>--- append deform opt hessian calculation
+  if (io == 0.and.calc%deform_opt_hess) then !.and. calc%do_HR )then
+    call env%ref%load(molnew)      !> load the optimized geometry
+    call deform_opt_hess(calc,molnew) !> run the hessian reconstruction
+  end if
+
+!========================================================================================!
+
   return
 end subroutine crest_optimization
 
@@ -159,7 +209,6 @@ subroutine crest_ensemble_optimization(env,tim)
   real(wp),allocatable :: eread(:)
   real(wp),allocatable :: xyz(:,:,:)
   integer,allocatable  :: at(:)
-  character(len=10),allocatable :: comments(:)
   character(len=80) :: atmp
   real(wp) :: percent
   character(len=52) :: bar
@@ -180,16 +229,16 @@ subroutine crest_ensemble_optimization(env,tim)
 
 !>---- read the input ensemble
   call rdensembleparam(ensnam,nat,nall)
-  if (nall .lt. 1)then
+  if (nall .lt. 1) then
     write (stdout,*) '**ERROR** empty ensemble file.'
     env%iostatus_meta = status_input
     return
-  endif
+  end if
   allocate (xyz(3,nat,nall),at(nat),eread(nall))
   call rdensemble(ensnam,nat,nall,at,xyz,eread)
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
 !>--- Important: crest_oloop requires coordinates in Bohrs
-  xyz = xyz / bohr
+  xyz = xyz/bohr
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
 
 !>--- set OMP parallelization
@@ -208,29 +257,35 @@ subroutine crest_ensemble_optimization(env,tim)
 
 !========================================================================================!
 !>--- output
-  write(stdout,'(/,a,a,a)') 'Rewriting ',ensemblefile,' in the correct order'// &
+  write (stdout,'(/,a,a,a)') 'Rewriting ',ensemblefile,' in the correct order'// &
   & ' (failed optimizations are assigned an energy of +1.0)'
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
-!>--- Back to Angstroem
-  xyz = xyz * bohr
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
-  allocate(comments(nall))
-  do i=1,nall
-     comments(i) = ''
-     if(eread(i) > 0.0_wp) comments(i) = '!failed'
-  enddo
-  call wrensemble(ensemblefile,nat,nall,at,xyz,eread,comments)
+!>--- write the optimized ensemble in extxyz format (consistent with the
+!>    refined ensemble). coord%xyz keeps the internal Bohr convention; the
+!>    extxyz writer converts to Angstroem on output.
+  block
+    type(coord),allocatable :: structures(:)
+    allocate (structures(nall))
+    do i = 1,nall
+      structures(i)%nat = nat
+      structures(i)%at = at
+      structures(i)%xyz = xyz(:,:,i)
+      structures(i)%energy = eread(i)
+      structures(i)%wrextxyz = .true.
+    end do
+    call wrensemble(ensemblefile,nall,structures)
+    deallocate (structures)
+  end block
 
   deallocate (eread,at,xyz)
-  write(stdout,'(/,a,a,a)') 'Optimized ensemble written to <',ensemblefile,'>'
+  write (stdout,'(/,a,a,a)') 'Optimized ensemble written to <',ensemblefile,'>'
 
 !========================================================================================!
 !>--- (optional) refinement step
   if (allocated(env%refine_queue)) then
-    write(stdout,*)
+    write (stdout,*)
     call crest_refine(env,ensemblefile,ensemblefile//'.refine')
-    write(stdout,'(/,a,a,a)') 'Refined ensemble written to <',ensemblefile,'.refine>'
-  endif 
+    write (stdout,'(/,a,a,a)') 'Refined ensemble written to <',ensemblefile,'.refine>'
+  end if
 
 !========================================================================================!
   call tim%stop(14)
@@ -252,7 +307,7 @@ subroutine crest_ensemble_screening(env,tim)
   use crest_calculator
   use strucrd
   use optimize_module
-  use iomod 
+  use iomod
   implicit none
   type(systemdata),intent(inout) :: env
   type(timer),intent(inout)      :: tim
@@ -291,11 +346,11 @@ subroutine crest_ensemble_screening(env,tim)
 
 !>---- read the input ensemble
   call rdensembleparam(ensnam,nat,nall)
-  if (nall .lt. 1)then
+  if (nall .lt. 1) then
     write (stdout,*) '**ERROR** empty ensemble file.'
     env%iostatus_meta = status_input
     return
-  endif
+  end if
 !>--- set OMP parallelization
   call new_ompautoset(env,'auto',nall,T,Tn)
 
@@ -314,8 +369,8 @@ subroutine crest_ensemble_screening(env,tim)
 !>--- call the loop
   call rmrfw('crest_rotamers_')
   call optlev_to_multilev(3.0d0,multilevel)
-  call crest_multilevel_oloop(env,ensnam,multilevel)
-  if(env%iostatus_meta .ne. 0 ) return
+  call crest_multilevel_oloop(env,ensnam,multilevel,0)
+  if (env%iostatus_meta .ne. 0) return
 
 !>--- printout
   call catdel('cregen.out.tmp')
@@ -326,7 +381,6 @@ subroutine crest_ensemble_screening(env,tim)
 !>--- clean up
   call screen_cleanup
 
-
 !========================================================================================!
   call tim%stop(14)
   return
diff --git a/src/algos/parallel.f90 b/src/algos/parallel.f90
index 27fa9f01..09611c6b 100644
--- a/src/algos/parallel.f90
+++ b/src/algos/parallel.f90
@@ -57,7 +57,6 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
       use strucrd
       use optimize_module
       use iomod,only:makedir,directory_exist,remove
-      use crest_restartlog,only:trackrestart,restart_write_dummy
       implicit none
       type(systemdata),target,intent(inout) :: env
       real(wp),intent(inout) :: xyz(3,nat,nall)
@@ -68,6 +67,27 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
       type(calcdata),intent(in),target,optional :: customcalc
     end subroutine crest_oloop
   end interface
+
+  interface
+    subroutine crest_hessloop(env,nat,nall,at,xyz,eread,gt_out,stot_out)
+      use crest_parameters,only:wp,stdout,sep
+      use crest_calculator
+      use omp_lib
+      use crest_data
+      use strucrd
+      use thermochem_module
+      use iomod,only:makedir,directory_exist,remove
+      implicit none
+      type(systemdata),intent(inout) :: env
+      real(wp),intent(inout) :: xyz(3,nat,nall)
+      integer,intent(in)  :: at(nat)
+      real(wp),intent(inout) :: eread(nall)
+      integer,intent(in) :: nat,nall
+      real(wp),optional,intent(out) :: gt_out(:,:)    !> (nall, nt_full)
+      real(wp),optional,intent(out) :: stot_out(:,:)  !> (nall, nt_full)
+    end subroutine crest_hessloop
+  end interface
+
 end module parallel_interface
 
 !========================================================================================!
@@ -80,6 +100,7 @@ subroutine crest_sploop(env,nat,nall,at,xyz,eread)
 !* subroutine crest_sploop
 !* This subroutine performs concurrent singlepoint evaluations
 !* for the given ensemble. Input eread is overwritten
+!* xyz must be in Bohrs
 !***************************************************************
   use crest_parameters,only:wp,stdout,sep
   use crest_calculator
@@ -88,6 +109,7 @@ subroutine crest_sploop(env,nat,nall,at,xyz,eread)
   use strucrd
   use optimize_module
   use iomod,only:makedir,directory_exist,remove
+  use term_ui,only:progress_init,progress_update,progress_finish
   implicit none
   type(systemdata),intent(inout) :: env
   real(wp),intent(inout) :: xyz(3,nat,nall)
@@ -119,12 +141,12 @@ subroutine crest_sploop(env,nat,nall,at,xyz,eread)
   call new_ompautoset(env,'auto_nested',nall,T,Tn)
   nested = env%omp_allow_nested
 
-
 !>--- prepare objects for parallelization
   T = env%threads
   allocate (calculations(T),source=env%calc)
   allocate (mols(T))
   do i = 1,T
+    call calculations(T)%copy(env%calc)
     do j = 1,env%calc%ncalculations
       calculations(i)%calcs(j) = env%calc%calcs(j)
       !>--- directories and io preparation
@@ -134,8 +156,8 @@ subroutine crest_sploop(env,nat,nall,at,xyz,eread)
       end if
       write (atmp,'(a,"_",i0)') sep,i
       calculations(i)%calcs(j)%calcspace = env%calc%calcs(j)%calcspace//trim(atmp)
-      if(allocated(calculations(i)%calcs(j)%calcfile)) deallocate(calculations(i)%calcs(j)%calcfile)
-      if(allocated(calculations(i)%calcs(j)%systemcall)) deallocate(calculations(i)%calcs(j)%systemcall)
+      if (allocated(calculations(i)%calcs(j)%calcfile)) deallocate (calculations(i)%calcs(j)%calcfile)
+      if (allocated(calculations(i)%calcs(j)%systemcall)) deallocate (calculations(i)%calcs(j)%systemcall)
       call calculations(i)%calcs(j)%printid(i,j)
     end do
     calculations(i)%pr_energies = .false.
@@ -144,12 +166,14 @@ subroutine crest_sploop(env,nat,nall,at,xyz,eread)
 
 !>--- printout directions and timer initialization
   pr = .false. !> stdout printout
-  wr = .false. !> write crestopt.log
+  wr = .false. !> write crestopt.log.xyz
   call profiler%init(1)
   call profiler%start(1)
 
-!>--- first progress printout (initializes progress variables)
-  call crest_oloop_pr_progress(env,nall,0)
+!>--- initialize progress bar
+  call progress_init(env%ps,nall,width=50,prefix=" ↳ ", &
+    &                suffix="",show_time=.true.,show_eta=.false.)
+  call progress_update(env%ps,0,nall)
 
 !>--- shared variables
   allocate (grads(3,nat,T),source=0.0_wp)
@@ -158,6 +182,8 @@ subroutine crest_sploop(env,nat,nall,at,xyz,eread)
   z = 0  !> counter to perform optimization in right order (1...nall)
   eread(:) = 0.0_wp
   grads(:,:,:) = 0.0_wp
+!>--- pre-start server-based calculators before forking OMP threads
+  call preinit_mlip_parallel(calculations,T)
 !>--- loop over ensemble
   !$omp parallel &
   !$omp shared(env,calculations,nat,nall,at,xyz,eread,grads,c,k,z,pr,wr) &
@@ -197,7 +223,7 @@ subroutine crest_sploop(env,nat,nall,at,xyz,eread)
     end if
     k = k+1
     !>--- print progress
-    call crest_oloop_pr_progress(env,nall,k)
+    call progress_update(env%ps,k,nall)
     !$omp end critical
     !$omp end task
   end do
@@ -206,7 +232,7 @@ subroutine crest_sploop(env,nat,nall,at,xyz,eread)
   !$omp end parallel
 
 !>--- finalize progress printout
-  call crest_oloop_pr_progress(env,nall,-1)
+  call progress_finish(env%ps)
 
 !>--- stop timer
   call profiler%stop(1)
@@ -230,6 +256,238 @@ subroutine crest_sploop(env,nat,nall,at,xyz,eread)
   return
 end subroutine crest_sploop
 
+!========================================================================================!
+!========================================================================================!
+!> Routines for concurrent singlepoint evaluations
+!========================================================================================!
+!========================================================================================!
+subroutine crest_hessloop(env,nat,nall,at,xyz,eread,gt_out,stot_out)
+!***************************************************************
+!* subroutine crest_hessloop
+!* Concurrent numerical Hessian evaluations for an ensemble.
+!* Input eread is overwritten with Gibbs free energies.
+!* xyz must be in Bohrs.
+!* eread contains only the gt@RT on output!
+!* Optional gt_out/stot_out return G and S at all temperatures
+!* from env%thermo; requires pre-allocated (nall,nt) arrays.
+!*
+!* Parallelization is enabled using numhess1 (OpenMP-compatible).
+!*
+!***************************************************************
+  use crest_parameters,only:wp,stdout,sep
+  use crest_calculator
+  use omp_lib
+  use crest_data
+  use strucrd
+  use optimize_module
+  use thermochem_module
+  use iomod,only:makedir,directory_exist,remove
+  use term_ui,only:progress_init,progress_update,progress_finish
+  implicit none
+  type(systemdata),intent(inout) :: env
+  real(wp),intent(inout) :: xyz(3,nat,nall)
+  integer,intent(in)  :: at(nat)
+  real(wp),intent(inout) :: eread(nall)
+  integer,intent(in) :: nat,nall
+  real(wp),optional,intent(out) :: gt_out(:,:)    !> (nall, nt_full)
+  real(wp),optional,intent(out) :: stot_out(:,:)  !> (nall, nt_full)
+
+  type(coord),allocatable :: mols(:)
+  integer :: i,j,k,l,io,ich,ich2,c,z,job_id,zcopy,nat3
+  logical :: pr,wr,ex
+  type(calcdata),allocatable :: calculations(:)
+  real(wp) :: energy,gnorm
+  real(wp),allocatable :: grad(:,:),grads(:,:,:)
+  real(wp),allocatable :: freqs(:,:),hess(:,:,:)
+  integer :: thread_id,vz,job
+  character(len=80) :: atmp
+  real(wp) :: percent,runtime
+
+  integer :: nt,nrt
+  real(wp),allocatable :: temps(:,:),et(:,:),ht(:,:),gt(:,:),stot(:,:)
+  real(wp) :: ithr,sthr,fscal,rt
+  character(len=:),allocatable :: emodel
+
+  type(timer) :: profiler
+  integer :: T,Tn  !> threads and threads per core
+  logical :: nested
+  real(wp),parameter :: big = 10e10
+
+!>--- check if we have any calculation settings allocated
+  if (env%calc%ncalculations < 1) then
+    write (stdout,*) 'no calculations allocated'
+    return
+  end if
+
+!>--- prepare calculation objects for parallelization (one per thread)
+  call new_ompautoset(env,'auto_nested',nall,T,Tn)
+  nested = env%omp_allow_nested
+
+!>--- prepare objects for parallelization
+  T = env%threads
+  allocate (calculations(T))!,source=env%calc)
+  allocate (mols(T))
+  nat3 = nat*3
+  allocate (freqs(nat3,T),source=0.0_wp)
+  allocate (hess(nat3,nat3,T),source=0.0_wp)
+  do i = 1,T
+    call calculations(i)%copy(env%calc)
+    do j = 1,env%calc%ncalculations
+      !calculations(i)%calcs(j) = env%calc%calcs(j)
+      !>--- directories and io preparation
+      ex = directory_exist(env%calc%calcs(j)%calcspace)
+      if (.not.ex) then
+        io = makedir(trim(env%calc%calcs(j)%calcspace))
+      end if
+      write (atmp,'(a,"_",i0)') sep,i
+      calculations(i)%calcs(j)%calcspace = env%calc%calcs(j)%calcspace//trim(atmp)
+      if (allocated(calculations(i)%calcs(j)%calcfile)) deallocate (calculations(i)%calcs(j)%calcfile)
+      if (allocated(calculations(i)%calcs(j)%systemcall)) deallocate (calculations(i)%calcs(j)%systemcall)
+      call calculations(i)%calcs(j)%printid(i,j)
+    end do
+    calculations(i)%pr_energies = .false.
+    allocate (mols(i)%at(nat),mols(i)%xyz(3,nat))
+  end do
+
+!>--- thermo settings
+  !> inversion threshold
+  ithr = env%thermo%ithr
+  !> frequency scaling factor
+  fscal = env%thermo%fscal
+  !> RR-HO interpolation (or cut-off)
+  sthr = env%thermo%sthr
+  !> Svib model
+  emodel = env%thermo%emodel
+  if (.not.allocated(env%thermo%temps)) then
+    call env%thermo%get_temps()
+  end if
+  if (present(gt_out)) then
+    nt = env%thermo%ntemps
+    allocate (temps(nt,T),et(nt,T),ht(nt,T),gt(nt,T),stot(nt,T),source=0.0_wp)
+    do i = 1,T
+      temps(:,i) = env%thermo%temps(:)
+    end do
+    rt = env%thermo%get_close_rt(nrt)
+  else
+    nt = 1
+    allocate (temps(nt,T),et(nt,T),ht(nt,T),gt(nt,T),stot(nt,T),source=0.0_wp)
+    rt = env%thermo%get_close_rt(nrt)
+    temps = rt
+    nrt = 1
+  end if
+
+!>--- printout directions and timer initialization
+  pr = .false. !> stdout printout
+  wr = .false. !> write crestopt.log.xyz
+  call profiler%init(1)
+  call profiler%start(1)
+
+!>--- initialize progress bar
+  call progress_init(env%ps,nall,width=50,prefix=" ↳ ", &
+    &                suffix="",show_time=.true.,show_eta=.false.)
+  call progress_update(env%ps,0,nall)
+
+!>--- shared variables
+  allocate (grads(3,nat,T),source=0.0_wp)
+  c = 0  !> counter of successfull optimizations
+  k = 0  !> counter of total optimization (fail+success)
+  z = 0  !> counter to perform optimization in right order (1...nall)
+  eread(:) = 0.0_wp
+  grads(:,:,:) = 0.0_wp
+!>--- pre-start server-based calculators before forking OMP threads
+  call preinit_mlip_parallel(calculations,T)
+!>--- loop over ensemble
+  !$omp parallel &
+  !$omp shared(env,calculations,nat,nall,at,xyz,eread,grads,c,k,z,pr,wr,nrt) &
+  !$omp shared(mols,nested,Tn,freqs,hess,temps,et,ht,gt,stot,nat3,ithr,fscal,sthr,nt,emodel)
+  !$omp single
+  do i = 1,nall
+
+    call initsignal()
+    vz = i
+    !$omp task firstprivate( vz ) private(i,j,job,energy,io,thread_id,zcopy)
+    call initsignal()
+
+    !>--- OpenMP nested region threads
+    if (nested) call ompmklset(Tn)
+
+    thread_id = OMP_GET_THREAD_NUM()
+    job = thread_id+1
+    !>--- modify calculation spaces
+    !$omp critical
+    z = z+1
+    zcopy = z
+    mols(job)%nat = nat
+    mols(job)%at(:) = at(:)
+    mols(job)%xyz(:,:) = xyz(:,:,z)
+    !$omp end critical
+
+    !>-- engery+gradient call first, for setup
+    call engrad(mols(job),calculations(job),energy,grads(:,:,job),io)
+    !>-- then, numerical hessian
+    call numhess1(mols(job)%nat,mols(job)%at,mols(job)%xyz, &
+                  calculations(job),hess(:,:,job),io)
+    !!$omp critical
+    if (io .eq. 0) then
+      call prj_mw_hess(mols(job)%nat,mols(job)%at,nat3,mols(job)%xyz,hess(:,:,job))
+      !>-- Computes the Frequencies
+      call frequencies(mols(job)%nat,mols(job)%at,mols(job)%xyz, &
+                       nat3,hess(:,:,job),freqs(:,job),io)
+    end if
+
+    if (io .eq. 0) then
+      call calcthermo(mols(job)%nat,mols(job)%at,mols(job)%xyz,   &
+                      freqs(:,job),.false.,ithr,fscal,sthr,nt,    &
+                      temps(:,job),et(:,job),ht(:,job),gt(:,job), &
+                      stot(:,job),emodel=emodel)
+    end if
+    !!$omp end critical
+
+    !$omp critical
+    if (io == 0) then
+      c = c+1
+      eread(zcopy) = gt(nrt,job)
+      if (present(gt_out))   gt_out(zcopy,:)   = gt(:,job)
+      if (present(stot_out)) stot_out(zcopy,:) = stot(:,job)
+    else
+      eread(zcopy) = big
+    end if
+    k = k+1
+    call progress_update(env%ps,k,nall)
+    !$omp end critical
+    !$omp end task
+  end do
+  !$omp taskwait
+  !$omp end single
+  !$omp end parallel
+
+!>--- finalize progress printout
+  call progress_finish(env%ps)
+
+!>--- stop timer
+  call profiler%stop(1)
+
+!>--- prepare some summary printout
+  percent = float(c)/float(nall)*100.0_wp
+  write (atmp,'(f5.1,a)') percent,'% success)'
+  write (stdout,'(">",1x,i0,a,i0,a,a)') c,' of ',nall,' structures successfully evaluated (', &
+  &     trim(adjustl(atmp))
+  write (atmp,'(">",1x,a,i0,a)') 'Total runtime for ',nall,' frequency calculations:'
+  call profiler%write_timing(stdout,1,trim(atmp),.true.)
+  runtime = profiler%get(1)
+  write (atmp,'(f16.3,a)') runtime/real(nall,wp),' sec'
+  write (stdout,'(a,a,a)') '> Corresponding to approximately ',trim(adjustl(atmp)), &
+  &                       ' per processed structure'
+
+  deallocate (grads)
+  call profiler%clear()
+  deallocate (calculations)
+  if (allocated(mols)) deallocate (mols)
+  if (allocated(freqs)) deallocate (freqs)
+  if (allocated(hess)) deallocate (hess)
+  return
+end subroutine crest_hessloop
+
 !========================================================================================!
 !========================================================================================!
 !> Routines for concurrent geometry optimization
@@ -243,7 +501,8 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
 !* env        - contains parallelization and other program settings
 !* dump       - decides on whether to dump an ensemble file
 !*              WARNING: the ensemble file will NOT be in the same order
-!*              as the input xyz array. However, the overwritten xyz will be! 
+!*              as the input xyz array. However, the overwritten xyz will be!
+!*
 !* customcalc - customized (optional) calculation level data
 !*
 !* IMPORTANT: xyz should be in Bohr(!) for this routine
@@ -255,7 +514,7 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
   use strucrd
   use optimize_module
   use iomod,only:makedir,directory_exist,remove
-  use crest_restartlog,only:trackrestart,restart_write_dummy
+  use term_ui,only:progress_init,progress_update,progress_finish
   implicit none
   type(systemdata),target,intent(inout) :: env
   real(wp),intent(inout) :: xyz(3,nat,nall)
@@ -280,18 +539,12 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
   integer :: T,Tn  !> threads and threads per core
   logical :: nested
 
-!>--- decide wether to skip this call
-  if (trackrestart(env)) then
-    call restart_write_dummy(ensemblefile)
-    return
-  end if
-
 !>--- check which calc to use
-  if(present(customcalc))then
+  if (present(customcalc)) then
     mycalc => customcalc
   else
     mycalc => env%calc
-  endif
+  end if
 
 !>--- check if we have any calculation settings allocated
   if (mycalc%ncalculations < 1) then
@@ -304,23 +557,24 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
   nested = env%omp_allow_nested
 
 !>--- prepare objects for parallelization
-  allocate (calculations(T),source=mycalc)
+  allocate (calculations(T))!,source=mycalc)
   allocate (mols(T),molsnew(T))
   do i = 1,T
+    call calculations(i)%copy(mycalc)
     do j = 1,mycalc%ncalculations
-      calculations(i)%calcs(j) = mycalc%calcs(j)
+      !calculations(i)%calcs(j) = mycalc%calcs(j)
       !>--- directories and io preparation
       ex = directory_exist(mycalc%calcs(j)%calcspace)
       if (.not.ex) then
         io = makedir(trim(mycalc%calcs(j)%calcspace))
       end if
-      if(calculations(i)%calcs(j)%id == jobtype%tblite)then
-         calculations(i)%optnewinit=.true.
-      endif
+      if (calculations(i)%calcs(j)%id == jobtype%tblite) then
+        calculations(i)%optnewinit = .true.
+      end if
       write (atmp,'(a,"_",i0)') sep,i
       calculations(i)%calcs(j)%calcspace = mycalc%calcs(j)%calcspace//trim(atmp)
-      if(allocated(calculations(i)%calcs(j)%calcfile)) deallocate(calculations(i)%calcs(j)%calcfile)
-      if(allocated(calculations(i)%calcs(j)%systemcall)) deallocate(calculations(i)%calcs(j)%systemcall)
+      if (allocated(calculations(i)%calcs(j)%calcfile)) deallocate (calculations(i)%calcs(j)%calcfile)
+      if (allocated(calculations(i)%calcs(j)%systemcall)) deallocate (calculations(i)%calcs(j)%systemcall)
       call calculations(i)%calcs(j)%printid(i,j)
     end do
     calculations(i)%pr_energies = .false.
@@ -330,7 +584,7 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
 
 !>--- printout directions and timer initialization
   pr = .false. !> stdout printout
-  wr = .false. !> write crestopt.log
+  wr = .false. !> write crestopt.log.xyz
   if (dump) then
     open (newunit=ich,file=ensemblefile)
     open (newunit=ich2,file=ensembleelog)
@@ -338,8 +592,10 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
   call profiler%init(1)
   call profiler%start(1)
 
-!>--- first progress printout (initializes progress variables)
-  call crest_oloop_pr_progress(env,nall,0)
+!>--- initialize progress bar
+  call progress_init(env%ps,nall,width=50,prefix=" ↳ ", &
+    &                suffix="",show_time=.true.,show_eta=.false.)
+  call progress_update(env%ps,0,nall)
 
 !>--- shared variables
   allocate (grads(3,nat,T),source=0.0_wp)
@@ -348,6 +604,8 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
   z = 0  !> counter to perform optimization in right order (1...nall)
   eread(:) = 0.0_wp
   grads(:,:,:) = 0.0_wp
+!>--- pre-start server-based calculators before forking OMP threads
+  call preinit_mlip_parallel(calculations,T)
 !>--- loop over ensemble
   !$omp parallel &
   !$omp shared(env,calculations,nat,nall,at,xyz,eread,grads,c,k,z,pr,wr,dump) &
@@ -387,14 +645,14 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
       c = c+1
       if (dump) then
         gnorm = norm2(grads(:,:,job))
-        write (atmp,'(1x,"Etot=",f16.10,1x,"g norm=",f12.8)') energy,gnorm
+        write (atmp,'(1x,"energy=",f16.10,1x,"g norm=",f12.8)') energy,gnorm
         molsnew(job)%comment = trim(atmp)
         call molsnew(job)%append(ich)
         call calc_eprint(calculations(job),energy,calculations(job)%etmp,gnorm,ich2)
       end if
       eread(zcopy) = energy
       xyz(:,:,zcopy) = molsnew(job)%xyz(:,:)
-    else if(io==calculations(job)%maxcycle .and. calculations(job)%anopt) then
+    else if (io == calculations(job)%maxcycle.and.calculations(job)%anopt) then
       !>--- allow partial optimization?
       c = c+1
       eread(zcopy) = energy
@@ -404,7 +662,7 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
     end if
     k = k+1
     !>--- print progress
-    call crest_oloop_pr_progress(env,nall,k)
+    call progress_update(env%ps,k,nall)
     !$omp end critical
     !$omp end task
   end do
@@ -413,7 +671,7 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
   !$omp end parallel
 
 !>--- finalize progress printout
-  call crest_oloop_pr_progress(env,nall,-1)
+  call progress_finish(env%ps)
 
 !>--- stop timer
   call profiler%stop(1)
@@ -444,64 +702,6 @@ subroutine crest_oloop(env,nat,nall,at,xyz,eread,dump,customcalc)
   return
 end subroutine crest_oloop
 
-!========================================================================================!
-subroutine crest_oloop_pr_progress(env,total,current)
-!*********************************************
-!* subroutine crest_oloop_pr_progress
-!* A subroutine to print and track progress of
-!* concurrent geometry optimizations
-!*********************************************
-  use crest_parameters,only:wp,stdout
-  use crest_data
-  use iomod,only:to_str
-  implicit none
-  type(systemdata),intent(inout) :: env
-  integer,intent(in) :: total,current
-  real(wp) :: percent
-  character(len=5) :: atmp
-  real(wp),save :: increment
-  real(wp),save :: progressbarrier
-
-  percent = float(current)/float(total)*100.0_wp
-  if (current == 0) then !> as a wrapper to start the printout
-    progressbarrier = 0.0_wp
-    if (env%niceprint) then
-      percent = 0.0_wp
-      call printprogbar(percent)
-    end if
-    increment = 10.0_wp
-    if (total > 1000) increment = 7.5_wp
-    if (total > 5000) increment = 5.0_wp
-    if (total > 10000) increment = 2.5_wp
-    if (total > 20000) increment = 1.0_wp
-
-  else if (current <= total.and.current > 0) then !> the regular printout case
-    if (env%niceprint) then
-      call printprogbar(percent)
-
-    else if (.not.env%legacy) then
-      if (percent >= progressbarrier) then
-        write (atmp,'(f5.1)') percent
-        write (stdout,'(1x,a)',advance='no') '|>'//trim(adjustl(atmp))//'%'
-        progressbarrier = progressbarrier+increment
-        progressbarrier = min(progressbarrier,100.0_wp)
-        flush (stdout)
-      end if
-    else
-      write (stdout,'(1x,i0)',advance='no') current
-      flush (stdout)
-    end if
-
-  else !> as a wrapper to finalize the printout
-    if (.not.env%niceprint) then
-      write (stdout,'(/,1x,a)') 'done.'
-    else
-      write (stdout,*)
-    end if
-  end if
-
-end subroutine crest_oloop_pr_progress
-
 !========================================================================================!
 !========================================================================================!
 !> Routines for parallel MDs
@@ -520,7 +720,6 @@ subroutine crest_search_multimd(env,mol,mddats,nsim)
   use dynamics_module
   use iomod,only:makedir,directory_exist,remove
   use omp_lib
-  use crest_restartlog,only:trackrestart,restart_write_dummy
   implicit none
   type(systemdata),intent(inout) :: env
   type(mddata) :: mddats(nsim)
@@ -540,12 +739,6 @@ subroutine crest_search_multimd(env,mol,mddats,nsim)
   real(wp),allocatable :: grdtmp(:,:)
   type(timer) :: profiler
 !===========================================================!
-!>--- decide wether to skip this call
-  if (trackrestart(env)) then
-    call restart_write_dummy('crest_dynamics.trj')
-    return
-  end if
-
 !>--- check if we have any MD & calculation settings allocated
   if (.not.env%mddat%requested) then
     write (stdout,*) 'MD requested, but no MD settings present.'
@@ -575,8 +768,8 @@ subroutine crest_search_multimd(env,mol,mddats,nsim)
       end if
       write (atmp,'(a,"_",i0)') sep,i
       calculations(i)%calcs(j)%calcspace = env%calc%calcs(j)%calcspace//trim(atmp)
-      if(allocated(calculations(i)%calcs(j)%calcfile)) deallocate(calculations(i)%calcs(j)%calcfile)
-      if(allocated(calculations(i)%calcs(j)%systemcall)) deallocate(calculations(i)%calcs(j)%systemcall)
+      if (allocated(calculations(i)%calcs(j)%calcfile)) deallocate (calculations(i)%calcs(j)%calcfile)
+      if (allocated(calculations(i)%calcs(j)%systemcall)) deallocate (calculations(i)%calcs(j)%systemcall)
       call calculations(i)%calcs(j)%printid(i,j)
     end do
     calculations(i)%pr_energies = .false.
@@ -588,6 +781,8 @@ subroutine crest_search_multimd(env,mol,mddats,nsim)
   pr = .false.
   call profiler%init(nsim)
 
+!>--- pre-start server-based calculators before forking OMP threads
+  call preinit_mlip_parallel(calculations,T)
   !>--- run the MDs
   !$omp parallel &
   !$omp shared(env,calculations,mddats,mol,pr,percent,ich, nsim, moltmps, nested,Tn) &
@@ -643,7 +838,7 @@ subroutine collect(n,mddats)
     integer :: i,io,ich,ich2
     character(len=:),allocatable :: atmp
     character(len=256) :: btmp
-    open (newunit=ich,file='crest_dynamics.trj')
+    open (newunit=ich,file='crest_dynamics.trj.xyz')
     do i = 1,n
       atmp = mddats(i)%trajectoryfile
       inquire (file=atmp,exist=ex)
@@ -829,7 +1024,6 @@ subroutine crest_search_multimd2(env,mols,mddats,nsim)
   use shake_module
   use iomod,only:makedir,directory_exist,remove
   use omp_lib
-  use crest_restartlog,only:trackrestart,restart_write_dummy
   implicit none
   !> INPUT
   type(systemdata),intent(inout) :: env
@@ -848,12 +1042,6 @@ subroutine crest_search_multimd2(env,mols,mddats,nsim)
   integer :: vz,job,thread_id
   type(timer) :: profiler
 !===========================================================!
-!>--- decide wether to skip this call
-  if (trackrestart(env)) then
-    call restart_write_dummy('crest_dynamics.trj')
-    return
-  end if
-
 !>--- check if we have any MD & calculation settings allocated
   if (.not.env%mddat%requested) then
     write (stdout,*) 'MD requested, but no MD settings present.'
@@ -879,8 +1067,8 @@ subroutine crest_search_multimd2(env,mols,mddats,nsim)
       end if
       write (atmp,'(a,"_",i0)') sep,i
       calculations(i)%calcs(j)%calcspace = env%calc%calcs(j)%calcspace//trim(atmp)
-      if(allocated(calculations(i)%calcs(j)%calcfile)) deallocate(calculations(i)%calcs(j)%calcfile)
-      if(allocated(calculations(i)%calcs(j)%systemcall)) deallocate(calculations(i)%calcs(j)%systemcall)
+      if (allocated(calculations(i)%calcs(j)%calcfile)) deallocate (calculations(i)%calcs(j)%calcfile)
+      if (allocated(calculations(i)%calcs(j)%systemcall)) deallocate (calculations(i)%calcs(j)%systemcall)
       call calculations(i)%calcs(j)%printid(i,j)
     end do
     calculations(i)%pr_energies = .false.
@@ -890,6 +1078,8 @@ subroutine crest_search_multimd2(env,mols,mddats,nsim)
   pr = .false.
   call profiler%init(nsim)
 
+!>--- pre-start server-based calculators before forking OMP threads
+  call preinit_mlip_parallel(calculations,T)
 !>--- run the MDs
   !$omp parallel &
   !$omp shared(env,calculations,mddats,mols,pr,percent,ich, moltmps,profiler, nested,Tn)
@@ -944,7 +1134,7 @@ subroutine collect(n,mddats)
     integer :: i,io,ich,ich2
     character(len=:),allocatable :: atmp
     character(len=256) :: btmp
-    open (newunit=ich,file='crest_dynamics.trj')
+    open (newunit=ich,file='crest_dynamics.trj.xyz')
     do i = 1,n
       atmp = mddats(i)%trajectoryfile
       inquire (file=atmp,exist=ex)
@@ -978,14 +1168,15 @@ subroutine parallel_md_block_printout(MD,vz)
   use strucrd
   use dynamics_module
   use shake_module
-  use iomod,only:to_str
+  use iomod,only:to_str,drawbox
   implicit none
   type(mddata),intent(in) :: MD
   integer,intent(in) :: vz
-  character(len=40) :: atmp
-  integer :: il
+  character(len=60) :: atmp
+  integer,parameter :: bw = 54
   !$omp critical
 
+  ! ── title ────────────────────────────────────────────────────
   if (MD%simtype == type_md) then
     write (atmp,'(a,1x,i3)') 'starting MD',vz
   else if (MD%simtype == type_mtd) then
@@ -995,37 +1186,43 @@ subroutine parallel_md_block_printout(MD,vz)
       write (atmp,'(a,1x,i4)') 'starting MTD',vz
     end if
   end if
-  il = (44-len_trim(atmp))/2
-  write (stdout,'(2x,a,1x,a,1x,a)') repeat(':',il),trim(atmp),repeat(':',il)
-
-  write (stdout,'(2x,"|   MD simulation time   :",f8.1," ps       |")') MD%length_ps
-  write (stdout,'(2x,"|   target T             :",f8.1," K        |")') MD%tsoll
-  write (stdout,'(2x,"|   timestep dt          :",f8.1," fs       |")') MD%tstep
-  write (stdout,'(2x,"|   dump interval(trj)   :",f8.1," fs       |")') MD%dumpstep
+  call drawbox(stdout,trim(atmp),width=bw,charset=4,ltab=1,procedual=0)
+  call drawbox(stdout,trim(atmp),width=bw,charset=4,ltab=1,procedual=1)
+  call drawbox(stdout,trim(atmp),width=bw,charset=4,ltab=1,procedual=3)
+
+  ! ── simulation parameters ────────────────────────────────────
+  write (stdout,'(1x,"│   MD simulation time   :",f8.1," ps",16x,"│")') MD%length_ps
+  write (stdout,'(1x,"│   target T             :",f8.1," K",17x,"│")') MD%tsoll
+  write (stdout,'(1x,"│   timestep dt          :",f8.1," fs",16x,"│")') MD%tstep
+  write (stdout,'(1x,"│   dump interval(trj)   :",f8.1," fs",16x,"│")') MD%dumpstep
   if (MD%shake.and.MD%shk%shake_mode > 0) then
     if (MD%shk%shake_mode == 2) then
-      write (stdout,'(2x,"|   SHAKE algorithm      :",a5," (all bonds) |")') to_str(MD%shake)
+      write (stdout,'(1x,"│   SHAKE algorithm      :",a5," (all bonds)",10x,"│")') to_str(MD%shake)
     else
-      write (stdout,'(2x,"|   SHAKE algorithm      :",a5," (H only) |")') to_str(MD%shake)
+      write (stdout,'(1x,"│   SHAKE algorithm      :",a5," (H only)",13x,"│")') to_str(MD%shake)
     end if
   end if
   if (allocated(MD%active_potentials)) then
-    write (stdout,'(2x,"|   active potentials    :",i4," potential    |")') size(MD%active_potentials,1)
+    write (stdout,'(1x,"│   active potentials    :",i4," potential(s)",10x,"│")') size(MD%active_potentials,1)
   end if
   if (MD%simtype == type_mtd) then
     if (MD%cvtype(1) == cv_rmsd) then
-      write (stdout,'(2x,"|   dump interval(Vbias) :",f8.2," ps       |")') &
+      write (stdout,'(1x,"│   dump interval(Vbias) :",f8.2," ps",16x,"│")') &
           & MD%mtd(1)%cvdump_fs/1000.0_wp
     end if
-    write (stdout,'(2x,"|   Vbias prefactor (k)  :",f8.4," Eh       |")') &
-      &  MD%mtd(1)%kpush
+    write (stdout,'(1x,"│   Vbias prefactor (k)  :",f8.4," Eh",16x,"│")') MD%mtd(1)%kpush
     if (MD%cvtype(1) == cv_rmsd.or.MD%cvtype(1) == cv_rmsd_static) then
-      write (stdout,'(2x,"|   Vbias exponent (α)   :",f8.4," bohr⁻²   |")') MD%mtd(1)%alpha
+      write (stdout,'(1x,"│   Vbias exponent (α)   :",f8.4," bohr⁻²",12x,"│")') MD%mtd(1)%alpha
     else
-      write (stdout,'(2x,"|   Vbias exponent (α)   :",f8.4,"          |")') MD%mtd(1)%alpha
+      write (stdout,'(1x,"│   Vbias exponent (α)   :",f8.4,19x,"│")') MD%mtd(1)%alpha
+    end if
+    if (allocated(MD%mtd(1)%atinclude)) then
+      write (stdout,'(1x,"│   # active atoms       :",i9," atoms",12x,"│")') count(MD%mtd(1)%atinclude,1)
     end if
   end if
 
+  call drawbox(stdout,'',width=bw,charset=4,ltab=1,procedual=2)
+
   !$omp end critical
 
 end subroutine parallel_md_block_printout
diff --git a/src/algos/playground.f90 b/src/algos/playground.f90
index bffbf199..82abf58d 100644
--- a/src/algos/playground.f90
+++ b/src/algos/playground.f90
@@ -30,61 +30,68 @@ subroutine crest_playground(env,tim)
   use crest_parameters
   use crest_data
   use crest_calculator
-  use strucrd 
-  use canonical_mod
+  use strucrd
   implicit none
   type(systemdata),intent(inout) :: env
   type(timer),intent(inout)      :: tim
   type(coord) :: mol,molnew
-  integer :: i,j,k,l,io,ich 
+  integer :: i,j,k,l,io,ich
   logical :: pr,wr
 !========================================================================================!
   type(calcdata) :: calc
   real(wp) :: accuracy,etemp
-   
+
   integer :: V,maxgen
   integer,allocatable :: A(:,:)
   logical,allocatable :: rings(:,:)
   integer,allocatable :: tmp(:)
-  logical :: connected,fail
+  logical :: connected,fail,doreturn
 
   real(wp) :: energy
-  real(wp),allocatable :: grad(:,:),geo(:,:),csv(:,:)
+  real(wp),allocatable :: grad(:,:),geo(:,:),csv(:,:),q(:)
 
-  type(canonical_sorter) ::  can
 !========================================================================================!
-  call tim%start(14,'Test implementation') 
+  call tim%start(14,'Test implementation')
 !========================================================================================!
   !call system('figlet welcome')
-  write(*,*) "              _                          "
-  write(*,*) "__      _____| | ___ ___  _ __ ___   ___ "
-  write(*,*) "\ \ /\ / / _ \ |/ __/ _ \| '_ ` _ \ / _ \"
-  write(*,*) " \ V  V /  __/ | (_| (_) | | | | | |  __/"
-  write(*,*) "  \_/\_/ \___|_|\___\___/|_| |_| |_|\___|"
-  write(*,*) 
+  write (*,*) "              _                          "
+  write (*,*) "__      _____| | ___ ___  _ __ ___   ___ "
+  write (*,*) "\ \ /\ / / _ \ |/ __/ _ \| '_ ` _ \ / _ \"
+  write (*,*) " \ V  V /  __/ | (_| (_) | | | | | |  __/"
+  write (*,*) "  \_/\_/ \___|_|\___\___/|_| |_| |_|\___|"
+  write (*,*)
 !========================================================================================!
   call env%ref%to(mol)
-  write(*,*)
-  write(*,*) 'Input structure:'
+  write (*,*)
+  write (*,*) 'Input structure:'
   call mol%append(stdout)
-  write(*,*) 
+  write (*,*)
+!!========================================================================================!
+!
+!  allocate (grad(3,mol%nat),source=0.0_wp)
+!  call env2calc(env,calc,mol)
+!  calc%calcs(1)%rdwbo = .true.
+!  call calc%info(stdout)
+!
+!  call engrad(mol,calc,energy,grad,io)
+!  call calculation_summary(calc,mol,energy,grad)
 !========================================================================================!
 
-  allocate(grad(3,mol%nat), source=0.0_wp)
-  call env2calc(env,calc,mol)
-  calc%calcs(1)%rdwbo=.true.
-  call calc%info(stdout)
+  allocate(mol%gradient(3,mol%nat), source=1.0_wp)
+  call mol%write('dummy.extxyz')
+
 
-  call engrad(mol,calc,energy,grad,io)
-  call calculation_summary(calc,mol,energy,grad)
-  
+  call molnew%open("dummy.extxyz")
+  call molnew%write("dummy2.extxyz")
 
-  write(stdout,*)
-  write(stdout,*) 'CANGEN algorithm' 
-  call can%init(mol,calc%calcs(1)%wbo,'apsp+')
-  call can%stereo(mol)
-  call can%rankprint(mol) 
 
+  block
+    type(coord),allocatable :: structures(:)
+    integer :: nall
+    call rdensemble(env%inputcoords,nall,structures)
+    write(*,*) nall,'structures read from ',env%inputcoords
+    call wrensemble('dummyensemble.xyz',nall,structures)
+  end block
 !========================================================================================!
   call tim%stop(14)
   return
diff --git a/src/algos/propcalc.f90 b/src/algos/propcalc.f90
new file mode 100644
index 00000000..0f33eb5f
--- /dev/null
+++ b/src/algos/propcalc.f90
@@ -0,0 +1,314 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2018-2020 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!> Skeleton stub for property calculations on an ensemble.
+!> Each mode needs to be implemented via modern algo routines.
+!> The legacy implementation (system-call/I/O based) has been removed.
+!> See git history for reference.
+
+subroutine propcalc(iname,imode,env,tim)
+  use crest_parameters
+  use crest_data
+  use cregen_interface
+  implicit none
+  character(len=*),intent(in) :: iname
+  integer,intent(in) :: imode
+  type(systemdata),intent(inout) :: env
+  type(timer),intent(inout) :: tim
+
+  select case (imode)
+  case (p_prop_hess)
+    !> TODO: Hessian calculations for all conformers (was: xtb --hess)
+  case (p_prop_autoir)
+    !> TODO: IR spectrum averaging over populated conformers (was: autoir + xtb --ohess)
+  case (p_prop_ohess)
+    !> TODO: Optimization + Hessian for all conformers (was: xtb --ohess)
+  case (p_prop_gsolv)
+    !> TODO: Free energy in solvation, 2-step (was: xtb --sp + xtb --ohess)
+  case (p_prop_reopt)
+    !> TODO: Vtight reoptimization for all conformers (was: xtb --opt vtight)
+  case (p_prop_finalhess)
+    call crest_finalhess(iname,env,tim)
+
+  case (p_prop_multilevel:p_prop_multilevel+9)
+    !> Post-search processing of the conformer ensemble at a higher level.
+    !> Dispatched by job number; input is typically crest_rotamers.xyz.
+    block
+      integer :: saved_stage
+      saved_stage = env%calc%refine_stage
+      select case (imode)
+      case (p_prop_multilevel+1)  !> A@B post-search geo-opt (existing)
+        env%calc%refine_stage = refine%post_opt
+        call crest_multilevel_reopt(iname,env,tim)
+      case (p_prop_multilevel+2)  !> --rerank post-search SP re-ranking
+        call crest_rerank_sp(iname,env,tim)
+      case (p_prop_multilevel+3)  !> --reopt post-search geo-opt (standalone)
+        env%calc%refine_stage = refine%post_reopt
+        call crest_multilevel_reopt(iname,env,tim)
+      case default
+        write (stdout,'(a,i0,a)') 'propcalc: multilevel mode ',imode,' not implemented'
+      end select
+      env%calc%refine_stage = saved_stage
+    end block
+  case (p_prop_dipole)
+    !> TODO: Singlepoint + dipole extraction (was: xtb --sp, grep molecular dipole)
+  case (p_prop_rerank)
+    !> TODO: Singlepoint + reranking (was: xtb --sp + newcregen)
+  case default
+    write (stdout,'(a,i0,a)') 'propcalc: mode ',imode,' not yet implemented'
+  end select
+
+end subroutine propcalc
+
+!========================================================================================!
+
+subroutine crest_multilevel_reopt(iname,env,tim)
+!*******************************************************************
+!* Read the ensemble iname, optimize all structures using the
+!* calculator whose refine_lvl matches env%calc%refine_stage,
+!* sort via CREGEN, and write crest_reopt.xyz.
+!*
+!* The caller is responsible for setting env%calc%refine_stage
+!* to the desired level before this routine is called.
+!*
+!* Input:
+!*   iname  - path to input ensemble (e.g. crest_rotamers.xyz)
+!* Output:
+!*   crest_reopt.xyz (sorted conformer ensemble at the higher level)
+!*******************************************************************
+  use crest_parameters,only:wp,stdout,bohr
+  use crest_data
+  use crest_calculator
+  use strucrd
+  use parallel_interface
+  use cregen_interface
+  use iomod,only:drawbox,catdel
+  implicit none
+  character(len=*),intent(in) :: iname
+  type(systemdata),intent(inout) :: env
+  type(timer),intent(inout) :: tim
+  integer :: nat,nall,T,Tn
+  real(wp),allocatable :: xyz(:,:,:),eread(:)
+  integer,allocatable  :: at(:)
+  character(len=*),parameter :: outname = 'crest_reopt.xyz'
+  logical :: ex
+
+  inquire(file=iname,exist=ex)
+  if (.not.ex) then
+    write(stdout,'(a,a,a)') '**WARNING** ',trim(iname),' not found, skipping multilevel reopt'
+    return
+  end if
+
+  call tim%start(16,'Multilevel reopt')
+
+  call rdensembleparam(iname,nat,nall)
+  if (nall < 1) then
+    write(stdout,*) '**WARNING** empty ensemble, skipping multilevel reopt'
+    call tim%stop(16)
+    return
+  end if
+  allocate(xyz(3,nat,nall),at(nat),eread(nall))
+  call rdensemble(iname,nat,nall,at,xyz,eread)
+! ── crest_oloop requires Bohr ────────────────────────────────────
+  xyz = xyz/bohr
+
+  call new_ompautoset(env,'auto',nall,T,Tn)
+
+  write(stdout,*)
+  call drawbox(stdout,'MULTILEVEL ENSEMBLE REOPT',charset=7,width=51,ltab=10)
+  write(stdout,'(1x,a,i0,a,1x,a)') &
+    & 'Re-optimizing ',nall,' structures of file ',trim(iname)
+
+! ── refine_stage is set by the caller; run geo-opt ───────────────
+  call crest_oloop(env,nat,nall,at,xyz,eread,.true.)
+
+! ── back to Angstrom, write output ───────────────────────────────
+  xyz = xyz*bohr
+  call wrensemble(outname,nat,nall,at,xyz,eread)
+
+  write(stdout,'(/,a,a,a)') 'Re-optimized ensemble written to <',outname,'>'
+
+! ── sort via CREGEN ──────────────────────────────────────────────
+  call newcregen(env,0,outname)
+  call catdel('cregen.out.tmp')
+
+  deallocate(xyz,at,eread)
+  call tim%stop(16)
+end subroutine crest_multilevel_reopt
+
+!========================================================================================!
+
+subroutine crest_rerank_sp(iname,env,tim)
+!*******************************************************************
+!* Read the ensemble iname, run single-point energies using the
+!* calculator tagged with refine_lvl == refine%post_sp (= 11,
+!* set by the --rerank keyword), re-sort via CREGEN, and write
+!* crest_reopt.xyz. Geometries are not changed.
+!*
+!* Input:
+!*   iname  - path to input ensemble (e.g. crest_rotamers.xyz)
+!* Output:
+!*   crest_reopt.xyz (ensemble re-ranked by higher-level SP energies)
+!*******************************************************************
+  use crest_parameters,only:wp,stdout,bohr
+  use crest_data
+  use crest_calculator
+  use strucrd
+  use parallel_interface
+  use cregen_interface
+  use iomod,only:drawbox,catdel
+  implicit none
+  character(len=*),intent(in) :: iname
+  type(systemdata),intent(inout) :: env
+  type(timer),intent(inout) :: tim
+  integer :: nat,nall,T,Tn,old_stage
+  real(wp),allocatable :: xyz(:,:,:),eread(:)
+  integer,allocatable  :: at(:)
+  character(len=*),parameter :: outname = 'crest_reopt.xyz'
+  logical :: ex
+
+  inquire(file=iname,exist=ex)
+  if (.not.ex) then
+    write(stdout,'(a,a,a)') '**WARNING** ',trim(iname),' not found, skipping SP rerank'
+    return
+  end if
+
+  call tim%start(16,'Post-search SP rerank')
+
+  call rdensembleparam(iname,nat,nall)
+  if (nall < 1) then
+    write(stdout,*) '**WARNING** empty ensemble, skipping SP rerank'
+    call tim%stop(16)
+    return
+  end if
+  allocate(xyz(3,nat,nall),at(nat),eread(nall))
+  call rdensemble(iname,nat,nall,at,xyz,eread)
+! ── crest_sploop requires coordinates in Bohr ────────────────────
+  xyz = xyz/bohr
+
+  call new_ompautoset(env,'auto',nall,T,Tn)
+
+  write(stdout,*)
+  call drawbox(stdout,'POST-SEARCH SP RE-RANKING',charset=7,width=51,ltab=10)
+  write(stdout,'(1x,a,i0,a,1x,a)') &
+    & 'Re-ranking ',nall,' structures of file ',trim(iname)
+
+! ── activate only the SP reranking calculator ────────────────────
+  old_stage = env%calc%refine_stage
+  env%calc%refine_stage = refine%post_sp
+
+  call crest_sploop(env,nat,nall,at,xyz,eread)
+
+  env%calc%refine_stage = old_stage
+
+! ── back to Angstrom, write output ───────────────────────────────
+  xyz = xyz*bohr
+  call wrensemble(outname,nat,nall,at,xyz,eread)
+
+  write(stdout,'(/,a,a,a)') 'Re-ranked ensemble written to <',outname,'>'
+
+! ── sort via CREGEN ──────────────────────────────────────────────
+  call newcregen(env,0,outname)
+  call catdel('cregen.out.tmp')
+
+  deallocate(xyz,at,eread)
+  call tim%stop(16)
+end subroutine crest_rerank_sp
+
+!========================================================================================!
+
+subroutine crest_finalhess(iname,env,tim)
+!*******************************************************************
+!* Run Hessians + thermochemistry on the final conformer ensemble,
+!* then re-sort via CREGEN using Gibbs free energies.
+!* Falls back from crest_conformers.xyz to crest_ensemble.xyz.
+!* Uses the main calculator as-is (no separate refine level).
+!* Input:
+!*   iname  - primary input file (crest_conformers.xyz)
+!* Output:
+!*   crest_hess.xyz (intermediate), then CREGEN overwrites
+!*   crest_conformers.xyz / crest_ensemble.xyz sorted by Gfree
+!*******************************************************************
+  use crest_parameters,only:wp,stdout,bohr
+  use crest_data
+  use crest_calculator
+  use strucrd
+  use parallel_interface
+  use cregen_interface
+  use iomod,only:drawbox,catdel
+  implicit none
+  character(len=*),intent(in) :: iname
+  type(systemdata),intent(inout) :: env
+  type(timer),intent(inout) :: tim
+  character(len=:),allocatable :: infile
+  integer :: nat,nall,T,Tn
+  real(wp),allocatable :: xyz(:,:,:),eread(:),etmp(:)
+  integer,allocatable  :: at(:)
+  character(len=*),parameter :: outname = 'crest_hess.xyz'
+  logical :: ex
+
+! ── select input file with fallback to crest_ensemble.xyz ────────
+  inquire(file=iname,exist=ex)
+  if (ex) then
+    infile = iname
+  else
+    inquire(file=ensemblefile,exist=ex)
+    if (ex) then
+      infile = ensemblefile
+    else
+      write(stdout,'(a)') '**WARNING** no conformer ensemble found, skipping --finalhess'
+      return
+    end if
+  end if
+
+  call tim%start(16,'Final ensemble Hessians')
+
+  call rdensembleparam(infile,nat,nall)
+  if (nall < 1) then
+    write(stdout,*) '**WARNING** empty ensemble, skipping --finalhess'
+    call tim%stop(16)
+    return
+  end if
+  allocate(xyz(3,nat,nall),at(nat),eread(nall),etmp(nall))
+  call rdensemble(infile,nat,nall,at,xyz,eread)
+! ── crest_hessloop requires coordinates in Bohr ──────────────────
+  xyz = xyz/bohr
+
+  call new_ompautoset(env,'auto',nall,T,Tn)
+
+  write(stdout,*)
+  call drawbox(stdout,'FINAL ENSEMBLE HESSIANS',charset=7,width=51,ltab=10)
+  write(stdout,'(1x,a,i0,a,1x,a)') &
+    & 'Computing Hessians for ',nall,' structures of file ',trim(infile)
+
+  call crest_hessloop(env,nat,nall,at,xyz,etmp)
+  eread(:) = eread(:) + etmp(:)
+
+! ── back to Angstrom, write intermediate file ─────────────────────
+  xyz = xyz*bohr
+  call wrensemble(outname,nat,nall,at,xyz,eread)
+  write(stdout,'(/,a,a,a)') 'Hessian ensemble written to <',outname,'>'
+
+! ── sort via CREGEN using Gibbs free energies ────────────────────
+  call newcregen(env,0,outname)
+  call catdel('cregen.out.tmp')
+
+  deallocate(xyz,at,eread)
+  call tim%stop(16)
+end subroutine crest_finalhess
diff --git a/src/algos/protonate.f90 b/src/algos/protonate.f90
index a058bddf..67a4c979 100644
--- a/src/algos/protonate.f90
+++ b/src/algos/protonate.f90
@@ -54,7 +54,6 @@ subroutine crest_new_protonate(env,tim)
   real(wp),allocatable :: grad(:,:)
   type(calcdata),allocatable :: tmpcalc
   type(calcdata),allocatable :: tmpcalc_ff
-  type(calculation_settings) :: tmpset
   real(wp),allocatable :: protxyz(:,:)
   integer :: natp,pstep,npnew
   integer,allocatable :: atp(:)
@@ -200,18 +199,15 @@ subroutine crest_new_protonate(env,tim)
     write (stdout,'(a)') '  with defined bond-topology can help circumvent this issue.'
     write (stdout,'(a)') '> Setting up force-field structure pre-optimization ...'
     allocate (tmpcalc_ff)
-    tmpcalc_ff%optnewinit = .true.
     env%calc%optnewinit = .true.
+    call tmpcalc_ff%create('gfnff',chrg=env%chrg)
     tmpcalc_ff%optnewinit = .true.
-    call tmpset%create('gfnff')
-    tmpset%chrg = env%chrg
-    call tmpcalc_ff%add(tmpset)
     tmpcalc_ff%maxcycle = 10000
     call tmpcalc_ff%info(stdout)
 
     !>--- Run optimizations
     call tim%start(15,'Ensemble optimization (FF)')
-    call print_opt_data(tmpcalc_ff,stdout)
+    call print_opt_data(tmpcalc_ff,stdout,natoms=natp)
     write (stdout,'(a,i0,a)') '> ',npnew,' structures to optimize ...'
     call crest_oloop(env,natp,npnew,atp,xyzp(:,:,1:npnew),ep(1:npnew),.false.,tmpcalc_ff)
     call tim%stop(15)
@@ -301,7 +297,7 @@ subroutine crest_new_protonate(env,tim)
     call tmpcalc%info(stdout)
     tmpcalc%optnewinit = .true.
     call tim%start(20,'Ensemble optimization')
-    call print_opt_data(env%calc,stdout)
+    call print_opt_data(env%calc,stdout,natoms=natp)
     write (stdout,'(a,i0,a)') '> ',npnew,' structures to optimize ...'
     call crest_oloop(env,natp,npnew,atp,xyzp(:,:,1:npnew),ep,.false.,tmpcalc)
     call tim%stop(20)
@@ -444,6 +440,7 @@ subroutine protonation_prep_canonical(env,refmol,fname)
   use iomod,only:remove
   use adjacency
   use cregen_interface
+  use term_ui,only:progress_init,progress_update,progress_finish
   implicit none
   type(systemdata) :: env
   type(coord),intent(in) :: refmol 
@@ -482,7 +479,9 @@ subroutine protonation_prep_canonical(env,refmol,fname)
   allocate (canon(nall))
 
   write (stdout,'(a,i0,a)') '> Setting up canonical atom order for ',nall,' structures via CN-based molecular graphs ...'
-  call crest_oloop_pr_progress(env,nall,0)
+  call progress_init(env%ps,nall,width=50,prefix=" ↳ ", &
+    &                suffix="",show_time=.true.,show_eta=.false.)
+  call progress_update(env%ps,0,nall)
   do i = 1,nall
     call canon(i)%init(structures(i),invtype='apsp+')
     call canon(i)%stereo(structures(i))
@@ -490,9 +489,9 @@ subroutine protonation_prep_canonical(env,refmol,fname)
     !call canon(i)%rankprint(structures(i))
     call canon(i)%shrink()
 
-    call crest_oloop_pr_progress(env,nall,i)
+    call progress_update(env%ps,i,nall)
   end do
-  call crest_oloop_pr_progress(env,nall,-1)
+  call progress_finish(env%ps)
 
 !>--- grouping loop
   allocate (group(nall),source=0)
@@ -588,7 +587,6 @@ subroutine crest_new_deprotonate(env,tim)
   real(wp),allocatable :: grad(:,:)
   type(calcdata),allocatable :: tmpcalc
   type(calcdata),allocatable :: tmpcalc_ff
-  type(calculation_settings) :: tmpset
   integer :: natp,pstep,npnew
   integer,allocatable :: atp(:)
   real(wp),allocatable :: xyzp(:,:,:)
@@ -684,18 +682,15 @@ subroutine crest_new_deprotonate(env,tim)
     write (stdout,'(a)') '  with defined bond-topology can help circumvent this issue.'
     write (stdout,'(a)') '> Setting up force-field structure pre-optimization ...'
     allocate (tmpcalc_ff)
-    tmpcalc_ff%optnewinit = .true.
     env%calc%optnewinit = .true.
+    call tmpcalc_ff%create('gfnff',chrg=env%chrg)
     tmpcalc_ff%optnewinit = .true.
-    call tmpset%create('gfnff')
-    tmpset%chrg = env%chrg
-    call tmpcalc_ff%add(tmpset)
     tmpcalc_ff%maxcycle = 10000
     call tmpcalc_ff%info(stdout)
 
     !>--- Run optimizations
     call tim%start(15,'Ensemble optimization (FF)')
-    call print_opt_data(tmpcalc_ff,stdout)
+    call print_opt_data(tmpcalc_ff,stdout,natoms=natp)
     write (stdout,'(a,i0,a)') '> ',npnew,' structures to optimize ...'
     call crest_oloop(env,natp,npnew,atp,xyzp(:,:,1:npnew),ep(1:npnew),.false.,tmpcalc_ff)
     call tim%stop(15)
@@ -784,7 +779,7 @@ subroutine crest_new_deprotonate(env,tim)
     call tmpcalc%info(stdout)
     tmpcalc%optnewinit = .true.
     call tim%start(20,'Ensemble optimization')
-    call print_opt_data(env%calc,stdout)
+    call print_opt_data(env%calc,stdout,natoms=natp)
     write (stdout,'(a,i0,a)') '> ',npnew,' structures to optimize ...'
     call crest_oloop(env,natp,npnew,atp,xyzp(:,:,1:npnew),ep(1:npnew),.false.,tmpcalc)
     call tim%stop(20)
@@ -996,7 +991,6 @@ subroutine crest_new_tautomerize(env,tim)
   real(wp),allocatable :: grad(:,:)
   type(calcdata),allocatable :: tmpcalc
   type(calcdata),allocatable :: tmpcalc_ff
-  type(calculation_settings) :: tmpset
   integer :: natp,pstep,npnew
   integer :: tautiter,structiter
   integer,allocatable :: atp(:)
@@ -1166,19 +1160,16 @@ subroutine crest_new_tautomerize(env,tim)
     write (stdout,'(a)') '  with defined bond-topology can help circumvent this issue.'
     write (stdout,'(a)') '> Setting up force-field structure pre-optimization ...'
     allocate (tmpcalc_ff)
-    tmpcalc_ff%optnewinit = .true.
     env%calc%optnewinit = .true.
+    call tmpcalc_ff%create('gfnff',chrg=env%chrg)
     tmpcalc_ff%optnewinit = .true.
-    call tmpset%create('gfnff')
-    tmpset%chrg = env%chrg
-    call tmpcalc_ff%add(tmpset)
     tmpcalc_ff%maxcycle = 10000
     tmpcalc_ff%anopt=.true.
     call tmpcalc_ff%info(stdout)
 
     !>--- Run optimizations
     call tim%start(15,'Ensemble optimization (FF)')
-    call print_opt_data(tmpcalc_ff,stdout)
+    call print_opt_data(tmpcalc_ff,stdout,natoms=natp)
     write (stdout,'(a,i0,a)') '> ',npnew,' structures to optimize ...'
     call crest_oloop(env,natp,npnew,atp,xyzp(:,:,1:npnew),ep(1:npnew),.false.,tmpcalc_ff)
     call tim%stop(15)
@@ -1271,7 +1262,7 @@ subroutine crest_new_tautomerize(env,tim)
     call tmpcalc%info(stdout)
     tmpcalc%optnewinit = .true.
     call tim%start(20,'Ensemble optimization')
-    call print_opt_data(env%calc,stdout)
+    call print_opt_data(env%calc,stdout,natoms=natp)
     write (stdout,'(a,i0,a)') '> ',npnew,' structures to optimize ...'
     call crest_oloop(env,natp,npnew,atp,xyzp(:,:,1:npnew),ep,.false.,tmpcalc)
     call tim%stop(20)
diff --git a/src/algos/queueing.f90 b/src/algos/queueing.f90
new file mode 100644
index 00000000..04492afb
--- /dev/null
+++ b/src/algos/queueing.f90
@@ -0,0 +1,831 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+subroutine crest_queue_setup(env,iterate)
+  use crest_parameters
+  use crest_data
+  use crest_calculator
+  use strucrd
+  use molbuilder_construct_list
+  use molbuilder_construct_mod
+  implicit none
+  type(systemdata),intent(inout) :: env
+  logical,intent(out) :: iterate
+
+  integer :: splitlayers
+  integer :: ii,jj,nn,kk,ich
+  type(coord),pointer :: reference_mol
+  type(coord),target :: mol
+  integer,allocatable :: splitatms(:)
+  integer :: parentlayer,parentnode
+  character(len=1024) :: thispath
+  real(wp),allocatable :: qat(:)
+  integer,allocatable :: lq(:)
+
+  iterate = .true.
+
+  if (allocated(env%splitqueue)) then
+
+    !> check for incompatible runtypes (or rather, whitelist a few)
+    if (.not.any(env%crestver == [crest_imtd,crest_imtd2,crest_sp, &
+      & crest_optimize,crest_moldyn,crest_rigcon,crest_trialopt,crest_bh,crest_test])) then
+      write (stdout,'(a)') '** ERROR ** Selected CREST runtype incompatible with substructure builder'
+      call creststop(status_config)
+    end if
+    if (allocated(env%ONIOM_input).or.allocated(env%ONIOM_toml)) then
+      write (stdout,'(a)') '** ERROR ** ONIOM incompatible with substructure builder'
+      call creststop(status_config)
+    end if
+
+    !> if the program sees no problem, set the global boolean
+    env%substructure_queue = .true.
+    splitlayers = size(env%splitqueue,1)
+
+    !> we may need to calculate charges to distribute them:
+    if (env%chrg .ne. 0) then
+      call calc_charges(env,qat)
+    else
+      allocate (qat(env%ref%nat),source=0.0_wp)
+    end if
+
+    !> start constructing the splitheap
+    env%splitheap%nlayer = splitlayers
+    allocate (env%splitheap%layer(splitlayers))
+    associate (heap => env%splitheap,layer => env%splitheap%layer)
+
+      do ii = 1,heap%nlayer
+        layer%id = ii
+
+        nn = env%splitqueue(ii)%natms
+        allocate (splitatms(nn))
+        splitatms(:) = env%splitqueue(ii)%atms(:)
+        if (ii == 1) then
+          call env%ref%to(mol)
+          reference_mol => mol
+        else
+
+          call pick_parent(heap,ii,splitatms,parentlayer,parentnode)
+          if (parentlayer == 0) then
+            call env%ref%to(mol)
+            reference_mol => mol
+          else
+            mol = heap%layer(parentlayer)%node(parentnode)
+            reference_mol => mol
+            heap%layer(ii)%parent = parentlayer
+            heap%layer(ii)%parentnode = parentnode
+          end if
+        end if
+        layer(ii)%refmol = reference_mol
+        call reference_mol%get_cn(layer(ii)%refcn)
+        allocate (layer(ii)%reficn(reference_mol%nat))
+        layer(ii)%reficn(:) = nint(layer(ii)%refcn(:))
+        call binarysplit(reference_mol,splitatms,layer(ii)%node,layer(ii)%alignmap, &
+          & ncap=layer(ii)%ncapped,position_mapping=layer(ii)%position_mapping)
+        deallocate (splitatms)
+        layer(ii)%nnodes = size(layer(ii)%node,1)
+        call heap%map_origins_for_layer(ii)
+        !> determening charges for fragments
+        call sum_charges_layer(env,heap,ii,qat,lq)
+        do jj = 1,layer(ii)%nnodes
+          layer(ii)%node(jj)%chrg = lq(jj)
+        end do
+      end do
+
+      call heap%setup_queue()
+      call getcwd(thispath)
+      !> some backups
+      call env%ref%to(heap%originmol)
+      heap%originmol%chrg = env%chrg
+      heap%origindir = trim(thispath)
+      heap%origincalc => env%calc
+
+    end associate
+    iterate = .true.
+  end if
+
+  return
+contains
+  subroutine pick_parent(heap,current_layer,splitatms,parentlayer,parentnode)
+    use molbuilder_construct_list
+    implicit none
+    type(construct_heap),intent(inout) :: heap
+    integer,intent(inout) :: splitatms(:)
+    integer,intent(in) :: current_layer
+    integer,intent(out) :: parentlayer,parentnode
+    integer :: ii,jj,kk,prev_layer
+    logical :: matching
+
+    parentlayer = 0
+    parentnode = 0
+    if (current_layer .eq. 1) return
+
+    !> iterate through the previous layer and check which node
+    !> contains all the split atoms
+    prev_layer = current_layer-1
+    LAYITER: do while (prev_layer >= 1)
+      do ii = 1,heap%layer(prev_layer)%nnodes
+        matching = .true.
+        do jj = 1,size(splitatms,1)
+          matching = matching.and. &
+            & any(heap%layer(prev_layer)%origin(ii)%map(:) .eq. splitatms(jj))
+        end do
+        if (matching) then
+          parentlayer = prev_layer
+          parentnode = ii
+          !> on the first match, exit
+          exit LAYITER
+        end if
+      end do
+      !> if no matching parent node was found, try again in one layer further up
+      if (parentnode == 0) prev_layer = prev_layer-1
+    end do LAYITER
+
+    !> IMPORTANT; we need to update the splitatms with the correctly mapped indices
+    !> reflecting their position in the selected parent layer
+    if (parentnode .ne. 0) then
+      do ii = 1,size(splitatms,1)
+        jj = splitatms(ii)
+        call heap%find_current_position(jj,parentlayer,parentnode,kk)
+        splitatms(ii) = kk
+      end do
+      !> we also map the current node as a child node of the selected parent
+      if (.not.allocated(heap%layer(parentlayer)%childlayer)) then
+        ii = heap%layer(parentlayer)%nnodes
+        allocate (heap%layer(parentlayer)%childlayer(ii),source=0)
+      end if
+      heap%layer(parentlayer)%childlayer(parentnode) = current_layer
+    end if
+
+  end subroutine pick_parent
+  subroutine calc_charges(env,qat)
+    use tblite_api,only:tblite_quick_ceh_q
+    implicit none
+    type(systemdata),intent(inout) :: env
+    real(wp),intent(out),allocatable :: qat(:)
+    real(wp),allocatable :: qat0(:)
+    character(len=256) :: atmp
+    type(coord)  :: mol
+    integer :: ii
+    write (atmp,'(a)') 'Calculating atomic charges under consideration of molecular charge'
+    call underline(trim(atmp))
+    write (stdout,'(a,i0)') 'Molecular charge : ',env%chrg
+    call env%ref%to(mol)
+    call tblite_quick_ceh_q(mol,qat, &
+      & chrg=env%chrg,uhf=env%uhf,pr=.true.,prch=stdout)
+    write (stdout,'(a)') 'Obtained CEH charges for full structure:'
+    do ii = 1,mol%nat
+      write (stdout,'(3x,a3,2x,f10.6)') i2e(mol%at(ii)),qat(ii)!,qat0(ii),qat(ii)-qat0(ii)
+    end do
+
+    write (stdout,'(/,a)') 'NOTE: Total charge for each fragment will be selected automatically by'
+    write (stdout,'(a)') '      matching the best atomic charge MAE to these charges.'
+  end subroutine calc_charges
+  subroutine sum_charges_layer(env,heap,lay,qat,lq)
+    use tblite_api,only:tblite_quick_ceh_q
+    implicit none
+    type(systemdata) :: env
+    type(construct_heap) :: heap
+    integer,intent(in) :: lay
+    real(wp),intent(in) :: qat(:)
+    integer,intent(out),allocatable :: lq(:)
+    integer :: ii,jj,nat,nnodes,kk,nnat,sign,cc,cc2,chrgs
+    integer,allocatable :: ichrgs(:)
+    real(wp) :: qtmp0,qtmpc
+    real(wp),allocatable :: qtmp(:)
+    real(wp),allocatable :: qattmp0(:),qattmpc(:),qattmpref(:),qdum(:)
+    real(wp),allocatable :: qattmp(:,:)
+
+    nat = size(qat,1)
+    nnodes = heap%layer(lay)%nnodes
+    allocate (lq(nnodes),source=0) !> default chrg of 0
+
+    if (env%chrg == 0) return !> return for neutral systems (may need some implementation for zwitter ions)
+
+    write (stdout,'(a,i0,a)') 'Calculating charges for fragments in layer ',lay,' ...'
+    sign = 1
+    if (env%chrg < 0) sign = -1
+    chrgs = abs(env%chrg)+1
+    allocate (qtmp(chrgs),source=0.0_wp)
+    allocate (ichrgs(chrgs),source=0)
+    cc2 = 0
+    do cc = 0,env%chrg,sign
+      cc2 = cc2+1
+      ichrgs(cc2) = cc
+    end do
+
+    do ii = 1,nnodes
+      qtmp(:) = 0.0_wp
+      qtmp0 = 0.0_wp
+      qtmpc = 0.0_wp
+      nnat = heap%layer(lay)%node(ii)%nat
+      allocate (qattmpref(nnat),source=0.0_wp)
+      allocate (qattmp(nnat,chrgs))
+      !> check different charge settings
+      cc2 = 0
+      do cc = 0,env%chrg,sign
+        cc2 = cc2+1
+        call tblite_quick_ceh_q(heap%layer(lay)%node(ii),qdum, &
+        & chrg=cc,uhf=env%uhf,pr=.false.,prch=stdout)
+        qattmp(:,cc2) = qdum(:)
+        do jj = 1,nnat
+          kk = heap%layer(lay)%origin(ii)%map(jj)
+          if (kk > 0) then
+            qattmpref(jj) = qat(kk)
+          else
+            qattmp(jj,cc2) = 0.0_wp
+          end if
+          qtmp(cc2) = qtmp(cc2)+abs(qattmp(jj,cc2)-qattmpref(jj))
+        end do
+      end do
+      !> select best charge
+      cc = minloc(qtmp,1)
+      lq(ii) = ichrgs(cc)
+      deallocate (qattmp,qattmpref)
+      !write (*,*) 'charge MAEs on frag:',qtmp
+      !write (*,*) 'selected charge:',lq(ii)
+    end do
+    write (stdout,'(2x,a)',advance='no') 'determined charges:'
+    write (stdout,*) lq
+  end subroutine sum_charges_layer
+end subroutine crest_queue_setup
+
+!=============================================================================!
+!#############################################################################!
+!=============================================================================!
+
+subroutine crest_queue_iter(env,iterate)
+  use crest_parameters
+  use crest_data
+  use strucrd
+  use iomod
+  use crest_calculator
+  implicit none
+  type(systemdata),intent(inout),target :: env
+  logical,intent(out) :: iterate
+  integer :: ii,jj,kk,io,nn,ll,lll,ati,atj
+  type(coord) :: mol
+  character(len=10) :: atmp
+  character(len=*),parameter :: dirname = 'crest_queue_'
+
+  iterate = .false.
+
+  if (allocated(env%splitqueue).and.env%splitheap%nqueue > 0) then
+!>--- important restoring to initial calc/dir
+    env%calc => env%splitheap%origincalc
+    call chdir(env%splitheap%origindir)
+
+    !> next iter
+    ii = env%queue_iter+1
+    env%queue_iter = ii
+
+    write (stdout,'(/,70("§"))')
+    write (stdout,'(a,i0)') "§§§   QUEUE ITERATION ",ii
+    write (stdout,'(70("§"))')
+
+    jj = env%splitheap%queue(ii)%layer
+    kk = env%splitheap%queue(ii)%node
+    associate (heap => env%splitheap,queue => env%splitheap%queue(ii))
+
+      !> create a dedicated work directory
+      write (atmp,'(i0)') ii
+      queue%workdir = dirname//trim(atmp)
+      io = makedir(queue%workdir)
+      call chdir(queue%workdir)
+      write (stdout,'(a,t28,a,t30,a)') 'Queue work (sub-)directory',':', &
+        & trim(queue%workdir)
+
+      !> selecting output file depending on runtype
+      select case (env%crestver)
+      case (crest_imtd,crest_imtd2)
+        queue%file = 'crest_ensemble.xyz'
+      case (crest_optimize)
+        queue%file = 'crestopt.xyz'
+      case (crest_moldyn)
+        queue%file = 'crest_dynamics.trj.xyz'
+      case (crest_bh)
+        queue%file = 'crest_quenched.xyz'
+      case default
+        queue%file = 'struc.xyz'
+      end select
+      write (stdout,'(a,t28,a,t30,a)') 'Selected output file',':',queue%file
+
+!>--- new calculator setup section and env update
+      call queue%calc%copy(env%calc,ignore_constraints=.true.)
+      !> for constraints we must be careful and map them to the new order
+      call update_constraints_queue(heap,jj,kk,env%calc,queue%calc)
+
+      mol = env%splitheap%layer(jj)%node(kk)
+      call env%ref%load(mol)
+      call mol%write('coord')
+      call queue%calc%set_charge(mol%chrg) !> the nodes may have different charges saved
+      call queue%calc%info(stdout)
+
+      if (allocated(env%ref%wbo)) deallocate (env%ref%wbo)
+      env%nat = mol%nat
+      env%rednat = mol%nat
+      env%chrg = mol%chrg
+      if (.not.env%user_mdtime) then
+        env%mdtime = -1.0_wp
+        env%mddat%length_ps = -1.0_wp
+      end if
+
+      env%calc => queue%calc
+
+    end associate
+    if (ii < env%splitheap%nqueue) then
+      iterate = .true.
+    end if
+
+    write (stdout,*)
+  end if
+
+contains
+  subroutine update_constraints_queue(heap,layer,node,refcalc,newcalc)
+    use molbuilder_construct_list
+    implicit none
+    type(construct_heap) :: heap
+    integer :: layer,node
+    type(calcdata),intent(in) :: refcalc
+    type(calcdata),intent(inout) :: newcalc
+    integer :: nn,ll,lll,ati,atj,nn2
+    type(constraint),allocatable :: cons(:)
+    if (refcalc%nconstraints > 0) then
+      nn = refcalc%nconstraints
+      allocate (cons(nn))
+      do ll = 1,nn
+        call cons(ll)%copy(refcalc%cons(ll))
+        do lll = 1,cons(ll)%n
+          ati = cons(ll)%atms(lll)
+          call heap%find_current_position(ati,layer,node,atj)
+          cons(ll)%atms(lll) = atj !> overwrite with the current position
+        end do
+        if (any(cons(ll)%atms(:) .eq. 0)) then
+          cons(ll)%active = .false.
+        end if
+      end do
+      !> clean (active) constraints
+      nn2 = 0
+      do ll = 1,nn
+        if (cons(ll)%active) nn2 = nn2+1
+      end do
+      if (nn2 > 0) then
+        newcalc%nconstraints = nn2
+        allocate (newcalc%cons(nn2))
+        lll = 0
+        do ll = 1,nn
+          if (cons(ll)%active) then
+            lll = lll+1
+            call newcalc%cons(lll)%copy(cons(ll))
+          end if
+        end do
+      end if
+    end if
+  end subroutine update_constraints_queue
+end subroutine crest_queue_iter
+
+subroutine crest_queue_iter_resort(env,iterate)
+  use crest_parameters
+  use crest_data
+  use iomod
+  use cregen_interface
+  implicit none
+  type(systemdata),intent(inout) :: env
+  logical,intent(in) :: iterate
+
+  character(len=:),allocatable :: file
+  logical :: heavytmp,confgotmp,ex
+
+  if (.not. (allocated(env%splitqueue).and.env%splitheap%nqueue > 0)) return
+
+  select case (env%crestver)
+  case (crest_imtd,crest_imtd2)
+
+    write (stdout,'(/,75("*"))')
+    write (stdout,'(a,i0)') "***  CREGEN heavy-atom resorting for QUEUE iteration ",env%queue_iter
+    write (stdout,'(75("*"))')
+    ex = .false.
+    if (file_exists(crefile//'.xyz')) then
+      ex = .true.
+      file = crefile//'.xyz'
+    else if (file_exists(conformerfile)) then
+      ex = .true.
+      file = conformerfile
+    end if
+    heavytmp = env%heavyrmsd
+    confgotmp = env%confgo
+    env%heavyrmsd = .true.
+    env%confgo = .true.
+    call newcregen(env,infile=file)
+    env%heavyrmsd = heavytmp
+    env%confgo = confgotmp
+    if (file_exists(file//'.sorted')) then
+      call rename(file//'.sorted',ensemblefile)
+    end if
+  case default
+  end select
+
+end subroutine crest_queue_iter_resort
+
+!=============================================================================!
+!#############################################################################!
+!=============================================================================!
+
+subroutine crest_queue_reconstruct(env,tim)
+  use crest_parameters
+  use crest_data
+  use molbuilder_construct_list
+  use molbuilder_construct_mod
+  use strucrd
+  use iomod
+  use crest_calculator
+  use utilities,only:checkname_xyz
+  use term_ui,only:progress_init,progress_update,progress_finish
+  implicit none
+  type(systemdata),intent(inout) ::  env
+  type(timer),intent(inout) :: tim
+  type(coord) :: mol
+  integer :: ii,jj,kk,nall
+  logical :: ex,multilevel(6)
+  type(timer) :: timtmp
+  type(coord),allocatable :: structures(:)
+  type(calcdata),target :: newcalc
+  character(len=256) :: inpnam,outnam
+  character(len=*),parameter :: recfile = 'crest_reconstruct.xyz'
+
+  if (.not. (allocated(env%splitqueue).and.env%splitheap%nqueue > 0)) then
+    return
+  end if
+
+  call tim%start(9,'Queue reconstruction')
+
+  write (stdout,'(/,80("#"))')
+  write (stdout,'(3("#"),t25,a,t78,3("#"))') 'QUEUE STRUCTURE RECONSTRUCTION'
+  write (stdout,'(80("#"),/)')
+
+  !> reset
+  mol = env%splitheap%originmol
+  call env%ref%load(mol)
+  env%nat = mol%nat
+  env%rednat = mol%nat
+  env%chrg = mol%chrg
+  env%calc => env%splitheap%origincalc
+  call chdir(env%splitheap%origindir)
+
+  call env%splitheap%fill_inverse_depth()
+  call recusrive_construct(env,env%splitheap,1)
+  nall = env%splitheap%layer(1)%nmols
+  allocate (structures(nall))
+  do ii = 1,nall
+    structures(ii) = env%splitheap%layer(1)%mols(ii)
+  end do
+  !deallocate (env%splitheap%layer(1)%mols)
+  deallocate (env%splitheap%layer)
+  deallocate (env%splitheap%queue)
+
+  write (stdout,'(/,1x,a)') 'Writing reconstructed structures to: "'//recfile//'"'
+  call wrensemble(recfile,nall,structures)
+  write (stdout,*)
+
+  call newcalc%copy(env%calc)
+  env%calc => newcalc
+  call env%calc%info(stdout)
+
+  select case (env%crestver)
+  case (crest_optimize)
+    call env%ref%load(structures(1))
+    call crest_optimization(env,timtmp)
+  case default
+    call optlev_to_multilev(env%optlev,multilevel)
+    call crest_multilevel_oloop(env,recfile,multilevel,0)
+    if (env%iostatus_meta .ne. 0) return
+
+    call smallheadline('FINAL GEOMETRY OPTIMIZATION IN QUEUE RECONSTRUCTION')
+    call checkname_xyz(crefile,inpnam,outnam)
+    call rename(inpnam,recfile)
+    call crest_multilevel_wrap(env,recfile,0)
+
+    call V2terminating()
+  end select
+
+  if (.not.env%keepmodef) then
+    call rmrf('crest_queue_*')
+  end if
+
+  call tim%stop(9)
+
+contains
+  recursive subroutine recusrive_construct(env,heap,targetlayer)
+    use irmsd_module,only:irmsd,rmsd,rmsd_cache,rmsd_core_cache,min_rmsd
+    use canonical_mod
+    use omp_lib
+    implicit none
+    type(systemdata),intent(inout) :: env
+    type(construct_heap),intent(inout) :: heap
+    integer,intent(in) :: targetlayer
+
+    integer :: ii,jj,kk
+    integer :: queuepos
+    character(len=:),allocatable :: basefile,sidefile
+    type(coord),allocatable :: structures_b(:)
+    type(coord),allocatable :: structures_s(:)
+    type(coord) :: mol,moltmp
+    type(coord),allocatable :: moltmp_arr(:)
+    integer :: nall_b,nall_s,id_b,id_s
+    integer :: rr,io,rg,nregions,max_structs
+    integer :: reg_blo(3),reg_bhi(3),reg_slo(3),reg_shi(3)
+    integer :: target_bhi,target_shi
+    integer :: outer_lo,outer_hi,inner_lo,inner_hi,outer_idx,inner_idx
+    logical :: base_is_outer
+    integer :: duplicates
+    logical :: ex,clash,duplicate
+    real(wp) :: RTHR,rmsval,ETHR,deltaE,depthlimit
+    real(wp) :: layerfactor_b,layerfactor_s,weight_s,weight_b
+    type(rmsd_cache),allocatable :: rcache(:)
+    type(rmsd_core_cache),allocatable :: ccache(:)
+    type(canonical_sorter) :: canref
+    real(wp),allocatable :: xyzscratch(:,:,:,:)
+    logical,allocatable :: mask(:)
+    integer :: T,Tn,tt
+    type(timer) :: profiler
+
+    character(len=*),parameter :: subdir_tmp = 'crest_queue_'
+    character(len=:),allocatable :: subdirfile
+    character(len=10) :: atmp
+    character(len=60) :: btmp
+
+    associate (layer => heap%layer(targetlayer))
+      if (layer%nnodes > 2) then
+        write (stdout,'(a)') 'currently unhandled edge-case in layer reconstruction:'
+        write (stdout,'(a,i0,a)') 'layer ',targetlayer,' was split in more than 2 structures'
+        stop
+      end if
+
+      layer%inverse_depth = layer%inverse_depth+1.0_wp
+      do ii = 1,layer%nnodes
+        if (allocated(layer%childlayer)) then
+          jj = layer%childlayer(ii)
+        else
+          jj = 0
+        end if
+        if (jj == 0.and.ii == 1) then
+
+          do kk = 1,heap%nqueue
+            if (heap%queue(kk)%layer == targetlayer.and.heap%queue(kk)%node == ii) then
+              basefile = heap%queue(kk)%file
+              id_b = kk
+            end if
+          end do
+
+          write (atmp,'(i0)') id_b
+          subdirfile = subdir_tmp//trim(atmp)//'/'//basefile
+          inquire (exist=ex,file=subdirfile)
+          if (ex) then
+            write (stdout,'(a,t26,a,t30,a)',advance='no') &
+              & 'Reading fragment(s) from',':',subdirfile
+            call rdensemble(subdirfile,nall_b,structures_b)
+            write (stdout,'(1x,a,i0,a)') '--> ',nall_b,' structure(s)'
+
+          end if
+          layerfactor_b = 1.0_wp
+
+        else if (jj == 0.and.ii == 2) then
+
+          do kk = 1,heap%nqueue
+            if (heap%queue(kk)%layer == targetlayer.and.heap%queue(kk)%node == ii) then
+              sidefile = heap%queue(kk)%file
+              id_s = kk
+            end if
+          end do
+
+          write (atmp,'(i0)') id_s
+          subdirfile = subdir_tmp//trim(atmp)//'/'//sidefile
+          inquire (exist=ex,file=subdirfile)
+          if (ex) then
+            write (stdout,'(a,t26,a,t30,a)',advance='no') &
+              & 'Reading fragment(s) from',':',subdirfile
+            call rdensemble(subdirfile,nall_s,structures_s)
+            write (stdout,'(1x,a,i0,a)') '--> ',nall_s,' structure(s)'
+          end if
+          layerfactor_s = 1.0_wp
+
+        else
+          call recusrive_construct(env,heap,jj)
+          if (ii == 1) then
+            nall_b = heap%layer(jj)%nmols
+            allocate (structures_b(nall_b))
+            do kk = 1,nall_b
+              structures_b(kk) = heap%layer(jj)%mols(kk)
+            end do
+            layerfactor_b = heap%layer(jj)%inverse_depth
+
+          else if (ii == 2) then
+
+            nall_s = heap%layer(jj)%nmols
+            allocate (structures_s(nall_s))
+            do kk = 1,nall_s
+              structures_s(kk) = heap%layer(jj)%mols(kk)
+            end do
+            layerfactor_s = heap%layer(jj)%inverse_depth
+            !deallocate (heap%layer(jj)%mols)
+          end if
+        end if
+      end do
+      weight_s = layerfactor_s/(layerfactor_s+layerfactor_b)
+      weight_b = layerfactor_b/(layerfactor_s+layerfactor_b)
+
+      write (stdout,*)
+      write (stdout,'(a,i0)') 'Reconstructing layer : ',targetlayer
+      write (stdout,'(2x,a,i0)') 'Base structures         : ',nall_b
+      write (stdout,'(2x,a,i0)') 'Side chain structures   : ',nall_s
+      write (stdout,'(2x,a,es9.2)') 'Max. combinations       : ',real(nall_b,wp)*real(nall_s,wp)
+      write (stdout,'(2x,a,f7.5,a)') 'Similarity threshold    : ',env%rthr,' Å'
+      write (stdout,'(2x,a,f7.5,a)') 'ΔE threshold (ETHR)     : ',env%ethr,' kcal/mol'
+
+      layer%nmols = 0
+      depthlimit = real(env%queue_maxreconstruct,wp)*(env%queue_depthfac**real(targetlayer-1,wp))
+      max_structs = nint(min(real(nall_b,wp)*real(nall_s,wp),depthlimit))
+      allocate (layer%mols(max_structs))
+      write (stdout,'(2x,a,i0)') 'Capping limit           : ',env%queue_maxreconstruct
+      write (stdout,'(2x,a,f4.2,a)') 'Depth factor            : ',env%queue_depthfac,'^(layer-1)'
+      write (stdout,'(2x,a,i0)') 'Max. new structs stored : ',max_structs
+
+      RTHR = env%rthr*aatoau   !> RMSD threshold in Bohr
+      ETHR = env%ethr/autokcal !> deltaE threshold in hartree
+      duplicates = 0
+      T = 1
+      call new_ompautoset(env,'max',max_structs,T,Tn)
+      write (stdout,'(2x,a,i0)') 'OpenMP threads          : ',T
+      allocate (ccache(T))
+      allocate (rcache(T))
+      allocate (moltmp_arr(T))
+      allocate (mask(layer%refmol%nat),source=.true.)
+      call canref%init(layer%refmol,invtype='apsp+',heavy=.false.)
+
+      do tt = 1,T
+        call ccache(tt)%allocate(layer%refmol%nat,scratch=.true.)
+        call rcache(tt)%allocate(layer%refmol%nat)
+        rcache(tt)%stereocheck = .not. (canref%hasstereo(layer%refmol))
+        rcache(tt)%rank(:,1) = canref%rank(:)
+        rcache(tt)%rank(:,2) = canref%rank(:)
+      end do
+      do ii = 1,layer%refmol%nat
+        if (layer%refmol%at(ii) == 1) mask(ii) = .false.
+      end do
+!      write (stdout,'(2x,a)') 'Recombining under heavy-atom RMSD consideration (this may take a while) ... '
+      write (stdout,'(2x,a)') 'Recombining under iRMSD consideration (this may take a while) ... '
+      call progress_init(env%ps,max_structs,width=50,prefix=" ↳ ", &
+        &                suffix="",show_time=.true.,show_eta=.false.)
+      call progress_update(env%ps,0,max_structs)
+
+      call profiler%init(1)
+      call profiler%start(1)
+
+      ! ── Precompute sampling regions ──────────────────────────────
+      !> Region 1 targets max_structs combinations in the correct
+      !> weight ratio.  Regions 2–3 expand into remaining structures.
+      base_is_outer = (nall_b <= nall_s)
+      nregions = 0
+
+      target_bhi = nint(sqrt(real(max_structs,wp)*weight_b/weight_s))
+      target_shi = nint(sqrt(real(max_structs,wp)*weight_s/weight_b))
+
+      reg_blo(1) = 1
+      reg_slo(1) = 1
+      reg_bhi(1) = min(nall_b,target_bhi)
+      reg_shi(1) = min(nall_s,target_shi)
+      !> reciprocal fill if one dimension was capped
+      if (reg_bhi(1) < target_bhi.and.reg_bhi(1) > 0) then
+        reg_shi(1) = min(nall_s,nint(real(max_structs,wp)/real(reg_bhi(1),wp)))
+      else if (reg_shi(1) < target_shi.and.reg_shi(1) > 0) then
+        reg_bhi(1) = min(nall_b,nint(real(max_structs,wp)/real(reg_shi(1),wp)))
+      end if
+      nregions = 1
+
+      !> Region 2: expand whichever dimension wasn't exhausted
+      if (reg_shi(1) == nall_s.and.reg_bhi(1) < nall_b) then
+        nregions = 2
+        reg_blo(2) = reg_bhi(1)+1
+        reg_bhi(2) = nall_b
+        reg_slo(2) = 1
+        reg_shi(2) = nall_s
+      else if (reg_bhi(1) == nall_b.and.reg_shi(1) < nall_s) then
+        nregions = 2
+        reg_blo(2) = 1
+        reg_bhi(2) = nall_b
+        reg_slo(2) = reg_shi(1)+1
+        reg_shi(2) = nall_s
+      else if (reg_bhi(1) < nall_b.and.reg_shi(1) < nall_s) then
+        !> Neither exhausted: expand larger dim first, then the other
+        nregions = 3
+        if (base_is_outer) then
+          reg_blo(2) = 1
+          reg_bhi(2) = reg_bhi(1)
+          reg_slo(2) = reg_shi(1)+1
+          reg_shi(2) = nall_s
+          reg_blo(3) = reg_bhi(1)+1
+          reg_bhi(3) = nall_b
+          reg_slo(3) = 1
+          reg_shi(3) = nall_s
+        else
+          reg_blo(2) = reg_bhi(1)+1
+          reg_bhi(2) = nall_b
+          reg_slo(2) = 1
+          reg_shi(2) = reg_shi(1)
+          reg_blo(3) = 1
+          reg_bhi(3) = nall_b
+          reg_slo(3) = reg_shi(1)+1
+          reg_shi(3) = nall_s
+        end if
+      end if
+
+      ! ── Reconstruct by iterating over regions ───────────────────
+      regionloop: do rg = 1,nregions
+        if (base_is_outer) then
+          outer_lo = reg_blo(rg); outer_hi = reg_bhi(rg)
+          inner_lo = reg_slo(rg); inner_hi = reg_shi(rg)
+        else
+          outer_lo = reg_slo(rg); outer_hi = reg_shi(rg)
+          inner_lo = reg_blo(rg); inner_hi = reg_bhi(rg)
+        end if
+        do outer_idx = outer_lo,outer_hi
+          do inner_idx = inner_lo,inner_hi
+            if (base_is_outer) then
+              ii = outer_idx; jj = inner_idx
+            else
+              ii = inner_idx; jj = outer_idx
+            end if
+
+            call attach(structures_b(ii),structures_s(jj),layer%alignmap,mol, &
+            & remove_lastx=layer%ncapped,original_map=layer%position_mapping, &
+            & clash=clash,reficn=layer%reficn)
+            mol%energy = structures_b(ii)%energy+structures_s(jj)%energy
+            if (.not.clash) then
+              duplicate = .false.
+
+              !$omp parallel &
+              !$omp shared(duplicate,duplicates,mol,ccache,rcache,mask,ETHR,moltmp_arr) &
+              !$omp private(rr,tt,deltaE,rmsval)
+              !$omp do schedule(dynamic)
+              do rr = 1,layer%nmols
+                if (duplicate) cycle
+                tt = omp_get_thread_num()+1
+                deltaE = abs(mol%energy-layer%mols(rr)%energy)
+                if (deltaE < ETHR) then
+                  call moltmp_arr(tt)%copy(layer%mols(rr))
+                  call min_rmsd(mol,moltmp_arr(tt),rcache=rcache(tt),rmsdout=rmsval,align=.false.)
+                  !$omp critical
+                  if (rmsval < RTHR.and..not.duplicate) then
+                    duplicate = .true.
+                    duplicates = duplicates+1
+                  end if
+                  !$omp end critical
+                end if
+              end do
+              !$omp end do
+              !$omp end parallel
+
+              if (.not.duplicate) then
+                layer%nmols = layer%nmols+1
+                layer%mols(layer%nmols) = mol
+                call progress_update(env%ps,layer%nmols,max_structs)
+                if (layer%nmols == max_structs) exit regionloop
+              end if
+            end if
+          end do
+        end do
+      end do regionloop
+      if (layer%nmols < max_structs) then
+        call progress_update(env%ps,1,1)
+      end if
+      call progress_finish(env%ps)
+      write (stdout,'(2x,a)') 'done!'
+      if (duplicates > 0) then
+        write (stdout,'(2x,a,i0)') 'Avoided duplicates       : ',duplicates
+      end if
+      write (stdout,'(2x,a,i0)') 'Successful combinations  : ',layer%nmols
+      call profiler%stop(1)
+      write (btmp,'(2x,a)') 'Total runtime for recombination step:'
+      call profiler%write_timing(stdout,1,trim(btmp),.true.)
+      write (stdout,*)
+
+    end associate
+  end subroutine recusrive_construct
+
+end subroutine crest_queue_reconstruct
+
diff --git a/src/algos/refine.f90 b/src/algos/refine.f90
index 71a96b28..59a13d8d 100644
--- a/src/algos/refine.f90
+++ b/src/algos/refine.f90
@@ -49,6 +49,7 @@ subroutine crest_refine(env,input,output)
   real(wp),allocatable :: xyz(:,:,:)
   integer,allocatable  :: at(:)
   integer :: nrefine,refine_stage
+  type(coord),allocatable :: structures(:)
 !===========================================================!
 !>--- setup
   if (present(output)) then
@@ -56,20 +57,33 @@ subroutine crest_refine(env,input,output)
   else
     outname = input  !> overwrite
   end if
- 
+
+  if(.not.allocated(env%refine_queue))then
+    call rename(trim(input),trim(output))
+    return
+  endif
+
 !>--- presorting step, if necessary
-  if(env%refine_presort)then
+  if (env%refine_presort) then
     call newcregen(env,0,input)
     call rename('crest_ensemble.xyz',input)
-  endif
+  end if
 
 !>--- read in
-  call rdensemble(input,nat,nall,at,xyz,eread)
-  allocate (etmp(nall),source=0.0_wp)
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
-!>--- Important: crest_sploop requires coordinates in Bohrs
-    xyz = xyz / bohr
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!  call rdensemble(input,nat,nall,at,xyz,eread)
+!  allocate (etmp(nall),source=0.0_wp)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!!>--- Important: crest_sploop requires coordinates in Bohrs
+!  xyz = xyz/bohr
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+  call rdensembleparam(input,nat,nall)
+  allocate (xyz(3,nat,nall),at(nat),etmp(nall),eread(nall))
+  call rdensemble(input,nall,structures)
+  at(:) = structures(1)%at(:)
+  do j = 1,nall
+    eread(j) = structures(j)%energy
+    xyz(1:3,1:nat,j) = structures(j)%xyz(1:3,1:nat)
+  end do
 
 !===========================================================!
   DO_REFINE: if (allocated(env%refine_queue)) then
@@ -98,15 +112,13 @@ subroutine crest_refine(env,input,output)
         write (stdout,'("> Geometry optimization of ",i0," structures")') nall
         call crest_oloop(env,nat,nall,at,xyz,eread,.false.)
 
-      case(refine%confsolv)
-        call new_ompautoset(env,'subprocess',1,t1,t2)
-        write (stdout,'("> ConfSolv: ΔΔGsoln estimation from 3D directed message passing neural networks (D-MPNN)")')
-        call confsolv_request( input, nall, t2, etmp, io)
-        if(io == 0)then
-        eread(:) = etmp(:)*kcaltoau  !> since CREGEN deals with Eh energies
-        endif   
+      case (refine%deltaG)
+        write (stdout,'("> Free energy correction (δG) for ",i0," structures")') nall
+        call crest_hessloop(env,nat,nall,at,xyz,etmp)
+        eread(:) = eread(:)+etmp(:)
+
       end select
-      write(stdout,*) 
+      write (stdout,*)
     end do
 
     !> reset the refinement stage of the calculator
@@ -116,15 +128,17 @@ subroutine crest_refine(env,input,output)
   end if DO_REFINE
 !===========================================================!
 
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
-!>--- Important: ensemble file must be written in AA
-  xyz = xyz / angstrom
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
-!>--- write output ensemble
-  call wrensemble(outname,nat,nall,at,xyz,eread)
+!>--- sync refined energies and coordinates back into coord structures
+  do j = 1,nall
+    structures(j)%energy = eread(j)
+    structures(j)%xyz(1:3,1:nat) = xyz(1:3,1:nat,j)
+    structures(j)%wrextxyz = .true.
+  end do
+!>--- write output ensemble in extxyz format
+  call wrensemble(outname,nall,structures)
 
 !===========================================================!
-  deallocate (etmp,eread,xyz,at)
+  deallocate (etmp,eread,xyz,at,structures)
   return
 end subroutine crest_refine
 !========================================================================================!
diff --git a/src/algos/scan.f90 b/src/algos/scan.f90
index 0a40d94d..2460aadf 100644
--- a/src/algos/scan.f90
+++ b/src/algos/scan.f90
@@ -74,7 +74,7 @@ subroutine crest_scan(env,tim)
 
 !========================================================================================!
   allocate (grad(3,mol%nat),source=0.0_wp)
-  calc = env%calc
+  call calc%copy(env%calc)
   calcclean = env%calc
 
   !>--- initialize scanning
@@ -190,8 +190,6 @@ subroutine initscans(mol,calc)
       deallocate (tmppoints)
     end do
 
-    write(*,*) 'constraints',calc%nconstraints
-
     !>--- set calculations to 1 for the geometry generation
     calc%ncalculations = 1
 
@@ -287,7 +285,7 @@ recursive subroutine runscan(mol,calc,calcclean,current)
     allocate (grad(3,mol%nat),source=0.0_wp)
     !>-- geometry optimization
     pr = .false. !> stdout printout
-    wr = .true. !> write crestopt.log
+    wr = .true. !> write crestopt.log.xyz
     molbackup = mol
     do j=1,calc%scans(current)%steps 
       !write(*,*) current, calc%scans(current)%steps, j
diff --git a/src/algos/search_1.f90 b/src/algos/search_1.f90
index 8b4d9ae9..ece172ff 100644
--- a/src/algos/search_1.f90
+++ b/src/algos/search_1.f90
@@ -43,7 +43,7 @@ subroutine crest_search_1(env,tim)
   real(wp),allocatable :: eread(:)
   real(wp),allocatable :: xyz(:,:,:)
   integer,allocatable  :: at(:)
-  logical :: dump
+  logical :: dump,doreturn
 
 !===========================================================!
 !>--- printout header
@@ -61,10 +61,8 @@ subroutine crest_search_1(env,tim)
   write (stdout,*)
 
 !>--- saftey termination
-  if(mol%nat .le. 2)then
-     call catchdiatomic(env)
-    return
-  endif
+  call crest_sampling_skip(env,doreturn)
+  if (doreturn) return
 
 !===========================================================!
 !>--- Dynamics
@@ -82,8 +80,8 @@ subroutine crest_search_1(env,tim)
   call tim%start(2,'Molecular dynamics (MD)')
   call crest_search_multimd(env,mol,mddats,nsim)
   call tim%stop(2)
-!>--- a file called crest_dynamics.trj should have been written
-  ensnam = 'crest_dynamics.trj'
+!>--- a file called crest_dynamics.trj.xyz should have been written
+  ensnam = 'crest_dynamics.trj.xyz'
 
 !==========================================================!
 !>--- Reoptimization of trajectories
diff --git a/src/algos/search_conformers.f90 b/src/algos/search_conformers.f90
index abf606d5..0e24d617 100644
--- a/src/algos/search_conformers.f90
+++ b/src/algos/search_conformers.f90
@@ -20,12 +20,12 @@
 subroutine crest_search_imtdgc(env,tim)
 !*******************************************************************
 !* This is the re-implementation of CREST's iMTD-GC default workflow
-!* 
+!*
 !* Compared to the legacy implementation, this version
 !* is separated from the entropy algo to keep things clean
 !* The entropy algo (sMTD-iMTD) can be found in search_entropy.f90
 !*******************************************************************
-  use crest_parameters, only: wp,stdout
+  use crest_parameters,only:wp,stdout
   use crest_data
   use crest_calculator
   use strucrd
@@ -34,12 +34,13 @@ subroutine crest_search_imtdgc(env,tim)
   use iomod
   use utilities
   use cregen_interface
+  use crest_restartlog
   implicit none
   type(systemdata),intent(inout) :: env
   type(timer),intent(inout)      :: tim
   type(coord) :: mol,molnew
   integer :: i,j,k,l,io,ich,m
-  logical :: pr,wr
+  logical :: pr,wr,doreturn
 !===========================================================!
   type(calcdata) :: calc
   type(mddata) :: mddat
@@ -59,6 +60,9 @@ subroutine crest_search_imtdgc(env,tim)
   character(len=80) :: atmp,btmp,str
   logical :: multilevel(6)
   logical :: start,lower
+!===========================================================!
+  type(restart_data) :: rdat
+  logical :: do_restart,skip_mtdloop,skip_collect,firstiter,fex
 !===========================================================!
 !>--- printout header
   write (stdout,*)
@@ -67,6 +71,21 @@ subroutine crest_search_imtdgc(env,tim)
   write (stdout,'(10x,"┕",49("━"),"┙")')
   write (stdout,*)
 
+! ── restart detection ─────────────────────────────────────────────
+  do_restart = .false.
+  skip_mtdloop = .false.
+  skip_collect = .false.
+  if (env%allowrestart .and. restart_file_exists()) then
+    call read_restart_log(rdat)
+    if (rdat%runtype == crest_imtd .and. rdat%stage /= 'done') then
+      do_restart = .true.
+      call print_restart_info(rdat)
+      !> skip entire mtdloop and collectcre only when past the MTD loop
+      skip_mtdloop = (rdat%stage == 'post_collect')
+      skip_collect = (rdat%stage == 'post_collect')
+    end if
+  end if
+
 !===========================================================!
 !>--- setup
   call env%ref%to(mol)
@@ -74,140 +93,191 @@ subroutine crest_search_imtdgc(env,tim)
   call mol%append(stdout)
   write (stdout,*)
 
-!>--- saftey termination
-  if(mol%nat .le. 2)then
-     call catchdiatomic(env)
-    return
-  endif
+!>--- saftey terminations
+  call crest_sampling_skip(env,doreturn)
+  if (doreturn) return
 
 !>--- sets the MD length according to a flexibility measure
-  call md_length_setup(env) 
+  call md_length_setup(env)
 !>--- create the MD calculator saved to env
   call env_to_mddat(env)
 
   if (env%performMTD) then
 !>--- (optional) calculate a short 1ps test MTD to check settings
-   call tim%start(1,'Trial metadynamics (MTD)')
-   call trialmd(env)  
-   call tim%stop(1)
-   if(env%iostatus_meta .ne. 0 ) return
+    call tim%start(1,'Trial metadynamics (MTD)')
+    call trialmd(env)
+    call tim%stop(1)
+    if (env%iostatus_meta .ne. 0) return
   end if
 
 !===========================================================!
-!>--- Start mainloop 
+!>--- Start mainloop
   env%nreset = 0
   start = .true.
-  MAINLOOP : do
+! ── apply restart state ───────────────────────────────────────────
+  if (do_restart) then
+    env%nreset   = rdat%main_iter
+    env%elowest  = rdat%elowest
+    env%eprivious = rdat%eprivious
+    env%nmetadyn = rdat%nmetadyn
+    start = .false.
+  end if
+  MAINLOOP: do
     call printiter
-    if (.not. start) then
+    if (do_restart) then
+!>--- restart: preserve .cre_*.xyz files, skip cleanup
+      continue
+    else if (.not.start) then
 !>--- clean Dir for new iterations, but leave iteration backup files
-      call clean_V2i 
-      env%nreset = env%nreset + 1
-    else 
+      call clean_V2i
+      env%nreset = env%nreset+1
+    else
 !>--- at the beginning, wipe directory clean
       call V2cleanup(.false.)
     end if
 !===========================================================!
-!>--- Meta-dynamics loop
-  mtdloop: do i = 1,env%Maxrestart
-
-    write(stdout,*)
-    write(stdout,'(1x,a)') '------------------------------'
-    write(stdout,'(1x,a,i0)') 'Meta-Dynamics Iteration ',i
-    write(stdout,'(1x,a)') '------------------------------'
-
-    nsim = -1 !>--- enambles automatic MTD setup in init routines
-    call crest_search_multimd_init(env,mol,mddat,nsim)
-    allocate (mddats(nsim), source=mddat)
-    call crest_search_multimd_init2(env,mddats,nsim)
-
-    call tim%start(2,'Metadynamics (MTD)')
-    call crest_search_multimd(env,mol,mddats,nsim)
-    call tim%stop(2)
-!>--- a file called crest_dynamics.trj should have been written
-    ensnam = 'crest_dynamics.trj'
-!>--- deallocate for next iteration
-    if(allocated(mddats))deallocate(mddats)
+!>--- Meta-dynamics loop (skipped on restart to use existing .cre_*.xyz)
+    if (.not.skip_mtdloop) then
+    mtdloop: do i = 1,env%Maxrestart
+
+! ── restart: skip based on stage ──────────────────────────────────
+      if (do_restart) then
+        if (rdat%stage == 'mtd_loop' .and. i <= rdat%mtd_iter) cycle mtdloop
+        if (rdat%stage == 'mtd_trj'  .and. i <  rdat%mtd_iter) cycle mtdloop
+      end if
+
+      write (stdout,*)
+      write (stdout,'(1x,a)') '------------------------------'
+      write (stdout,'(1x,a,i0)') 'Meta-Dynamics Iteration ',i
+      write (stdout,'(1x,a)') '------------------------------'
+
+!==========================================================!
+!>--- MTD run (skipped for mtd_trj restart: trajectory already exists)
+      if (do_restart .and. i == rdat%mtd_iter .and. &
+        &  rdat%stage == 'mtd_trj') then
+        write (stdout,'(1x,a,i0,a)') 'Restarting iteration ',i, &
+          & ' from existing trajectory/ensemble'
+        ensnam = trim(rdat%last_file)
+      else
+        nsim = -1 !>--- enambles automatic MTD setup in init routines
+        call crest_search_multimd_init(env,mol,mddat,nsim)
+        allocate (mddats(nsim),source=mddat)
+        call crest_search_multimd_init2(env,mddats,nsim)
+
+        call tim%start(2,'Metadynamics (MTD)')
+        call crest_search_multimd(env,mol,mddats,nsim)
+        call tim%stop(2)
+!>--- a file called crest_dynamics.trj.xyz should have been written
+        ensnam = 'crest_dynamics.trj.xyz'
+        if (allocated(mddats)) deallocate (mddats)
+!>--- checkpoint: trajectory ready, optimization about to start
+        call write_restart_log(crest_imtd,'mtd_trj',env%nreset,i, &
+          &  env%nmetadyn,env%elowest,env%eprivious,ensnam)
+      end if
 
 !==========================================================!
 !>--- Reoptimization of trajectories
-    call tim%start(3,'Geometry optimization')
-    call optlev_to_multilev(env%optlev,multilevel)
-    call crest_multilevel_oloop(env,ensnam,multilevel)
-    call tim%stop(3)
-    if(env%iostatus_meta .ne. 0 ) return
+      call tim%start(3,'Geometry optimization')
+      call optlev_to_multilev(env%optlev,multilevel)
+      call crest_multilevel_oloop(env,ensnam,multilevel,i)
+      call tim%stop(3)
+      if (env%iostatus_meta .ne. 0) return
 
 !>--- save the CRE under a backup name
-    call checkname_xyz(crefile,atmp,str)
-    call checkname_xyz('.cre',str,btmp)
-    call rename(atmp,btmp)
+      call checkname_xyz(crefile,atmp,str)
+      call checkname_xyz('.cre',str,btmp)
+      call rename(atmp,btmp)
 !>--- save cregen output
-    call checkname_tmp('cregen',atmp,btmp)
-    call rename('cregen.out.tmp',btmp)
+      call checkname_tmp('cregen',atmp,btmp)
+      call rename('cregen.out.tmp',btmp)
 
 !=========================================================!
-!>--- cleanup after first iteration and prepare next
-    if (i .eq. 1 .and. start) then
-      start = .false.
+!>--- cleanup and state update after first iteration (before checkpoint)
+      firstiter = (i .eq. 1 .and. start)
+      if (firstiter) then
+        start = .false.
 !>-- obtain a first lowest energy as reference
-      env%eprivious = env%elowest
+        env%eprivious = env%elowest
 !>-- remove the two extreme-value MTDs
-      if (.not. env%readbias .and.  env%runver .ne. 33 .and. &
-      &   env%runver .ne. 787878 ) then
-        env%nmetadyn = env%nmetadyn - 2
+        if (.not.env%readbias.and.env%runver .ne. 33.and. &
+        &   env%runver .ne. 787878) then
+          env%nmetadyn = env%nmetadyn-2
+        end if
+!>-- the cleanup
+        call clean_V2i
       end if
-!>-- the cleanup 
-      call clean_V2i   
-!>-- and always do two cycles of MTDs
-      cycle mtdloop 
-    endif
+!>--- checkpoint after this MTD iteration (nmetadyn already updated above)
+      call write_restart_log(crest_imtd,'mtd_loop',env%nreset,i, &
+        &  env%nmetadyn,env%elowest,env%eprivious,trim(str))
+!>-- always do two cycles of MTDs
+      if (firstiter) cycle mtdloop
 !=========================================================!
 !>--- Check for lowest energy
-    call elowcheck(lower,env)
-    if (.not. lower) then
-      exit mtdloop
-    end if
-  enddo mtdloop
+      call elowcheck(lower,env)
+      if (.not.lower) then
+        exit mtdloop
+      end if
+    end do mtdloop
+    end if !> end skip_mtdloop guard
+    skip_mtdloop = .false.
+    do_restart = .false.
 !=========================================================!
 !>--- collect all ensembles from mtdloop and merge
-  write(stdout,*)
-  write (stdout,'(''========================================'')')
-  write (stdout,'(''           MTD Simulations done         '')')
-  write (stdout,'(''========================================'')')
-  write (stdout,'(1x,''Collecting ensmbles.'')')
+    if (skip_collect) then
+!>--- post_collect restart: collectcre already ran, reuse last file
+      inquire(file=trim(rdat%last_file),exist=fex)
+      if (.not.fex) then
+        write (stdout,'(/,a)') '**ERROR** restart ensemble not found: ' &
+          &  //trim(rdat%last_file)
+        write (stdout,'(a,/)') ' Delete crest.restart and rerun from scratch.'
+        call creststop(status_safety)
+      end if
+      atmp = trim(rdat%last_file)
+      write (stdout,'(1x,a,a)') 'Restarting from ensemble: ',trim(atmp)
+      skip_collect = .false.
+    else
+      write (stdout,*)
+      write (stdout,'(''========================================'')')
+      write (stdout,'(''           MTD Simulations done         '')')
+      write (stdout,'(''========================================'')')
+      write (stdout,'(1x,''Collecting ensmbles.'')')
 !>-- collecting all ensembles saved as ".cre_*.xyz"
-  call collectcre(env)                      
-  call newcregen(env,0)
-  call checkname_xyz(crefile,atmp,btmp)
+      call collectcre(env)
+      call newcregen(env,0)
+      call checkname_xyz(crefile,atmp,btmp)
+!>--- checkpoint after collection and CREGEN
+      call write_restart_log(crest_imtd,'post_collect',env%nreset,0, &
+        &  env%nmetadyn,env%elowest,env%eprivious,trim(atmp))
+    end if
 !>--- remaining number of structures
-  call remaining_in(atmp,env%ewin,nallout) 
+    call remaining_in(atmp,env%ewin,nallout)
 
 !=========================================================!
 !>--- (optional) Perform additional MDs on the lowest conformers
-  if (env%rotamermds) then
-    call tim%start(4,'Molecular dynamics (MD)')
-    call crest_rotamermds(env,conformerfile)
-    call tim%stop(4)
-    if(env%iostatus_meta .ne. 0 ) return
+    if (env%rotamermds) then
+      call tim%start(4,'Molecular dynamics (MD)')
+      call crest_rotamermds(env,conformerfile)
+      call tim%stop(4)
+      if (env%iostatus_meta .ne. 0) return
 
 !>--- Reoptimization of trajectories
-    call checkname_xyz(crefile,atmp,btmp)
-    write(stdout,'('' Appending file '',a,'' with new structures'')')trim(atmp)
-    ensnam = 'crest_dynamics.trj'
-    call appendto(ensnam,trim(atmp))
-    call tim%start(3,'Geometry optimization')
-    call crest_multilevel_wrap(env,trim(atmp),-1)
-    call tim%stop(3)
-    if(env%iostatus_meta .ne. 0 ) return
-
-    call elowcheck(lower,env)
-    if (lower) then
-      call checkname_xyz(crefile,atmp,str)
-      call checkname_xyz('.cre',str,btmp)
-      call rename(atmp,btmp)
-      cycle MAINLOOP
+      call checkname_xyz(crefile,atmp,btmp)
+      write (stdout,'('' Appending file '',a,'' with new structures'')') trim(atmp)
+      ensnam = 'crest_dynamics.trj.xyz'
+      call appendto(ensnam,trim(atmp))
+      call tim%start(3,'Geometry optimization')
+      call crest_multilevel_wrap(env,trim(atmp),-1)
+      call tim%stop(3)
+      if (env%iostatus_meta .ne. 0) return
+
+      call elowcheck(lower,env)
+      if (lower) then
+        call checkname_xyz(crefile,atmp,str)
+        call checkname_xyz('.cre',str,btmp)
+        call rename(atmp,btmp)
+        cycle MAINLOOP
+      end if
     end if
-  end if
 
 !=========================================================!
 !>--- (optional) Perform GC step
@@ -215,7 +285,7 @@ subroutine crest_search_imtdgc(env,tim)
       call tim%start(5,'Genetic crossing (GC)')
       call crest_newcross3(env)
       call tim%stop(5)
-      if(env%iostatus_meta .ne. 0 ) return
+      if (env%iostatus_meta .ne. 0) return
 
       call confg_chk3(env)
       call elowcheck(lower,env)
@@ -229,32 +299,37 @@ subroutine crest_search_imtdgc(env,tim)
 
 !==========================================================!
 !>--- exit mainloop
-   exit MAINLOOP
-  enddo MAINLOOP
+    exit MAINLOOP
+  end do MAINLOOP
 
 !==========================================================!
 !>--- final ensemble optimization
-    write (stdout,'(/)')
-    write (stdout,'(3x,''================================================'')')
-    write (stdout,'(3x,''|           Final Geometry Optimization        |'')')
-    write (stdout,'(3x,''================================================'')')
-    call tim%start(3,'Geometry optimization')
-    call checkname_xyz(crefile,atmp,str)
-    call crest_multilevel_wrap(env,trim(atmp),0) 
-    call tim%stop(3)                 
-    if(env%iostatus_meta .ne. 0 ) return
+  write (stdout,'(/)')
+  write (stdout,'(3x,''================================================'')')
+  write (stdout,'(3x,''|           Final Geometry Optimization        |'')')
+  write (stdout,'(3x,''================================================'')')
+  call tim%start(3,'Geometry optimization')
+  call checkname_xyz(crefile,atmp,str)
+  call crest_multilevel_wrap(env,trim(atmp),0)
+  call tim%stop(3)
+  if (env%iostatus_meta .ne. 0) return
+
+!==========================================================!
+!>--- checkpoint: run is complete
+  call write_restart_log(crest_imtd,'done',env%nreset,0, &
+    &  env%nmetadyn,env%elowest,env%eprivious,conformerfile)
 
 !==========================================================!
 !>--- final ensemble sorting
-!  call newcregen(env,0) 
+!  call newcregen(env,0)
 !> this is actually done within the last crest_multilevel_
 !> call, so I comment it out here
 
 !==========================================================!
 !>--- print CREGEN results and clean up Directory a bit
-    write (stdout,'(/)')
-    call smallhead('Final Ensemble Information')
-    call V2terminating()
+  write (stdout,'(/)')
+  call smallhead('Final Ensemble Information')
+  call V2terminating()
 
 !==========================================================!
   return
@@ -269,7 +344,7 @@ subroutine crest_multilevel_wrap(env,ensnam,level)
 !* wrapper for the multilevel_oloop to select
 !* only a single optimization level
 !*************************************************
-  use crest_parameters, only: wp,stdout,bohr
+  use crest_parameters,only:wp,stdout,bohr
   use crest_data
   use crest_calculator
   use strucrd
@@ -280,52 +355,56 @@ subroutine crest_multilevel_wrap(env,ensnam,level)
   logical :: multilevel(6)
   integer :: k
   multilevel = .false.
-  select case(level)
-  case( 1: ) !> explicit selection (level is a positie integer)
-    k = min(level,6) 
-    multilevel(k) =.true.
-  case default 
-  !>-- map global variable to multilevel selection (level is 0 or negative)
-    k = optlevmap_alt(env%optlev) + level
+  select case (level)
+  case (1:) !> explicit selection (level is a positie integer)
+    k = min(level,6)
+    multilevel(k) = .true.
+  case default
+    !>-- map global variable to multilevel selection (level is 0 or negative)
+    k = optlevmap_alt(env%optlev)+level
     k = max(1,k)
-    multilevel(k) =.true.
+    multilevel(k) = .true.
   end select
-  call crest_multilevel_oloop(env,ensnam,multilevel)
+  call crest_multilevel_oloop(env,ensnam,multilevel,0)
 end subroutine crest_multilevel_wrap
 
 !========================================================================================!
-subroutine crest_multilevel_oloop(env,ensnam,multilevel_in)
+subroutine crest_multilevel_oloop(env,ensnam,multilevel_in,mtd_iter_in)
 !*******************************************************
 !* multilevel optimization loop.
 !* construct consecutive optimizations starting with
-!* crude thresholds to very tight ones
+!* crude thresholds to very tight ones.
+!* mtd_iter_in: when > 0, writes a mtd_trj restart
+!* checkpoint after each CREGEN step (pass 0 to skip).
 !*******************************************************
-  use crest_parameters, only: wp,stdout,bohr
+  use crest_parameters,only:wp,stdout,bohr
   use crest_data
   use crest_calculator
   use strucrd
   use optimize_module
   use utilities
-  use crest_restartlog
   use parallel_interface
+  use crest_restartlog
   implicit none
-  type(systemdata) :: env 
+  type(systemdata) :: env
   character(len=*),intent(in) :: ensnam
   logical,intent(in) :: multilevel_in(6)
+  integer,intent(in) :: mtd_iter_in
   integer :: nat,nall
   real(wp),allocatable :: eread(:)
   real(wp),allocatable :: xyz(:,:,:)
   integer,allocatable  :: at(:)
   logical :: dump,pr
   character(len=128) :: inpnam,outnam
-  integer :: i,l,k,T,Tn
+  integer :: i,l,k,T,Tn,j
   real(wp) :: ewinbackup,rthrbackup
   real(wp) :: hlowbackup
   integer :: microbackup
   integer :: optlevelbackup
   logical :: multilevel(6)
+  type(coord),allocatable :: structures(:)
 
-  interface 
+  interface
     subroutine crest_refine(env,input,output)
       use crest_data
       implicit none
@@ -336,151 +415,171 @@ end subroutine crest_refine
   end interface
 
 !>--- save backup thresholds
-  ewinbackup     = env%ewin
-  rthrbackup     = env%rthr
+  ewinbackup = env%ewin
+  rthrbackup = env%rthr
   optlevelbackup = env%calc%optlev
-  hlowbackup     = env%calc%hlow_opt
-  microbackup    = env%calc%micro_opt
+  hlowbackup = env%calc%hlow_opt
+  microbackup = env%calc%micro_opt
 
 !>--- set multilevels, or enforce just one
   multilevel(:) = .false.
-  if(env%multilevelopt)then
-     multilevel(:) = multilevel_in(:)    
+  if (env%multilevelopt) then
+    multilevel(:) = multilevel_in(:)
   else
     k = optlevmap_alt(env%optlev)
     multilevel(k) = .true.
-  endif
+  end if
 
   pr = .false.
   l = count(multilevel)
-  if( l > 1 )then
-  pr = .true.
-  write(stdout,*)
-  write(stdout,'(1x,a)') '======================================'
-  write(stdout,'(1x,a)') '|  Multilevel Ensemble Optimization  |'
-  write(stdout,'(1x,a)') '======================================'
-  endif
-  
+  if (l > 1) then
+    pr = .true.
+    write (stdout,*)
+    write (stdout,'(1x,a)') '======================================'
+    write (stdout,'(1x,a)') '|  Multilevel Ensemble Optimization  |'
+    write (stdout,'(1x,a)') '======================================'
+  end if
+
 !>--- read ensemble
   call rdensembleparam(ensnam,nat,nall)
   if (nall .lt. 1) then
-    write(stdout,*) '**ERROR** empty ensemble file ',trim(ensnam)
+    write (stdout,*) '**ERROR** empty ensemble file ',trim(ensnam)
     env%iostatus_meta = status_failed
     return
-  endif
+  end if
   allocate (xyz(3,nat,nall),at(nat),eread(nall))
-  call rdensemble(ensnam,nat,nall,at,xyz,eread)
-!>--- track ensemble for restart
-  call trackensemble(ensnam,nat,nall,at,xyz,eread)
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
-!>--- Important: crest_oloop requires coordinates in Bohrs
-  xyz = xyz / bohr
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!  call rdensemble(ensnam,nat,nall,at,xyz,eread)
+!!>--- track ensemble for restart
+!  !call trackensemble(ensnam,nat,nall,at,xyz,eread)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!!>--- Important: crest_oloop requires coordinates in Bohrs
+!  xyz = xyz/bohr
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+  call rdensemble(ensnam,nall,structures)
+  at(:) = structures(1)%at(:)
+  do j = 1,nall
+    eread(j) = structures(j)%energy
+    xyz(1:3,1:nat,j) = structures(j)%xyz(1:3,1:nat)
+  end do
+  deallocate (structures)
 
-  write(stdout,'(1x,a,i0,a,a,a)')'Optimizing all ',nall, &
+  write (stdout,'(1x,a,i0,a,a,a)') 'Optimizing all ',nall, &
   & ' structures from file "',trim(ensnam),'" ...'
 
 !>--- sequential optimizations of ensembles
   dump = .true. !> optimized structures will be written to crest_ensemble.xyz
-  do i=1,6
-    if(multilevel(i))then
-     !>--- set threads
-       call new_ompautoset(env,'auto',nall,T,Tn)
-     !>--- set optimization parameters
-       call set_multilevel_options(env,i,.true.)
-     !>--- run parallel optimizations
-       call crest_oloop(env,nat,nall,at,xyz,eread,dump)
-       deallocate(eread,at,xyz)
-     !>--- rename ensemble and sort
-       call checkname_xyz(crefile,inpnam,outnam)
-       call rename(ensemblefile,trim(inpnam))
-     !>--- check for empty ensemble content
-       call rdensembleparam(trim(inpnam),nat,nall)
-       if (nall .lt. 1) then
-         write(stdout,*) '**ERROR** empty ensemble file',trim(inpnam)
-         env%iostatus_meta = status_failed
-         return
-       endif
-
-       write(stdout,*)
-     !==========================================================!
-     !>-- dedicated ensemble refinement step (overwrites inpnam)
-      call  crest_refine(env,trim(inpnam))
-     !==========================================================!
-
-     !>--- CREGEN sorting
-       call sort_and_check(env,trim(inpnam))
-       call checkname_xyz(crefile,inpnam,outnam)
-     !>--- check for empty ensemble content (again)
-       call rdensembleparam(trim(inpnam),nat,nall)
-       if (nall .lt. 1) then
-         write(stdout,*) '**ERROR** empty ensemble file',trim(inpnam)
-         env%iostatus_meta = status_failed
-         return
-       endif
-     !>--- read new ensemble for next iteration
-       allocate (xyz(3,nat,nall),at(nat),eread(nall))
-       call rdensemble(trim(inpnam),nat,nall,at,xyz,eread)
-     !>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
-     !>--- Important: crest_oloop requires coordinates in Bohrs
-       xyz = xyz / bohr
-     !>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
-     !>--- restore default sorting thresholds
-       env%ewin        = ewinbackup
-       env%rthr        = rthrbackup
-       env%calc%optlev = optlevelbackup
-       env%calc%hlow_opt  = hlowbackup
-       env%calc%micro_opt = microbackup
-    endif
-  enddo
-
-  if(allocated(eread)) deallocate(eread)
-  if(allocated(at))  deallocate(at)
-  if(allocated(xyz)) deallocate(xyz)
+  do i = 1,6
+    if (multilevel(i)) then
+      !>--- set threads
+      call new_ompautoset(env,'auto',nall,T,Tn)
+      !>--- set optimization parameters
+      call set_multilevel_options(env,i,.true.)
+      !>--- run parallel optimizations
+      call crest_oloop(env,nat,nall,at,xyz,eread,dump)
+      deallocate (eread,at,xyz)
+      !>--- rename ensemble and sort
+      call checkname_xyz(crefile,inpnam,outnam)
+      call rename(ensemblefile,trim(inpnam))
+      !>--- check for empty ensemble content
+      call rdensembleparam(trim(inpnam),nat,nall)
+      if (nall .lt. 1) then
+        write (stdout,*) '**ERROR** empty ensemble file',trim(inpnam)
+        env%iostatus_meta = status_failed
+        return
+      end if
+
+      write (stdout,*)
+      !==========================================================!
+      !>-- dedicated ensemble refinement step (overwrites inpnam)
+      call crest_refine(env,trim(inpnam))
+      !==========================================================!
+
+      !>--- CREGEN sorting
+      call sort_and_check(env,trim(inpnam))
+      call checkname_xyz(crefile,inpnam,outnam)
+! ── restart checkpoint: intermediate ensemble after this opt. level ──
+      if (mtd_iter_in > 0) then
+        call write_restart_log(env%crestver,'mtd_trj',env%nreset, &
+          &  mtd_iter_in,env%nmetadyn,env%elowest,env%eprivious,trim(inpnam))
+      end if
+      !>--- check for empty ensemble content (again)
+      call rdensembleparam(trim(inpnam),nat,nall)
+      if (nall .lt. 1) then
+        write (stdout,*) '**ERROR** empty ensemble file',trim(inpnam)
+        env%iostatus_meta = status_failed
+        return
+      end if
+      !>--- read new ensemble for next iteration
+      allocate (xyz(3,nat,nall),at(nat),eread(nall))
+      !call rdensemble(trim(inpnam),nat,nall,at,xyz,eread)
+      !!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+      !!>--- Important: crest_oloop requires coordinates in Bohrs
+      !xyz = xyz/bohr
+      !!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+      call rdensemble(trim(inpnam),nall,structures)
+      at(:) = structures(1)%at(:)
+      do j = 1,nall
+        eread(j) = structures(j)%energy
+        xyz(1:3,1:nat,j) = structures(j)%xyz(1:3,1:nat)
+      end do
+      deallocate (structures)
+
+      !>--- restore default sorting thresholds
+      env%ewin = ewinbackup
+      env%rthr = rthrbackup
+      env%calc%optlev = optlevelbackup
+      env%calc%hlow_opt = hlowbackup
+      env%calc%micro_opt = microbackup
+    end if
+  end do
+
+  if (allocated(eread)) deallocate (eread)
+  if (allocated(at)) deallocate (at)
+  if (allocated(xyz)) deallocate (xyz)
   return
 contains
   subroutine set_multilevel_options(env,i,pr)
     implicit none
     type(systemdata) :: env
     integer,intent(in) :: i
-    logical,intent(in) :: pr 
+    logical,intent(in) :: pr
 
-    env%calc%hlow_opt  = env%hlowopt
+    env%calc%hlow_opt = env%hlowopt
     env%calc%micro_opt = nint(env%microopt)
 
-    select case( i )  
-    case( 1 )
-     if(pr) call smallhead('crude pre-optimization')
-     env%calc%optlev =  -3
-     !> larger thresholds
-     env%rthr = env%rthr * 2.0d0
-     env%ewin = aint(env%ewin * 2.0d0)
-    case( 2 )
-     if(pr) call smallhead('optimization with very loose thresholds')
-     env%calc%optlev =  -2
-     env%rthr = env%rthr *1.5d0
-     env%ewin = aint(env%ewin * 2.0d0)
-    case( 3 )
-     if(pr) call smallhead('optimization with loose thresholds')
-     env%calc%optlev =  -1
+    select case (i)
+    case (1)
+      if (pr) call smallhead('crude pre-optimization')
+      env%calc%optlev = -3
+      !> larger thresholds
+      env%rthr = env%rthr*2.0d0
+      env%ewin = aint(env%ewin*2.0d0)
+    case (2)
+      if (pr) call smallhead('optimization with very loose thresholds')
+      env%calc%optlev = -2
+      env%rthr = env%rthr*1.5d0
+      env%ewin = aint(env%ewin*2.0d0)
+    case (3)
+      if (pr) call smallhead('optimization with loose thresholds')
+      env%calc%optlev = -1
       env%ewin = aint(env%ewin*(10.0d0/6.0d0))
-    case( 4 )
-     if(pr) call smallhead('optimization with regular thresholds')
-     env%calc%optlev =  0
-    case( 5 )
-     if(pr) call smallhead('optimization with tight thresholds')
-     env%calc%optlev =  1
-    case( 6 )
-     if(pr) call smallhead('optimization with very tight thresholds')
-     env%calc%optlev =  2
+    case (4)
+      if (pr) call smallhead('optimization with regular thresholds')
+      env%calc%optlev = 0
+    case (5)
+      if (pr) call smallhead('optimization with tight thresholds')
+      env%calc%optlev = 1
+    case (6)
+      if (pr) call smallhead('optimization with very tight thresholds')
+      env%calc%optlev = 2
     case default
-     if(pr) call smallhead('optimization with default thresholds')
-     env%ewin        = 6.0_wp
-     env%rthr        = 0.125_wp
-     env%calc%optlev = 0
+      if (pr) call smallhead('optimization with default thresholds')
+      env%ewin = 6.0_wp
+      env%rthr = 0.125_wp
+      env%calc%optlev = 0
     end select
 
-    call print_opt_data(env%calc, stdout)
+    call print_opt_data(env%calc,stdout,natoms=env%ref%nat)
 
   end subroutine set_multilevel_options
 end subroutine crest_multilevel_oloop
@@ -491,7 +590,7 @@ subroutine crest_rotamermds(env,ensnam)
 !* set up and perform several MDs at different temperatures
 !* on the lowest few conformers
 !***********************************************************
-  use crest_parameters, only: wp,stdout,bohr
+  use crest_parameters,only:wp,stdout,bohr
   use crest_data
   use crest_calculator
   use strucrd
@@ -504,7 +603,7 @@ subroutine crest_rotamermds(env,ensnam)
   integer :: nsim
   type(mddata) :: mddat
   type(mddata),allocatable :: mddats(:)
-  type(coord) :: mol 
+  type(coord) :: mol
   type(coord),allocatable :: mols(:)
   integer :: nat,nall
   real(wp),allocatable :: eread(:)
@@ -513,65 +612,65 @@ subroutine crest_rotamermds(env,ensnam)
   integer :: nstrucs,i,j,k,io
   real(wp) :: temp,newtemp
   character(len=80) :: atmp
-  
+
 !>--- coord setup
   call env%ref%to(mol)
   call rdensembleparam(ensnam,nat,nall)
   if (nall .lt. 1) then
-    write(stdout,*) '**ERROR** empty ensemble file',trim(ensnam)
+    write (stdout,*) '**ERROR** empty ensemble file',trim(ensnam)
     env%iostatus_meta = status_failed
     return
-  endif
+  end if
 
 !>--- determine how many MDs need to be run and setup
   call adjustnormmd(env)
-  nstrucs = min(nall, env%nrotammds)
-  nsim = nstrucs * env%temps 
+  nstrucs = min(nall,env%nrotammds)
+  nsim = nstrucs*env%temps
   call crest_search_multimd_init(env,mol,mddat,nsim)
-  allocate (mddats(nsim), source=mddat)
+  allocate (mddats(nsim),source=mddat)
   call crest_search_multimd_init2(env,mddats,nsim)
 !>--- adjust T's and runtimes
   k = 0
-  do i=1,env%temps
+  do i = 1,env%temps
     !> each T block 100K higher
-    temp = env%nmdtemp + (i-1)*100.0_wp
-    do j=1,nstrucs
-      k= k + 1
+    temp = env%nmdtemp+(i-1)*100.0_wp
+    do j = 1,nstrucs
+      k = k+1
       mddats(k)%tsoll = temp
       !> reduce runtime by 50% compared to MTDs
-      mddats(k)%length_ps = mddats(k)%length_ps * 0.5_wp
+      mddats(k)%length_ps = mddats(k)%length_ps*0.5_wp
       call mdautoset(mddats(k),io)
-    enddo
-  enddo 
+    end do
+  end do
 
 !>--- read ensemble and prepare mols
   allocate (xyz(3,nat,nall),at(nat),eread(nall))
   call rdensemble(ensnam,nat,nall,at,xyz,eread)
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
 !>--- Important: mols must be in Bohrs
-  xyz = xyz / bohr
+  xyz = xyz/bohr
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
-  allocate(mols(nsim), source=mol) 
+  allocate (mols(nsim),source=mol)
   k = 0
-  do i=1,env%temps
-    do j=1,nstrucs
-      k = k + 1
+  do i = 1,env%temps
+    do j = 1,nstrucs
+      k = k+1
       mols(k)%at = at
       mols(k)%xyz(:,:) = xyz(:,:,j)
-    enddo
-  enddo
-  deallocate(eread,at,xyz)
-  
+    end do
+  end do
+  deallocate (eread,at,xyz)
+
 !>--- print what we are doing
-  write(stdout,*)
-  write(atmp,'(''Additional regular MDs on lowest '',i0,'' conformer(s)'')')nstrucs
-  call smallheadline(trim(atmp)) 
+  write (stdout,*)
+  write (atmp,'(''Additional regular MDs on lowest '',i0,'' conformer(s)'')') nstrucs
+  call smallheadline(trim(atmp))
 
 !>--- and finally, run the MDs
   call crest_search_multimd2(env,mols,mddats,nsim)
 
-  if(allocated(mols))deallocate(mols)
-  if(allocated(mddats))deallocate(mddats) 
+  if (allocated(mols)) deallocate (mols)
+  if (allocated(mddats)) deallocate (mddats)
   return
 end subroutine crest_rotamermds
 
@@ -587,7 +686,7 @@ subroutine crest_newcross3(env)
   use iomod
   use utilities
   implicit none
-  type(systemdata) :: env  
+  type(systemdata) :: env
   real(wp) :: ewinbackup
   integer  :: i,imax,tmpconf,nremain
   character(len=128) :: inpnam,outnam,refnam
@@ -603,8 +702,8 @@ subroutine crest_newcross3(env)
     imax = min(nint(env%mdtime*50.0d0),5000)
     if (env%setgcmax) then
       imax = nint(env%gcmax)
-    else if(imax<0)then
-      imax=5000
+    else if (imax < 0) then
+      imax = 5000
     end if
     if (env%quick) then
       imax = nint(float(imax)*0.5d0)
@@ -612,7 +711,7 @@ subroutine crest_newcross3(env)
 
 !>-- call the crossing routine
     call checkname_xyz(crefile,refnam,tmppath)
-    call touch(trim(tmppath)) 
+    call touch(trim(tmppath))
     call crest_crossing(env,imax,trim(refnam),env%gcmaxparent)
     if (imax .lt. 1) then
       call remove(trim(tmppath))
@@ -626,18 +725,40 @@ subroutine crest_newcross3(env)
     else
       multilevel(4) = .true.
     end if
-    call crest_multilevel_oloop(env,'confcross.xyz',multilevel)
-    if(env%iostatus_meta .ne. 0 ) return
+    call crest_multilevel_oloop(env,'confcross.xyz',multilevel,0)
+    if (env%iostatus_meta .ne. 0) return
 
 !>-- append optimized crossed structures and original to a single file
     call checkname_xyz(crefile,inpnam,outnam)
-    write(stdout,'(a,a)')'appending new structures to ',trim(refnam)
+    write (stdout,'(a,a)') 'appending new structures to ',trim(refnam)
     call appendto(trim(inpnam),trim(refnam))
-    do while(trim(inpnam).ne.trim(refnam))
+    do while (trim(inpnam) .ne. trim(refnam))
       call remove(trim(inpnam))
       call checkname_xyz(crefile,inpnam,outnam)
-    enddo
+    end do
   end do
 end subroutine crest_newcross3
 
+!=============================================================================!
+!#############################################################################!
+!=============================================================================!
+
+subroutine crest_sampling_skip(env,doreturn)
+  use crest_data
+  implicit none
+  type(systemdata),intent(inout) :: env
+  logical,intent(out) :: doreturn
+
+  doreturn = .false.
+
+  !> Diatomic molecules need no sampling
+  if (env%ref%nat .le. 2) then
+    call catchdiatomic(env)
+    doreturn = .true.
+    return
+  end if
+
+  !> "alkylize" special runtype
+  call crest_proxy_nalkane(env,doreturn)
 
+end subroutine crest_sampling_skip
diff --git a/src/algos/search_entropy.f90 b/src/algos/search_entropy.f90
index 9c1b8c77..7c68015e 100644
--- a/src/algos/search_entropy.f90
+++ b/src/algos/search_entropy.f90
@@ -32,12 +32,13 @@ subroutine crest_search_entropy(env,tim)
   use iomod
   use utilities
   use cregen_interface
+  use crest_restartlog
   implicit none
   type(systemdata),intent(inout) :: env
   type(timer),intent(inout)      :: tim
   type(coord) :: mol,molnew
   integer :: i,j,k,l,io,ich,m
-  logical :: pr,wr
+  logical :: pr,wr,doreturn
 !===========================================================!
   type(calcdata) :: calc
   type(mddata) :: mddat
@@ -61,6 +62,9 @@ subroutine crest_search_entropy(env,tim)
 !> Entropy algo variables
   logical :: stopiter,fail
   integer :: bref,dum,eit,eit2
+!===========================================================!
+  type(restart_data) :: rdat
+  logical :: do_restart,skip_mtdloop,skip_collect,skip_emtdcopy0,firstiter,fex
 !===========================================================!
 !>--- printout header
   write (stdout,*)
@@ -73,6 +77,26 @@ subroutine crest_search_entropy(env,tim)
   write (stdout,'(1x,a)') '• J.Gorges, S.Grimme, A.Hansen, P.Pracht, PCCP, 2022,24, 12249-12259.'
   write (stdout,*)
 
+! ── restart detection ─────────────────────────────────────────────
+  do_restart = .false.
+  skip_mtdloop = .false.
+  skip_collect = .false.
+  skip_emtdcopy0 = .false.
+  if (env%allowrestart .and. restart_file_exists()) then
+    call read_restart_log(rdat)
+    if (rdat%runtype == env%crestver .and. rdat%stage /= 'done') then
+      do_restart = .true.
+      call print_restart_info(rdat)
+      !> skip entire mtdloop and collectcre when past the MTD loop
+      skip_mtdloop = (rdat%stage == 'post_collect' .or. &
+        &              rdat%stage == 'entropy_smtd')
+      skip_collect = (rdat%stage == 'post_collect' .or. &
+        &              rdat%stage == 'entropy_smtd')
+      !> additionally skip emtdcopy(iter=0) when that call already ran
+      skip_emtdcopy0 = (rdat%stage == 'entropy_smtd')
+    end if
+  end if
+
 !===========================================================!
 !>--- setup
   call env%ref%to(mol)
@@ -80,11 +104,9 @@ subroutine crest_search_entropy(env,tim)
   call mol%append(stdout)
   write (stdout,*)
 
-!>--- saftey termination
-  if(mol%nat .le. 2)then
-     call catchdiatomic(env)
-    return
-  endif
+!>--- saftey terminations
+  call crest_sampling_skip(env,doreturn)
+  if (doreturn) return
 
 !>--- sets the MD length according to a flexibility measure
   call md_length_setup(env)
@@ -94,7 +116,7 @@ subroutine crest_search_entropy(env,tim)
   if (env%performMTD) then
 !>--- (optional) calculate a short 1ps test MTD to check settings
    call tim%start(1,'Trial metadynamics (MTD)')
-   call trialmd(env)    
+   call trialmd(env)
    call tim%stop(1)
    if(env%iostatus_meta .ne. 0) return
   end if
@@ -103,9 +125,20 @@ subroutine crest_search_entropy(env,tim)
 !>--- Start mainloop
   env%nreset = 0
   start = .true.
+! ── apply restart state ───────────────────────────────────────────
+  if (do_restart) then
+    env%nreset   = rdat%main_iter
+    env%elowest  = rdat%elowest
+    env%eprivious = rdat%eprivious
+    env%nmetadyn = rdat%nmetadyn
+    start = .false.
+  end if
   MAINLOOP: do
     call printiter
-    if (.not.start) then
+    if (do_restart) then
+!>--- restart: preserve .cre_*.xyz files, skip cleanup
+      continue
+    else if (.not.start) then
 !>--- clean Dir for new iterations, but leave iteration backup files
       call clean_V2i
       env%nreset = env%nreset+1
@@ -114,32 +147,50 @@ subroutine crest_search_entropy(env,tim)
       call V2cleanup(.false.)
     end if
 !===========================================================!
-!>--- Meta-dynamics loop
+!>--- Meta-dynamics loop (skipped on restart to use existing .cre_*.xyz)
+    if (.not.skip_mtdloop) then
     mtdloop: do i = 1,env%Maxrestart
 
+! ── restart: skip based on stage ──────────────────────────────────
+      if (do_restart) then
+        if (rdat%stage == 'mtd_loop' .and. i <= rdat%mtd_iter) cycle mtdloop
+        if (rdat%stage == 'mtd_trj'  .and. i <  rdat%mtd_iter) cycle mtdloop
+      end if
+
       write (stdout,*)
       write (stdout,'(1x,a)') '------------------------------'
       write (stdout,'(1x,a,i0)') 'Meta-Dynamics Iteration ',i
       write (stdout,'(1x,a)') '------------------------------'
 
-      nsim = -1 !>--- enambles automatic MTD setup in init routines
-      call crest_search_multimd_init(env,mol,mddat,nsim)
-      allocate (mddats(nsim),source=mddat)
-      call crest_search_multimd_init2(env,mddats,nsim)
-
-      call tim%start(2,'Metadynamics (MTD)')
-      call crest_search_multimd(env,mol,mddats,nsim)
-      call tim%stop(2)
-!>--- a file called crest_dynamics.trj should have been written
-      ensnam = 'crest_dynamics.trj'
-!>--- deallocate for next iteration
-      if (allocated(mddats)) deallocate (mddats)
+!==========================================================!
+!>--- MTD run (skipped for mtd_trj restart: trajectory already exists)
+      if (do_restart .and. i == rdat%mtd_iter .and. &
+        &  rdat%stage == 'mtd_trj') then
+        write (stdout,'(1x,a,i0,a)') 'Restarting iteration ',i, &
+          & ' from existing trajectory/ensemble'
+        ensnam = trim(rdat%last_file)
+      else
+        nsim = -1 !>--- enambles automatic MTD setup in init routines
+        call crest_search_multimd_init(env,mol,mddat,nsim)
+        allocate (mddats(nsim),source=mddat)
+        call crest_search_multimd_init2(env,mddats,nsim)
+
+        call tim%start(2,'Metadynamics (MTD)')
+        call crest_search_multimd(env,mol,mddats,nsim)
+        call tim%stop(2)
+!>--- a file called crest_dynamics.trj.xyz should have been written
+        ensnam = 'crest_dynamics.trj.xyz'
+        if (allocated(mddats)) deallocate (mddats)
+!>--- checkpoint: trajectory ready, optimization about to start
+        call write_restart_log(env%crestver,'mtd_trj',env%nreset,i, &
+          &  env%nmetadyn,env%elowest,env%eprivious,ensnam)
+      end if
 
 !==========================================================!
 !>--- Reoptimization of trajectories
       call tim%start(3,'Geometry optimization')
       call optlev_to_multilev(env%optlev,multilevel)
-      call crest_multilevel_oloop(env,ensnam,multilevel)
+      call crest_multilevel_oloop(env,ensnam,multilevel,i)
       call tim%stop(3)
       if(env%iostatus_meta .ne. 0 ) return
 
@@ -152,8 +203,9 @@ subroutine crest_search_entropy(env,tim)
       call rename('cregen.out.tmp',btmp)
 
 !=========================================================!
-!>--- cleanup after first iteration and prepare next
-      if (i .eq. 1.and.start) then
+!>--- cleanup and state update after first iteration (before checkpoint)
+      firstiter = (i .eq. 1 .and. start)
+      if (firstiter) then
         start = .false.
 !>-- obtain a first lowest energy as reference
         env%eprivious = env%elowest
@@ -164,9 +216,12 @@ subroutine crest_search_entropy(env,tim)
         end if
 !>-- the cleanup
         call clean_V2i
-!>-- and always do two cycles of MTDs
-        cycle mtdloop
       end if
+!>--- checkpoint after this MTD iteration (nmetadyn already updated above)
+      call write_restart_log(env%crestver,'mtd_loop',env%nreset,i, &
+        &  env%nmetadyn,env%elowest,env%eprivious,trim(str))
+!>-- always do two cycles of MTDs
+      if (firstiter) cycle mtdloop
 !=========================================================!
 !>--- Check for lowest energy
       call elowcheck(lower,env)
@@ -174,17 +229,37 @@ subroutine crest_search_entropy(env,tim)
         exit mtdloop
       end if
     end do mtdloop
+    end if !> end skip_mtdloop guard
+    skip_mtdloop = .false.
+    do_restart = .false.
 !=========================================================!
 !>--- collect all ensembles from mtdloop and merge
-    write (stdout,*)
-    write (stdout,'(''========================================'')')
-    write (stdout,'(''           MTD Simulations done         '')')
-    write (stdout,'(''========================================'')')
-    write (stdout,'(1x,''Collecting ensmbles.'')')
+    if (skip_collect) then
+!>--- post_collect restart: collectcre already ran, reuse last file
+      inquire(file=trim(rdat%last_file),exist=fex)
+      if (.not.fex) then
+        write (stdout,'(/,a)') '**ERROR** restart ensemble not found: ' &
+          &  //trim(rdat%last_file)
+        write (stdout,'(a,/)') ' Delete crest.restart and rerun from scratch.'
+        call creststop(status_safety)
+      end if
+      atmp = trim(rdat%last_file)
+      write (stdout,'(1x,a,a)') 'Restarting from ensemble: ',trim(atmp)
+      skip_collect = .false.
+    else
+      write (stdout,*)
+      write (stdout,'(''========================================'')')
+      write (stdout,'(''           MTD Simulations done         '')')
+      write (stdout,'(''========================================'')')
+      write (stdout,'(1x,''Collecting ensmbles.'')')
 !>-- collecting all ensembles saved as ".cre_*.xyz"
-    call collectcre(env)
-    call newcregen(env,0)
-    call checkname_xyz(crefile,atmp,btmp)
+      call collectcre(env)
+      call newcregen(env,0)
+      call checkname_xyz(crefile,atmp,btmp)
+!>--- checkpoint after collection and CREGEN
+      call write_restart_log(env%crestver,'post_collect',env%nreset,0, &
+        &  env%nmetadyn,env%elowest,env%eprivious,trim(atmp))
+    end if
 !>--- remaining number of structures
     call remaining_in(atmp,env%ewin,nallout)
 
@@ -195,7 +270,17 @@ subroutine crest_search_entropy(env,tim)
 !>--- and other entropy mode parameters
       call adjustnormmd(env)
       call mtdatoms(env)
-      call emtdcopy(env,0,stopiter,fail)
+      if (.not.skip_emtdcopy0) then
+        call emtdcopy(env,0,stopiter,fail)
+! ── checkpoint: entropy rotamer file written, sMTD iterations about to start ──
+        if (env%crestver == crest_imtd2) then
+          write (btmp,'(a,i0,a)') 'crest_smtd_',0,'.xyz'
+        else
+          write (btmp,'(a,i0,a)') 'crest_entropy_rotamer_',0,'.xyz'
+        end if
+        call write_restart_log(env%crestver,'entropy_smtd',env%nreset,0, &
+          &  env%nmetadyn,env%elowest,env%eprivious,trim(btmp))
+      end if
       bref = env%emtd%nbias
 
 !>--- sMTD iterations, done until max iterations or convergence
@@ -227,7 +312,7 @@ subroutine crest_search_entropy(env,tim)
             call checkname_xyz(crefile,atmp,btmp)
             call tim%start(3,'Geometry optimization')
             multilevel = (/.true.,.false.,.false.,.false.,.false.,.true./)
-            call crest_multilevel_oloop(env,trim(atmp),multilevel)
+            call crest_multilevel_oloop(env,trim(atmp),multilevel,0)
             call tim%stop(3)
             if(env%iostatus_meta .ne. 0 ) return
 
@@ -242,6 +327,14 @@ subroutine crest_search_entropy(env,tim)
             eit2 = eit
             call emtdcopy(env,eit2,stopiter,fail)
             env%emtd%iterlast = eit2
+! ── checkpoint: update last_file to current entropy rotamer file ──────
+            if (env%crestver == crest_imtd2) then
+              write (btmp,'(a,i0,a)') 'crest_smtd_',eit2,'.xyz'
+            else
+              write (btmp,'(a,i0,a)') 'crest_entropy_rotamer_',eit2,'.xyz'
+            end if
+            call write_restart_log(env%crestver,'entropy_smtd',env%nreset,0, &
+              &  env%nmetadyn,env%elowest,env%eprivious,trim(btmp))
           end if
 
           if (.not.lower.and.fail.and..not.stopiter) then
@@ -263,6 +356,11 @@ subroutine crest_search_entropy(env,tim)
     exit MAINLOOP
   end do MAINLOOP
 
+!==========================================================!
+!>--- checkpoint: run is complete
+  call write_restart_log(env%crestver,'done',env%nreset,0, &
+    &  env%nmetadyn,env%elowest,env%eprivious,conformerfile)
+
 !==========================================================!
 !>--- print CREGEN results and clean up Directory a bit
   write (stdout,'(/)')
@@ -373,10 +471,10 @@ subroutine crest_smtd_mds(env,ensnam)
 !===================================================================!
 !>--- and finally, run the sMTDs on the different starting structures
   call crest_search_multimd2(env,mols,mddats,nsim)
-!>--- output will be collected in crest_dynamics.trj
+!>--- output will be collected in crest_dynamics.trj.xyz
 !>--- but the entropy routines look for the crest_rotamers_ files
   call checkname_xyz(crefile,atmp,btmp)
-  call rename('crest_dynamics.trj',atmp)
+  call rename('crest_dynamics.trj.xyz',atmp)
 !===================================================================!
 !>--- by default, clean up the directory
   if (.not.env%keepModef) call cleanMTD
diff --git a/src/algos/search_mecp.f90 b/src/algos/search_mecp.f90
index b480fbfe..c0f8ae45 100644
--- a/src/algos/search_mecp.f90
+++ b/src/algos/search_mecp.f90
@@ -72,8 +72,8 @@ subroutine crest_search_mecp(env,tim)
   call tim%start(2,'Molecular dynamics (MD)')
   call crest_search_multimd(env,mol,mddats,nsim)
   call tim%stop(2)
-  !>--- a file called crest_dynamics.trj should have been written
-  ensnam = 'crest_dynamics.trj'
+  !>--- a file called crest_dynamics.trj.xyz should have been written
+  ensnam = 'crest_dynamics.trj.xyz'
 
 !==========================================================!
 !>--- Reoptimization of trajectories
diff --git a/src/algos/search_newnci.f90 b/src/algos/search_newnci.f90
index 2472b28c..c93e531b 100644
--- a/src/algos/search_newnci.f90
+++ b/src/algos/search_newnci.f90
@@ -36,7 +36,7 @@ subroutine crest_search_newnci(env,tim)
   type(timer),intent(inout)      :: tim
   type(coord) :: mol,molnew
   integer :: i,j,k,l,io,ich,m
-  logical :: pr,wr
+  logical :: pr,wr,doreturn
 !===========================================================!
   type(calcdata) :: calc
   type(mddata) :: mddat
@@ -71,11 +71,9 @@ subroutine crest_search_newnci(env,tim)
   call mol%append(stdout)
   write (stdout,*)
 
-!>--- saftey termination
-  if(mol%nat .le. 2)then
-     call catchdiatomic(env)
-    return
-  endif
+!>--- saftey terminations
+  call crest_sampling_skip(env,doreturn)
+  if (doreturn) return
 
 !>--- sets the MD length according to a flexibility measure
   call md_length_setup(env)
@@ -121,8 +119,8 @@ subroutine crest_search_newnci(env,tim)
       call tim%start(2,'Metadynamics (MTD)')
       call crest_search_multimd(env,mol,mddats,nsim)
       call tim%stop(2)
-!>--- a file called crest_dynamics.trj should have been written
-      ensnam = 'crest_dynamics.trj'
+!>--- a file called crest_dynamics.trj.xyz should have been written
+      ensnam = 'crest_dynamics.trj.xyz'
 !>--- deallocate for next iteration
       if (allocated(mddats)) deallocate (mddats)
 
@@ -130,7 +128,7 @@ subroutine crest_search_newnci(env,tim)
 !>--- Reoptimization of trajectories
       call tim%start(3,'Geometry optimization')
       call optlev_to_multilev(env%optlev,multilevel)
-      call crest_multilevel_oloop(env,ensnam,multilevel)
+      call crest_multilevel_oloop(env,ensnam,multilevel,i)
       call tim%stop(3)
       if(env%iostatus_meta .ne. 0 ) return
 
diff --git a/src/algos/setuptest.f90 b/src/algos/setuptest.f90
index 720d73c6..f7fe77d4 100644
--- a/src/algos/setuptest.f90
+++ b/src/algos/setuptest.f90
@@ -60,10 +60,10 @@ subroutine trialMD_calculator(env)
   type(timer) :: profiler
 
   type(calcdata) :: tmpcalc
-  type(calcdata) :: calcstart
+  type(calcdata),allocatable :: calcstart(:)
   real(wp) :: energy
   real(wp),allocatable :: grd(:,:)
-  integer :: T,Tn
+  integer :: T,Tn,ii
   character(len=*),parameter :: dirnam = 'TRIALMD'
 
 !>--- OMP settings (should be set to 1 to simulate max parallelization)
@@ -88,13 +88,13 @@ subroutine trialMD_calculator(env)
   if (allocated(env%ref%wbo)) then  !> should be allocated from main program
     MDSTART%shk%wbo = env%ref%wbo
   else !> otherwise, obtain from scratch
-    tmpcalc = env%calc
+    call tmpcalc%copy(env%calc)
     mol = molstart
     tmpcalc%calcs(1)%rdwbo = .true. !> obtain WBOs
-    allocate(grd(3,mol%nat))
+    allocate (grd(3,mol%nat))
     call engrad(mol,tmpcalc,energy,grd,io)
-    call move_alloc(tmpcalc%calcs(1)%wbo, env%ref%wbo)
-    deallocate(grd)
+    call move_alloc(tmpcalc%calcs(1)%wbo,env%ref%wbo)
+    deallocate (grd)
     call tmpcalc%reset()
     MDSTART%shk%wbo = env%ref%wbo
   end if
@@ -105,8 +105,6 @@ subroutine trialMD_calculator(env)
   MTD%mtdtype = cv_rmsd
   MTD%cvdump_fs = 550.0_wp
   call MDSTART%add(MTD)
-  calcstart = env%calc !> Save clean state before loop
-
   pr = .false. !> supress stdout printout of MD
 
 !>--- Header
@@ -116,6 +114,13 @@ subroutine trialMD_calculator(env)
 !>--- Iterative loop, since it is also tested if the MD runs at all
   counter = 1
   maxiter = 6
+
+!>--- temporary clean calculation storage per iteration
+  allocate (calcstart(maxiter))
+  do ii = 1,maxiter
+    call calcstart(ii)%copy(env%calc)
+  end do
+
   tstep = MDSTART%tstep
   shakemode = MDSTART%shk%shake_mode
   call profiler%init(maxiter)
@@ -123,8 +128,7 @@ subroutine trialMD_calculator(env)
 
 !>--- Restore initial starting geometry
     mol = molstart
-!>--- Restore clean calculation state
-    env%calc = calcstart
+
 !>--- Modify MD output trajectory
     MD = MDSTART
     MD%tstep = tstep
@@ -137,7 +141,7 @@ subroutine trialMD_calculator(env)
     io = 1
     !================================!
     call profiler%start(counter)
-    call dynamics(mol,MD,env%calc,pr,io)
+    call dynamics(mol,MD,calcstart(counter),pr,io)
     call profiler%stop(counter)
     !================================!
 
@@ -181,6 +185,8 @@ subroutine trialMD_calculator(env)
 !>--- End loop
   end do iterativ
 
+  deallocate (calcstart)
+
 !>--- transfer final settings to global settings
   env%mdstep = MD%tstep
   env%mddat%tstep = MD%tstep
@@ -302,28 +308,28 @@ subroutine trialOPT_calculator(env)
 !>--- setup
   call env%ref%to(mol)
   call env%ref%to(molopt)
-  allocate(grd(3,mol%nat), source=0.0_wp)
-  tmpcalc = env%calc  !> create copy of calculator
-  tmpcalc%optlev = -1 !> set loose convergence thresholds 
+  allocate (grd(3,mol%nat),source=0.0_wp)
+  call tmpcalc%copy(env%calc)  !> create copy of calculator
+  tmpcalc%optlev = -1 !> set loose convergence thresholds
 
 !>--- perform geometry optimization
-  pr = .false. !> stdout printout
-  wr = .true.  !> write crestopt.log
-  if(wr)then
-    call remove('crestopt.log')
-  endif 
+  pr = env%crestver == crest_trialopt
+  wr = .true.  !> write crestopt.log.xyz
+  if (wr) then
+    call remove('crestopt.log.xyz')
+  end if
   call optimize_geometry(mol,molopt,tmpcalc,energy,grd,pr,wr,io)
 
-!>--- check success 
+!>--- check success
   success = (io == 0)
   call trialOPT_warning(env,molopt,success)
 !>--- if the checks were successfull, env%ref is overwritten
   env%ref%nat = molopt%nat
   env%ref%at = molopt%at
   env%ref%xyz = molopt%xyz
-  env%ref%etot = energy  
+  env%ref%etot = energy
 
-  deallocate(grd) 
+  deallocate (grd)
 end subroutine trialOPT_calculator
 
 !========================================================================================!
@@ -352,7 +358,7 @@ subroutine trialOPT_warning(env,mol,success)
   if (.not.success) then
     write (stdout,*)
     write (stdout,*) ' Initial geometry optimization failed!'
-    write (stdout,*) ' Please check your input and, if present, crestopt.log.'
+    write (stdout,*) ' Please check your input and, if present, crestopt.log.xyz.'
     call creststop(status_failed)
   end if
   write (stdout,*) 'Geometry successfully optimized.'
@@ -396,7 +402,7 @@ subroutine trialOPT_warning(env,mol,success)
         if (env%legacy) then
           write (stdout,'(1x,a)') 'You can check the optimization trajectory in the "xtbopt.log" file.'
         else
-          write (stdout,'(1x,a)') 'You can check the optimization trajectory in the "crestopt.log" file.'
+          write (stdout,'(1x,a)') 'You can check the optimization trajectory in the "crestopt.log.xyz" file.'
         end if
         write (stdout,'(1x,a)') 'Try either of these options:'
         write (stdout,'(/,4x,a)') 'A) Pre-optimize your input seperately and use the optimized'
diff --git a/src/algos/singlepoint.f90 b/src/algos/singlepoint.f90
index 6fb67e27..a5ffa8aa 100644
--- a/src/algos/singlepoint.f90
+++ b/src/algos/singlepoint.f90
@@ -35,6 +35,7 @@ subroutine crest_singlepoint(env,tim)
   use crest_calculator
   use strucrd
   use gradreader_module,only:write_engrad
+  use iomod,only:colorify
   implicit none
   type(systemdata),intent(inout) :: env
   type(timer),intent(inout)      :: tim
@@ -52,13 +53,14 @@ subroutine crest_singlepoint(env,tim)
   character(len=*),parameter :: partial = '∂E/∂'
 !========================================================================================!
   write (stdout,*)
-  !call system('figlet singlepoint')
-  write (stdout,*) "     _             _                  _       _   "
-  write (stdout,*) " ___(_)_ __   __ _| | ___ _ __   ___ (_)_ __ | |_ "
-  write (stdout,*) "/ __| | '_ \ / _` | |/ _ \ '_ \ / _ \| | '_ \| __|"
-  write (stdout,*) "\__ \ | | | | (_| | |  __/ |_) | (_) | | | | | |_ "
-  write (stdout,*) "|___/_|_| |_|\__, |_|\___| .__/ \___/|_|_| |_|\__|"
-  write (stdout,*) "             |___/       |_|                      "
+  write (stdout,*) " ------------------------------------------------------------------ "
+  write (stdout,*) "  ####  # #    #  ####  #      ###### #####   ####  # #    # #####  "
+  write (stdout,*) " #      # ##   # #    # #      #      #    # #    # # ##   #   #    "
+  write (stdout,*) "  ####  # # #  # #      #      #####  #    # #    # # # #  #   #    "
+  write (stdout,*) "      # # #  # # #  ### #      #      #####  #    # # #  # #   #    "
+  write (stdout,*) " #    # # #   ## #    # #      #      #      #    # # #   ##   #    "
+  write (stdout,*) "  ####  # #    #  ####  ###### ###### #       ####  # #    #   #    "
+  write (stdout,*) " ------------------------------------------------------------------ "
   write (stdout,*)
 !========================================================================================!
   call new_ompautoset(env,'max',0,T,Tn)
@@ -76,7 +78,7 @@ subroutine crest_singlepoint(env,tim)
   write (stdout,'(a)')
 
   allocate (grad(3,mol%nat),source=0.0_wp)
-  calc = env%calc
+  call calc%copy(env%calc)
   calc%calcs(:)%prstdout = .true.
 
 !>--- print some info about the calculation
@@ -183,7 +185,7 @@ subroutine crest_xtbsp(env,xtblevel,molin)
 !>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<!
 !>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<!
   if (io .ne. 0) then
-    write(stdout,'(a)') 'crest_xtbsp() failed'
+    write (stdout,'(a)') 'crest_xtbsp() failed'
     call creststop(status_error)
   end if
 
@@ -250,11 +252,11 @@ subroutine crest_ensemble_singlepoints(env,tim)
 
 !>---- read the input ensemble
   call rdensembleparam(ensnam,nat,nall)
-  if (nall .lt. 1)then
+  if (nall .lt. 1) then
     write (stdout,*) '**ERROR** empty ensemble file.'
     env%iostatus_meta = status_input
     return
-  endif
+  end if
   allocate (xyz(3,nat,nall),at(nat),eread(nall))
   call rdensemble(ensnam,nat,nall,at,xyz,eread)
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
diff --git a/src/algos/sorting.f90 b/src/algos/sorting.f90
new file mode 100644
index 00000000..e6b9d7d3
--- /dev/null
+++ b/src/algos/sorting.f90
@@ -0,0 +1,229 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2024 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!========================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
+!> Implementation for standalone sorting
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
+!========================================================================================!
+!> Input/Output:
+!>  env  -  crest's systemdata object
+!>  tim  -  timer object
+!>-----------------------------------------------
+subroutine crest_sort(env,tim)
+  use crest_parameters
+  use crest_data
+  use crest_calculator
+  use strucrd
+  use cregen_interface
+  use iomod,only:catdel
+  implicit none
+  type(systemdata),intent(inout) :: env
+  type(timer),intent(inout)      :: tim
+  type(coord) :: mol,molnew
+  integer :: i,j,k,l,io,ich
+  logical :: pr,wr
+  external :: CCEGEN
+!========================================================================================!
+  integer :: nall
+  type(coord),allocatable :: structures(:)
+  integer,allocatable :: groups(:)
+
+!========================================================================================!
+  select case (env%sortmode)
+  case default
+    write (stdout,'(a,a,a)',advance='no') '> Read ensemble ',trim(env%ensemblename),' ... '
+    flush (stdout)
+    call rdensemble(env%ensemblename,nall,structures)
+    allocate (groups(nall),source=0)
+    write (stdout,'(i0,a)') nall,' structures!'
+  case ('irmsd','rmsd','hrmsd')
+    write (stdout,'(a,a)',advance='no') '> Reading files ',trim(env%ensemblename)
+    flush (stdout)
+    write (stdout,'(a,a)') ' and ',trim(env%ensemblename2)
+  case ('cluster')
+    continue !> ccegen reads the ensemble internally
+  end select
+  write (stdout,*)
+
+  env%confgo = .true.
+!========================================================================================!
+  call tim%start(11,'Sorting')
+
+  select case (env%sortmode)
+
+  case ('rmsd')
+    call quick_rmsd_tool(trim(env%ensemblename),trim(env%ensemblename2),.false.)
+    stop
+
+  case ('hrmsd')
+    call quick_rmsd_tool(trim(env%ensemblename),trim(env%ensemblename2),.true.)
+    stop
+
+  case ('irmsd')
+    call irmsd_tool(trim(env%ensemblename),trim(env%ensemblename2),env%iinversion)
+    stop
+
+  case ('compare')
+    call compare_ensembles(env)
+
+  case ('isort')
+!>--- Assigning structures to conformers based on RTHR,with canonical atom IDs
+    call underline('Assigning conformers based on iRMSD and RTHR')
+    call cregen_irmsd_sort(env,nall,structures,groups,allcanon=.true.,printlvl=2)
+
+  case ('isort_noid')
+!>--- Assigning structures to conformers based on RTHR, WITHOUT canonical atom IDs
+    call underline('Assigning conformers based on iRMSD and RTHR')
+    call cregen_irmsd_sort(env,nall,structures,groups,allcanon=.false.,printlvl=2)
+
+  case ('all','allpair')
+!>--- all unique pairs of the ensemble (only suitable for small ensembles)
+    call underline('Running all unique pair RMSDs incl. atom permutation')
+    call cregen_irmsd_all(nall,structures,printlvl=2,iinversion=env%iinversion)
+
+  case ('cregen')
+!>--- the original CREGEN procedure
+    call newcregen(env,structurelist=structures)
+    call catdel('cregen.out.tmp')
+
+  case ('cluster')
+!>--- PCA and k-means clustering
+    call CCEGEN(env,.true.,env%ensemblename)
+
+  case default
+!>--- all unique pairs of the ensemble (only suitable for small ensembles)
+    call cregen_irmsd_sort(env,nall,structures,groups,allcanon=.true.,printlvl=2)
+  end select
+
+!========================================================================================!
+  call tim%stop(11)
+  if (allocated(structures)) deallocate (structures)
+  return
+end subroutine crest_sort
+
+!=========================================================================================!
+
+subroutine irmsd_tool(fname1,fname2,iinversion)
+!*******************************************************
+!* irmsd_tool
+!* Standalone implementation to compare two structures
+!* with the iRMSD method.
+!* This implementation should be called only on its own,
+!* for ensemble-based processing see the CREGEN file
+!*******************************************************
+  use crest_parameters
+  use strucrd
+  use axis_module
+  use irmsd_module
+  use canonical_mod
+  implicit none
+  character(len=*),intent(in) :: fname1
+  character(len=*),intent(in) :: fname2
+  integer,intent(in) :: iinversion
+  type(coord) :: mol,ref
+  real(wp) :: rmsdval,tmpd(3),tmpdist
+  integer :: i,ich
+  type(rmsd_cache) :: rcache
+  type(canonical_sorter) :: canmol
+  type(canonical_sorter) :: canref
+  logical :: mirror
+  logical,parameter :: debug = .false.
+
+  write (stdout,*) 'iRMSD algorithm'
+  write (stdout,*) 'reference: ',trim(fname1)
+  write (stdout,*) 'processed: ',trim(fname2)
+  write (stdout,*)
+
+  !> read the geometries
+  call ref%open(trim(fname1))
+  call mol%open(trim(fname2))
+
+  !> move ref to CMA and align rotational axes
+  call axis(ref%nat,ref%at,ref%xyz)
+
+  !> allocate memory
+  call rcache%allocate(ref%nat)
+
+  !> canonical atom ranks
+  call canref%init(ref,invtype='apsp+',heavy=.false.)
+  !call canref%add_h_ranks(ref)
+  rcache%stereocheck = .not. (canref%hasstereo(ref))
+  call canref%shrink()
+  write (stdout,*) 'false enantiomers possible?: ',rcache%stereocheck
+  select case (iinversion)
+  case (0)
+    mirror = .true.
+  case (1)
+    mirror = .true.
+    rcache%stereocheck = .true.
+  case (2)
+    mirror = .false.
+    rcache%stereocheck = .false.
+  end select
+  write (stdout,*) 'allow inversion?:            ',mirror
+
+  call canmol%init(mol,invtype='apsp+',heavy=.false.)
+  !call canmol%add_h_ranks(mol)
+  call canmol%shrink()
+
+  !> check if we can work with the determined ranks
+  if (checkranks(ref%nat,canref%rank,canmol%rank)) then
+    write (stdout,*) 'using canonical atom identities as rank backend'
+    rcache%rank(:,1) = canref%rank(:)
+    rcache%rank(:,2) = canmol%rank(:)
+    if (debug) then
+      write (*,*) 'iRMSD ranks:'
+      write (*,*) 'atom',' rank('//fname1//')',' rank('//fname2//')'
+      do i = 1,ref%nat
+        write (*,*) i,rcache%rank(i,1),rcache%rank(i,2)
+      end do
+      write (*,*)
+    end if
+  else
+    !> if not, fall back to atom types
+    write (stdout,*) 'using atom types as rank backend'
+    call fallbackranks(ref,mol,ref%nat,rcache%rank)
+  end if
+
+  call min_rmsd(ref,mol,rcache=rcache,rmsdout=rmsdval,align=.true.)
+
+  !> write the rotated and shifted coordinates to one file
+  open (newunit=ich,file='irmsd.xyz')
+  call ref%append(ich)
+  call mol%append(ich)
+  close (ich)
+  write (stdout,*)
+  write (stdout,*) 'aligned structures written to irmsd.xyz'
+  write (stdout,*)
+
+  do i = 1,mol%nat
+    tmpd(:) = (mol%xyz(:,i)-ref%xyz(:,i))**2
+    tmpdist = sqrt(sum(tmpd(:)))*autoaa
+    if (tmpdist > 0.01_wp) then
+      write (*,*) i,mol%at(i),tmpdist
+    end if
+  end do
+
+  rmsdval = rmsdval*autoaa
+  write (*,'(1x,a,f16.8)') 'Calculated iRMSD (Å):',rmsdval
+
+  return
+end subroutine irmsd_tool
+
diff --git a/src/algos/term_ui.f90 b/src/algos/term_ui.f90
new file mode 100644
index 00000000..b9c2313e
--- /dev/null
+++ b/src/algos/term_ui.f90
@@ -0,0 +1,516 @@
+module term_ui
+  use crest_parameters
+  use iso_c_binding,only:c_int
+  implicit none
+  private
+
+  interface
+    integer(c_int) function c_isatty(fd) bind(c,name="isatty")
+      use iso_c_binding,only:c_int
+      integer(c_int),value :: fd
+    end function c_isatty
+  end interface
+
+  !> Public API
+  public :: ansi_enabled,set_ansi_enabled
+  public :: fg,bg,style,reset,strip_ansi
+  public :: printc,eprintc
+  public :: progress_state
+  public :: progress_init,progress_update,progress_finish
+  public :: clear_line
+
+  !> ============================================================
+  !> Configuration
+  !> ============================================================
+  logical :: ansi_enabled = .true.
+
+  integer,parameter :: C_RESET = -1
+
+  !> Basic 8-color codes (foreground base 30..37, background base 40..47)
+  integer,parameter,public :: &
+   &  BLACK = 0,RED = 1,GREEN = 2,YELLOW = 3, &
+   &  BLUE = 4,MAGENTA = 5,CYAN = 6,WHITE = 7
+
+  !> Style SGR codes
+  integer,parameter,public :: &
+   &  S_BOLD = 1, &
+   &  S_DIM = 2, &
+   &  S_UNDERLINE = 4, &
+   &  S_BLINK = 5, &
+   &  S_REVERSE = 7, &
+   &  S_HIDDEN = 8
+
+  !> ============================================================
+  !> Progress state
+  !> ============================================================
+  type :: progress_state
+    real(wp) :: t0 = 0.0_wp
+    integer      :: width = 40
+    character(:),allocatable :: prefix
+    character(:),allocatable :: suffix
+    character(:),allocatable :: fill_char
+    character(:),allocatable :: empty_char
+    character(:),allocatable :: left_cap
+    character(:),allocatable :: right_cap
+    integer(int64) :: last_draw_ms = -huge(0_int64)
+    integer(int64) :: min_interval_ms = 50_int64  !> throttle redraw
+    logical :: show_time = .true.
+    logical :: show_eta = .true.
+    logical :: started = .false.
+    logical :: tty = .false.        !> auto-set by progress_init
+    real(wp) :: increment = 10.0_wp !> % step for non-TTY mode
+    real(wp) :: barrier = 0.0_wp   !> current % threshold for non-TTY mode
+  end type progress_state
+
+!========================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================!
+
+  !> ============================================================
+  !> Time helper (seconds as wp) - based on system_clock
+  !> ============================================================
+  function now_seconds() result(t)
+    real(wp) :: t
+    integer(int64) :: count,rate
+    call system_clock(count=count,count_rate=rate)
+    if (rate > 0_int64) then
+      t = real(count,wp)/real(rate,wp)
+    else
+      t = 0.0_wp
+    end if
+  end function now_seconds
+
+  function now_millis_i64() result(ms)
+    integer(int64) :: ms
+    integer(int64) :: count,rate
+    call system_clock(count=count,count_rate=rate)
+    if (rate > 0_int64) then
+      ms = int((real(count,wp)*1000.0_wp)/real(rate,wp),int64)
+    else
+      ms = 0_int64
+    end if
+  end function now_millis_i64
+
+  subroutine set_ansi_enabled(flag)
+    logical,intent(in) :: flag
+    ansi_enabled = flag
+  end subroutine set_ansi_enabled
+
+  !> ============================================================
+  !> ANSI builders
+  !> ============================================================
+  pure function sgr(code) result(s)
+    integer,intent(in) :: code
+    character(:),allocatable :: s
+    if (.not.ansi_enabled) then
+      s = ""
+    else
+      s = achar(27)//"["//itoa(code)//"m"
+    end if
+  end function sgr
+
+  pure function reset() result(s)
+    character(:),allocatable :: s
+    s = sgr(0)
+  end function reset
+
+  pure function fg(color,bright) result(s)
+    integer,intent(in) :: color
+    logical,intent(in),optional :: bright
+    character(:),allocatable :: s
+    integer :: base
+    logical :: b
+    if (.not.ansi_enabled) then
+      s = ""
+      return
+    end if
+    b = .false.; if (present(bright)) b = bright
+    if (color == C_RESET) then
+      s = achar(27)//"[39m"
+    else
+      base = 30+max(0,min(7,color))
+      if (b) then
+        !> "Bright" variant using 90..97 (widely supported)
+        base = 90+max(0,min(7,color))
+      end if
+      s = achar(27)//"["//itoa(base)//"m"
+    end if
+  end function fg
+
+  pure function bg(color,bright) result(s)
+    integer,intent(in) :: color
+    logical,intent(in),optional :: bright
+    character(:),allocatable :: s
+    integer :: base
+    logical :: b
+    if (.not.ansi_enabled) then
+      s = ""
+      return
+    end if
+    b = .false.; if (present(bright)) b = bright
+    if (color == C_RESET) then
+      s = achar(27)//"[49m"
+    else
+      base = 40+max(0,min(7,color))
+      if (b) then
+        base = 100+max(0,min(7,color))
+      end if
+      s = achar(27)//"["//itoa(base)//"m"
+    end if
+  end function bg
+
+  pure function style(code) result(s)
+    integer,intent(in) :: code
+    character(:),allocatable :: s
+    s = sgr(code)
+  end function style
+
+  !> ============================================================
+  !> Printing helpers
+  !> ============================================================
+  subroutine printc(msg,unit,advance)
+    character(len=*),intent(in) :: msg
+    integer,intent(in),optional :: unit
+    logical,intent(in),optional :: advance
+    integer :: u
+    logical :: adv
+    u = stdout; if (present(unit)) u = unit
+    adv = .true.; if (present(advance)) adv = advance
+    if (adv) then
+      write (u,'(a)') msg
+    else
+      write (u,'(a)',advance='no') msg
+    end if
+  end subroutine printc
+
+  subroutine eprintc(msg,advance)
+    character(len=*),intent(in) :: msg
+    logical,intent(in),optional :: advance
+    call printc(msg,unit=stderr,advance=advance)
+  end subroutine eprintc
+
+  !> Clears current line and returns carriage to start (no newline).
+  pure function clear_line() result(s)
+    character(:),allocatable :: s
+    if (.not.ansi_enabled) then
+      s = achar(13)  !> CR only
+    else
+      !> CR + "erase line" (EL2) is common; some use EL0. We'll do EL2.
+      s = achar(13)//achar(27)//"[2K"
+    end if
+  end function clear_line
+
+  !> ============================================================
+  !> Progress bar API
+  !> ============================================================
+  subroutine progress_init(ps,total,width,prefix,suffix,min_interval_ms,show_time,show_eta, &
+                           fill_char,empty_char,left_cap,right_cap)
+    !***********************************************************
+    !* Initialise a progress_state object.
+    !* Automatically detects whether stdout is a TTY and selects
+    !* either the fancy ANSI bar or the sequential |>x% mode.
+    !* total: total number of steps (used to calibrate the non-TTY
+    !*        print interval).
+    !***********************************************************
+    implicit none
+    type(progress_state),intent(inout) :: ps
+    integer,intent(in),optional :: total
+    integer,intent(in),optional :: width
+    character(len=*),intent(in),optional :: prefix,suffix
+    integer(int64),intent(in),optional :: min_interval_ms
+    logical,intent(in),optional :: show_time,show_eta
+    character(len=*),intent(in),optional :: fill_char,empty_char,left_cap,right_cap
+
+    ps%t0 = now_seconds()
+    ps%started = .true.
+
+    if (present(width)) ps%width = max(5,width)
+    if (present(min_interval_ms)) ps%min_interval_ms = max(0_int64,min_interval_ms)
+    if (present(show_time)) ps%show_time = show_time
+    if (present(show_eta)) ps%show_eta = show_eta
+
+    if (present(prefix)) then
+      ps%prefix = prefix
+    else
+      ps%prefix = ""
+    end if
+
+    if (present(suffix)) then
+      ps%suffix = suffix
+    else
+      ps%suffix = ""
+    end if
+
+    if (present(fill_char)) then
+      ps%fill_char = fill_char
+    else
+      ps%fill_char = "█"
+    end if
+
+    if (present(empty_char)) then
+      ps%empty_char = empty_char
+    else
+      ps%empty_char = "░"
+    end if
+
+    if (present(left_cap)) then
+      ps%left_cap = left_cap
+    else
+      ps%left_cap = "["
+      ps%left_cap = "┃"
+    end if
+
+    if (present(right_cap)) then
+      ps%right_cap = right_cap
+    else
+      ps%right_cap = "]"
+      ps%right_cap = "┃"
+    end if
+
+    ps%last_draw_ms = -huge(0_int64)
+
+    ! ── TTY detection & non-TTY state ────────────────────────────
+    ps%tty = (c_isatty(1_c_int) /= 0)
+    ps%barrier = 0.0_wp
+    ps%increment = 10.0_wp
+    if (.not.ps%tty .and. present(total)) then
+      if (total > 20000) ps%increment = 1.0_wp
+      if (total > 10000 .and. total <= 20000) ps%increment = 2.5_wp
+      if (total > 5000  .and. total <= 10000) ps%increment = 5.0_wp
+      if (total > 1000  .and. total <= 5000)  ps%increment = 7.5_wp
+    end if
+  end subroutine progress_init
+
+  subroutine progress_update(ps,curr,tot,unit,force)
+    !***********************************************************
+    !* Update the progress display.
+    !* TTY: renders the in-place ANSI bar.
+    !* non-TTY: prints sequential |>x% markers.
+    !***********************************************************
+    implicit none
+    type(progress_state),intent(inout) :: ps
+    integer,intent(in) :: curr,tot
+    integer,intent(in),optional :: unit
+    logical,intent(in),optional :: force
+
+    integer :: u
+    integer(int64) :: current,total
+    logical :: do_force
+    integer(int64) :: ms,elapsed_ms
+    real(wp) :: frac,elapsed_s,rate,eta_s
+    integer :: filled,nfilled
+    character(:),allocatable :: line,pct,time_str,eta_str
+    character(:),allocatable :: bar
+    real(wp) :: pct_r
+    character(len=5) :: atmp
+
+    if (.not.ps%started) call progress_init(ps)
+
+    current = int(curr,int64)
+    total = int(tot,int64)
+    u = stdout; if (present(unit)) u = unit
+    do_force = .false.; if (present(force)) do_force = force
+
+    if (ps%tty) then
+      ! ── Fancy in-place ANSI bar ───────────────────────────────────
+      if (current == total) do_force = .true.
+
+      ms = now_millis_i64()
+      if (.not.do_force) then
+        if (ps%last_draw_ms >= 0_int64) then
+          if (ms-ps%last_draw_ms < ps%min_interval_ms) return
+        end if
+      end if
+      ps%last_draw_ms = ms
+
+      if (total <= 0_int64) then
+        frac = 0.0_wp
+      else
+        frac = real(max(0_int64,min(current,total)),wp)/real(total,wp)
+      end if
+
+      filled = int(frac*real(ps%width,wp))
+      filled = max(0,min(ps%width,filled))
+      nfilled = max(0,(ps%width-filled))
+
+      pct = fmt_percent(frac)
+
+      elapsed_s = now_seconds()-ps%t0
+      elapsed_ms = int(elapsed_s*1000.0_wp,int64)
+
+      if (ps%show_time) then
+        time_str = " "//dim_text("("//fmt_hms(elapsed_ms)//")")
+      else
+        time_str = ""
+      end if
+
+      if (ps%show_eta.and.current > 0_int64.and.total > 0_int64.and.current < total) then
+        rate = real(current,wp)/max(1.0e-12_wp,elapsed_s)
+        eta_s = real(total-current,wp)/max(1.0e-12_wp,rate)
+        eta_str = " "//dim_text("ETA "//fmt_hms(int(eta_s*1000.0_wp,int64)))
+      else if (ps%show_eta.and.total > 0_int64.and.current >= total) then
+        eta_str = " "//dim_text("ETA 00:00")
+      else
+        eta_str = ""
+      end if
+
+      if (ansi_enabled) then
+        if (frac >= 0.999_wp) then
+          bar = ps%left_cap// &
+            & fg(GREEN,bright=.true.)//repeat(ps%fill_char,filled)//reset()// &
+            & repeat(ps%empty_char,nfilled)//ps%right_cap
+        else
+          bar = ps%left_cap// &
+            & fg(GREEN,bright=.false.)//repeat(ps%fill_char,filled)//reset()// &
+            & fg(YELLOW,bright=.false.)//repeat(ps%empty_char,nfilled)//reset()// &
+            & ps%right_cap
+        end if
+      else
+        bar = ps%left_cap//repeat(ps%fill_char,filled)// &
+              & repeat(ps%empty_char,nfilled)//ps%right_cap
+      end if
+
+      line = clear_line()//ps%prefix//bar//" "//pct//ps%suffix//eta_str//time_str
+
+      call printc(line,unit=u,advance=.false.)
+      call flush_unit(u)
+
+    else
+      ! ── non-TTY: sequential |>x% printout ────────────────────────
+      if (current <= 0_int64) return
+      if (total <= 0_int64) return
+      pct_r = real(current,wp)/real(total,wp)*100.0_wp
+      if (pct_r >= ps%barrier) then
+        write (atmp,'(f5.1)') pct_r
+        write (u,'(1x,a)',advance='no') '|>'//trim(adjustl(atmp))//'%'
+        ps%barrier = min(ps%barrier+ps%increment,100.0_wp)
+        call flush_unit(u)
+      end if
+
+    end if
+  end subroutine progress_update
+
+  subroutine progress_finish(ps,unit,newline)
+    !***********************************************************
+    !* Finalise the progress display.
+    !* TTY: prints a terminating newline.
+    !* non-TTY: prints a newline followed by " done." to close the
+    !*          inline |>x% sequence.
+    !***********************************************************
+    implicit none
+    type(progress_state),intent(inout) :: ps
+    integer,intent(in),optional :: unit
+    logical,intent(in),optional :: newline
+    integer :: u
+    logical :: nl
+
+    u = stdout; if (present(unit)) u = unit
+    nl = .true.; if (present(newline)) nl = newline
+
+    if (ps%tty) then
+      if (nl) call printc("",unit=u,advance=.true.)
+    else
+      if (nl) write (u,'(/,1x,a)') 'done.'
+    end if
+    call flush_unit(u)
+    ps%started = .false.
+  end subroutine progress_finish
+
+  !> ============================================================
+  !> Utilities: formatting, flushing, ANSI stripping
+  !> ============================================================
+  subroutine flush_unit(u)
+    integer,intent(in) :: u
+    flush (u)
+  end subroutine flush_unit
+
+  pure function itoa(i) result(s)
+    integer,intent(in) :: i
+    character(:),allocatable :: s
+    character(len=64) :: buf
+    write (buf,'(i0)') i
+    s = trim(buf)
+  end function itoa
+
+  pure function itoa_i64(i) result(s)
+    integer(int64),intent(in) :: i
+    character(:),allocatable :: s
+    character(len=64) :: buf
+    write (buf,'(i0)') i
+    s = trim(buf)
+  end function itoa_i64
+
+  pure function fmt_percent(frac) result(s)
+    real(wp),intent(in) :: frac
+    character(:),allocatable :: s
+    integer :: p
+    real(wp) :: rp
+    character(8) :: buf
+    rp = min(100.0_wp*max(0.0_wp,min(1.0_wp,frac))+0.5_wp,100.0_wp)
+    write (buf,'(f5.1,a)') rp,"%"
+    s = adjustl(buf)
+  end function fmt_percent
+
+  pure function fmt_hms(ms) result(s)
+    integer(int64),intent(in) :: ms
+    character(:),allocatable :: s
+    integer(int64) :: t,hh,mm,ss
+    character(32) :: buf
+
+    t = max(0_int64,ms/1000_int64)
+    hh = t/3600_int64
+    mm = (t-hh*3600_int64)/60_int64
+    ss = t-hh*3600_int64-mm*60_int64
+
+    if (hh > 0_int64) then
+      write (buf,'(i0,":",i2.2,":",i2.2)') hh,int(mm),int(ss)
+    else
+      write (buf,'(i2.2,":",i2.2)') int(mm),int(ss)
+    end if
+    s = trim(buf)
+  end function fmt_hms
+
+  pure function dim_text(t) result(s)
+    character(len=*),intent(in) :: t
+    character(:),allocatable :: s
+    if (.not.ansi_enabled) then
+      s = t
+    else
+      s = style(S_DIM)//t//reset()
+    end if
+  end function dim_text
+
+  pure function strip_ansi(s_in) result(s_out)
+    character(len=*),intent(in) :: s_in
+    character(:),allocatable :: s_out
+    integer :: i,n
+    character :: c
+    logical :: in_esc
+    in_esc = .false.
+    s_out = ""
+    n = len_trim(s_in)
+
+    i = 1
+    do while (i <= n)
+      c = s_in(i:i)
+      if (.not.in_esc) then
+        if (c == achar(27)) then
+          in_esc = .true.
+        else
+          s_out = s_out//c
+        end if
+      else
+        !> We are inside ESC[ ... m ; consume until 'm' or end
+        if (c == "m") then
+          in_esc = .false.
+        end if
+      end if
+      i = i+1
+    end do
+  end function strip_ansi
+
+!=============================================================================!
+!#############################################################################!
+!=============================================================================!
+end module term_ui
+
diff --git a/src/axis_module.f90 b/src/axis_module.f90
index f6e7379a..e03952dd 100644
--- a/src/axis_module.f90
+++ b/src/axis_module.f90
@@ -75,6 +75,8 @@ module axis_module
   end interface cma
   public :: CMAtrf
 
+  public :: uniqueax
+
 !========================================================================================!
 !========================================================================================!
 contains  !> MODULE PROCEDURES START HERE
@@ -95,15 +97,15 @@ module axis_module
 !========================================================================================!
   subroutine axis_0(nat,at,coord,rot,avmom,evec)
     implicit none
-    integer :: nat
-    integer :: at(nat)
-    real(wp) :: coord(3,nat)
-    real(wp) :: rot(3),avmom,evec(3,3)
+    integer,intent(in)   :: nat
+    integer,intent(in)   :: at(nat)
+    real(wp),intent(in)  :: coord(3,nat)
+    real(wp),intent(out) :: rot(3),avmom,evec(3,3)
     real(wp) :: a(3,3)
     real(wp) :: t(6),xyzmom(3),eig(3)
     !real(wp) :: x(nat),y(nat),z(nat)
-    real(wp),allocatable :: x(:),y(:),z(:)
-    real(wp) :: atmass
+    !real(wp),allocatable :: x(:),y(:),z(:)
+    real(wp) :: atmass,shift(3)
     integer :: i,j
     !************************************************************************
     !*     const1 =  10**40/(n*a*a)
@@ -116,8 +118,9 @@ subroutine axis_0(nat,at,coord,rot,avmom,evec)
     !> first we move the molecule to the CMA
     !> this depends on the isotopic masses, and the cartesian geometry.
     !>
-    allocate (x(nat),y(nat),z(nat),source=0.0_wp)
-    call CMA(nat,at,coord,x,y,z)
+!    allocate (x(nat),y(nat),z(nat),source=0.0_wp)
+!    call CMA(nat,at,coord,x,y,z)
+     call CMAshift(nat,at,coord,shift)
 
     !************************************************************************
     !*    matrix for moments of inertia is of form
@@ -133,12 +136,18 @@ subroutine axis_0(nat,at,coord,rot,avmom,evec)
     end do
     do i = 1,nat
       atmass = ams(at(i))
-      t(1) = t(1) + atmass * (y(i)**2 + z(i)**2)
-      t(2) = t(2) - atmass * x(i) * y(i)
-      t(3) = t(3) + atmass * (z(i)**2 + x(i)**2)
-      t(4) = t(4) - atmass * z(i) * x(i)
-      t(5) = t(5) - atmass * y(i) * z(i)
-      t(6) = t(6) + atmass * (x(i)**2 + y(i)**2)
+!      t(1) = t(1) + atmass * (y(i)**2 + z(i)**2)
+!      t(2) = t(2) - atmass * x(i) * y(i)
+!      t(3) = t(3) + atmass * (z(i)**2 + x(i)**2)
+!      t(4) = t(4) - atmass * z(i) * x(i)
+!      t(5) = t(5) - atmass * y(i) * z(i)
+!      t(6) = t(6) + atmass * (x(i)**2 + y(i)**2)
+      t(1) = t(1) + atmass * ((coord(2,i)-shift(2))**2 + (coord(3,i)-shift(3))**2)
+      t(2) = t(2) - atmass * (coord(1,i)-shift(1)) * (coord(2,i)-shift(2))
+      t(3) = t(3) + atmass * ((coord(3,i)-shift(3))**2 + (coord(1,i)-shift(1))**2)
+      t(4) = t(4) - atmass * (coord(3,i)-shift(3)) * (coord(1,i)-shift(1))
+      t(5) = t(5) - atmass * (coord(2,i)-shift(2)) * (coord(3,i)-shift(3))
+      t(6) = t(6) + atmass * ((coord(1,i)-shift(1))**2 + (coord(2,i)-shift(2))**2)
       a(1,1) = t(1)
       a(2,1) = t(2)
       a(1,2) = t(2)
@@ -149,7 +158,7 @@ subroutine axis_0(nat,at,coord,rot,avmom,evec)
       a(2,3) = t(5)
       a(3,3) = t(6) 
     end do
-    deallocate (z,y,x)
+!    deallocate (z,y,x)
 
     evec = 0.0_wp
     eig = 0.0_wp
@@ -241,12 +250,14 @@ subroutine axis_2(pr,nat,at,coord,eax)
   end subroutine axis_2
 
 !========================================================================================!
-!> subroutine axis_3
-!> axis routine that orients the molecule along the
-!> calculated principle axes and shifts it to CMA.
-!> new geometry is written to coordout.
-!>---------------------------------------------
+
   subroutine axis_3(nat,at,coord,coordout,rot)
+!****************************************************
+!* subroutine axis_3
+!* axis routine that orients the molecule along the
+!* calculated principle axes and shifts it to CMA.
+!* new geometry is written to coordout.
+!****************************************************
     implicit none
     integer,intent(in) :: nat
     integer,intent(in) :: at(nat)
@@ -293,24 +304,50 @@ subroutine axis_3(nat,at,coord,coordout,rot)
   end subroutine axis_3
 
 !========================================================================================!
-!> subroutine axis_4
-!> axis routine that orients the molecule along the
-!> calculated principle axes and shifts it to CMA.
-!> new geometry OVERWRITES input.
-!>--------------------------------
-  subroutine axis_4(nat,at,coord)
+
+  subroutine axis_4(nat,at,coord,rotconst)
+!****************************************************
+!* subroutine axis_4
+!* axis routine that orients the molecule along the
+!* calculated principle axes and shifts it to CMA.
+!* new geometry OVERWRITES input.
+!* Optimized for minimal allocation overhead.
+!****************************************************
     implicit none
     integer,intent(in) :: nat
     integer,intent(in) :: at(nat)
     real(wp),intent(inout) :: coord(3,nat)
-    real(wp) :: rot(3)
-    real(wp),allocatable :: coordtmp(:,:)
+    real(wp),intent(out),optional :: rotconst(3)
+    real(wp) :: coordtmp(3),shift(3)
+    real(wp) :: rot(3),avmom,evec(3,3)
+    integer :: i,j,k
+    real(wp) :: xsum
+    call axis_0(nat,at,coord,rot,avmom,evec)
+    call CMAshift(nat,at,coord,shift)
+    do i=1,nat
+       coord(:,i) = coord(:,i) - shift(:)
+    enddo
+    !> do the trafo (chirality is preserved)
+    xsum = calcxsum(evec)
+    if (xsum .lt. 0.0_wp) then
+      do j = 1,3
+        evec(j,1) = -evec(j,1)
+      end do
+    end if
 
-    allocate (coordtmp(3,nat))
-    !> call axis routine
-    call axis_3(nat,at,coord,coordtmp,rot)
-    coord = coordtmp
-    deallocate (coordtmp)
+    do i = 1,nat
+      coordtmp(:) = coord(:,i)
+      do j = 1,3
+        xsum = 0.0_wp
+        do k = 1,3
+          xsum = xsum + coordtmp(k) * evec(k,j)
+        end do
+        coord(j,i) = xsum
+      end do
+    end do
+    if(present(rotconst))then
+       rotconst(:) = rot(:)
+    endif
 
     return
   end subroutine axis_4
@@ -378,10 +415,43 @@ real(wp) function calcxsum(evec)
   end function calcxsum
 
 !========================================================================================!
-!> subroutine CMA
-!> calculate CMA-shifted coordinates x y z
-!>--------------------------------------
+
+  subroutine uniqueax(rot,unique,thr)
+!**************************************************
+!* check if a given rotational constant is unique
+!**************************************************
+    implicit none
+    real(wp),intent(in) :: rot(3)
+    logical,intent(out) :: unique(3)
+    real(wp),intent(in),optional :: thr
+    real(wp) :: thrtmp
+    real(wp) :: diff(3)
+
+    unique(:) = .false.
+
+    if(present(thr))then
+      thrtmp = thr
+    else
+      thrtmp = 0.01_wp
+    endif
+
+    diff(1) = abs(rot(2)/rot(1) - 1.0_wp)
+    diff(2) = abs(rot(3)/rot(1) - 1.0_wp)
+    diff(3) = abs(rot(3)/rot(2) - 1.0_wp)
+
+    if(diff(1) .gt. thrtmp .and. diff(2) .gt. thrtmp) unique(1) = .true.
+    if(diff(1) .gt. thrtmp .and. diff(3) .gt. thrtmp) unique(2) = .true.
+    if(diff(2) .gt. thrtmp .and. diff(3) .gt. thrtmp) unique(3) = .true.
+
+  end subroutine uniqueax
+
+!========================================================================================!
+
   subroutine CMAxyz(nat,at,coord,x,y,z)
+!********************************************
+!* subroutine CMA
+!* calculate CMA-shifted coordinates x y z
+!********************************************
     implicit none
     integer,intent(in) :: nat
     integer,intent(in) :: at(nat)
@@ -411,6 +481,40 @@ subroutine CMAxyz(nat,at,coord,x,y,z)
     return
   end subroutine CMAxyz
 
+!========================================================================================!
+
+  subroutine CMAshift(nat,at,coord,shift)
+!*********************************************************
+!* subroutine CMAshift
+!* calculate the shift vector to shift a molecule to CMA
+!*********************************************************
+    implicit none
+    integer,intent(in) :: nat
+    integer,intent(in) :: at(nat)
+    real(wp),intent(in) :: coord(3,nat)
+    real(wp),intent(out) :: shift(3)
+    integer :: i
+    real(wp) :: sumw,sumwx,sumwy,sumwz,atmass
+    sumw = 1.d-20
+    sumwx = 0.d0
+    sumwy = 0.d0
+    sumwz = 0.d0
+    do i = 1,nat
+      atmass = ams(at(i))
+      sumw = sumw + atmass
+      sumwx = sumwx + atmass * coord(1,i)
+      sumwy = sumwy + atmass * coord(2,i)
+      sumwz = sumwz + atmass * coord(3,i)
+    end do
+    sumwx = sumwx / sumw
+    sumwy = sumwy / sumw
+    sumwz = sumwz / sumw
+    shift(1) = sumwx
+    shift(2) = sumwy
+    shift(3) = sumwz
+    return
+  end subroutine CMAshift
+
 !========================================================================================!
 !> subroutine CMAtrf
 !> calculate a shift to the first nat0 atoms' CMA
diff --git a/src/basinhopping/CMakeLists.txt b/src/basinhopping/CMakeLists.txt
new file mode 100644
index 00000000..6a29ef85
--- /dev/null
+++ b/src/basinhopping/CMakeLists.txt
@@ -0,0 +1,35 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+#
+# crest is free software: you can redistribute it and/or modify it under
+# the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# crest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with crest.  If not, see <https://www.gnu.org/licenses/>.
+
+set(dir "${CMAKE_CURRENT_SOURCE_DIR}")
+
+list(APPEND srcs
+  "${dir}/algo.f90"
+  "${dir}/basinhopping.f90"
+  "${dir}/class.f90"
+  "${dir}/mc.f90"
+  "${dir}/takestep.f90"
+)
+
+set(srcs ${srcs} PARENT_SCOPE)
+
+
+
+
+
+
+
+
diff --git a/src/basinhopping/algo.f90 b/src/basinhopping/algo.f90
new file mode 100644
index 00000000..c800fc67
--- /dev/null
+++ b/src/basinhopping/algo.f90
@@ -0,0 +1,335 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2024 Philipp Pracht, David Wales
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module bh_algo_interface
+  implicit none
+  interface
+    subroutine single_basinhopping_core(env,mol,calc,structuredump)
+      use crest_data
+      use crest_calculator
+      use strucrd
+      implicit none
+      type(systemdata),intent(inout) :: env
+      type(coord),intent(inout) :: mol
+      type(coord),allocatable,intent(inout) :: structuredump(:)
+      type(calcdata),intent(inout) :: calc
+    end subroutine single_basinhopping_core
+    subroutine parallel_basinhopping_core(env,mol,calc,structuredump)
+      use crest_data
+      use crest_calculator
+      use strucrd
+      implicit none
+      !> INPUT/OUTPUT
+      type(systemdata),intent(inout) :: env
+      type(coord),intent(inout) :: mol
+      type(coord),allocatable,intent(inout) :: structuredump(:)
+      type(calcdata),intent(in) :: calc
+    end subroutine parallel_basinhopping_core
+  end interface
+end module bh_algo_interface
+
+!================================================================================!
+!================================================================================!
+!================================================================================!
+
+subroutine crest_basinhopping(env,tim)
+  use crest_parameters
+  use crest_data
+  use crest_calculator
+  use strucrd
+  use cregen_interface,only:unionizeEnsembles,cregen_irmsd_sort
+  use optimize_module
+  use bh_module
+  use bh_algo_interface
+  implicit none
+  type(systemdata),intent(inout) :: env
+  type(timer),intent(inout)      :: tim
+  type(coord) :: mol,molnew
+  integer :: i,j,k,l,io,ich,T,Tn,mciter
+  logical :: pr,wr
+!========================================================================================!
+  type(calcdata) :: calc
+
+  real(wp) :: energy,gnorm
+  real(wp),allocatable :: grad(:,:)
+  integer :: nall
+  type(coord),allocatable :: structuredump(:)
+  integer,allocatable :: groups(:)
+  logical :: parallel
+  character(len=80) :: atmp
+  character(len=*),parameter :: trjf = 'crest_quenched.xyz'
+!========================================================================================!
+  write (stdout,*)
+  write (stdout,*) " ____            _       _   _                   _             "
+  write (stdout,*) "| __ )  __ _ ___(_)_ __ | | | | ___  _ __  _ __ (_)_ __   __ _ "
+  write (stdout,*) "|  _ \ / _` / __| | '_ \| |_| |/ _ \| '_ \| '_ \| | '_ \ / _` |"
+  write (stdout,*) "| |_) | (_| \__ \ | | | |  _  | (_) | |_) | |_) | | | | | (_| |"
+  write (stdout,*) "|____/ \__,_|___/_|_| |_|_| |_|\___/| .__/| .__/|_|_| |_|\__, |"
+  write (stdout,*) "                                    |_|   |_|            |___/ "
+  write (stdout,*) ""
+  call new_ompautoset(env,'max',0,T,Tn)
+  call ompprint_intern()
+
+  calc = env%calc
+  call env%ref%to(mol)
+  write (stdout,*)
+  write (stdout,*) 'Input structure:'
+  call mol%append(stdout)
+  write (stdout,*)
+!========================================================================================!
+!>--- print calculation info
+  call calc%info(stdout)
+  write (stdout,'(a)') '> Geometry optimization settings:'
+  call print_opt_data(calc,stdout,natoms=mol%nat,tag=' : ')
+  write (stdout,*)
+
+!>--- singlepoint of input structure
+  allocate (grad(3,mol%nat),source=0.0_wp)
+  call engrad(mol,calc,energy,grad,io)
+  mol%energy = energy  !> we need this to start the Markov-chain
+
+!==========================================================================================!
+  parallel = .false.
+  if (allocated(env%bh_ref)) then
+    parallel = env%bh_ref%parallel
+  end if
+
+!=========================================================================================!
+  call tim%start(14,'Basin-Hopping (BH)')
+
+  if (parallel) then
+    call parallel_basinhopping_core(env,mol,calc,structuredump)
+  else
+    call single_basinhopping_core(env,mol,calc,structuredump)
+  end if
+!>--- dump saved minima
+  nall = size(structuredump,1)
+  open (newunit=ich,file=trjf)
+  call wrensemble(ich,nall,structuredump)
+  close (ich)
+
+  if (io == 0) then
+    write (stdout,*)
+    write (stdout,*) 'BH run completed successfully'
+    write (stdout,*) 'Successfull quenches written to ',trjf
+  else
+    write (stdout,*) 'WARNING: BH run terminated ABNORMALLY'
+    env%iostatus_meta = status_failed
+  end if
+  call tim%stop(14)
+
+  write (stdout,*)
+  call smallhead('Final Ensemble Sorting (iRMSD)')
+  allocate (groups(nall),source=0)
+  env%confgo = .true.
+  call cregen_irmsd_sort(env,nall,structuredump,groups,allcanon=.false.,printlvl=2)
+
+  if (allocated(groups)) deallocate (groups)
+  if (allocated(structuredump)) deallocate (structuredump)
+  return
+end subroutine crest_basinhopping
+
+subroutine single_basinhopping_core(env,mol,calc,structuredump)
+  use crest_parameters
+  use crest_data
+  use crest_calculator
+  use strucrd
+  use cregen_interface,only:unionizeEnsembles
+  use optimize_module
+  use molbuilder_classify
+  use bh_module
+  implicit none
+  type(systemdata),intent(inout) :: env
+  type(coord),intent(inout) :: mol
+  type(coord),allocatable,intent(inout) :: structuredump(:)
+  type(calcdata),intent(inout) :: calc
+!========================================================================================!
+  integer :: i,j,k,l,io,ich,T,Tn,mciter
+  logical :: pr,wr
+  type(bh_class) :: bh
+  integer :: nall
+!========================================================================================!
+  call new_ompautoset(env,'max',0,T,Tn)
+!========================================================================================!
+!>--- actual basin hopping
+  if (allocated(env%bh_ref)) then
+    bh = env%bh_ref
+    call bh%init()
+  else
+    call bh%init(300.0_wp,200,20)
+    bh%stepsize(1) = 1.0_wp
+  end if
+  select case (bh%steptype)
+  case (1,2) !> internals, dihedral only
+    write (stdout,'(a)') '> Setting up internal coordinates for input molecule:'
+    call setup_classify(mol,bh%molc)
+    call functional_group_classify(bh%molc)
+    call bh%molc%get_zmat(.true.)
+    call bh%molc%print_zmat(stdout)
+    write (stdout,*)
+    call bh%molc%check_dihedrals()
+  end select
+  bh%id = 0
+  if (allocated(env%refine_queue)) then
+    bh%refine_queue = env%refine_queue
+  end if
+
+  nall = 0
+  do mciter = 1,bh%maxiter
+    if (bh%maxiter > 1) call printiter3('Basin-Hopping Epoch',mciter)
+    call bh%newiter()
+    call mc(calc,mol,bh,io,verbosity=2)
+
+    if (io .eq. 0) then
+      write (stdout,'(a)') 'New structures will be appended to memory ...'
+      call unionizeEnsembles(nall,structuredump,bh%saved,bh%structures, &
+      &                      ethr=bh%ethr,rthr=bh%rthr)
+    else
+      write (stdout,'(a)') 'Skipping run with failed initial quench ...'
+    end if
+    write (stdout,'(a,i0,a)') 'Currently ',nall,' structures saved!'
+  end do
+  return
+end subroutine single_basinhopping_core
+
+subroutine parallel_basinhopping_core(env,mol,calc,structuredump)
+!**************************************************************************
+!* subroutine parallel_basinhopping_core
+!* Perform multiple independent BH runs from a single given starting point
+!* Ensembles are unified at the end and returned via structuedump
+!**************************************************************************
+  use crest_parameters
+  use crest_data
+  use crest_calculator
+  use strucrd
+  use cregen_interface,only:unionizeEnsembles
+  use optimize_module
+  use bh_module
+  use iomod,only:is_terminal
+  use molbuilder_classify
+  implicit none
+  !> INPUT/OUTPUT
+  type(systemdata),intent(inout) :: env
+  type(coord),intent(inout) :: mol
+  type(coord),allocatable,intent(inout) :: structuredump(:)
+  type(calcdata),intent(in) :: calc
+!========================================================================================!
+  !> LOCAL
+  integer :: i,j,k,l,io,ich,T,Tn,mciter
+  logical :: pr,wr
+  type(calcdata),allocatable :: calcp(:)
+  type(bh_class),allocatable :: bhp(:)
+  type(coord),allocatable    :: mols(:)
+  real(wp) :: energy
+  integer :: nall,verbose,iostatus
+  character(len=128) :: tag
+  type(mollist),allocatable :: dumplist(:)
+
+  call new_ompautoset(env,'auto',0,T,Tn)
+  !======================================================================================!
+  !> THIS IS THE PARALLEL IMPORTANT BIT
+  !======================================================================================!
+!>--- allocate temporary spaces for parallel usage
+  allocate (mols(T),source=mol)
+  allocate (bhp(T))
+  allocate (calcp(T),source=calc)
+  allocate (dumplist(T))
+  if (allocated(env%bh_ref)) then
+    do K = 1,T
+      bhp(K) = env%bh_ref
+      call bhp(K)%init()
+    end do
+  else
+    do K = 1,T
+      call bhp(K)%init(300.0_wp,200,20)
+      bhp(K)%stepsize(1) = 1.0_wp
+    end do
+  end if
+  do K = 1,T
+    call calcp(K)%copy(calc)
+    bhp(K)%id = K-1
+    !$omp critical
+    select case (bhp(K)%steptype)
+    case (1,2) !> internals, dihedral only
+      if (K == 1) write (stdout,'(a)') '> Setting up internal coordinates for input molecule:'
+      call setup_classify(mol,bhp(K)%molc)
+      call functional_group_classify(bhp(K)%molc)
+      call bhp(K)%molc%get_zmat(.true.)
+      if (K == 1) call bhp(K)%molc%print_zmat(stdout)
+      if (K == 1) write (stdout,*)
+      call bhp(K)%molc%check_dihedrals()
+    end select
+    if (allocated(env%refine_queue)) then
+      bhp(K)%refine_queue = env%refine_queue
+    end if
+    !$omp end critical
+  end do
+
+!>--- pre-start server-based calculators before forking OMP threads
+  call preinit_mlip_parallel(calcp,T)
+
+  write (stdout,'(a)') '> Starting parallel Basin-Hopping execution'
+  write (stdout,*)
+
+  do mciter = 1,bhp(1)%maxiter
+    !$omp critical
+    write (tag,'(a,i0,a)') 'Basin-Hopping Epoch'
+    if (bhp(1)%maxiter > 1) call printiter3(trim(tag),mciter)
+    !$omp end critical
+    !$omp parallel do default(shared) private(K, mciter, iostatus) schedule(dynamic)
+    do K = 1,T
+      call bhp(K)%newiter()
+      call mc(calcp(K),mols(K),bhp(K),iostatus,verbosity=1)
+      if (iostatus .eq. 0) then
+        !$omp critical
+        write (stdout,'(a)') 'New structures will be appended to memory ...'
+        !$omp end critical
+        call unionizeEnsembles(dumplist(K)%nall,dumplist(K)%structure, &
+        &                      bhp(K)%saved,bhp(K)%structures, &
+        &                      ethr=bhp(K)%ethr,rthr=bhp(K)%rthr)
+      else
+        !$omp critical
+        write (stdout,'(a)') 'Skipping run with failed initial quench ...'
+        !$omp end critical
+      end if
+      !$omp critical
+      write (stdout,'(a,i0,a,i0,a)') 'Currently ',dumplist(K)%nall, &
+      &      ' structures saved (BH[',bhp(K)%id,'])!'
+      !$omp end critical
+    end do
+    !$omp end parallel do
+
+    !> Do things here (?)
+  end do
+
+  write (stdout,*)
+  write (stdout,'(a)') 'Parallel BH runs done!'
+  write (stdout,'(a)') 'Collecting structures in one ensemble ...'
+  nall = 0
+  do K = 1,T
+    call unionizeEnsembles(nall,structuredump, &
+    &                      dumplist(K)%nall,dumplist(K)%structure, &
+    &                      ethr=bhp(K)%ethr,rthr=bhp(K)%rthr)
+  end do
+  write (stdout,'(a,i0,a)') 'Total of ',nall,' structures remain.'
+!=======================================================================================!
+!> PARALLEL BIT END
+!=======================================================================================!
+  return
+end subroutine parallel_basinhopping_core
diff --git a/src/basinhopping/basinhopping.f90 b/src/basinhopping/basinhopping.f90
new file mode 100644
index 00000000..ddbc62e3
--- /dev/null
+++ b/src/basinhopping/basinhopping.f90
@@ -0,0 +1,47 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2024 Philipp Pracht, David Wales
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module bh_module
+  use crest_parameters
+  use strucrd,only:coord
+  use crest_calculator
+  use optimize_module
+  use bh_class_module
+  use bh_step_module
+  use bh_mc_module
+  implicit none
+  private
+
+  logical,parameter :: debug = .true.
+!  logical,parameter :: debug = .false.
+
+!>-- RE-EXPORTS
+  public :: mc
+  public :: bh_class
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+!=========================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!=========================================================================================!
+end module bh_module
diff --git a/src/basinhopping/class.f90 b/src/basinhopping/class.f90
new file mode 100644
index 00000000..3076f744
--- /dev/null
+++ b/src/basinhopping/class.f90
@@ -0,0 +1,203 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2024 Philipp Pracht, David Wales
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module bh_class_module
+  use crest_parameters
+  use strucrd,only:coord
+  use canonical_mod
+  use irmsd_module
+  use molbuilder_classify
+  implicit none
+
+!=========================================================================================!
+
+  public :: bh_class
+  type :: bh_class
+!************************************************************************
+!* data object that contains the data for a *SINGLE* basin-hopping chain
+!************************************************************************
+    integer :: id = 0            !> Run/Thread ID
+    integer,allocatable :: seed  !> RNG seed, only used when allocated
+!>--- settings
+    logical :: parallel = .false.  !> runtype definition    
+    integer :: quenchmode = 0      !> selection of how to quench structures 
+    integer :: duplicatemode = 0   !> selection of how to prune duplicates
+
+!>--- counters
+    integer :: iteration = 0   !> current iteration
+    integer :: saved = 0       !> number of saved quenches
+
+!>--- paramters
+    integer  :: maxiter = 1        !> maximum repetitions of the whole BH run
+    integer  :: maxsteps = 100     !> maximum steps to take
+    real(wp) :: temp = 300.0_wp    !> MC acceptance temperature
+    real(wp) :: scalefac = 1.0_wp  !> temperature increase factor
+    real(wp) :: rthr = 0.125_wp    !> RMSD threshold (\AA)
+    real(wp) :: ethr = 0.05_wp     !> minima/conformer energy distinction (kcal/mol)
+    integer :: steptype = 0        !> step type selection
+    real(wp) :: stepsize(3) = &    !> step sizes e.g. for lengths, angles, dihedrals
+    &    (/0.2_wp,0.2_wp,0.2_wp/)
+    integer :: maxsave = 100       !> maximum number of quenches saved
+    real(wp),allocatable :: etarget  !> target energy to be hit (useful in benchmarks)
+
+    integer,allocatable :: refine_queue(:)
+
+!>--- results/properties
+    real(wp) :: emin = 0.0_wp  !> current ref energy of markov chain
+    integer  :: whichmin = 0   !> mapping to which structure emin refers
+    real(wp) :: emax = 0.0_wp  !> highest energy structure among saved quenches
+    integer  :: whichmax = 0   !> mapping of highest energy structure
+    type(coord),allocatable :: structures(:)  !> list of structures from succesfull quenches
+
+!>--- temporary storage
+    integer,allocatable  :: amat(:,:)        !> adjacency matrix
+    type(rmsd_cache),allocatable :: rcache   !> similarity check cache (iRMSD)
+    logical :: stereocheck = .false.         !> check for false-rotamers?
+    type(canonical_sorter),allocatable :: sorters(:) !> canonical atom ID storage
+    logical :: topocheck = .true.            !> check for correct connectivity
+    type(canonical_sorter),allocatable :: refsort  !> use same reference connectivity for all
+
+!> internal coordinates (stored via coord_classify)
+   type(coord_classify) :: molc
+   
+
+!>--- Type procedures
+  contains
+    procedure :: init => bh_class_allocate
+    procedure :: deallocate => bh_class_deallocate
+    procedure :: add => bh_class_add
+    procedure :: newiter => bh_class_newiter
+  end type bh_class
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  subroutine bh_class_allocate(self,temp,maxsteps,maxsave)
+    implicit none
+    class(bh_class) :: self
+    real(wp),intent(in),optional :: temp
+    integer,intent(in),optional  :: maxsteps
+    integer,intent(in),optional  :: maxsave
+    real(wp) :: rand
+
+    call self%deallocate()
+    if (present(temp)) then
+      self%temp = temp
+    end if
+    if (present(maxsteps)) then
+      self%maxsteps = maxsteps
+    end if
+    if (present(maxsave)) then
+      self%maxsave = maxsave
+    end if
+    self%maxsave = min(self%maxsave,self%maxsteps)
+
+    self%iteration = 0
+    self%saved = 0
+    allocate (self%structures(self%maxsave))
+    allocate (self%sorters(self%maxsave))
+
+!>--- generate a random seed, if the object doesn't have one already
+    if (.not.allocated(self%seed)) then
+      !> Generate a real in [0,1)
+      call random_number(rand)
+      !> Scale and shift to produce an integer in [1,10mil]
+      allocate (self%seed)
+      self%seed = (int(rand*100000000.0)+1)
+    end if
+  end subroutine bh_class_allocate
+
+!=========================================================================================!
+
+  subroutine bh_class_deallocate(self)
+    implicit none
+    class(bh_class) :: self
+    if (allocated(self%structures)) deallocate (self%structures)
+    if (allocated(self%amat)) deallocate (self%amat)
+    if (allocated(self%sorters)) deallocate (self%sorters)
+    if (allocated(self%rcache)) deallocate (self%rcache)
+    if (allocated(self%refsort)) deallocate (self%refsort)
+  end subroutine bh_class_deallocate
+
+!========================================================================================!
+
+  subroutine bh_class_newiter(self)
+    implicit none
+    class(bh_class) :: self
+    integer :: i
+    self%iteration = self%iteration + 1
+    !$omp critical
+      do i = 1,self%saved
+         call self%sorters(i)%deallocate() 
+      enddo
+    !$omp end critical
+    self%saved=0
+  end subroutine bh_class_newiter
+
+!=========================================================================================!
+
+  subroutine bh_class_add(self,mol)
+    implicit none
+    class(bh_class) :: self
+    type(coord) :: mol
+    integer :: i,j
+    real(wp) :: mintmp,maxtmp
+    if (self%saved < self%maxsave) then
+      self%saved = self%saved+1
+      i = self%saved
+      !$omp critical 
+      self%structures(i) = mol
+      call self%sorters(i)%init(mol,invtype='apsp+',heavy=.false.)
+      if (i == 1) then
+        self%stereocheck = .not. (self%sorters(i)%hasstereo(mol))
+      end if
+      !$omp end critical
+    else
+      i = self%whichmax
+      !$omp critical 
+      self%structures(i) = mol
+      call self%sorters(i)%deallocate()
+      call self%sorters(i)%init(mol,invtype='apsp+',heavy=.false.)
+      call self%sorters(i)%shrink()
+      !$omp end critical
+    end if
+
+    mintmp = huge(mintmp)
+    maxtmp = -huge(maxtmp)
+    do i = 1,self%saved
+      if (self%structures(i)%energy < mintmp) then
+        mintmp = self%structures(i)%energy
+        self%whichmin = i
+      end if
+      if (self%structures(i)%energy > maxtmp) then
+        maxtmp = self%structures(i)%energy
+        self%whichmax = i
+      end if
+    end do
+    self%emin = mintmp
+    self%emax = maxtmp
+  end subroutine bh_class_add
+
+!=========================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!=========================================================================================!
+end module bh_class_module
diff --git a/src/basinhopping/mc.f90 b/src/basinhopping/mc.f90
new file mode 100644
index 00000000..effb7e26
--- /dev/null
+++ b/src/basinhopping/mc.f90
@@ -0,0 +1,488 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2024 Philipp Pracht, David Wales
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module bh_mc_module
+  use crest_parameters
+  use iomod
+  use strucrd,only:coord
+  use crest_calculator
+  use optimize_module
+  use axis_module
+  use irmsd_module
+  use canonical_mod
+  use quicksort_interface,only:ensemble_qsort
+  use bh_class_module
+  use bh_step_module
+  implicit none
+  private
+
+!  logical,parameter :: debug = .true.
+  logical,parameter :: debug = .false.
+
+  public :: mc
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  subroutine mc(calc,mol,bh,iostat,verbosity)
+!********************************************************************
+!* A thread-safe single basin-hopping MC run
+!* Parameters and quenched structures are saved within the bh object
+!********************************************************************
+    implicit none
+    !> IN/OUTPUT
+    type(calcdata),intent(inout) :: calc  !> potential settings
+    type(coord),intent(inout)    :: mol   !> molecular system
+    type(bh_class),intent(inout) :: bh    !> BH settings
+    integer,intent(out) :: iostat
+    integer,intent(in),optional  :: verbosity  !> printout parameter
+    !> LOCAL
+    type(coord) :: tmpmol    !> copy to take steps
+    type(coord) :: optmol    !> quenched structure
+    integer :: iter,iostatus,accepted,discarded,broke
+    real(wp) :: etot,ratio
+    real(wp),allocatable :: grd(:,:)
+    logical :: accept,dupe,broken
+    integer :: printlvl,first,last,dynamicseed
+    character(len=20) :: tag
+
+    !$omp critical
+    write (tag,'("BH[Runner ",i3,"]>")') bh%id
+    !$omp end critical
+
+    if (present(verbosity)) then
+      printlvl = verbosity
+    else
+      printlvl = 0
+    end if
+
+    iostat = 0
+
+!>--- Add input energy to Markov chain after an initial quench
+    !$omp critical
+    allocate (grd(3,mol%nat),source=0.0_wp)
+    !$omp end critical
+
+    if (printlvl > 0) then
+      !$omp critical
+      write (stdout,'(a,1x,a)') trim(tag),'Performing '//colorify('initial quench','gold')//"."
+      !$omp end critical
+    end if
+
+    tmpmol = mol
+    call mcquench(calc,bh,tmpmol,optmol,etot,grd,iostatus)
+    if (iostatus .ne. 0) then
+      !$omp critical
+      write (stdout,'(a,1x,a)') trim(tag),colorify('** WARNING **','red')// &
+        & ' initial quench failed. Returning.'
+      !$omp end critical
+      iostat = iostatus
+      return
+    end if
+    !$omp critical
+    mol = optmol
+    bh%emin = mol%energy
+    !$omp end critical
+    call bh%add(mol)
+
+!>--- print information about the run?
+    if (printlvl > 0) then
+      !$omp critical
+      call mcheader(bh)
+      !$omp end critical
+    end if
+
+!>--- seed the RNG?
+    if (allocated(bh%seed)) then
+      dynamicseed = bh%seed+(bh%iteration-1)+bh%id*1000
+      if (printlvl > 1) then
+        !$omp critical
+        write (stdout,'(a,1x,2(a,i0),a)') trim(tag), &
+        & 'Seeding current RNG instance with: ',bh%seed,' (',dynamicseed,')'
+        !$omp end critical
+      end if
+      call RNG_seed(bh%seed)
+    end if
+
+!=======================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+    accepted = 0
+    discarded = 0
+    broke = 0
+    MonteCarlo: do iter = 1,bh%maxsteps
+      broken = .false.
+      dupe = .false.
+
+!>--- Take the step (mol --> tmpmol)
+      call takestep(mol,calc,bh,tmpmol)
+
+!>--- Quench it (tmpmol --> optmol)
+      call mcquench(calc,bh,tmpmol,optmol,etot,grd,iostatus)
+
+!>--- Accept/reject
+      if (iostatus == 0) then  !> successfull optimization
+
+        if (printlvl > 1) then
+          !$omp critical
+          write (stdout,'(a,1x,a,es17.8,a,es17.8,a)') trim(tag),'Quench E=',etot, &
+          &  ' Eh, Markov E=',bh%emin,' Eh'
+          !$omp end critical
+        end if
+
+        accept = mcaccept(optmol,bh)
+        if (accept) then
+          accepted = accepted+1
+
+          call axis(optmol%nat,optmol%at,optmol%xyz)
+
+          !> check duplicates here
+          call mcduplicate(mol,bh,dupe,broken)
+
+          !$omp critical
+          if (printlvl > 1) then
+            write (stdout,'(a)',advance='no') repeat(' ',len_trim(tag)+1)// &
+            & "Quench "//colorify('ACCEPTED','green')
+          end if
+
+          if (broken) then
+            broke = broke+1
+            if (printlvl > 1) write (stdout,'(a)',advance='no') &
+            & ', but REJECTED due to topology mismatch!'
+          else if (dupe) then
+            discarded = discarded+1
+            if (printlvl > 1) write (stdout,'(a)',advance='no') &
+            & ', but '//colorify('NOT SAVED','yellow')//' due to duplicate detection!'
+          else if (printlvl == 1) then
+            write (stdout,'(a,1x,a,a,es17.8,a)') trim(tag),"Quench "//colorify('ACCEPTED','green'), &
+              & ', NEW Markov E=',bh%emin,' Eh'
+          end if
+
+          if (printlvl > 1) write (stdout,'(/)')
+          !$omp end critical
+        else
+          if (printlvl > 1) then
+            !$omp critical
+            write (stdout,'(a,a,/)') repeat(' ',len_trim(tag)+1), &
+            &                 'Quench '//colorify('REJECTED','red')//', does not fulfill MC criterion'
+            !$omp end critical
+          end if
+          cycle MonteCarlo
+        end if
+      else
+        if (printlvl > 1)then
+          !$omp critical
+          write (stdout,'(a,1x,a,/)') trim(tag),"Quench "//colorify("FAILED","red")
+          !$omp end critical
+        endif
+        cycle MonteCarlo
+      end if
+
+!>--- Update structures
+      if (.not.broken) then
+        !> continue Markov chain
+        !$omp critical
+        mol = optmol
+        !$omp end critical
+
+        if (.not.dupe) then
+          !> Save new unique structures
+          call bh%add(mol)
+        end if
+      end if
+
+    end do MonteCarlo
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!=======================================================================================!
+
+!>--- Post-processing
+    first = 1
+    last = bh%saved
+    call ensemble_qsort(bh%maxsave,bh%structures,first,last)
+
+!>--- Stats
+    if (printlvl > 0) then
+      !$omp critical
+      call mcstats(bh,accepted,discarded,broke)
+      !$omp end critical
+    end if
+
+    deallocate (grd)
+  end subroutine mc
+
+!=========================================================================================!
+
+  subroutine mcheader(bh)
+    implicit none
+    type(bh_class),intent(in) :: bh
+    character(len=80) :: atmp
+    integer :: n
+
+    write (stdout,'(t8,a)') '┌'//repeat('─',63)//'┐'
+    write (stdout,'(t8,a,1x)',advance='no') '│'
+    write (stdout,'(a,3x)',advance='no') 'Starting Basin-Hopping Global Optimization'
+    write (stdout,'(a,i3,a)',advance='no') '[Thread/ID ',bh%id,']'
+    write (stdout,'(2x,"│")')
+    write (stdout,'(t8,a)') '╞'//repeat('═',63)//'╡'
+
+    write (stdout,'(t8,a,1x)',advance='no') '│'
+    write (stdout,'(a,f20.10,a)',advance='no') 'Initial energy:',bh%emin,' Eh'
+    write (stdout,'(24x,"│")')
+
+    write (stdout,'(t8,a,1x)',advance='no') '│'
+    write (stdout,'(a,es10.3,2x)',advance='no') 'T/K: ',bh%temp
+    write (stdout,'(a,i5,3x)',advance='no') 'steps: ',bh%maxsteps
+    write (stdout,'(a,i5,3x)',advance='no') 'max save: ',bh%maxsave
+    write (stdout,'(12x,"│")')
+
+    if (allocated(bh%seed)) then
+      write (stdout,'(t8,a,1x)',advance='no') '│'
+      write (atmp,'(a,i0)') 'Random number generation (reference) seed: ',bh%seed
+      write (stdout,'(a,1x)',advance='no') trim(atmp)
+      n = 61-len_trim(atmp)
+      write (stdout,'(a)',advance='no') repeat(' ',n)
+      write (stdout,'("│")')
+    end if
+
+    write (stdout,'(t8,a,1x)',advance='no') '│'
+    write (stdout,'(a,a,2x)',advance='no') 'step type: ',steptypestr(bh%steptype)
+    write (stdout,'(a,3f9.5)',advance='no') 'step size:',bh%stepsize(1:3)
+    write (stdout,'(3x,"│")')
+
+    write (stdout,'(t8,a,1x)',advance='no') '│'
+    write (stdout,'(a,f9.5,a)',advance='no') 'Thresholds   ΔRMSD:',bh%rthr,' Å,  '
+    write (stdout,'(a,es11.4,a)',advance='no') 'ΔE: ',bh%ethr,' kcal/mol'
+    write (stdout,'(5x,"│")')
+
+    write (stdout,'(t8,a)') '└'//repeat('─',63)//'┘'
+  end subroutine mcheader
+
+  subroutine mcstats(bh,accepted,discarded,broke)
+    implicit none
+    type(bh_class),intent(in) :: bh
+    integer,intent(in) :: accepted,discarded,broke
+    real(wp) :: ratio
+
+    write (stdout,'(t8,a)') colorify('┌'//repeat('─',63)//'┐','green')
+    write (stdout,'(t8,a,1x)',advance='no') colorify("│","green")
+    write (stdout,'(a,21x)',advance='no') 'Basin-Hopping Statistics'
+    write (stdout,'(a,i3,a)',advance='no') '[Thread/ID ',bh%id,']'
+    write (stdout,'(2x,a)') colorify("│","green")
+
+    write (stdout,'(t8,a,1x)',advance='no') colorify("│","green")
+    write (stdout,'(a,12x,f17.8,a)',advance='no') 'Latest Markov chain energy: ',bh%emin,' Eh'
+    write (stdout,'(2x,a)') colorify("│","green")
+
+    write (stdout,'(t8,a,1x)',advance='no') colorify("│","green")
+    ratio = real(accepted,wp)/real(bh%maxsteps,wp)
+    write (stdout,'(a,f6.2,a)',advance='no') 'MC acceptance ratio ',ratio*100.0_wp,' %, '
+    ratio = real(discarded,wp)/real(accepted,wp)
+    write (stdout,'(a,f6.2,a)',advance='no') 'similarity rejection  ',ratio*100.0_wp,' %'
+    write (stdout,'(2x,a)') colorify("│","green")
+
+    write (stdout,'(t8,a,1x)',advance='no') colorify("│","green")
+    ratio = real(broke,wp)/real(accepted,wp)
+    write (stdout,'(a,f6.2,a)',advance='no') 'topology rejection  ',ratio*100.0_wp,' %, '
+    ratio = real(accepted-discarded-broke,wp)/real(bh%maxsteps,wp)
+    write (stdout,'(a,f6.2,a)',advance='no') 'TOTAL ACCEPT ratio    ',ratio*100.0_wp,' %'
+    write (stdout,'(2x,a)') colorify("│","green")
+    write (stdout,'(t8,a)') colorify('└'//repeat('─',63)//'┘',"green")
+  end subroutine mcstats
+
+!=========================================================================================!
+
+  subroutine RNG_seed(iseed)
+!*************************************
+!* seed the RNG to get a reproducible
+!* sequence of random numbers
+!*************************************
+    integer,intent(in) :: iseed
+    integer :: n
+    integer,allocatable :: seedArray(:)
+    !> 1) Query how many integers are needed to set the seed (compiler dependent!)
+    call random_seed(size=n)
+    !> 2) Allocate and assign a known pattern
+    allocate (seedArray(n))
+    seedArray(:) = iseed
+    !> 3) Set the seed explicitly
+    call random_seed(put=seedArray)
+    deallocate (seedArray)
+  end subroutine RNG_seed
+
+!=========================================================================================!
+
+  function mcaccept(mol,bh) result(accept)
+!**************************************
+!* The regular MC acceptance condition
+!**************************************
+    implicit none
+    logical :: accept
+    type(coord),intent(in) :: mol
+    type(bh_class),intent(in) :: bh
+    real(wp) :: eold,enew,temp
+    real(wp) :: random,fact
+    accept = .false.
+    eold = bh%emin
+    enew = mol%energy
+    temp = bh%temp*kB  !> Kelvin to a.u.
+
+    if (enew .lt. eold) then
+      accept = .true.
+    else
+      call random_number(random)
+      fact = exp(-(enew-eold)/temp)
+      if (fact .gt. random) accept = .true.
+    end if
+
+  end function mcaccept
+
+!=========================================================================================!
+
+  subroutine mcduplicate(mol,bh,dupe,broken)
+!*****************************************************
+!* Check if a new structure (mol) is already in the
+!* list of saved structures (bh%structures)
+!*****************************************************
+    implicit none
+    type(coord),intent(in)       :: mol
+    type(bh_class),intent(inout) :: bh
+    real(wp) :: rthr,ethr
+    logical,intent(out) :: dupe,broken
+    !> LOCAL
+    integer :: i,j,k,l,nat
+    type(canonical_sorter) :: newsort
+    real(wp) :: rmsdval,deltaE
+    logical :: topocheck
+
+    dupe = .false.
+    broken = .false.
+    ethr = bh%ethr
+    rthr = bh%rthr
+    nat = mol%nat
+    topocheck = .true.
+
+    if (debug) write (*,*)
+
+    if (.not.allocated(bh%rcache)) then
+      if (debug) write (*,*) "allocating RCACHE"
+      !$omp critical
+      allocate (bh%rcache)
+      call bh%rcache%allocate(nat)
+      !$omp end critical
+    end if
+
+    !$omp critical
+    call newsort%init(mol,invtype='apsp+',heavy=.false.)
+    !$omp end critical
+
+    COMPARE: do i = 1,bh%saved
+
+      !> Energy difference
+      deltaE = (mol%energy-bh%structures(i)%energy)*autokcal
+
+      !> Geometry difference (permutation-invariant RMSD)
+      if (topocheck) then
+        bh%rcache%rank(1:nat,1) = newsort%rank(1:nat)
+        bh%rcache%rank(1:nat,2) = bh%sorters(i)%rank(1:nat)
+      end if
+      call min_rmsd(mol,bh%structures(i), &
+      &        rcache=bh%rcache,rmsdout=rmsdval)
+
+      if (debug) write (*,'(a,es15.4,a,es15.4,a)') 'RMSD=',rmsdval*autoaa, &
+      &          ' Å, delta E=',deltaE,' kcal/mol'
+
+      !> Check
+      if (abs(deltaE) .lt. ethr.and.rmsdval*autoaa .lt. rthr) then
+        dupe = .true.
+        if (deltaE < 0.0_wp) then
+          !> if the energy is lower, we replace the molecule (better conformation)
+          bh%structures(i) = mol
+        end if
+        exit COMPARE
+      end if
+    end do COMPARE
+
+    !$omp critical
+    call newsort%deallocate()
+    !$omp end critical
+  end subroutine mcduplicate
+
+  !========================================================================================!
+
+  subroutine mcquench(calc,bh,tmpmol,optmol,etot,grd,iostat)
+    implicit none
+    !> Input
+    type(calcdata),intent(inout) :: calc      !> potential settings
+    type(bh_class),intent(inout) :: bh        !> BH settings
+    type(coord),intent(inout)    :: tmpmol    !> molecular system
+    real(wp),intent(inout)       :: etot      !> quenechd energy
+    real(wp),intent(inout)       :: grd(:,:)  !> gradient (temp storage)
+    !> Output
+    type(coord),intent(out)      :: optmol    !> molecular system output
+    integer,intent(out)          :: iostat    !> return status
+
+    integer :: nrefine,ii
+    real(wp) :: etmp
+    iostat = 1
+
+    !> initial proper quench (refine_lvl = 0)
+    call optimize_geometry(tmpmol,optmol,calc,etot,grd, &
+     &                      .false.,.false.,iostat)
+
+    !> Special Post-processing via refinement queue
+    if (allocated(bh%refine_queue).and.iostat == 0) then
+
+      nrefine = size(bh%refine_queue,1)
+
+      do ii = 1,nrefine
+        if (iostat .ne. 0) exit
+        calc%refine_stage = bh%refine_queue(ii)
+        select case (calc%refine_stage)
+        case (1) !> singlepoint (rerank)
+          call engrad(optmol,calc,etot,grd,iostat)
+
+        case (2) !> singlepoint (add)
+          call engrad(optmol,calc,etmp,grd,iostat)
+          etot = etot+etmp
+
+        case (3) !> geometry opt (requench)
+          tmpmol = optmol
+          call optimize_geometry(tmpmol,optmol,calc,etot,grd, &
+          &                      .false.,.false.,iostat)
+
+        case default
+          continue
+        end select
+      end do
+
+      !> RESET refine level for next quench
+      calc%refine_stage = 0
+
+      !> Important: last energy must be stored in the optmol
+      optmol%energy = etot
+    end if
+
+  end subroutine mcquench
+
+!=========================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!=========================================================================================!
+end module bh_mc_module
diff --git a/src/basinhopping/meson.build b/src/basinhopping/meson.build
new file mode 100644
index 00000000..0b83855d
--- /dev/null
+++ b/src/basinhopping/meson.build
@@ -0,0 +1,10 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+
+srcs += files(
+'algo.f90',
+'basinhopping.f90',
+'class.f90',
+'mc.f90',
+'takestep.f90',
+)
diff --git a/src/basinhopping/takestep.f90 b/src/basinhopping/takestep.f90
new file mode 100644
index 00000000..fa705d23
--- /dev/null
+++ b/src/basinhopping/takestep.f90
@@ -0,0 +1,157 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2024 Philipp Pracht, David Wales
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module bh_step_module
+  use crest_parameters
+  use strucrd,only:coord
+  use crest_calculator
+  use bh_class_module
+  implicit none
+  private
+
+  logical,parameter :: debug = .true.
+!  logical,parameter :: debug = .false.
+
+  public :: takestep,steptypestr,takestep_cart,take_fixed_stepsize_cart
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  function steptypestr(steptype) result(str)
+    implicit none
+    integer,intent(in) :: steptype
+    character(len=:),allocatable :: str
+    select case (steptype)
+    case default !> Cartesian
+      str = 'Cartesian'
+    case (1) !> natural internals
+      str = 'internal '
+    case (2) !> dihedral only
+      str = 'dihedral '
+    case (3) !> intermolecular (CMA,tilt) only
+      str = 'intermol '
+    end select
+  end function steptypestr
+
+!=========================================================================================!
+!=========================================================================================!
+
+  subroutine takestep(mol,calc,bh,newmol)
+    implicit none
+    !> IN/OUTPUT
+    type(coord),intent(in)       :: mol   !> molecular system
+    type(calcdata),intent(inout) :: calc
+    type(bh_class),intent(inout) :: bh    !> BH settings
+    type(coord),intent(out)      :: newmol
+    !> LOCAL
+
+    select case (bh%steptype)
+    case (0) !> Cartesian
+      newmol = mol
+      call takestep_cart(newmol,bh%stepsize(1),calc)
+    case (2) !> dihedral only
+      newmol = mol
+      call takestep_dihedral(newmol,bh%molc,bh%stepsize(3),calc)
+    case default
+      error stop 'Steptype not implemented yet'
+    end select
+
+  end subroutine takestep
+
+!=========================================================================================!
+!=========================================================================================!
+
+  subroutine takestep_cart(newmol,stepsize,calc)
+    implicit none
+    type(coord),intent(inout) :: newmol
+    real(wp),intent(in) :: stepsize
+    type(calcdata),intent(inout) :: calc
+    real(wp) :: r(3)
+    integer :: i
+    do i = 1,newmol%nat
+      if (calc%nfreeze > 0) then
+        if (calc%freezelist(i)) cycle
+      end if
+      call random_number(r)
+      r(:) = (r(:)-0.5_wp)*2.0_wp
+      newmol%xyz(:,i) = newmol%xyz(:,i)+r(:)*stepsize
+    end do
+  end subroutine takestep_cart
+
+  subroutine take_fixed_stepsize_cart(newmol,stepsize,calc)
+    implicit none
+    type(coord),intent(inout) :: newmol
+    real(wp),intent(in) :: stepsize
+    type(calcdata),intent(inout) :: calc
+    real(wp) :: r(3),length
+    integer :: i
+    do i = 1,newmol%nat
+      if (calc%nfreeze > 0) then
+        if (calc%freezelist(i)) cycle
+      end if
+      call random_number(r)
+      r(:) = (r(:)-0.5_wp)*2.0_wp
+      length = norm2(r)
+      newmol%xyz(:,i) = newmol%xyz(:,i)+r(:)*stepsize/length
+    end do
+  end subroutine take_fixed_stepsize_cart
+
+!=========================================================================================!
+
+  subroutine takestep_dihedral(newmol,molc,stepsize,calc)
+    use molbuilder_classify_type, only: dtypes
+    implicit none
+    type(coord),intent(inout) :: newmol
+    type(coord_classify),intent(inout) :: molc
+    real(wp),intent(in) :: stepsize
+    type(calcdata),intent(inout) :: calc
+    real(wp) :: r(1)
+    integer :: i,k
+    logical :: smartstep
+    call molc%update_zmat(newmol)
+    smartstep = allocated(molc%dtype)
+    if (smartstep) then
+      !> fallback: we need at least one valid dihdral if smartstep is true
+      !> otherwise we should turn it off again
+      k = count(molc%dtype(:) == dtypes%single)
+      if (k == 0) smartstep = .false.
+    end if
+
+    do i = 1,newmol%nat
+      if (molc%zmap(i,3) .ne. 0) then
+        if (smartstep) then
+          if (molc%dtype(i) .ne. dtypes%single) cycle
+        end if
+        call random_number(r)
+        r(:) = (r(:)-0.5_wp)*2.0_wp
+
+        molc%zmat(3,i) = molc%zmat(3,i)+r(1)*stepsize
+      end if
+    end do
+    !call molc%print_zmat(stdout)
+    call molc%from_zmat(newmol)
+  end subroutine takestep_dihedral
+
+!=========================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!=========================================================================================!
+end module bh_step_module
diff --git a/src/calculator/CMakeLists.txt b/src/calculator/CMakeLists.txt
index 13e1cd2e..29dead01 100644
--- a/src/calculator/CMakeLists.txt
+++ b/src/calculator/CMakeLists.txt
@@ -28,16 +28,27 @@ list(APPEND srcs
   "${dir}/oniom_hessian.F90"
   "${dir}/nonadiabatic.f90"
   "${dir}/tblite_api.F90"
+  "${dir}/components/rmsdpot.f90"
   "${dir}/api_helpers.F90"
   "${dir}/api_engrad.f90"
   "${dir}/gradreader.f90"
-  "${dir}/libpvol.F90"
+  "${dir}/components/libpvol.F90"
   "${dir}/subprocess_types.f90"
   "${dir}/xtb_sc.f90"
   "${dir}/orca_sc.f90"
   "${dir}/generic_sc.f90"
   "${dir}/turbom_sc.f90"
   "${dir}/subprocess_engrad.f90"
+  "${dir}/hessian_reconstruct.f90"
+  "${dir}/hr_utils.f90"
+  "${dir}/modelhessians.f90"
+  "${dir}/approxg.f90"
+  "${dir}/penalty.f90"
+  "${dir}/mlip_sc.F90"
+  "${dir}/components/ddx_pc.F90"
+  "${dir}/components/electrostatic.F90"
+  "${dir}/components/surface.F90"
+  "${dir}/components/solvation.F90"
 )
 
 set(srcs ${srcs} PARENT_SCOPE)
diff --git a/src/calculator/api_engrad.f90 b/src/calculator/api_engrad.f90
index 2db81965..920de4e7 100644
--- a/src/calculator/api_engrad.f90
+++ b/src/calculator/api_engrad.f90
@@ -1,7 +1,7 @@
 !================================================================================!
 ! This file is part of crest.
 !
-! Copyright (C) 2021 - 2023 Philipp Pracht
+! Copyright (C) 2021 - 2025 Philipp Pracht
 !
 ! crest is free software: you can redistribute it and/or modify it under
 ! the terms of the GNU Lesser General Public License as published by
@@ -27,14 +27,20 @@ module api_engrad
   use iso_fortran_env,only:wp => real64,stdout => output_unit
   use strucrd
   use calc_type
-  use iomod,only:makedir,directory_exist,remove
+  use iomod,only:makedir,directory_exist,remove,dump_array_to_tmp
+  use omp_lib
   !> API modules
   use api_helpers
   use tblite_api
   use gfn0_api
   use gfnff_api
+  use crest_solvation,only:solvation_setup,solvation_core
+  use crest_electrostatic,only:electrostatic_core
   use libpvol_api
   use lj
+  use approxg_module
+  use penalty_module
+  use mlip_sc
   implicit none
 !>--- private module variables and parameters
   private
@@ -43,7 +49,13 @@ module api_engrad
   public :: gfn0_engrad,gfn0occ_engrad
   public :: gfnff_engrad
   public :: libpvol_engrad
-  public :: lj_engrad !> RE-EXPORT
+  public :: lj_engrad   !> RE-EXPORT
+  public :: modelhessian_engrad
+  public :: rmsd_engrad
+  public :: mlip_engrad
+  public :: preinit_mlip_parallel
+  public :: solvation_engrad
+  public :: electrostatic_engrad
 
 !=========================================================================================!
 !=========================================================================================!
@@ -63,7 +75,6 @@ subroutine tblite_engrad(mol,calc,energy,grad,iostatus)
     real(wp),intent(inout) :: grad(3,mol%nat)
     integer,intent(out) :: iostatus
 
-    character(len=:),allocatable :: cpath
     logical :: loadnew,pr
 
     integer :: i,j,k,l,ich,och,io
@@ -76,25 +87,27 @@ subroutine tblite_engrad(mol,calc,energy,grad,iostatus)
     call tblite_init(calc,loadnew)
 !>--- tblite printout handling
     call api_handle_output(calc,'tblite.out',mol,pr)
-    if (pr .or. calc%prstdout) then
+    if (pr.or.calc%prstdout) then
       !> tblite uses its context (ctx) type, rather than calc%prch
       calc%tblite%ctx%unit = calc%prch
       calc%tblite%ctx%verbosity = 1
-      if(calc%prstdout)then
+      if (calc%prstdout) then
         !> special case, fwd to stdout (be carefule with this!)
         calc%tblite%ctx%unit = stdout
         calc%tblite%ctx%verbosity = 2
-      endif
+      end if
     else
       calc%tblite%ctx%verbosity = 0
     end if
 
 !>-- populate parameters and wavefunction
     if (loadnew) then
-      call tblite_setup(mol,calc%chrg,calc%uhf,calc%tblitelvl,calc%etemp,calc%tblite)
+      call tblite_setup(mol,calc%chrg,calc%uhf,calc%tblitelvl,calc%etemp,calc%tblite,calc%ceh_guess)
 
       call tblite_addsettings(calc%tblite,calc%maxscc,calc%rdwbo,calc%saveint,calc%accuracy)
 
+      call tblite_add_efield(calc%tblite,calc%efield)
+
       call tblite_add_solv(mol,calc%chrg,calc%uhf,calc%tblite, &
       &    calc%solvmodel,calc%solvent)
     end if
@@ -105,7 +118,7 @@ subroutine tblite_engrad(mol,calc,energy,grad,iostatus)
     call tblite_singlepoint(mol,calc%chrg,calc%uhf,calc%tblite, &
     &                       energy,grad,iostatus)
     if (iostatus /= 0) return
-    if(.not.calc%prstdout) &
+    if (.not.calc%prstdout) &
     & call api_print_e_grd(pr,calc%prch,mol,energy,grad)
 
 !>--- postprocessing, getting other data
@@ -116,6 +129,67 @@ subroutine tblite_engrad(mol,calc,energy,grad,iostatus)
     return
   end subroutine tblite_engrad
 
+!========================================================================================!
+
+  subroutine solvation_engrad(mol,calc,energy,grad,iostatus)
+!*********************************************************************
+!* Interface singlepoint call for the composite solvation calculator
+!*********************************************************************
+    implicit none
+    type(coord) :: mol
+    type(calculation_settings) :: calc
+    real(wp),intent(inout) :: energy
+    real(wp),intent(inout) :: grad(3,mol%nat)
+    integer,intent(out) :: iostatus
+
+    iostatus = 0
+    if (.not.allocated(calc%solv)) then
+      iostatus = 1
+      return
+    end if
+
+!>--- lazily resolve dielectric constant + GFN2/ALPB parameters
+    call solvation_setup(mol,calc%solv,iostatus)
+    if (iostatus /= 0) return
+
+!>--- stitched energy + gradient
+    call solvation_core(mol,calc%chrg,calc%solv,energy,grad,iostatus)
+    if (.not.calc%prstdout) call api_print_e_grd(.false.,calc%prch,mol,energy,grad)
+
+    return
+  end subroutine solvation_engrad
+
+!========================================================================================!
+
+  subroutine electrostatic_engrad(mol,calc,energy,grad,iostatus)
+!*********************************************************************
+!* Interface singlepoint call for the charge-equilibration calculator
+!*********************************************************************
+    implicit none
+    type(coord) :: mol
+    type(calculation_settings) :: calc
+    real(wp),intent(inout) :: energy
+    real(wp),intent(inout) :: grad(3,mol%nat)
+    integer,intent(out) :: iostatus
+    character(len=:),allocatable :: model
+
+    iostatus = 0
+    if (.not.allocated(calc%eeq)) then
+      iostatus = 1
+      return
+    end if
+    model = 'eeqbc'
+    if (allocated(calc%eeq%charge_model)) model = calc%eeq%charge_model
+
+!>--- energy, gradient and atomic charges (kept on the settings)
+    if (.not.allocated(calc%qat)) allocate (calc%qat(mol%nat))
+    call electrostatic_core(mol,calc%chrg,model,energy,grad,calc%qat,iostatus)
+    if (iostatus /= 0) return
+    if (.not.calc%prstdout) call api_print_e_grd(.false.,calc%prch,mol,energy,grad)
+
+    return
+  end subroutine electrostatic_engrad
+
 !========================================================================================!
 
   subroutine gfn0_engrad(mol,calc,g0calc,energy,grad,iostatus)
@@ -134,7 +208,6 @@ subroutine gfn0_engrad(mol,calc,g0calc,energy,grad,iostatus)
     integer,intent(out) :: iostatus
     !> LOCAL
     type(gfn0_results) :: res
-    character(len=:),allocatable :: cpath
     logical :: loadnew
     logical :: pr
 
@@ -161,7 +234,7 @@ subroutine gfn0_engrad(mol,calc,g0calc,energy,grad,iostatus)
     if (iostatus /= 0) return
     if (pr) then
       call gfn0_print(calc%prch,g0calc,res)
-      if(.not.calc%prstdout) &
+      if (.not.calc%prstdout) &
       & call api_print_e_grd(pr,calc%prch,mol,energy,grad)
     end if
 
@@ -191,7 +264,6 @@ subroutine gfn0occ_engrad(mol,calc,g0calc,energy,grad,iostatus)
     integer,intent(out) :: iostatus
     !> LOCAL
     type(gfn0_results) :: res
-    character(len=:),allocatable :: cpath
     logical :: loadnew,pr
     integer :: i,j,k,l,ich,och,io
     logical :: ex
@@ -217,7 +289,7 @@ subroutine gfn0occ_engrad(mol,calc,g0calc,energy,grad,iostatus)
     if (iostatus /= 0) return
     if (pr) then
       call gfn0_print(calc%prch,g0calc,res)
-      if(.not.calc%prstdout) &
+      if (.not.calc%prstdout) &
       & call api_print_e_grd(pr,calc%prch,mol,energy,grad)
     end if
 
@@ -243,13 +315,14 @@ subroutine gfnff_engrad(mol,calc,energy,grad,iostatus)
     real(wp),intent(inout) :: grad(3,mol%nat)
     integer,intent(out) :: iostatus
 
-    character(len=:),allocatable :: cpath
     logical :: loadnew,pr
     integer :: i,j,k,l,ich,och,io
     logical :: ex
+    character(len=:),allocatable :: tmpchrgs
+    real(wp),allocatable :: q(:)
     iostatus = 0
     pr = .false.
-!>--- setup system call information
+!>--- setup calculation data
     !$omp critical
     call gfnff_init(calc,loadnew)
 !>--- printout handling
@@ -257,7 +330,22 @@ subroutine gfnff_engrad(mol,calc,energy,grad,iostatus)
 
 !>--- populate parameters and neighbourlists
     if (loadnew) then
+      if (calc%ceh_guess) then
+        if (pr) then
+          write (calc%prch,'(/,a)') 'Initializing (fragement) charges from CEH model'
+        end if
+        !> A bit hacky and additional I/O, but would need adjusting submodule code otherwise
+        call tblite_quick_ceh_q(mol,q,calc%chrg,pr=pr,prch=calc%prch)
+        tmpchrgs = dump_array_to_tmp(q)
+        calc%ff_dat%refcharges = tmpchrgs
+      end if
+
       call gfnff_api_setup(mol,calc%chrg,calc%ff_dat,iostatus,pr,calc%prch)
+
+      if (calc%ceh_guess) then
+        call remove(tmpchrgs)
+        deallocate (q)
+      end if
     end if
     !$omp end critical
     if (iostatus /= 0) return
@@ -270,7 +358,7 @@ subroutine gfnff_engrad(mol,calc,energy,grad,iostatus)
 !>--- printout
     if (pr) then
       call gfnff_printout(calc%prch,calc%ff_dat)
-      if(.not.calc%prstdout) & 
+      if (.not.calc%prstdout) &
       & call api_print_e_grd(pr,calc%prch,mol,energy,grad)
     end if
 
@@ -296,7 +384,6 @@ subroutine libpvol_engrad(mol,calc,energy,grad,iostatus)
     real(wp),intent(inout) :: grad(3,mol%nat)
     integer,intent(out) :: iostatus
 
-    character(len=:),allocatable :: cpath
     logical :: loadnew,pr
     integer :: i,j,k,l,ich,och,io
     logical :: ex
@@ -324,7 +411,7 @@ subroutine libpvol_engrad(mol,calc,energy,grad,iostatus)
 !>--- printout
     if (pr) then
       !> the libpvol_sp call includes the printout within libpvol-lib
-      if(.not.calc%prstdout) &
+      if (.not.calc%prstdout) &
       & call api_print_e_grd(pr,calc%prch,mol,energy,grad)
     end if
 
@@ -334,5 +421,203 @@ subroutine libpvol_engrad(mol,calc,energy,grad,iostatus)
   end subroutine libpvol_engrad
 
 !========================================================================================!
+
+  subroutine modelhessian_engrad(mol,calc,energy,grad,iostatus)
+!***************************************************************
+!* Interface singlepoint call between CREST and XHC force field
+!***************************************************************
+    implicit none
+    type(coord) :: mol
+    type(calculation_settings) :: calc
+
+    real(wp),intent(inout) :: energy
+    real(wp),intent(inout) :: grad(3,mol%nat)
+    integer,intent(out) :: iostatus
+
+    logical :: loadnew,pr
+    integer :: i,j,k,l,ich,och,io,n3
+    logical :: ex
+    iostatus = 0
+    pr = .false.
+!>--- setup system call information
+    !$omp critical
+!>--- printout handling
+    call api_handle_output(calc,'modh.out',mol,pr)
+!>--- populate parameters
+    n3 = mol%nat*3
+    if (calc%ag%dim .ne. mol%nat) then
+      calc%ag%pr = calc%prstdout.and..not.calc%numgrad
+
+      if (allocated(calc%ag%hess)) deallocate (calc%ag%hess)
+      allocate (calc%ag%hess(n3,n3),source=0.0_wp)
+
+      if (allocated(calc%ag%h)) deallocate (calc%ag%h)
+      allocate (calc%ag%h(n3*(n3+1)/2),source=0.0_wp)
+
+      if (allocated(calc%ag%freq)) deallocate (calc%ag%freq)
+      allocate (calc%ag%freq(n3),source=0.0_wp)
+
+      if (allocated(calc%ag%xyz)) deallocate (calc%ag%xyz)
+      allocate (calc%ag%xyz(3,mol%nat),source=0.0_wp)
+
+      calc%ag%dim = mol%nat
+    else
+      calc%ag%hess(:,:) = 0.0_wp
+      calc%ag%h(:) = 0.0_wp
+    end if
+    !$omp end critical
+    if (iostatus /= 0) return
+
+!>--- do the engrad call
+    call initsignal()
+    call modh_engrad(mol,calc%ag,energy,grad,iostatus)
+    if (iostatus /= 0) return
+
+!>--- printout
+    if (pr) then
+      !> the libpvol_sp call includes the printout within libpvol-lib
+      if (.not.calc%prstdout) &
+      & call api_print_e_grd(pr,calc%prch,mol,energy,grad)
+    end if
+
+!>--- postprocessing, getting other data
+
+    return
+  end subroutine modelhessian_engrad
+
+!========================================================================================!
+
+  subroutine rmsd_engrad(mol,calc,energy,grad,iostatus)
+!**************************************************************************
+!* Interface singlepoint to add RMSD penalty function (as in metadynamics)
+!**************************************************************************
+    implicit none
+    type(coord) :: mol
+    type(calculation_settings),target :: calc
+
+    real(wp),intent(inout) :: energy
+    real(wp),intent(inout) :: grad(3,mol%nat)
+    integer,intent(out) :: iostatus
+
+    logical :: loadnew,pr
+    integer :: i,j,k,l,ich,och,io,nall
+    logical :: ex
+    iostatus = 0
+    pr = .false.
+!>--- setup system call information
+
+    if (.not.associated(calc%penalty%biaslist)) then
+      if (allocated(calc%penalty%biasfile)) then
+        !$omp critical
+        call rdensemble(calc%penalty%biasfile,nall,calc%penalty%biastmp)
+        calc%penalty%biaslist => calc%penalty%biastmp
+        !$omp end critical
+      else
+        return
+      end if
+    end if
+    !$omp critical
+!>--- printout handling
+    call api_handle_output(calc,'rmsd_penalty.out',mol,pr)
+!>--- populate parameters
+    if (.not.allocated(calc%penalty%gradtmp)) then
+      allocate (calc%penalty%gradtmp(3,mol%nat),source=0.0_wp)
+      call calc%penalty%ccache%allocate(mol%nat)
+    else
+      calc%penalty%gradtmp(:,:) = 0.0_wp
+    end if
+    !$omp end critical
+    if (iostatus /= 0) return
+
+!>--- do the engrad call
+    call initsignal()
+    call rmsd_penalty_engrad(mol,calc%penalty,energy,grad,iostatus)
+    if (iostatus /= 0) return
+
+!>--- printout
+    if (pr) then
+      !> the libpvol_sp call includes the printout within libpvol-lib
+      if (.not.calc%prstdout) &
+      & call api_print_e_grd(pr,calc%prch,mol,energy,grad)
+    end if
+
+!>--- postprocessing, getting other data
+
+    return
+  end subroutine rmsd_engrad
+
+!========================================================================================!
+
+  subroutine preinit_mlip_parallel(calculations,T)
+!***********************************************************************
+!* Serially start one fmlip-relay server instance per OMP thread.
+!* Must be called before the OMP parallel region to avoid fork() inside
+!* a live thread team (triggers OMP Warning #191).
+!* Input:  calculations - per-thread calcdata array (size >= T)
+!*         T            - number of OMP threads / instances to start
+!***********************************************************************
+    implicit none
+    type(calcdata),intent(inout) :: calculations(:)
+    integer,intent(in)           :: T
+    integer :: i,j
+    do i = 1,T
+      do j = 1,calculations(i)%ncalculations
+        if (calculations(i)%calcs(j)%id == jobtype%mlip) then
+          call fmlip_relay_init(calculations(i)%calcs(j)%MPAR,i)
+        end if
+      end do
+    end do
+  end subroutine preinit_mlip_parallel
+
+!========================================================================================!
+
+  subroutine mlip_engrad(mol,calc,energy,grad,iostatus)
+!**************************************************************************
+!* MLIP singlepoint through persistent python socket
+!**************************************************************************
+    implicit none
+    type(coord) :: mol
+    type(calculation_settings),target :: calc
+
+    real(wp),intent(inout) :: energy
+    real(wp),intent(inout) :: grad(3,mol%nat)
+    integer,intent(out) :: iostatus
+
+    logical :: loadnew,pr
+    integer :: i,j,k,l,ich,och,io,iid
+    logical :: ex
+    iostatus = 0
+    pr = .false.
+!>--- each OpenMP thread owns one server instance; init is a no-op if running
+    iid = OMP_GET_THREAD_NUM()+1
+    !$omp critical
+    call fmlip_relay_init(calc%MPAR,iid)
+!>--- printout handling
+    call api_handle_output(calc,'mlip.out',mol,pr)
+    !$omp end critical
+    if (iostatus /= 0) return
+
+!>--- do the engrad call
+    call initsignal()
+    !> fmlip-relay expects the spin multiplicity (2S+1), not uhf = Nα-Nβ
+    call calc%sync_multiplicity()
+    call mlip_engrad_core(mol,calc%MPAR,energy,grad,iostatus, &
+      &                   charge=calc%chrg,spin=calc%multiplicity,iid=iid)
+    if (iostatus /= 0) return
+
+!>--- printout
+    if (pr) then
+      !> the libpvol_sp call includes the printout within libpvol-lib
+      if (.not.calc%prstdout) &
+      & call api_print_e_grd(pr,calc%prch,mol,energy,grad)
+    end if
+
+!>--- postprocessing, getting other data
+
+    return
+  end subroutine mlip_engrad
+
+!========================================================================================!
+!########################################################################################!
 !========================================================================================!
 end module api_engrad
diff --git a/src/calculator/api_helpers.F90 b/src/calculator/api_helpers.F90
index 81ee45e0..b268b938 100644
--- a/src/calculator/api_helpers.F90
+++ b/src/calculator/api_helpers.F90
@@ -21,7 +21,7 @@ module api_helpers
   use iso_fortran_env,only:wp => real64,stdout => output_unit
   use strucrd
   use calc_type
-  use iomod,only:makedir,directory_exist,remove
+  use iomod,only:makedir,directory_exist,remove,random_tmp_name
   !> APIs
   use tblite_api
   use gfn0_api
@@ -155,6 +155,7 @@ subroutine tblite_init(calc,loadnew)
       if(allocated(calc%tbliteparam))then
         calc%tblite%paramfile = calc%tbliteparam
       endif
+      calc%tblite%spin_polarized = calc%spin_polarized
       loadnew = .true.
     end if
     if (calc%apiclean) loadnew = .true.
@@ -390,6 +391,8 @@ subroutine libpvol_initcheck(calc,loadnew)
 #endif
   end subroutine libpvol_initcheck
 
+  
+
 !========================================================================================!
 !========================================================================================!
 end module api_helpers
diff --git a/src/calculator/approxg.f90 b/src/calculator/approxg.f90
new file mode 100644
index 00000000..61342048
--- /dev/null
+++ b/src/calculator/approxg.f90
@@ -0,0 +1,93 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!> a small module for getting a free energy as engrad call
+
+module approxg_module
+  use crest_parameters
+  use modelhessian_core
+  use thermochem_module
+  use strucrd
+  use optimize_maths,only:dhtosq
+  implicit none
+  private
+
+  public :: approxg_params
+  type :: approxg_params
+     integer :: dim = 0
+     logical :: pr = .false.
+     real(wp) :: T = 298.15_wp
+     real(wp),allocatable :: hess(:,:)
+     real(wp),allocatable :: h(:)
+     real(wp),allocatable :: freq(:)
+     real(wp),allocatable :: xyz(:,:)
+     real(wp) :: fscal = 1.0_wp
+     real(wp) :: ithr = -50.0_wp
+     real(wp) :: sthr = 50.0_wp
+  end type approxg_params
+
+  public :: modh_engrad
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  subroutine modh_engrad(mol,ag,dg,dggrad,iostatus)
+    type(coord),intent(in) :: mol
+    type(approxg_params),intent(inout) :: ag
+    real(wp),intent(out) :: dg
+    real(wp),intent(out) :: dggrad(:,:)
+    integer,intent(out) :: iostatus
+    integer :: n3,io
+    integer,parameter :: nt = 1
+    real(wp) :: temps(nt),et(nt),ht(nt),gt(nt),stot(nt)
+
+    type(mhparam) :: mhset
+
+    iostatus = 0
+    dg = 0.0_wp
+    dggrad(:,:) = 0.0_wp
+    temps(1) = ag%T
+
+    !> setup
+    n3 = mol%nat*3
+    call ddvopt(mol%xyz,mol%nat,ag%h,mol%at,mhset)
+
+    call dhtosq(n3,ag%hess,ag%h)
+    ag%h(:) = 0.0_wp
+
+    call prj_mw_hess(mol%nat,mol%at,n3,mol%xyz, &
+      &  ag%hess,ag%h)
+
+    call frequencies(mol%nat,mol%at,mol%xyz,n3,ag%hess,ag%freq,io)
+    iostatus = io
+    if (iostatus .ne. 0) return
+
+    ag%xyz(:,:) = mol%xyz(:,:)
+    call calcthermo(mol%nat,mol%at,ag%xyz,ag%freq,ag%pr, &
+                    ag%ithr,ag%fscal,ag%sthr,nt,temps,et,ht,gt,stot)
+
+    dg = gt(1)
+  end subroutine modh_engrad
+
+!========================================================================================!
+!========================================================================================!
+end module approxg_module
diff --git a/src/calculator/calc_type.f90 b/src/calculator/calc_type.f90
index 3b61bc49..4ff5106f 100644
--- a/src/calculator/calc_type.f90
+++ b/src/calculator/calc_type.f90
@@ -24,11 +24,17 @@ module calc_type
 !>--- api types
   use tblite_api
   use gfn0_api
+  use crest_solvation,only:solvation_data
+  use crest_electrostatic,only:electrostatic_data
   use gfnff_api,only:gfnff_data
   use libpvol_api,only:libpvol_calculator
 !>--- other types
   use orca_type
   use lwoniom_module
+  use hessian_reconstruct
+  use approxg_module, only: approxg_params
+  use penalty_module, only: penalty_params
+  use mlip_sc, only: mlip_params
   implicit none
 
   character(len=*),public,parameter :: sep = '/'
@@ -49,10 +55,15 @@ module calc_type
     integer :: gfnff     = 9
     integer :: libpvol   = 10
     integer :: lj        = 11
+    integer :: approxg   = 12
+    integer :: penalty   = 13
+    integer :: mlip      = 14
+    integer :: solvation = 15
+    integer :: electrostatic = 16
   end type enum_jobtype
   type(enum_jobtype), parameter,public :: jobtype = enum_jobtype()
 
-  character(len=45),parameter,private :: jobdescription(12) = [ &
+  character(len=45),parameter,private :: jobdescription(17) = [ &
      & 'Unknown calculation type                    ', &
      & 'xTB calculation via external binary         ', &
      & 'Generic script execution                    ', &
@@ -64,7 +75,12 @@ module calc_type
      & 'GFN0*-xTB calculation via GFN0 lib          ', &
      & 'GFN-FF calculation via GFNFF lib            ', &
      & 'external pressure calculation via libpvol   ', &
-     & 'Lennard-Jones potential calculation         ' ]
+     & 'Lennard-Jones potential calculation         ', &
+     & 'Approximate free energy computation         ', &
+     & 'Empirical penalty function                  ', &
+     & 'MLIP via persistent python socket           ', &
+     & 'Standalone implicit solvation contribution  ', &
+     & 'Charge-equilibration electrostatics         ']
 !&>
 
 !=========================================================================================!
@@ -82,7 +98,9 @@ module calc_type
     integer :: refine_lvl = 0 !> to allow defining different refinement levels
 
     integer :: chrg = 0          !> molecular charge
-    integer :: uhf = 0           !> uhf parameter (xtb) or multiplicity (other)
+    integer :: uhf = 0           !> uhf = Nα-Nβ = 2S (xtb/tblite/gfn0/gfnff/turbomole)
+    integer :: multiplicity = 1  !> spin multiplicity = 2S+1 = uhf+1 (ORCA, fmlip-relay)
+                                 !> kept aligned with uhf via sync_multiplicity/set_multiplicity
     logical :: active = .true.   !> active setting to disable the calculation (this is different from weight=0)
     real(wp) :: weight = 1.0_wp  !> calculation weight (when adding them up)
 
@@ -126,14 +144,16 @@ module calc_type
     real(wp),allocatable :: dipgrad(:,:)
 
     !> other properties
-    logical,allocatable :: getsasa(:) 
+    logical,allocatable :: getsasa(:)
     logical :: getlmocent = .false.
     integer :: nprot = 0
-    real(wp),allocatable :: protxyz(:,:) 
+    real(wp),allocatable :: protxyz(:,:)
+    real(wp),allocatable :: efield(:)  !> in V/Å
 
 !>--- API constructs
     integer  :: tblitelvl = 2
     real(wp) :: etemp = 300.0_wp
+    logical  :: etemp_user_set = .false.
     real(wp) :: accuracy = 1.0_wp
     logical  :: apiclean = .true.
     integer  :: maxscc = 500
@@ -150,6 +170,8 @@ module calc_type
 !>--- tblite data
     type(tblite_data),allocatable :: tblite
     character(len=:),allocatable :: tbliteparam
+    logical :: ceh_guess = .false.
+    logical :: spin_polarized = .false.
 
 !>--- GFN0-xTB data
     type(gfn0_data),allocatable :: g0calc
@@ -169,13 +191,28 @@ module calc_type
     real(wp) :: pvradscal = 1.0_wp     !> Scaling factor for SAS radii
     type(libpvol_calculator),allocatable :: libpvol
 
+!>--- implicit solvation composite data
+    type(solvation_data),allocatable :: solv
+
+!>--- charge-equilibration electrostatics data
+    type(electrostatic_data),allocatable :: eeq
+
+!>--- approxg data
+    type(approxg_params) :: ag
+
+!>--- penalty params
+    type(penalty_params) :: penalty
+
     !> ONIOM fragment IDs
     integer :: ONIOM_highlowroot = 0
     integer :: ONIOM_id = 0
 
-    !> ORCA job template
+!>--- ORCA job template
     type(orca_input) :: ORCA
 
+!>--- MLIP settings
+    type(mlip_params) :: MPAR
+
 !>--- Type procedures
   contains
     procedure :: deallocate => calculation_settings_deallocate
@@ -186,6 +223,9 @@ module calc_type
     procedure :: create => create_calclevel_shortcut
     procedure :: norestarts => calculation_settings_norestarts
     procedure :: dumpdipgrad => calculation_dump_dipgrad
+    procedure :: copy => calculation_settings_copy
+    procedure :: sync_multiplicity => calc_sync_multiplicity
+    procedure :: set_multiplicity => calc_set_multiplicity
   end type calculation_settings
 
 !=========================================================================================!
@@ -251,6 +291,9 @@ module calc_type
     logical  :: tsopt = .false.
     integer  :: iupdat = 0  !> 0=BFGS, 1=Powell, 2=SR1, 3=Bofill, 4=Schlegel
     integer  :: opt_engine = 0 !> default: ANCOPT
+    integer  :: lbfgs_histsize = 20  !> L-BFGS history size
+    integer  :: hess_init = 5 !> Initialization of the hessian, standard modhess lindh95
+    logical  :: logextxyz = .true.  !> write extended xyz files from optimization trajectories
 
 !>--- GFN0* data, needed for special MECP application
     type(gfn0_data),allocatable  :: g0calc
@@ -266,10 +309,36 @@ module calc_type
     integer,allocatable :: ONIOMmap(:) !> map ONIOM fragments to calculation_settings
     integer,allocatable :: ONIOMrevmap(:) !> map calculation settings to ONIOM frags (or zero)
 
+!>--- Hessian Reconstructor and Thermo data
+    type(cashed_hessian),allocatable :: chess
+    logical :: do_HR = .false.
+    logical :: full_HR = .false. !> Keyword for HR with all opt steps
+    integer :: hu_steps = 10 !> default number of update steps
+    integer :: nt !> following all required for thermochemistry
+    real(wp),allocatable :: temperatures(:)
+    real(wp),allocatable :: et(:),ht(:),gt(:),stot(:)
+    real(wp) :: ithr,fscal,sthr
+    character(len=:),allocatable :: emodel
+    integer :: initialize_hr_type !> case defining initialization
+    integer :: mh_type = 0
+    integer :: hr_hu_type = 0
+    logical :: deform_opt_hess = .false.
+    real(wp) :: doh_stepsize = 0.10_wp !>stepsize for the deformation/reoptimization hessian generation
+    real(wp) :: chess_id_guess = 0.1_wp
+    logical :: g_sampling = .false. !>Do sampling on free energy surface as approximated using the lindh95 hessian
+    integer :: gs_hess_type = 5
+
+!>--- Parameters for smooth function within optimizer
+    real(wp) :: L = 1.50_wp
+    real(wp) :: k = 5000.0_wp
+    real(wp) :: shift = 0.0006_wp
+    real(wp) :: scaling = 0.1_wp
+
 !>--- Type procedures
   contains
     procedure :: reset => calculation_reset
     procedure :: init => calculation_init
+    procedure :: create => calcdata_create_shortcut
     generic,public :: add => calculation_add_constraint,calculation_add_settings, &
     & calculation_add_scan,calculation_add_constraintlist
     procedure,private :: calculation_add_constraint,calculation_add_settings, &
@@ -281,7 +350,10 @@ module calc_type
     procedure :: ONIOMexpand => calculation_ONIOMexpand
     procedure :: active => calc_set_active
     procedure :: active_restore => calc_set_active_restore
+    generic,public :: set_freeze => calculation_set_freeze_range,calculation_set_freeze_bools
+    procedure,private :: calculation_set_freeze_range,calculation_set_freeze_bools
     procedure :: freezegrad => calculation_freezegrad
+    procedure :: set_charge => calculation_set_charge
     procedure :: increase_charge => calculation_increase_charge
     procedure :: decrease_charge => calculation_decrease_charge
     procedure :: dealloc_params => calculation_deallocate_params
@@ -353,10 +425,10 @@ subroutine calculation_deallocate_params(self)
     integer :: i,j,k
     if (self%ncalculations > 0) then
       do i = 1,self%ncalculations
-        if(allocated(self%calcs(i)%tblite)) deallocate(self%calcs(i)%tblite)
-        if(allocated(self%calcs(i)%g0calc)) deallocate(self%calcs(i)%g0calc)
-        if(allocated(self%calcs(i)%ff_dat)) deallocate(self%calcs(i)%ff_dat)
-        if(allocated(self%calcs(i)%libpvol)) deallocate(self%calcs(i)%libpvol)
+        if (allocated(self%calcs(i)%tblite)) deallocate (self%calcs(i)%tblite)
+        if (allocated(self%calcs(i)%g0calc)) deallocate (self%calcs(i)%g0calc)
+        if (allocated(self%calcs(i)%ff_dat)) deallocate (self%calcs(i)%ff_dat)
+        if (allocated(self%calcs(i)%libpvol)) deallocate (self%calcs(i)%libpvol)
       end do
     end if
   end subroutine calculation_deallocate_params
@@ -387,6 +459,52 @@ subroutine calculation_add_settings(self,cal)
     return
   end subroutine calculation_add_settings
 
+!=========================================================================================!
+
+  subroutine calcdata_create_shortcut(self,levelstring, &
+      & chrg,uhf,solvmodel,solvent)
+!*********************************************************************
+!* subroutine calcdata_create_shortcut called with %create(...)
+!* Quick clean setup of a *fresh* calcdata object holding exactly
+!* one calculation level. The calcdata is reset first, then a single
+!* calculation_settings object is built (via its own %create) for the
+!* requested level of theory and registered in self%calcs(1).
+!*
+!* This is the calcdata-level counterpart to the %create shortcut of
+!* the calculation_settings type and exists as an internal code
+!* shortcut only (it does not sanity-check the chosen settings).
+!*
+!* Required argument:
+!*  - levelstring : level of theory, passed on to settings%create
+!* Optional arguments (forwarded to settings%create):
+!*  - chrg        : molecular charge  (integer)
+!*  - uhf         : uhf parameter     (integer)
+!*  - solvmodel   : solvation model   (only together with solvent)
+!*  - solvent     : implicit solvent  (only together with solvmodel)
+!*********************************************************************
+    implicit none
+    class(calcdata),intent(inout) :: self
+    character(len=*),intent(in) :: levelstring
+    integer,intent(in),optional :: chrg
+    integer,intent(in),optional :: uhf
+    character(len=*),intent(in),optional :: solvmodel
+    character(len=*),intent(in),optional :: solvent
+    type(calculation_settings) :: job
+
+    ! ── start from a clean calcdata object ──────────────────────────
+    call self%reset()
+
+    ! ── build the single calculation level (absent optionals are ────
+    ! ── forwarded as absent to settings%create) ─────────────────────
+    call job%create(levelstring,chrg=chrg,uhf=uhf, &
+    &               solvmodel=solvmodel,solvent=solvent)
+
+    ! ── register it as the only level in this calcdata ──────────────
+    call self%add(job)
+
+    return
+  end subroutine calcdata_create_shortcut
+
 !=========================================================================================!
 
   subroutine calculation_add_constraint(self,constr)
@@ -532,47 +650,159 @@ end subroutine calculation_init
 
 !=========================================================================================!
 !> copy a calcdata object from src to self
-  subroutine calculation_copy(self,src)
+  subroutine calculation_copy(self,src,ignore_constraints)
     class(calcdata) :: self
-    type(calcdata) :: src
+    type(calcdata),intent(in) :: src
+    logical,intent(in),optional :: ignore_constraints
+    type(calculation_settings) :: newset
+    type(constraint) :: newcons
     integer :: i
+    logical :: igno
 
-    self%id = src%id
+    call self%reset()
 
-    self%ncalculations = src%ncalculations
-    if (allocated(self%calcs)) deallocate (self%calcs)
-    !self%calcs = src%calcs
-    do i = 1,self%ncalculations
-      call self%add(src%calcs(i))
-    end do
+! ── identity ─────────────────────────────────────────────────────────────────
+    self%id           = src%id
+    self%refine_stage = src%refine_stage
 
-    self%nconstraints = src%nconstraints
-    if (allocated(self%cons)) deallocate (self%cons)
-    !self%cons = src%cons
-    do i = 1,self%nconstraints
-      call self%add(src%cons(i))
+! ── calculation levels ───────────────────────────────────────────────────────
+    if (allocated(self%calcs)) deallocate(self%calcs)
+    self%ncalculations = 0
+    do i = 1,src%ncalculations
+      call newset%copy(src%calcs(i))
+      call self%add(newset)
     end do
 
-    self%optlev = src%optlev
-    self%micro_opt = src%micro_opt
-    self%maxcycle = src%maxcycle
-    self%maxdispl_opt = src%maxdispl_opt
-    self%hlow_opt = src%hlow_opt
-    self%hmax_opt = src%hmax_opt
-    self%acc_opt = src%acc_opt
-    self%exact_rf = src%exact_rf
-    self%average_conv = src%average_conv
-    self%tsopt = src%tsopt
-    self%iupdat = src%iupdat
+! ── constraints ──────────────────────────────────────────────────────────────
+    igno = .false.
+    if (present(ignore_constraints)) igno = ignore_constraints
+    if (allocated(self%cons)) deallocate(self%cons)
+    self%nconstraints = 0
+    if (.not.igno) then
+      do i = 1,src%nconstraints
+        call newcons%copy(src%cons(i))
+        call self%add(newcons)
+      end do
+    end if
 
-    self%pr_energies = src%pr_energies
-    self%eout_unit = src%eout_unit
-    self%elog = src%elog
+! ── scans ────────────────────────────────────────────────────────────────────
+    self%nscans    = src%nscans
+    self%relaxscan = src%relaxscan
+    self%scansforce = src%scansforce
+    if (allocated(src%scans)) then
+      allocate(self%scans(src%nscans))
+      do i = 1,src%nscans
+        self%scans(i)%type        = src%scans(i)%type
+        self%scans(i)%n           = src%scans(i)%n
+        self%scans(i)%steps       = src%scans(i)%steps
+        self%scans(i)%minval      = src%scans(i)%minval
+        self%scans(i)%maxval      = src%scans(i)%maxval
+        self%scans(i)%constrnmbr  = src%scans(i)%constrnmbr
+        self%scans(i)%restore     = src%scans(i)%restore
+        self%scans(i)%currentstep = src%scans(i)%currentstep
+        if (allocated(src%scans(i)%atms))   self%scans(i)%atms   = src%scans(i)%atms
+        if (allocated(src%scans(i)%points)) self%scans(i)%points = src%scans(i)%points
+      end do
+    end if
 
+! ── frozen atoms ─────────────────────────────────────────────────────────────
+    self%nfreeze = src%nfreeze
+    if (allocated(src%freezelist)) self%freezelist = src%freezelist
+
+! ── optimization settings ────────────────────────────────────────────────────
+    self%optnewinit     = src%optnewinit
+    self%anopt          = src%anopt
+    self%optlev         = src%optlev
+    self%micro_opt      = src%micro_opt
+    self%maxcycle       = src%maxcycle
+    self%maxdispl_opt   = src%maxdispl_opt
+    self%ethr_opt       = src%ethr_opt
+    self%gthr_opt       = src%gthr_opt
+    self%hlow_opt       = src%hlow_opt
+    self%hmax_opt       = src%hmax_opt
+    self%acc_opt        = src%acc_opt
+    self%maxerise       = src%maxerise
+    self%hguess         = src%hguess
+    self%exact_rf       = src%exact_rf
+    self%average_conv   = src%average_conv
+    self%tsopt          = src%tsopt
+    self%iupdat         = src%iupdat
+    self%opt_engine     = src%opt_engine
+    self%lbfgs_histsize = src%lbfgs_histsize
+    self%hess_init      = src%hess_init
+    self%logextxyz      = src%logextxyz
+
+! ── smooth-function parameters ───────────────────────────────────────────────
+    self%L       = src%L
+    self%k       = src%k
+    self%shift   = src%shift
+    self%scaling = src%scaling
+
+! ── printout and I/O ─────────────────────────────────────────────────────────
+    self%pr_energies = src%pr_energies
+    self%eout_unit   = src%eout_unit
+    if (allocated(src%elog)) self%elog = src%elog
+
+! ── ONIOM integer maps ───────────────────────────────────────────────────────
+    if (allocated(src%ONIOMmap))    self%ONIOMmap    = src%ONIOMmap
+    if (allocated(src%ONIOMrevmap)) self%ONIOMrevmap = src%ONIOMrevmap
+
+! ── thermochemistry ──────────────────────────────────────────────────────────
+    self%do_HR              = src%do_HR
+    self%full_HR            = src%full_HR
+    self%hu_steps           = src%hu_steps
+    self%nt                 = src%nt
+    self%ithr               = src%ithr
+    self%fscal              = src%fscal
+    self%sthr               = src%sthr
+    self%initialize_hr_type = src%initialize_hr_type
+    self%mh_type            = src%mh_type
+    self%hr_hu_type         = src%hr_hu_type
+    self%deform_opt_hess    = src%deform_opt_hess
+    self%doh_stepsize       = src%doh_stepsize
+    self%chess_id_guess     = src%chess_id_guess
+    self%g_sampling         = src%g_sampling
+    self%gs_hess_type       = src%gs_hess_type
+    if (allocated(src%emodel))       self%emodel       = src%emodel
+    if (allocated(src%temperatures)) self%temperatures = src%temperatures
+    if (allocated(src%et))   self%et   = src%et
+    if (allocated(src%ht))   self%ht   = src%ht
+    if (allocated(src%gt))   self%gt   = src%gt
+    if (allocated(src%stot)) self%stot = src%stot
+
+!>  NOTE: API handle objects (g0calc, ONIOM, ONIOMmols, chess) are NOT copied;
+!>        they hold C-level or heavy reconstructed state and are re-initialized.
     return
   end subroutine calculation_copy
 
 !=========================================================================================!
+  subroutine calculation_set_freeze_range(self,nat,start,finish)
+    class(calcdata) :: self
+    integer,intent(in) :: nat,start,finish
+    integer :: i,k
+    if (allocated(self%freezelist)) deallocate (self%freezelist)
+    allocate (self%freezelist(nat),source=.false.)
+    k = 0
+    do i = 1,nat
+
+      if (i >= start.and.i <= finish) then
+        k = k+1
+        self%freezelist(i) = .true.
+      end if
+    end do
+    self%nfreeze = k
+  end subroutine calculation_set_freeze_range
+
+  subroutine calculation_set_freeze_bools(self,freezetmp)
+    class(calcdata) :: self
+    logical,intent(in) :: freezetmp(:)
+    integer :: nat
+    if (allocated(self%freezelist)) deallocate (self%freezelist)
+    nat = size(freezetmp,1)
+    allocate (self%freezelist(nat),source=.false.)
+    self%nfreeze = count(freezetmp)
+    self%freezelist(:) = freezetmp(:)
+  end subroutine calculation_set_freeze_bools
 
   subroutine calculation_freezegrad(self,grad)
     class(calcdata) :: self
@@ -591,25 +821,43 @@ end subroutine calculation_freezegrad
 
 !=========================================================================================!
 
+  subroutine calculation_set_charge(self,dchrg)
+!***********************************************************
+!* set the charge of all calculation_settings objects to 
+!* the specified dchrg
+!***********************************************************
+    implicit none
+    class(calcdata) :: self
+    integer,intent(in) :: dchrg
+    integer :: i,j
+    if (self%ncalculations > 0) then
+       j = dchrg
+      do i = 1,self%ncalculations
+        self%calcs(i)%chrg = j
+      end do
+    end if
+    return
+  end subroutine calculation_set_charge
+
   subroutine calculation_increase_charge(self,dchrg)
 !******************************************************************
 !* increase the charge of all calculation_settings objects by one
 !* or the specified dchrg
-!****************************************************************** 
+!******************************************************************
     implicit none
     class(calcdata) :: self
     integer,intent(in),optional :: dchrg
     integer :: i,j
-    if(self%ncalculations > 0)then
-     if(present(dchrg))then
-       j = dchrg
-     else
-       j = 1
-     endif
-     do i=1,self%ncalculations
-        self%calcs(i)%chrg = self%calcs(i)%chrg + j
-     enddo
-    endif
+    if (self%ncalculations > 0) then
+      if (present(dchrg)) then
+        j = dchrg
+      else
+        j = 1
+      end if
+      do i = 1,self%ncalculations
+        self%calcs(i)%chrg = self%calcs(i)%chrg+j
+      end do
+    end if
     return
   end subroutine calculation_increase_charge
 
@@ -619,21 +867,21 @@ subroutine calculation_decrease_charge(self,dchrg)
 !******************************************************************
 !* decrease the charge of all calculation_settings objects by one
 !* or the specified dchrg
-!****************************************************************** 
+!******************************************************************
     implicit none
     class(calcdata) :: self
     integer,intent(in),optional :: dchrg
     integer :: i,j
-      if(self%ncalculations > 0)then
-     if(present(dchrg))then
-       j = dchrg
-     else
-       j = 1
-     endif
-     do i=1,self%ncalculations
-        self%calcs(i)%chrg = self%calcs(i)%chrg - j
-     enddo
-    endif
+    if (self%ncalculations > 0) then
+      if (present(dchrg)) then
+        j = dchrg
+      else
+        j = 1
+      end if
+      do i = 1,self%ncalculations
+        self%calcs(i)%chrg = self%calcs(i)%chrg-j
+      end do
+    end if
     return
   end subroutine calculation_decrease_charge
 
@@ -659,9 +907,9 @@ subroutine calc_set_active(self,ids)
         self%calcs(i)%active = .false.
       else
 !>--- and all other to active
-        if(self%calcs(i)%weight == 0.0_wp)then
-           self%calcs(i)%weight = 1.0_wp
-        endif 
+        if (self%calcs(i)%weight == 0.0_wp) then
+          self%calcs(i)%weight = 1.0_wp
+        end if
         self%calcs(i)%active = .true.
       end if
     end do
@@ -806,19 +1054,24 @@ end subroutine calculation_ONIOMexpand
 
 !========================================================================================!
 
-  subroutine calculation_info(self,iunit)
+  subroutine calculation_info(self,iunit,printhdr)
     implicit none
     class(calcdata) :: self
     integer,intent(in) :: iunit
+    logical,intent(in),optional :: printhdr
     integer :: i,j
     character(len=*),parameter :: fmt1 = '(1x,a20," : ",i5)'
     character(len=*),parameter :: fmt2 = '(1x,a20," : ",f12.5)'
     character(len=20) :: atmp
     integer :: constraintype(8)
+    logical :: prhdr
 
-    write (iunit,'(1x,a)') '----------------'
-    write (iunit,'(1x,a)') 'Calculation info'
-    write (iunit,'(1x,a)') '----------------'
+    prhdr=.true.; if(present(printhdr)) prhdr = printhdr
+    if(prhdr)then
+      write (iunit,'(1x,a)') '----------------'
+      write (iunit,'(1x,a)') 'Calculation info'
+      write (iunit,'(1x,a)') '----------------'
+    endif
     if (self%ncalculations <= 0) then
       write (iunit,'("> ",a)') 'No calculation levels set up!'
     else if (self%ncalculations > 1) then
@@ -840,11 +1093,13 @@ subroutine calculation_info(self,iunit)
       write (iunit,'("> ",a)') 'User-defined constraints:'
       if (self%nconstraints <= 20) then
         do i = 1,self%nconstraints
+          if (.not.self%cons(i)%active) cycle
           call self%cons(i)%print(iunit)
         end do
       else
         constraintype(:) = 0
         do i = 1,self%nconstraints
+          if (.not.self%cons(i)%active) cycle
           j = self%cons(i)%type
           if (j > 0.and.j < 9) then
             constraintype(j) = constraintype(j)+1
@@ -888,8 +1143,6 @@ subroutine calculation_info(self,iunit)
     return
   end subroutine calculation_info
 
-
-
 !=========================================================================================!
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
 !> CALCULATION_SETTINGS associated routines
@@ -916,6 +1169,8 @@ subroutine calculation_settings_deallocate(self)
     if (allocated(self%solvent)) deallocate (self%solvent)
     if (allocated(self%tblite)) deallocate (self%tblite)
     if (allocated(self%g0calc)) deallocate (self%g0calc)
+    if (allocated(self%solv)) deallocate (self%solv)
+    if (allocated(self%eeq)) deallocate (self%eeq)
     if (allocated(self%ff_dat)) deallocate (self%ff_dat)
     if (allocated(self%libpvol)) deallocate (self%libpvol)
 
@@ -936,6 +1191,7 @@ subroutine calculation_settings_deallocate(self)
 
     self%tblitelvl = 2
     self%etemp = 300.0_wp
+    self%etemp_user_set = .false.
     self%accuracy = 1.0_wp
     self%apiclean = .false.
     self%maxscc = 500
@@ -947,9 +1203,120 @@ subroutine calculation_settings_deallocate(self)
 
     self%ONIOM_highlowroot = 0
     self%ONIOM_id = 0
+
     return
   end subroutine calculation_settings_deallocate
 
+  subroutine calculation_settings_copy(self,src)
+    implicit none
+    class(calculation_settings),intent(out) :: self
+    type(calculation_settings) :: src
+
+! ── identity and printout ────────────────────────────────────────────────────
+    self%id         = src%id
+    self%prch       = src%prch
+    self%pr         = src%pr
+    self%prappend   = src%prappend
+    self%prstdout   = src%prstdout
+    self%refine_lvl = src%refine_lvl
+
+! ── system ───────────────────────────────────────────────────────────────────
+    self%chrg       = src%chrg
+    self%uhf        = src%uhf
+    self%multiplicity = src%multiplicity
+    self%active     = src%active
+    self%weight     = src%weight
+
+! ── allocatable strings ──────────────────────────────────────────────────────
+    if (allocated(src%calcspace))      self%calcspace      = src%calcspace
+    if (allocated(src%calcfile))       self%calcfile       = src%calcfile
+    if (allocated(src%gradfile))       self%gradfile       = src%gradfile
+    if (allocated(src%path))           self%path           = src%path
+    if (allocated(src%other))          self%other          = src%other
+    if (allocated(src%binary))         self%binary         = src%binary
+    if (allocated(src%systemcall))     self%systemcall     = src%systemcall
+    if (allocated(src%description))    self%description    = src%description
+    if (allocated(src%shortflag))      self%shortflag      = src%shortflag
+    if (allocated(src%gradkey))        self%gradkey        = src%gradkey
+    if (allocated(src%efile))          self%efile          = src%efile
+    if (allocated(src%solvmodel))      self%solvmodel      = src%solvmodel
+    if (allocated(src%solvent))        self%solvent        = src%solvent
+    if (allocated(src%parametrisation))self%parametrisation= src%parametrisation
+    if (allocated(src%restartfile))    self%restartfile    = src%restartfile
+    if (allocated(src%refgeo))         self%refgeo         = src%refgeo
+    if (allocated(src%refcharges))     self%refcharges     = src%refcharges
+    if (allocated(src%tbliteparam))    self%tbliteparam    = src%tbliteparam
+    if (allocated(src%solv))           self%solv           = src%solv
+    if (allocated(src%eeq))            self%eeq            = src%eeq
+
+! ── gradient settings ────────────────────────────────────────────────────────
+    self%numgrad    = src%numgrad
+    self%gradstep   = src%gradstep
+    self%rdgrad     = src%rdgrad
+    self%gradtype   = src%gradtype
+    self%gradfmt    = src%gradfmt
+
+! ── property requests ────────────────────────────────────────────────────────
+    self%rdwbo      = src%rdwbo
+    self%rdqat      = src%rdqat
+    self%dumpq      = src%dumpq
+    self%rddip      = src%rddip
+    self%dipole     = src%dipole
+    self%rddipgrad  = src%rddipgrad
+    self%getlmocent = src%getlmocent
+    self%nprot      = src%nprot
+    if (allocated(src%getsasa))   self%getsasa   = src%getsasa
+    if (allocated(src%efield))    self%efield    = src%efield
+    if (allocated(src%wbo))       self%wbo       = src%wbo
+    if (allocated(src%qat))       self%qat       = src%qat
+    if (allocated(src%dipgrad))   self%dipgrad   = src%dipgrad
+    if (allocated(src%protxyz))   self%protxyz   = src%protxyz
+
+! ── API / backend settings ───────────────────────────────────────────────────
+    self%tblitelvl  = src%tblitelvl
+    self%etemp          = src%etemp
+    self%etemp_user_set = src%etemp_user_set
+    self%accuracy   = src%accuracy
+    self%apiclean   = src%apiclean
+    self%maxscc     = src%maxscc
+    self%saveint    = src%saveint
+    self%ceh_guess  = src%ceh_guess
+    self%restart    = src%restart
+
+    self%ngrid       = src%ngrid
+    self%extpressure = src%extpressure
+    self%proberad    = src%proberad
+    self%pvmodel     = src%pvmodel
+    self%vdwset      = src%vdwset
+    self%pvradscal   = src%pvradscal
+
+    self%nconfig     = src%nconfig
+    if (allocated(src%config))    self%config    = src%config
+    if (allocated(src%occ))       self%occ       = src%occ
+
+! ── ONIOM identifiers ────────────────────────────────────────────────────────
+    self%ONIOM_highlowroot = src%ONIOM_highlowroot
+    self%ONIOM_id          = src%ONIOM_id
+
+! ── ORCA input block ─────────────────────────────────────────────────────────
+    self%ORCA%mpi    = src%ORCA%mpi
+    self%ORCA%nlines = src%ORCA%nlines
+    if (allocated(src%ORCA%cmd))   self%ORCA%cmd   = src%ORCA%cmd
+    if (allocated(src%ORCA%input)) self%ORCA%input = src%ORCA%input
+
+! ── inline potentials ────────────────────────────────────────────────────────
+    self%ag      = src%ag
+    self%penalty = src%penalty
+
+! ── MLIP settings ────────────────────────────────────────────────────────────
+    self%MPAR     = src%MPAR
+    self%MPAR%iid = 0  !> reset instance ID for parallelization
+
+!>  NOTE: API handle objects (tblite, g0calc, ff_dat, libpvol) are NOT copied;
+!>        they hold C-level state and are re-initialized on first use.
+    return
+  end subroutine calculation_settings_copy
+
 !=========================================================================================!
 
   subroutine calculation_settings_addconfig(self,config)
@@ -993,6 +1360,9 @@ subroutine calculation_settings_autocomplete(self,id)
     self%description = trim(jobdescription(self%id+1))
     call calculation_settings_shortflag(self)
 
+    !> ── keep the spin multiplicity aligned with the uhf carrier ─────────────────
+    call self%sync_multiplicity()
+
     if (.not.allocated(self%calcspace)) then
       !> I've decided to perform all calculations in a separate directory to
       !> avoid accumulation of files in the main workspace
@@ -1000,29 +1370,58 @@ subroutine calculation_settings_autocomplete(self,id)
       self%calcspace = 'calculation.level.'//trim(nmbr)
     end if
 
-    if (self%pr .and. self%prch.ne.stdout) then
+    if (self%pr.and.self%prch .ne. stdout) then
       self%prch = self%prch+id
     end if
   end subroutine calculation_settings_autocomplete
 
+!========================================================================================!
+
+  subroutine calc_sync_multiplicity(self)
+    !***************************************************************
+    !* Align the spin multiplicity with the uhf carrier:          *
+    !* multiplicity = uhf + 1 = (Nα-Nβ) + 1 = 2S+1.               *
+    !* uhf is the single source of truth that survives copies and *
+    !* direct assignments; call this before any interface that    *
+    !* consumes a multiplicity (ORCA, fmlip-relay).               *
+    !***************************************************************
+    implicit none
+    class(calculation_settings) :: self
+    self%multiplicity = self%uhf+1
+  end subroutine calc_sync_multiplicity
+
+!========================================================================================!
+
+  subroutine calc_set_multiplicity(self,mult)
+    !***************************************************************
+    !* Set the spin state from a multiplicity (2S+1) value while  *
+    !* keeping the uhf carrier (=2S=Nα-Nβ) aligned: uhf = mult-1. *
+    !***************************************************************
+    implicit none
+    class(calculation_settings) :: self
+    integer,intent(in) :: mult
+    self%multiplicity = mult
+    self%uhf = mult-1
+  end subroutine calc_set_multiplicity
+
 !>--- create a short calculation info flag
-    subroutine calculation_settings_shortflag(self)
+  subroutine calculation_settings_shortflag(self)
     implicit none
     class(calculation_settings) :: self
     integer :: i,j
 
-    select case( self%id )
-    case( jobtype%xtbsys )   
+    select case (self%id)
+    case (jobtype%xtbsys)
       self%shortflag = 'xtb subprocess'
-    case( jobtype%generic ) 
-      self%shortflag = 'generic subprocess' 
-    case( jobtype%turbomole ) 
+    case (jobtype%generic)
+      self%shortflag = 'generic subprocess'
+    case (jobtype%turbomole)
       self%shortflag = 'TURBOMOLE subprocess'
-    case( jobtype%orca ) 
+    case (jobtype%orca)
       self%shortflag = 'ORCA subprocess'
-    case( jobtype%terachem ) 
+    case (jobtype%terachem)
       self%shortflag = 'TeraChem subprocess'
-    case( jobtype%tblite )
+    case (jobtype%tblite)
       select case (self%tblitelvl)
       case (xtblvl%gfn2)
         self%shortflag = 'GFN2-xTB'
@@ -1037,23 +1436,43 @@ subroutine calculation_settings_shortflag(self)
       case (xtblvl%param)
         self%shortflag = 'parameter file: '//trim(self%tbliteparam)
       end select
-    case( jobtype%gfn0 )
-      self%shortflag =  'GFN0-xTB' 
-    case( jobtype%gfn0occ )
-      self%shortflag =  'GFN0-xTB*'
-    case( jobtype%gfnff )
-      self%shortflag =  'GFN-FF'
-    case( jobtype%libpvol )
-      self%shortflag =  'LIVPVOL'
-    case( jobtype%lj )
-      self%shortflag =  'LJ'
+    case (jobtype%gfn0)
+      self%shortflag = 'GFN0-xTB'
+    case (jobtype%gfn0occ)
+      self%shortflag = 'GFN0-xTB*'
+    case (jobtype%gfnff)
+      self%shortflag = 'GFN-FF'
+    case (jobtype%libpvol)
+      self%shortflag = 'libpvol'
+    case (jobtype%lj)
+      self%shortflag = 'LJ'
+    case (jobtype%approxg)
+      self%shortflag = 'model Hessian gradient'
+    case (jobtype%penalty)
+      self%shortflag = 'penalty potential'
+    case (jobtype%mlip)
+      self%shortflag = 'MLIP'
+    case (jobtype%solvation)
+      self%shortflag = 'solvation'
+      if (allocated(self%solv)) then
+        if (allocated(self%solv%smodel)) &
+        & self%shortflag = self%shortflag//'/'//trim(self%solv%smodel)
+        if (allocated(self%solv%solvent)) &
+        & self%shortflag = self%shortflag//'('//trim(self%solv%solvent)//')'
+      end if
+    case (jobtype%electrostatic)
+      self%shortflag = 'EEQ'
+      if (allocated(self%eeq)) then
+        if (allocated(self%eeq%charge_model)) &
+        & self%shortflag = trim(self%eeq%charge_model)
+      end if
     case default
       self%shortflag = 'undefined'
     end select
-    if(allocated(self%solvmodel).and.allocated(self%solvent))then
+    if (allocated(self%solvmodel).and.allocated(self%solvent)) then
       self%shortflag = self%shortflag//'/'//trim(self%solvmodel)
-       self%shortflag = self%shortflag//'('//trim(self%solvent)//')'
-    endif
+      self%shortflag = self%shortflag//'('//trim(self%solvent)//')'
+    end if
   end subroutine calculation_settings_shortflag
 
 !>-- generate a unique print id for the calculation
@@ -1095,7 +1514,7 @@ subroutine calculation_settings_info(self,iunit)
     character(len=20) :: atmp
     logical :: gxtbwarn
 
-    gxtbwarn=.false.
+    gxtbwarn = .false.
 
     if (allocated(self%description)) then
       write (iunit,'(" :",1x,a)') trim(self%description)
@@ -1114,26 +1533,177 @@ subroutine calculation_settings_info(self,iunit)
         write (iunit,fmt4) 'Charge Extended Hückel (CEH) model'
       end select
     end if
+
+    !> MLIP (fmlip-relay) backend details — print only what is meaningful
+    !> for the selected backend
+    if (self%id == jobtype%mlip) then
+      block
+        character(len=:),allocatable :: bk
+        bk = 'unknown'
+        if (allocated(self%MPAR%backend)) bk = trim(self%MPAR%backend)
+        ! ── friendly backend headline ───────────────────────────────────────
+        select case (bk)
+        case ('uma')
+          write (iunit,fmt4) 'FairChem UMA foundation model (fairchem)'
+        case ('mace_off')
+          write (iunit,fmt4) 'MACE-OFF23 organic force field'
+        case ('mace_mp')
+          write (iunit,fmt4) 'MACE-MP foundation model (Materials Project)'
+        case ('mace')
+          write (iunit,fmt4) 'Custom MACE model'
+        case ('lj')
+          write (iunit,fmt4) 'Lennard-Jones potential'
+        case ('dummy')
+          write (iunit,fmt4) 'Dummy (zero) potential'
+        case default
+          write (iunit,fmt4) 'fmlip-relay backend: '//bk
+        end select
+        write (atmp,*) 'MLIP backend'
+        write (iunit,fmt3) atmp,bk
+        ! ── backend-specific model / task selection ─────────────────────────
+        select case (bk)
+        case ('uma')
+          write (atmp,*) 'UMA model'
+          if (allocated(self%MPAR%umamodel)) then
+            write (iunit,fmt3) atmp,trim(self%MPAR%umamodel)
+          else
+            write (iunit,fmt3) atmp,'uma-s-1p2 (default)'
+          end if
+          write (atmp,*) 'UMA task'
+          if (allocated(self%MPAR%umatask)) then
+            write (iunit,fmt3) atmp,trim(self%MPAR%umatask)
+          else
+            write (iunit,fmt3) atmp,'omol (default)'
+          end if
+        case ('mace_off','mace_mp')
+          if (allocated(self%MPAR%modelpath)) then
+            write (atmp,*) 'MACE model file'
+            write (iunit,fmt3) atmp,trim(self%MPAR%modelpath)
+          else
+            write (atmp,*) 'MACE model size'
+            if (allocated(self%MPAR%modelsize)) then
+              write (iunit,fmt3) atmp,trim(self%MPAR%modelsize)
+            else
+              write (iunit,fmt3) atmp,'medium (default)'
+            end if
+          end if
+        case default
+          if (allocated(self%MPAR%modelpath)) then
+            write (atmp,*) 'Model file'
+            write (iunit,fmt3) atmp,trim(self%MPAR%modelpath)
+          end if
+        end select
+        ! ── compute device: always shown for the torch-based backends ───────
+        select case (bk)
+        case ('uma','mace_off','mace_mp','mace')
+          write (atmp,*) 'Compute device'
+          if (allocated(self%MPAR%device)) then
+            write (iunit,fmt3) atmp,trim(self%MPAR%device)
+          else
+            write (iunit,fmt3) atmp,'cpu (default)'
+          end if
+        case default
+          !> lj / dummy etc. have no torch device; show only if explicitly set
+          if (allocated(self%MPAR%device)) then
+            write (atmp,*) 'Compute device'
+            write (iunit,fmt3) atmp,trim(self%MPAR%device)
+          end if
+        end select
+        if (self%MPAR%BASE_PORT /= 54320) then
+          write (atmp,*) 'Socket base port'
+          write (iunit,fmt1) atmp,self%MPAR%BASE_PORT
+        end if
+        if (self%MPAR%TIMEOUT_SEC /= 120) then
+          write (atmp,*) 'Server timeout [s]'
+          write (iunit,fmt1) atmp,self%MPAR%TIMEOUT_SEC
+        end if
+      end block
+    end if
+
+    !> composite implicit-solvation calculator details
+    if (self%id == jobtype%solvation .and. allocated(self%solv)) then
+      write (iunit,fmt4) 'Composite implicit solvation (ddX-based)'
+      if (allocated(self%solv%solvent)) then
+        write (atmp,*) 'solvent'
+        write (iunit,fmt3) atmp,trim(self%solv%solvent)
+      end if
+      if (allocated(self%solv%smodel)) then
+        write (atmp,*) 'continuum model'
+        write (iunit,fmt3) atmp,trim(self%solv%smodel)
+      end if
+      if (allocated(self%solv%charge_model)) then
+        write (atmp,*) 'charge model'
+        write (iunit,fmt3) atmp,trim(self%solv%charge_model)
+      end if
+      write (atmp,*) 'nonpolar params'
+      write (iunit,fmt3) atmp,'GFN2/ALPB'
+      write (atmp,*) 'H-bond term'
+      if (self%solv%do_hbond) then
+        write (iunit,fmt3) atmp,'on'
+      else
+        write (iunit,fmt3) atmp,'off'
+      end if
+    end if
+
+    !> charge-equilibration electrostatics details
+    if (self%id == jobtype%electrostatic .and. allocated(self%eeq)) then
+      write (iunit,fmt4) 'Charge-equilibration electrostatics (multicharge)'
+      if (allocated(self%eeq%charge_model)) then
+        write (atmp,*) 'charge model'
+        write (iunit,fmt3) atmp,trim(self%eeq%charge_model)
+      end if
+    end if
+
     if (any((/jobtype%orca,jobtype%xtbsys,jobtype%turbomole, &
     &  jobtype%generic,jobtype%terachem/) == self%id)) then
-      if(index(self%binary,'gxtb').ne.0)then
-        write(iunit,fmt4) 'g-xTB (development version)'
+      if (index(self%binary,'gxtb') .ne. 0) then
+        write (iunit,fmt4) 'g-xTB (development version)'
         gxtbwarn = .true.
-      else  
+      else
         write (iunit,'(" :",3x,a,a)') 'selected binary : ',trim(self%binary)
-      endif
+      end if
     end if
     if (self%refine_lvl > 0) then
       write (atmp,*) 'refinement stage'
-      write (iunit,fmt1) atmp,self%refine_lvl
+      block
+        character(len=20) :: rtmp
+        select case (self%refine_lvl)
+        case (1);  rtmp = 'singlepoint'
+        case (2);  rtmp = 'correction'
+        case (3);  rtmp = 'geoopt'
+        case (5);  rtmp = 'deltaG'
+        case (10); rtmp = 'post_opt'
+        case (11); rtmp = 'post_sp'
+        case (12); rtmp = 'post_reopt'
+        case default
+          write (rtmp,'(i0)') self%refine_lvl
+        end select
+        write (iunit,fmt3) atmp,trim(rtmp)
+      end block
     end if
 
     !> system data
     write (atmp,*) 'Molecular charge'
     write (iunit,fmt1) atmp,self%chrg
-    if (self%uhf /= 0) then
-      write (atmp,*) 'UHF parameter'
-      write (iunit,fmt1) atmp,self%uhf
+    !> spin: ORCA and the UMA (omol) backend consume a multiplicity (2S+1)
+    !> from the multiplicity store, the xtb-type methods consume uhf = Nα-Nβ
+    block
+      logical :: use_mult
+      use_mult = (self%id == jobtype%orca)
+      if (self%id == jobtype%mlip .and. allocated(self%MPAR%backend)) then
+        if (trim(self%MPAR%backend) == 'uma') use_mult = .true.
+      end if
+      if (use_mult) then
+        write (atmp,*) 'Multiplicity'
+        write (iunit,fmt1) atmp,self%multiplicity
+      else if (self%uhf /= 0) then
+        write (atmp,*) 'UHF parameter'
+        write (iunit,fmt1) atmp,self%uhf
+      end if
+    end block
+    if (self%id == jobtype%tblite .and. self%spin_polarized) then
+      write (atmp,*) 'Spin-polarization'
+      write (iunit,fmt3) atmp,'yes'
     end if
 
     if (allocated(self%solvmodel)) then
@@ -1141,7 +1711,7 @@ subroutine calculation_settings_info(self,iunit)
       write (iunit,fmt3) atmp,trim(self%solvmodel)
     end if
     if (allocated(self%solvent)) then
-    write (atmp,*) 'Solvent'
+      write (atmp,*) 'Solvent'
       write (iunit,fmt3) atmp,trim(self%solvent)
     end if
 
@@ -1173,31 +1743,45 @@ subroutine calculation_settings_info(self,iunit)
       end select
       write (iunit,fmt1) trim(atmp),self%ONIOM_id
     else
-      if(self%weight .ne. 1.0_wp)then
+      if (self%weight .ne. 1.0_wp) then
         write (atmp,*) 'Weight'
         write (iunit,fmt2) atmp,self%weight
-      endif
+      end if
     end if
 
-    if(gxtbwarn)then
-       write(iunit,fmt4) 'WARNING: This currently is the development version of g-xTB.'
-       write(iunit,fmt4) 'WARNING: Gradients are NUMERICAL (i.e., expensive and noisy!)' 
-    endif
+    if (gxtbwarn) then
+      write (iunit,fmt4) 'WARNING: This currently is the development version of g-xTB.'
+      write (iunit,fmt4) 'WARNING: Gradients are NUMERICAL (i.e., expensive and noisy!)'
+    end if
 
   end subroutine calculation_settings_info
 
 !=========================================================================================!
 
-  subroutine create_calclevel_shortcut(self,levelstring)
+  subroutine create_calclevel_shortcut(self,levelstring, &
+      & chrg,uhf,solvmodel,solvent)
 !*********************************************************************
 !* subroutine create_calclevel_shortcut called with %create(...)
 !* Set up a calculation_settings object for a given level of theory
 !* More shortcuts can be added as required.
+!*
+!* Optional settings are for:
+!*  - molecular charge  (integer)
+!*  - uhf parameter (integer)
+!*  - solvent/solventmodel (either none or BOTH must be present to work)
+!*
 !* Be careful about the intent(out) setting!
+!* Also, the routine is "dumb" and does not check if the user-provided
+!* settings actually make sense for a create_calclevel_shortcutation. It very much
+!* exists as an internal code shortcut only.
 !*********************************************************************
     implicit none
     class(calculation_settings),intent(out) :: self
-    character(len=*) :: levelstring
+    character(len=*),intent(in) :: levelstring
+    integer,intent(in),optional :: chrg
+    integer,intent(in),optional :: uhf
+    character(len=*),intent(in),optional :: solvmodel
+    character(len=*),intent(in),optional :: solvent
     call self%deallocate()
     select case (trim(levelstring))
     case ('gfnff','--gff','--gfnff')
@@ -1214,22 +1798,57 @@ subroutine create_calclevel_shortcut(self,levelstring)
       self%id = jobtype%turbomole
       self%rdgrad = .false.
       self%binary = 'gp3'
-    case ('gxtb','gxtb_dev')
-      self%id = jobtype%turbomole 
-      self%rdgrad = .false.       
-      self%binary = 'gxtb'
-      self%rdwbo = .false.
-      if(index(levelstring,'_dev').ne.0)then
-        self%other = '-grad'
-        self%rdgrad=.true.
-      endif  
-    case ('orca')
+    case ('gxtb','--gxtb')
+      if (have_gxtb) then
+        self%id = jobtype%tblite
+        self%tblitelvl = xtblvl%gxtb
+        self%etemp = 0.0_wp  ! g-xTB uses integer occupations (T=0)
+      else
+        self%id = jobtype%xtbsys
+        self%other = '--gxtb'
+      end if
+    case ('orca','--orca')
       self%id = jobtype%orca
 
+    case ('uma','--uma')
+      !> FairChem UMA via fmlip-relay; default to the molecular (omol) task head
+      self%id = jobtype%mlip
+      self%MPAR%backend = 'uma'
+      self%MPAR%umatask = 'omol'
+
+    case ('maceoff','mace-off','mace_off','--maceoff')
+      !> MACE-OFF23 organic force field via fmlip-relay; default to medium size
+      self%id = jobtype%mlip
+      self%MPAR%backend = 'mace_off'
+      self%MPAR%modelsize = 'medium'
+
     case ('generic')
       self%id = jobtype%generic
 
     end select
+
+    if (present(chrg)) then
+      self%chrg = chrg
+    end if
+
+    if (present(uhf)) then
+      self%uhf = uhf
+    end if
+
+    !> both must be present to work
+    if (present(solvmodel).and.present(solvent)) then
+      !> the first two if-cases exist to convert cli args
+      !> into sensible keywords (required for legacy compatibility)
+      if (index(solvmodel,'gbsa') .ne. 0) then
+        self%solvmodel = 'gbsa'
+      else if (index(solvmodel,'alpb') .ne. 0) then
+        self%solvmodel = 'alpb'
+      else
+        self%solvmodel = trim(solvmodel)
+      end if
+      self%solvent = trim(solvent)
+    end if
+
     call self%autocomplete(self%id)
   end subroutine create_calclevel_shortcut
 
diff --git a/src/calculator/calculator.F90 b/src/calculator/calculator.F90
index 85e02162..4d0cd887 100644
--- a/src/calculator/calculator.F90
+++ b/src/calculator/calculator.F90
@@ -51,11 +51,12 @@ module crest_calculator
 !=========================================================================================!
 
 !>--- global engrad call counter
-  integer(int64),public :: engrad_total = 0
+  real(wp),public :: engrad_total = 0.0_wp
 
 !>--- public module routines
   public :: potential_core
   public :: engrad
+  public :: preinit_mlip_parallel
   interface engrad
     module procedure :: engrad_mol
   end interface engrad
@@ -126,7 +127,7 @@ subroutine engrad_mol(mol,calc,energy,gradient,iostatus)
         end do
       end if
       !>--- count the engrad call
-      engrad_total = engrad_total+1
+      engrad_total = engrad_total+1.0_wp
     end if
 
 !>--- update ONIOM geometries
@@ -297,6 +298,27 @@ subroutine engrad_mol(mol,calc,energy,gradient,iostatus)
 !**********************************************
     call calc%freezegrad(gradient)
 
+!**********************************************
+!>--- Hessian Reconstruct
+!**********************************************
+
+    if ((calc%do_HR.or.calc%deform_opt_hess).and.allocated(calc%chess)) then
+      if (calc%chess%track_step) then
+        call calc%chess%update(gradient,energy,mol%xyz)
+        !write(stdout,*) "HESSIAN CASH UPDATED"
+      end if
+    end if
+
+!*********************************************
+!>--- store some outptut data to mol itself?
+!*********************************************
+    mol%energy = energy
+    if (allocated(mol%gradient).or.mol%wrextxyz) then
+      !$omp critical
+      mol%gradient = gradient
+      !$omp end critical
+    end if
+
     return
   end subroutine engrad_mol
 
@@ -378,6 +400,20 @@ subroutine potential_core(molptr,calc,id,iostatus)
       &              calc%etmp(id),calc%grdtmp(:,1:pnat,id))
       calc%grdtmp(:,:,id) = calc%grdtmp(:,:,id)*autoaa
 
+    case (jobtype%approxg)
+      call modelhessian_engrad(molptr,calc%calcs(id),calc%etmp(id),calc%grdtmp(:,1:pnat,id),iostatus)
+
+    case (jobtype%penalty)
+      call rmsd_engrad(molptr,calc%calcs(id),calc%etmp(id),calc%grdtmp(:,1:pnat,id),iostatus)
+
+    case (jobtype%mlip)
+      call mlip_engrad(molptr,calc%calcs(id),calc%etmp(id),calc%grdtmp(:,1:pnat,id),iostatus)
+
+    case (jobtype%solvation)
+      call solvation_engrad(molptr,calc%calcs(id),calc%etmp(id),calc%grdtmp(:,1:pnat,id),iostatus)
+
+    case (jobtype%electrostatic)
+      call electrostatic_engrad(molptr,calc%calcs(id),calc%etmp(id),calc%grdtmp(:,1:pnat,id),iostatus)
     case default
       calc%etmp(id) = 0.0_wp
       calc%grdtmp(:,:,id) = 0.0_wp
@@ -398,7 +434,7 @@ subroutine numgrad_core(molptr,calc,id,iostatus)
 
     integer :: i,j,k,l,ich,och,io,pnat
     type(coord),allocatable :: moltmp
-    real(wp) :: energy,el,er, step,step2
+    real(wp) :: energy,el,er,step,step2
     real(wp),allocatable :: ngrd(:,:)
     !real(wp),parameter :: step = 0.0005_wp
     !real(wp),parameter :: step2 = 0.5_wp/step
@@ -410,13 +446,13 @@ subroutine numgrad_core(molptr,calc,id,iostatus)
     step = calc%calcs(id)%gradstep
     step2 = 0.5_wp/step
 
-    !> back up energy 
+    !> back up energy
     energy = calc%etmp(id)
 
     !> allocate temprorary gradient space
     !$omp critical
-    allocate(ngrd(3,pnat), source=0.0_wp)
-    allocate(moltmp, source=molptr)
+    allocate (ngrd(3,pnat),source=0.0_wp)
+    allocate (moltmp,source=molptr)
     !$omp end critical
 
     do i = 1,molptr%nat
@@ -437,8 +473,8 @@ subroutine numgrad_core(molptr,calc,id,iostatus)
     !> transfer tmp gradient to the calc object
     calc%grdtmp(:,1:pnat,id) = ngrd(:,1:pnat)
     !$omp critical
-    deallocate(moltmp)
-    deallocate(ngrd)
+    deallocate (moltmp)
+    deallocate (ngrd)
     !$omp end critical
 
     !> restore the energy
@@ -543,6 +579,8 @@ subroutine numhess1(nat,at,xyz,calc,hess,io)
     allocate (gradr(3,mol%nat),source=0.0_wp) !dummy
     allocate (gradl(3,mol%nat),source=0.0_wp) !dummy
 
+    if (allocated(calc%chess)) calc%chess%track_step = .false.
+
     do i = 1,mol%nat
       do j = 1,3
         ii = (i-1)*3+j
@@ -577,6 +615,8 @@ subroutine numhess1(nat,at,xyz,calc,hess,io)
 
     call engrad(mol,calc,el,gradl,io) !>- to get the gradient of the non-displaced structure
 
+    if (allocated(calc%chess)) calc%chess%track_step = .true.
+
     deallocate (gradl,gradr)
     call mol%deallocate()
     return
diff --git a/src/calculator/components/ddx_pc.F90 b/src/calculator/components/ddx_pc.F90
new file mode 100644
index 00000000..621ef943
--- /dev/null
+++ b/src/calculator/components/ddx_pc.F90
@@ -0,0 +1,185 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module crest_ddx_pc
+!********************************************************************************
+!* Standalone ddX point-charge solvation engine.
+!*
+!* Drives the low-level ddX API (COSMO/CPCM/PCM) with an *externally* supplied
+!* set of atomic point charges, returning the electrostatic solvation free
+!* energy and its Cartesian gradient.  This is the method-independent analogue
+!* of tblite's self-consistent reaction field: instead of variational xTB
+!* charges it accepts fixed charges (e.g. EEQ/EEQ-BC) plus their geometry
+!* derivative dq/dR, which adds the chain-rule term the SCRF case does not need.
+!********************************************************************************
+  use crest_parameters
+  use strucrd,only:coord
+#ifdef WITH_DDX
+  use ddx,only:ddx_type,ddx_state_type,ddx_error_type,ddinit,allocate_state, &
+  &            setup,fill_guess,fill_guess_adjoint,solve,solve_adjoint, &
+  &            solvation_force_terms,check_error
+  use ddx_core,only:ddx_electrostatics_type
+  use ddx_multipolar_solutes,only:multipole_electrostatics,multipole_psi, &
+  &                               multipole_force_terms
+  use tblite_solvation_data,only:get_vdw_rad_cosmo
+  use tblite_mesh_lebedev,only:grid_size
+#endif
+  implicit none
+  private
+
+  public :: ddx_pc_engrad
+
+contains
+!========================================================================================!
+
+  subroutine ddx_pc_engrad(mol,q,smodel,eps,energy,gradient,iostatus,dqdr)
+    !***********************************************************************
+    !* Electrostatic solvation energy + gradient for fixed point charges.
+    !*
+    !*  mol      : molecular structure (Bohr)
+    !*  q(nat)   : atomic point charges
+    !*  smodel   : 'cosmo' | 'cpcm' | 'pcm'
+    !*  eps      : solvent dielectric constant
+    !*  energy   : solvation free energy (out)
+    !*  gradient : 3,nat Cartesian gradient (out, overwritten)
+    !*  dqdr     : optional dq_i/dR_a (3,nat,nat); adds the charge-response
+    !*             term.  If absent the charges are treated as geometry fixed.
+    !***********************************************************************
+    type(coord),intent(in)        :: mol
+    real(wp),intent(in)           :: q(:)
+    character(len=*),intent(in)   :: smodel
+    real(wp),intent(in)           :: eps
+    real(wp),intent(out)          :: energy
+    real(wp),intent(out)          :: gradient(:,:)
+    integer,intent(out)           :: iostatus
+    real(wp),intent(in),optional  :: dqdr(:,:,:)
+#ifdef WITH_DDX
+    type(ddx_type)                :: ddx
+    type(ddx_state_type)          :: state
+    type(ddx_error_type)          :: error
+    type(ddx_electrostatics_type) :: elec
+    real(wp),allocatable :: rvdw(:),multipoles(:,:),force(:,:),jmat(:,:),dedq(:)
+    real(wp) :: feps,shift,sqrt4pi
+    integer  :: model,nat,iat,jat,izp
+    real(wp),parameter :: conv = 1.0e-9_wp
+
+    iostatus = 0
+    nat = mol%nat
+    energy = 0.0_wp
+    gradient(:,:) = 0.0_wp
+    sqrt4pi = sqrt(4.0_wp*pi)
+
+    ! ── model mapping + dielectric scaling factor (cf. tblite) ───────────────
+    select case (trim(smodel))
+    case ('cosmo')
+      model = 1; shift = -1.0_wp; feps = (eps-1.0_wp)/(eps+0.5_wp)
+    case ('cpcm')
+      model = 1; shift = -1.0_wp; feps = (eps-1.0_wp)/eps
+    case ('pcm')
+      model = 2; shift = 0.0_wp;  feps = 1.0_wp
+    case default
+      iostatus = 1; return
+    end select
+
+    ! ── van-der-Waals (COSMO) cavity radii ───────────────────────────────────
+    allocate (rvdw(nat))
+    do iat = 1,nat
+      izp = mol%at(iat)
+      rvdw(iat) = get_vdw_rad_cosmo(izp)
+    end do
+
+    ! ── ddX model + state setup ──────────────────────────────────────────────
+    call ddinit(model,nat,mol%xyz,rvdw,eps,ddx,error,force=1,ngrid=grid_size(8), &
+    &           lmax=1,eta=0.1_wp,shift=shift)
+    if (error%flag /= 0) then; iostatus = 1; return; end if
+    call allocate_state(ddx%params,ddx%constants,state,error)
+    if (error%flag /= 0) then; iostatus = 1; return; end if
+
+    ! ── build RHS from the (normalized) monopole distribution ────────────────
+    allocate (multipoles(1,nat))
+    multipoles(1,:) = q(:)/sqrt4pi
+    elec%do_phi = .true.; elec%do_e = .true.; elec%do_g = .true.
+    call multipole_electrostatics(ddx%params,ddx%constants,ddx%workspace, &
+    &                             multipoles,0,elec,error)
+    call multipole_psi(ddx%params,multipoles,0,state%psi)
+    call setup(ddx%params,ddx%constants,ddx%workspace,state,elec,state%psi,error)
+    if (error%flag /= 0) then; iostatus = 1; return; end if
+
+    ! ── solve primal + adjoint linear systems ────────────────────────────────
+    call fill_guess(ddx%params,ddx%constants,ddx%workspace,state,conv,error)
+    call fill_guess_adjoint(ddx%params,ddx%constants,ddx%workspace,state,conv,error)
+    call solve(ddx%params,ddx%constants,ddx%workspace,state,conv,error)
+    call solve_adjoint(ddx%params,ddx%constants,ddx%workspace,state,conv,error)
+    if (error%flag /= 0) then; iostatus = 1; return; end if
+
+    ! ── energy: feps * 1/2 <xs|psi> ──────────────────────────────────────────
+    energy = feps*0.5_wp*sum(state%xs*state%psi)
+
+    ! ── explicit (fixed-charge) gradient ─────────────────────────────────────
+    allocate (force(3,nat),source=0.0_wp)
+    call solvation_force_terms(ddx%params,ddx%constants,ddx%workspace,state, &
+    &                          elec,force,error)
+    call multipole_force_terms(ddx%params,ddx%constants,ddx%workspace,state, &
+    &                          0,multipoles,force,error)
+    if (error%flag /= 0) then; iostatus = 1; return; end if
+    gradient(:,:) = feps*force(:,:)
+
+    ! ── charge-response term: sum_i (dE/dq_i) * dq_i/dR ──────────────────────
+    if (present(dqdr)) then
+      allocate (jmat(ddx%constants%ncav,nat),source=0.0_wp)
+      call get_coulomb_matrix(mol%xyz,ddx%constants%ccav,jmat)
+      ! dE/dq_i = 1/2 feps ( -[J^T zeta]_i + sqrt(4pi) xs_0i )
+      allocate (dedq(nat))
+      dedq = 0.5_wp*feps*(-matmul(transpose(jmat),state%zeta)+sqrt4pi*state%xs(1,:))
+      do iat = 1,nat
+        do jat = 1,nat
+          gradient(:,iat) = gradient(:,iat)+dedq(jat)*dqdr(:,iat,jat)
+        end do
+      end do
+    end if
+#else
+    iostatus = 1
+    energy = 0.0_wp
+    gradient(:,:) = 0.0_wp
+#endif
+  end subroutine ddx_pc_engrad
+
+#ifdef WITH_DDX
+!========================================================================================!
+
+  subroutine get_coulomb_matrix(xyz,ccav,jmat)
+    !*********************************************************
+    !* 1/r Coulomb matrix between atoms and cavity points.
+    !*********************************************************
+    real(wp),intent(in)    :: xyz(:,:)
+    real(wp),intent(in)    :: ccav(:,:)
+    real(wp),intent(inout) :: jmat(:,:)
+    integer :: ic,jat
+    real(wp) :: vec(3)
+    do ic = 1,size(ccav,2)
+      do jat = 1,size(xyz,2)
+        vec(:) = ccav(:,ic)-xyz(:,jat)
+        jmat(ic,jat) = 1.0_wp/sqrt(sum(vec**2))
+      end do
+    end do
+  end subroutine get_coulomb_matrix
+#endif
+
+!========================================================================================!
+end module crest_ddx_pc
diff --git a/src/calculator/components/electrostatic.F90 b/src/calculator/components/electrostatic.F90
new file mode 100644
index 00000000..2be714e6
--- /dev/null
+++ b/src/calculator/components/electrostatic.F90
@@ -0,0 +1,133 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module crest_electrostatic
+!********************************************************************************
+!* Charge-equilibration electrostatic component.
+!*
+!* Thin wrapper around the multicharge library exposing the electrostatic
+!* energy, its Cartesian gradient, the atomic partial charges and their
+!* geometry derivative dq/dR for the EEQ (2019) and EEQ-BC (2025) models.
+!* Used standalone and as the charge source for the ddX solvation engine.
+!********************************************************************************
+  use crest_parameters
+  use strucrd,only:coord
+#ifdef WITH_TBLITE
+  use mctc_env,only:error_type
+  use mctc_io,only:structure_type,new
+  use mctc_cutoff,only:get_lattice_points
+  use multicharge_model,only:mchrg_model_type
+  use multicharge_param,only:new_eeq2019_model,new_eeqbc2025_model
+#endif
+  implicit none
+  private
+
+  public :: electrostatic_data
+  public :: electrostatic_core
+
+!> Bundled electrostatic settings (stored on calculation_settings)
+  type :: electrostatic_data
+    character(len=:),allocatable :: charge_model  !> 'eeq' | 'eeqbc'
+  end type electrostatic_data
+
+contains
+!========================================================================================!
+
+  subroutine electrostatic_core(mol,chrg,model,energy,gradient,qat,iostatus,dqdr)
+    !***********************************************************************
+    !* Charge-equilibration energy, gradient and atomic charges.
+    !*
+    !*  mol      : molecular structure (Bohr)
+    !*  chrg     : total molecular charge
+    !*  model    : 'eeq' (2019) | 'eeqbc' (2025)
+    !*  energy   : electrostatic energy (out)
+    !*  gradient : 3,nat Cartesian gradient (out, overwritten)
+    !*  qat      : atomic partial charges (out)
+    !*  dqdr     : optional dq_i/dR_a (3,nat,nat) charge derivative (out)
+    !***********************************************************************
+    type(coord),intent(in)        :: mol
+    integer,intent(in)            :: chrg
+    character(len=*),intent(in)   :: model
+    real(wp),intent(out)          :: energy
+    real(wp),intent(out)          :: gradient(:,:)
+    real(wp),intent(out)          :: qat(:)
+    integer,intent(out)           :: iostatus
+    real(wp),intent(out),optional :: dqdr(:,:,:)
+#ifdef WITH_TBLITE
+    type(structure_type) :: struc
+    class(mchrg_model_type),allocatable :: mchrg
+    type(error_type),allocatable :: error
+    real(wp),allocatable :: cn(:),dcndr(:,:,:),dcndL(:,:,:)
+    real(wp),allocatable :: qloc(:),dqlocdr(:,:,:),dqlocdL(:,:,:)
+    real(wp),allocatable :: trans(:,:),ener(:),sigma(:,:),dqdL(:,:,:)
+    integer :: nat
+
+    iostatus = 0
+    nat = mol%nat
+    energy = 0.0_wp
+    gradient(:,:) = 0.0_wp
+
+    call new(struc,mol%at,mol%xyz,charge=real(chrg,wp))
+
+    select case (trim(model))
+    case ('eeq')
+      call new_eeq2019_model(struc,mchrg,error)
+    case ('eeqbc')
+      call new_eeqbc2025_model(struc,mchrg,error)
+    case default
+      iostatus = 1; return
+    end select
+    if (allocated(error)) then; iostatus = 1; return; end if
+
+    ! ── coordination numbers + local charges (and their derivatives) ─────────
+    allocate (cn(nat),qloc(nat))
+    allocate (dcndr(3,nat,nat),dcndL(3,3,nat))
+    allocate (dqlocdr(3,nat,nat),dqlocdL(3,3,nat))
+    call get_lattice_points(struc%periodic,struc%lattice,mchrg%ncoord%cutoff,trans)
+    call mchrg%ncoord%get_coordination_number(struc,trans,cn,dcndr,dcndL)
+    call mchrg%local_charge(struc,trans,qloc,dqlocdr,dqlocdL)
+
+    ! ── solve the equilibration: energy + gradient + charges (+ dq/dR) ───────
+    allocate (ener(nat),source=0.0_wp)
+    allocate (sigma(3,3),source=0.0_wp)
+    !> branch on dqdr presence: forwarding a non-present optional to solve's
+    !> contiguous dummy segfaults under ifx.  dqdr is only evaluated by solve
+    !> when dqdL is present as well, so it has to be passed too.
+    if (present(dqdr)) then
+      allocate (dqdL(3,3,nat),source=0.0_wp)
+      call mchrg%solve(struc,error,cn,qloc,dcndr,dcndL,dqlocdr,dqlocdL, &
+      &                energy=ener,gradient=gradient,sigma=sigma,qvec=qat, &
+      &                dqdr=dqdr,dqdL=dqdL)
+    else
+      call mchrg%solve(struc,error,cn,qloc,dcndr,dcndL,dqlocdr,dqlocdL, &
+      &                energy=ener,gradient=gradient,sigma=sigma,qvec=qat)
+    end if
+    if (allocated(error)) then; iostatus = 1; return; end if
+    energy = sum(ener)
+#else
+    iostatus = 1
+    energy = 0.0_wp
+    gradient(:,:) = 0.0_wp
+    qat(:) = 0.0_wp
+    if (present(dqdr)) dqdr(:,:,:) = 0.0_wp
+#endif
+  end subroutine electrostatic_core
+
+!========================================================================================!
+end module crest_electrostatic
diff --git a/src/calculator/libpvol.F90 b/src/calculator/components/libpvol.F90
similarity index 100%
rename from src/calculator/libpvol.F90
rename to src/calculator/components/libpvol.F90
diff --git a/src/calculator/components/rmsdpot.f90 b/src/calculator/components/rmsdpot.f90
new file mode 100644
index 00000000..e6996ef9
--- /dev/null
+++ b/src/calculator/components/rmsdpot.f90
@@ -0,0 +1,75 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2025 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module rmsdpot
+  use strucrd
+  use iso_fortran_env,only:wp => real64
+
+  implicit none
+  private
+
+  type :: rmsdbias
+    integer :: nbias = 0
+    real(wp),allocatable :: alpha(:)
+    real(wp),allocatable :: kpush(:)
+    integer,allocatable  :: mult(:)
+    type(coord),pointer :: ptr_structures(:)
+  end type rmsdbias
+
+  public :: rmsdbias
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  subroutine rmsd_push_engrad(mol,rbias,energy,grad)
+!*************************************************************************
+!* Compute a repulsive energy and corresponding forces for
+!* the similarity match between the currnt mol and a list of references
+!*************************************************************************
+    implicit none
+    type(coord),intent(in) :: mol
+    type(rmsdbias) :: rbias
+
+    real(wp),intent(inout) :: energy
+    real(wp),intent(inout) :: grad(3,mol%nat)
+    integer :: i,j,k,l
+
+    real(wp) :: tmpe,ktot,rmssq 
+    real(wp),allocatable :: tmpgrad(:,:)
+
+    energy = 0.0_wp
+    grad = 0.0_wp
+
+    do i=1,rbias%nbias
+      rmssq = 0.0_wp ** 2
+      ktot = real(rbias%mult(i))*rbias%kpush(i)*real(mol%nat)
+      tmpe = ktot*exp(-rbias%alpha(i)*rmssq )
+       
+
+    enddo
+
+    return
+  end subroutine rmsd_push_engrad
+
+!========================================================================================!
+!========================================================================================!
+end module rmsdpot
diff --git a/src/calculator/components/solvation.F90 b/src/calculator/components/solvation.F90
new file mode 100644
index 00000000..da5c61b9
--- /dev/null
+++ b/src/calculator/components/solvation.F90
@@ -0,0 +1,236 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module crest_solvation
+!********************************************************************************
+!* Composite implicit-solvation contribution.
+!*
+!* Stitches the building-block components into a single, method-independent
+!* solvation free energy and gradient that can be added on top of any parent
+!* potential:
+!*   - charges (+ dq/dR) from the EEQ/EEQ-BC electrostatic component
+!*   - polar (electrostatic) free energy from the ddX continuum engine
+!*   - nonpolar surface-tension term from the SASA component
+!*   - optional charge-dependent hydrogen-bond term  h_i S_i q_i^2
+!*
+!* All settings and the cached (GFN2/ALPB) parameters are bundled in the
+!* solvation_data object, which is stored on the calculation_settings and
+!* passed together with the geometry to solvation_core, mirroring the
+!* tblite/gfn0/gfnff calculators.
+!********************************************************************************
+  use crest_parameters
+  use strucrd,only:coord
+#ifdef WITH_DDX
+  use crest_electrostatic,only:electrostatic_core
+  use crest_ddx_pc,only:ddx_pc_engrad
+  use crest_surface,only:surface_engrad
+  use mctc_env,only:error_type
+  use mctc_io,only:structure_type,new
+  use tblite_solvation_cds,only:cds_input
+  use tblite_solvation_data_cds,only:get_cds_param
+  use tblite_solvation,only:get_solvent_data,solvent_data
+#endif
+  implicit none
+  private
+
+  public :: solvation_data
+  public :: solvation_setup
+  public :: solvation_core
+
+!> Bundled solvation settings + cached parameters (stored on calculation_settings)
+  type :: solvation_data
+    !> user configuration
+    character(len=:),allocatable :: charge_model  !> 'eeq' | 'eeqbc'
+    character(len=:),allocatable :: smodel        !> 'cosmo' | 'cpcm' | 'pcm'
+    character(len=:),allocatable :: solvent       !> e.g. 'water'
+    logical  :: do_hbond = .true.
+    !> derived/cached by solvation_setup
+    logical  :: loaded = .false.
+    real(wp) :: eps = 0.0_wp
+    real(wp) :: probe = 0.0_wp
+    real(wp),allocatable :: tension(:)  !> per atom
+    real(wp),allocatable :: hbond(:)    !> per atom (scaled)
+    real(wp),allocatable :: rad(:)      !> per species (D3)
+  end type solvation_data
+
+contains
+!========================================================================================!
+
+  subroutine solvation_setup(mol,solv,iostatus)
+    !***********************************************************************
+    !* Resolve the solvent dielectric constant and load the GFN2/ALPB CDS
+    !* nonpolar parameters for the given molecule into the solvation_data
+    !* object.  Idempotent: skips once loaded.
+    !***********************************************************************
+    type(coord),intent(in)            :: mol
+    type(solvation_data),intent(inout) :: solv
+    integer,intent(out)               :: iostatus
+#ifdef WITH_DDX
+    type(solvent_data) :: sdat
+    real(wp),allocatable :: tension(:),hbond(:),rad(:)
+    real(wp) :: probe
+    character(len=:),allocatable :: solv_name
+
+    iostatus = 0
+    if (solv%loaded) return
+    if (.not.allocated(solv%charge_model)) solv%charge_model = 'eeqbc'
+    if (.not.allocated(solv%smodel)) solv%smodel = 'cpcm'
+    if (.not.allocated(solv%solvent)) then
+      iostatus = 1; return
+    end if
+
+    !> dielectric constant from the solvent database (tblite calls water 'water')
+    solv_name = solv%solvent
+    if (solv_name == 'h2o') solv_name = 'water'
+    sdat = get_solvent_data(solv_name)
+    if (sdat%eps <= 0.0_wp) then
+      iostatus = 1; return
+    end if
+    solv%eps = sdat%eps
+
+    !> GFN2/ALPB CDS nonpolar parameters
+    allocate (tension(mol%nat),hbond(mol%nat))
+    call solvation_cds_params(mol,solv_name,tension,hbond,rad,probe,iostatus)
+    if (iostatus /= 0) return
+    call move_alloc(tension,solv%tension)
+    call move_alloc(hbond,solv%hbond)
+    call move_alloc(rad,solv%rad)
+    solv%probe = probe
+    solv%loaded = .true.
+#else
+    iostatus = 1
+#endif
+  end subroutine solvation_setup
+
+!========================================================================================!
+
+  subroutine solvation_core(mol,chrg,solv,energy,gradient,iostatus)
+    !***********************************************************************
+    !* Total implicit-solvation energy and gradient for a prepared
+    !* solvation_data object (call solvation_setup first).
+    !*
+    !*  mol      : molecular structure (Bohr)
+    !*  chrg     : total molecular charge
+    !*  solv     : bundled settings + cached parameters
+    !*  energy   : total solvation free energy (out)
+    !*  gradient : 3,nat Cartesian gradient (out, overwritten)
+    !***********************************************************************
+    type(coord),intent(in)            :: mol
+    integer,intent(in)                :: chrg
+    type(solvation_data),intent(in)   :: solv
+    real(wp),intent(out)              :: energy
+    real(wp),intent(out)              :: gradient(:,:)
+    integer,intent(out)              :: iostatus
+#ifdef WITH_DDX
+    real(wp),allocatable :: qat(:),dqdr(:,:,:),gtmp(:,:),sasa(:),dsdr(:,:,:)
+    real(wp) :: edum,etmp
+    integer :: nat,iat,jat
+
+    iostatus = 0
+    nat = mol%nat
+    energy = 0.0_wp
+    gradient(:,:) = 0.0_wp
+    allocate (qat(nat),dqdr(3,nat,nat),gtmp(3,nat),sasa(nat),dsdr(3,nat,nat))
+
+    ! ── charges + dq/dR from the electrostatic component ─────────────────────
+    call electrostatic_core(mol,chrg,solv%charge_model,edum,gtmp,qat,iostatus,dqdr=dqdr)
+    if (iostatus /= 0) return
+
+    ! ── polar (ddX) free energy + gradient (incl. dq/dR chain term) ──────────
+    call ddx_pc_engrad(mol,qat,solv%smodel,solv%eps,etmp,gradient,iostatus,dqdr=dqdr)
+    if (iostatus /= 0) return
+    energy = etmp
+
+    ! ── nonpolar surface-tension term ────────────────────────────────────────
+    call surface_engrad(mol,solv%tension,etmp,gtmp,iostatus,sasa=sasa,dsdr=dsdr, &
+    &                   rad=solv%rad,probe=solv%probe)
+    if (iostatus /= 0) return
+    energy = energy+etmp
+    gradient(:,:) = gradient+gtmp
+
+    ! ── charge-dependent hydrogen-bond term:  E = sum_i h_i S_i q_i^2 ─────────
+    if (solv%do_hbond) then
+      energy = energy+sum(solv%hbond*sasa*qat**2)
+      do iat = 1,nat
+        do jat = 1,nat
+          gradient(:,iat) = gradient(:,iat) &
+          &  +solv%hbond(jat)*qat(jat)**2*dsdr(:,iat,jat) &            !> dS/dR part
+          &  +solv%hbond(jat)*sasa(jat)*2.0_wp*qat(jat)*dqdr(:,iat,jat) !> dq/dR part
+        end do
+      end do
+    end if
+#else
+    iostatus = 1
+    energy = 0.0_wp
+    gradient(:,:) = 0.0_wp
+#endif
+  end subroutine solvation_core
+
+!========================================================================================!
+
+  subroutine solvation_cds_params(mol,solvent,tension,hbond,rad,probe,iostatus)
+    !***********************************************************************
+    !* Fetch the GFN2/ALPB CDS nonpolar parameters for a given solvent from
+    !* tblite (no hard-coded numbers): per-atom surface tensions, per-atom
+    !* scaled hydrogen-bond strengths, per-species (D3) radii and the probe.
+    !*
+    !* We might want to switch this parameter getter out for something else
+    !* that is not hardcoded to the GFN2 calculator
+    !***********************************************************************
+    type(coord),intent(in)        :: mol
+    character(len=*),intent(in)   :: solvent
+    real(wp),intent(out)          :: tension(:)
+    real(wp),intent(out)          :: hbond(:)
+    real(wp),allocatable,intent(out) :: rad(:)
+    real(wp),intent(out)          :: probe
+    integer,intent(out)           :: iostatus
+#ifdef WITH_DDX
+    type(structure_type) :: struc
+    type(cds_input)      :: inp
+    type(error_type),allocatable :: error
+    real(wp),allocatable :: hbspec(:)
+    integer :: iat
+
+    iostatus = 0
+    call new(struc,mol%at,mol%xyz)
+    inp%alpb = .true.
+    inp%solvent = solvent
+    call get_cds_param(inp,struc,'gfn2',error)
+    if (allocated(error).or..not.allocated(inp%tension)) then
+      iostatus = 1; return
+    end if
+    probe = inp%probe
+    rad = inp%rad
+    !> hydrogen-bond strength is scaled by the atomic surface (cf. tblite new_cds)
+    allocate (hbspec(size(inp%hbond)))
+    hbspec = inp%hbond/(4.0_wp*pi*(inp%rad+inp%probe)**2)
+    do iat = 1,mol%nat
+      tension(iat) = inp%tension(struc%id(iat))
+      hbond(iat) = hbspec(struc%id(iat))
+    end do
+#else
+    iostatus = 1
+    tension(:) = 0.0_wp
+    hbond(:) = 0.0_wp
+    probe = 0.0_wp
+#endif
+  end subroutine solvation_cds_params
+
+!========================================================================================!
+end module crest_solvation
diff --git a/src/calculator/components/surface.F90 b/src/calculator/components/surface.F90
new file mode 100644
index 00000000..4a087456
--- /dev/null
+++ b/src/calculator/components/surface.F90
@@ -0,0 +1,120 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module crest_surface
+!********************************************************************************
+!* Solvent-accessible-surface-area (SASA) component.
+!*
+!* Thin wrapper around tblite's surface integrator providing per-atom SASA and
+!* the geometry-only nonpolar (cavity/dispersion) energy E = sum_i gamma_i S_i
+!* together with its Cartesian gradient.  This is the surface-tension part of
+!* the xTB ALPB/GBSA CDS term; the charge-dependent hydrogen-bond contribution
+!* is left to the solvation composite, where atomic charges are available.
+!********************************************************************************
+  use crest_parameters
+  use strucrd,only:coord
+#ifdef WITH_TBLITE
+  use mctc_io,only:structure_type,new
+  use tblite_solvation_surface,only:surface_integrator,new_surface_integrator
+  use tblite_solvation_data,only:get_vdw_rad_cosmo
+#endif
+  implicit none
+  private
+
+  public :: surface_engrad
+
+#ifdef WITH_TBLITE
+  real(wp),parameter :: probe_default = 1.0_wp*aatoau  !> probe radius (Bohr)
+  integer,parameter  :: nang_default = 230             !> Lebedev grid points
+#endif
+
+contains
+!========================================================================================!
+
+  subroutine surface_engrad(mol,tension,energy,gradient,iostatus,sasa,dsdr,rad,probe)
+    !***********************************************************************
+    !* Nonpolar SASA energy and gradient.
+    !*
+    !*  mol      : molecular structure (Bohr)
+    !*  tension  : per-atom surface tensions gamma_i
+    !*  energy   : nonpolar energy sum_i gamma_i S_i (out)
+    !*  gradient : 3,nat Cartesian gradient (out, overwritten)
+    !*  sasa     : optional per-atom solvent-accessible surface area (out)
+    !*  dsdr     : optional dS_i/dR_a (3,nat,nat); for charge-dependent terms
+    !*             (e.g. hydrogen bonding) assembled by the caller
+    !*  rad      : optional per-species vdW radii (default: COSMO radii)
+    !*  probe    : optional solvent probe radius (default: 1.0 Angstrom)
+    !***********************************************************************
+    type(coord),intent(in)        :: mol
+    real(wp),intent(in)           :: tension(:)
+    real(wp),intent(out)          :: energy
+    real(wp),intent(out)          :: gradient(:,:)
+    integer,intent(out)           :: iostatus
+    real(wp),intent(out),optional :: sasa(:)
+    real(wp),intent(out),optional :: dsdr(:,:,:)
+    real(wp),intent(in),optional  :: rad(:)
+    real(wp),intent(in),optional  :: probe
+#ifdef WITH_TBLITE
+    type(structure_type)     :: struc
+    type(surface_integrator) :: integ
+    real(wp),allocatable :: vdw(:),surface(:),ds(:,:,:)
+    real(wp) :: prb
+    integer :: nat,iat,jat
+
+    iostatus = 0
+    nat = mol%nat
+    energy = 0.0_wp
+    gradient(:,:) = 0.0_wp
+
+    call new(struc,mol%at,mol%xyz)
+
+    ! ── per-species radii + probe + surface integrator ───────────────────────
+    allocate (vdw(size(struc%num)))
+    if (present(rad)) then
+      vdw(:) = rad(:)
+    else
+      vdw(:) = get_vdw_rad_cosmo(struc%num)
+    end if
+    prb = probe_default
+    if (present(probe)) prb = probe
+    call new_surface_integrator(integ,struc%id,vdw,prb,nang_default)
+
+    ! ── SASA and its Cartesian derivative ────────────────────────────────────
+    allocate (surface(nat),ds(3,nat,nat))
+    call integ%get_surface(struc,surface,ds)
+
+    ! ── energy + gradient: E = sum_i gamma_i S_i ─────────────────────────────
+    energy = sum(surface*tension)
+    do iat = 1,nat
+      do jat = 1,nat
+        gradient(:,iat) = gradient(:,iat)+tension(jat)*ds(:,iat,jat)
+      end do
+    end do
+    if (present(sasa)) sasa(:) = surface(:)
+    if (present(dsdr)) dsdr(:,:,:) = ds(:,:,:)
+#else
+    iostatus = 1
+    energy = 0.0_wp
+    gradient(:,:) = 0.0_wp
+    if (present(sasa)) sasa(:) = 0.0_wp
+#endif
+  end subroutine surface_engrad
+
+!========================================================================================!
+end module crest_surface
diff --git a/src/calculator/constraints.f90 b/src/calculator/constraints.f90
index c4629213..a36f3160 100644
--- a/src/calculator/constraints.f90
+++ b/src/calculator/constraints.f90
@@ -82,6 +82,7 @@ module constraints
   contains
     procedure :: print => print_constraint
     procedure :: deallocate => constraint_deallocate
+    procedure :: copy => constraint_copy
     procedure :: bondconstraint => create_bond_constraint
     generic,public :: sphereconstraint => create_sphere_constraint,create_sphere_constraint_all
     procedure,private :: create_sphere_constraint,create_sphere_constraint_all
@@ -154,7 +155,7 @@ subroutine complete_defaults(self,mol)
       if (self%n .ne. 2) error stop '*** ERROR *** wrong number of atoms for bondrange constraint'
       if (.not.allocated(self%fc)) then
         allocate (self%fc(2))
-        self%fc(1) = fcdefault/kB !> bondrange doesn't use 300K default! 
+        self%fc(1) = fcdefault/kB !> bondrange doesn't use 300K default!
         self%fc(2) = betadefault
       else
         if (size(self%fc) < 2) error stop '*** ERROR *** wrong number of parameters for bondrange constraint'
@@ -165,7 +166,7 @@ subroutine complete_defaults(self,mol)
         self%ref(2) = self%ref(1)-1.0_wp
       else
         dummy = minval(self%ref(:))
-        self%ref(1) =  maxval(self%ref(:))
+        self%ref(1) = maxval(self%ref(:))
         self%ref(2) = dummy
       end if
 
@@ -288,7 +289,7 @@ subroutine calc_constraint(n,xyz,constr,energy,grd)
     energy = 0.0_wp
     grd = 0.0_wp
 
-    if(.not.constr%active) return
+    if (.not.constr%active) return
 
     select case (constr%type)
     case (bond)
@@ -324,7 +325,7 @@ subroutine print_constraint(self,chnl)
     character(len=10) :: atm
     integer :: chnl
     logical :: pr
-    character(len=*),parameter :: headfmt ='("> constraint: ",a,a)'
+    character(len=*),parameter :: headfmt = '("> constraint: ",a,a)'
     if (self%type == 0) return
     pr = .true.
     select case (self%type)
@@ -469,6 +470,27 @@ subroutine constraint_deallocate(self)
     return
   end subroutine constraint_deallocate
 
+  subroutine constraint_copy(self,src)
+    implicit none
+    class(constraint) :: self
+    type(constraint) :: src
+!&>
+    if (allocated(src%atms ))  self%atms = src%atms
+    if (allocated(src%ref  ))  self%ref  = src%ref
+    if (allocated(src%fc   ))  self%fc   = src%fc
+    self%active     = src%active
+    self%type       = src%type
+    self%n          = src%n
+    self%frozenatms = src%frozenatms
+    if(src%frozenatms)then
+      call self%addfreeze(src%freezeptr)
+    endif
+    self%wscal      = src%wscal
+    self%subtype    = src%subtype
+!&<
+    return
+  end subroutine constraint_copy
+
 !========================================================================================!
 !> subroutine constraint_freezeassoc
 !> associate the freezeptr
@@ -1082,10 +1104,10 @@ subroutine create_sphere_constraint(self,n,atms,r,k,alpha,logfermi)
     allocate (self%ref(3),source=r)
     ii = 0
     do i = 1,n
-      if (atms(i))then 
-        ii = ii +1
+      if (atms(i)) then
+        ii = ii+1
         self%atms(ii) = i
-      endif
+      end if
     end do
     self%ref(:) = r
     self%fc(1) = k
@@ -1116,10 +1138,10 @@ subroutine create_ellips_constraint(self,n,atms,r,k,alpha,logfermi)
     allocate (self%ref(3),source=r)
     ii = 0
     do i = 1,n
-      if (atms(i))then
-        ii = ii +1 
+      if (atms(i)) then
+        ii = ii+1
         self%atms(ii) = i
-      endif
+      end if
     end do
     self%ref(:) = r(:)
     self%fc(1) = k
diff --git a/src/calculator/gfnff_api.F90 b/src/calculator/gfnff_api.F90
index c9ec8ec4..d5ce3c0e 100644
--- a/src/calculator/gfnff_api.F90
+++ b/src/calculator/gfnff_api.F90
@@ -1,7 +1,7 @@
 !================================================================================!
 ! This file is part of crest.
 !
-! Copyright (C) 2023 Philipp Pracht
+! Copyright (C) 2023-2026 Philipp Pracht
 !
 ! crest is free software: you can redistribute it and/or modify it under
 ! the terms of the GNU Lesser General Public License as published by
@@ -58,6 +58,20 @@ module gfnff_api
 !========================================================================================!
 
   subroutine gfnff_api_setup(mol,chrg,ff_dat,io,pr,iunit)
+!*************************************************************
+!* Set up (initialize) a GFN-FF calculator from a coord mol. *
+!* Lattice vectors are read from mol%lat when present, so    *
+!* PBC calculations are automatically activated.             *
+!*                                                           *
+!* INPUT:                                                    *
+!*   mol    - molecule (coords + optional lattice)           *
+!*   chrg   - total molecular charge                         *
+!*   pr     - optional verbosity flag (logical)              *
+!*   iunit  - optional output unit                           *
+!* OUTPUT:                                                   *
+!*   ff_dat - initialized GFN-FF data object                 *
+!*   io     - error status (0 = success)                     *
+!*************************************************************
     implicit none
     type(coord),intent(in)      :: mol
     integer,intent(in)          :: chrg
@@ -66,18 +80,44 @@ subroutine gfnff_api_setup(mol,chrg,ff_dat,io,pr,iunit)
     integer,intent(in),optional :: iunit
     type(gfnff_data),allocatable,intent(inout) :: ff_dat
     type(coord) :: refmol
+    !> LOCAL
+    integer :: mylevel,myunit
     io = 0
+
+    ! ── map legacy pr/iunit to integer printlevel/printunit ──────────────────
+    mylevel = 0
+    if (present(pr)) then
+      if (pr) mylevel = 2
+    end if
+    if (present(iunit)) then
+      myunit = iunit
+    else
+      myunit = stdout
+    end if
+
 #ifdef WITH_GFNFF
     if (allocated(ff_dat%refgeo)) then
-      !> initialize GFN-FF from a separate reference structure
+      ! ── initialize from a separate reference structure ──────────────────────
       call refmol%open(ff_dat%refgeo)
-      call gfnff_initialize(refmol%nat,refmol%at,refmol%xyz,ff_dat, &
-      & ichrg=chrg,print=pr,iostat=io,iunit=iunit)
+      if (allocated(refmol%lat)) then
+        call gfnff_initialize(refmol%nat,refmol%at,refmol%xyz,ff_dat, &
+        &   ichrg=chrg,printlevel=mylevel,printunit=myunit,iostat=io, &
+        &   lattice=refmol%lat,npbc=3)
+      else
+        call gfnff_initialize(refmol%nat,refmol%at,refmol%xyz,ff_dat, &
+        &   ichrg=chrg,printlevel=mylevel,printunit=myunit,iostat=io)
+      end if
       call refmol%deallocate()
     else
-      !> initialize parametrization and topology of GFN-FF
-      call gfnff_initialize(mol%nat,mol%at,mol%xyz,ff_dat, &
-      & ichrg=chrg,print=pr,iostat=io,iunit=iunit)
+      ! ── initialize from mol directly ────────────────────────────────────────
+      if (allocated(mol%lat)) then
+        call gfnff_initialize(mol%nat,mol%at,mol%xyz,ff_dat, &
+        &   ichrg=chrg,printlevel=mylevel,printunit=myunit,iostat=io, &
+        &   lattice=mol%lat,npbc=3)
+      else
+        call gfnff_initialize(mol%nat,mol%at,mol%xyz,ff_dat, &
+        &   ichrg=chrg,printlevel=mylevel,printunit=myunit,iostat=io)
+      end if
     end if
 
 #else /* WITH_GFNFF */
@@ -89,7 +129,21 @@ end subroutine gfnff_api_setup
 
 !========================================================================================!
 
-  subroutine gfnff_sp(mol,ff_dat,energy,gradient,iostatus)
+  subroutine gfnff_sp(mol,ff_dat,energy,gradient,iostatus,sigma)
+!*************************************************************
+!* GFN-FF single-point energy + gradient for mol.           *
+!* When mol%lat is allocated the periodic singlepoint call  *
+!* is used automatically (lattice passed to gfnff).         *
+!*                                                           *
+!* INPUT:                                                    *
+!*   mol      - molecule (coords + optional lattice)        *
+!*   ff_dat   - initialized GFN-FF data object              *
+!* OUTPUT:                                                   *
+!*   energy   - total energy (Hartree)                      *
+!*   gradient - gradient (Eh/Bohr)                          *
+!*   iostatus - error status (0 = success)                  *
+!*   sigma    - optional stress tensor (Eh); zero non-PBC   *
+!*************************************************************
     implicit none
     !> INPUT
     type(coord),intent(in) :: mol
@@ -97,16 +151,23 @@ subroutine gfnff_sp(mol,ff_dat,energy,gradient,iostatus)
     !> OUTPUT
     real(wp),intent(out) :: energy
     real(wp),intent(out) :: gradient(3,mol%nat)
-    integer,intent(out) :: iostatus
+    integer,intent(out)  :: iostatus
+    real(wp),intent(out),optional :: sigma(3,3)
     !> LOCAL
-    logical :: fail
+    real(wp) :: sigma_loc(3,3)
     energy = 0.0_wp
     gradient = 0.0_wp
     iostatus = 0
-    fail = .false.
+    sigma_loc = 0.0_wp
 #ifdef WITH_GFNFF
-    call gfnff_singlepoint(mol%nat,mol%at,mol%xyz,ff_dat, &
-    & energy,gradient,iostat=iostatus)
+    if (allocated(mol%lat)) then
+      call gfnff_singlepoint(mol%nat,mol%at,mol%xyz,ff_dat, &
+      &   energy,gradient,lattice=mol%lat,sigma=sigma_loc,iostat=iostatus)
+    else
+      call gfnff_singlepoint(mol%nat,mol%at,mol%xyz,ff_dat, &
+      &   energy,gradient,iostat=iostatus)
+    end if
+    if (present(sigma)) sigma = sigma_loc
 #else
     write (stdout,*) 'Error: Compiled without GFN-FF support!'
     write (stdout,*) 'Use -DWITH_GFNFF=true in the setup to enable this function'
@@ -121,10 +182,8 @@ subroutine gfnff_printout(iunit,ff_dat)
     !> INPUT
     integer,intent(in)  :: iunit
     type(gfnff_data),allocatable,intent(inout) :: ff_dat
-    !> LOCAL
-    logical :: fail
 #ifdef WITH_GFNFF
-    call print_gfnff_results(iunit,ff_dat%res,allocated(ff_dat%solvation))
+    call ff_dat%resultprint(printunit=iunit)
 #else
     write (stdout,*) 'Error: Compiled without GFN-FF support!'
     write (stdout,*) 'Use -DWITH_GFNFF=true in the setup to enable this function'
@@ -162,17 +221,16 @@ subroutine gfnff_dump_sasa(ff_dat,nat,atlist)
     integer,intent(in) :: nat
     integer :: i
     real(wp) :: sumsasa
-    if(allocated(ff_dat%solvation))then
-      if(allocated(ff_dat%solvation%sasa))then
+    if (allocated(ff_dat%solvation)) then
+      if (allocated(ff_dat%solvation%sasa)) then
         sumsasa = 0.0_wp
-        do i=1,nat
-          if(atlist(i)) sumsasa = sumsasa + ff_dat%solvation%sasa(i)
-        enddo
-        write(5454,*) sumsasa
-      endif
-    endif
+        do i = 1,nat
+          if (atlist(i)) sumsasa = sumsasa+ff_dat%solvation%sasa(i)
+        end do
+        write (5454,*) sumsasa
+      end if
+    end if
   end subroutine gfnff_dump_sasa
 !========================================================================================!
 !========================================================================================!
 end module gfnff_api
-
diff --git a/src/calculator/hessian_reconstruct.f90 b/src/calculator/hessian_reconstruct.f90
new file mode 100644
index 00000000..20db7311
--- /dev/null
+++ b/src/calculator/hessian_reconstruct.f90
@@ -0,0 +1,168 @@
+module hessian_reconstruct
+  use iso_fortran_env,only:wp => real64
+  use hessupdate_module
+  use optimize_maths
+  use crest_parameters
+  implicit none
+  private
+
+  public cashed_hessian
+
+  type :: cashed_hessian
+
+    integer :: steps = 10
+    real(wp),allocatable :: gradient(:,:,:)
+    real(wp),allocatable :: coords(:,:,:)
+    real(wp),allocatable :: energy(:)
+    real(wp),allocatable :: H(:,:)
+    integer,allocatable :: order(:),natm
+    integer :: stepcount = 0
+    real(wp) :: hguess = 0.02_wp
+    real(wp),allocatable ::hess(:)
+    logical :: track_step = .true.
+    integer :: initialize_type != 0
+    integer :: hu_type != 0
+
+  contains
+
+    procedure :: alloc => cashed_hessian_allocate
+    procedure :: dealloc => cashed_hessian_deallocate
+    procedure :: update => update_cashed_hessian
+    procedure :: construct_hessian
+
+  end type cashed_hessian
+
+contains
+
+  subroutine cashed_hessian_allocate(self,N,steps,hguess,initialize_type, hu_type) !> maybe make keywords optional later
+    integer,intent(in) :: N,steps, initialize_type, hu_type
+    class(cashed_hessian),intent(inout) :: self
+    real(wp),intent(in) :: hguess
+
+
+    self%steps = steps
+    self%hguess = hguess
+    self%natm = N
+    self%initialize_type = initialize_type
+    self%hu_type = hu_type
+    allocate (self%gradient(steps,3,N))
+    allocate (self%coords(steps,3,N))
+    allocate (self%energy(steps))
+    allocate (self%order(steps))
+    allocate (self%hess((3*N*(3*N+1))/2))
+    allocate (self%H(3*N,3*N))
+
+    self%order(:) = 0
+
+  end subroutine cashed_hessian_allocate
+
+  subroutine cashed_hessian_deallocate(self)
+    class(cashed_hessian),intent(inout) :: self
+
+    if (allocated(self%gradient)) deallocate (self%gradient)
+    if (allocated(self%coords)) deallocate (self%coords)
+    if (allocated(self%energy)) deallocate (self%energy)
+    if (allocated(self%order)) deallocate (self%order)
+
+  end subroutine cashed_hessian_deallocate
+
+  subroutine update_cashed_hessian(self,gradient,energy,coords)
+    class(cashed_hessian),intent(inout) :: self
+    real(wp),intent(in) :: gradient(:,:),energy,coords(:,:)
+    integer :: idx,i
+
+    self%stepcount = self%stepcount+1
+    idx = minloc(self%order,1)
+    self%order(idx) = self%stepcount
+    self%gradient(idx,:,:) = gradient
+    self%energy(idx) = energy
+    self%coords(idx,:,:) = coords
+
+  end subroutine update_cashed_hessian
+
+  subroutine construct_hessian(self)
+    class(cashed_hessian),intent(inout) :: self
+    integer :: i,j,k,nat3
+    real(wp),allocatable :: tmp(:),tmp_coords(:,:),tmp_grads(:,:),dx(:)
+    real(wp) :: gnorm
+    integer :: unit,iter,made_iters
+
+    nat3 = 3*self%natm
+
+    allocate (tmp_coords(self%steps,nat3))
+    allocate (tmp_grads(self%steps,nat3))
+    allocate (tmp(self%steps))
+    allocate (dx(nat3))
+
+    tmp = self%order
+
+    tmp_coords = reshape(self%coords, [self%steps,nat3])
+    tmp_grads = reshape(self%gradient, [self%steps,nat3])
+
+    made_iters = self%steps
+
+    !>Hessian guess is installed previously in optimize routine but could also be read in explicitly for better readability?
+
+    if (minval(tmp) == 0) then !> Implement keyword like exact HU that kills the process
+      made_iters = maxval(tmp) !> if made_iters<steps
+      write (stdout,*) "Requsted Number of reconstruction steps is",self%steps, &
+      & "but only",made_iters,"geometry optimization steps were made!"
+      write (stdout,*) "Hessian is reconstructed with",made_iters,"update steps only!"
+
+      do while (minval(tmp) == 0)
+        j = minloc(tmp,1)
+        tmp(j) = HUGE(tmp(j))
+      end do
+    end if
+
+    do i = 1,made_iters
+      if (i == 1) then
+        j = minloc(tmp,1)
+        tmp(j) = HUGE(tmp(j))
+      else
+        j = minloc(tmp,1) !> This only happens if made_iters>steps
+        if (j == 1) then  !> => Not affected if too many steps requested
+          dx = tmp_coords(j,:)-tmp_coords(self%steps,:)
+          call update_hessian(nat3,gnorm,tmp_grads(j,:),tmp_grads(self%steps,:),dx,self%hess(:),self%hu_type)
+        else
+          dx = tmp_coords(j,:)-tmp_coords(j-1,:)
+          call update_hessian(nat3,gnorm,tmp_grads(j,:),tmp_grads(j-1,:),dx,self%hess(:),self%hu_type)
+        end if
+        tmp(j) = HUGE(tmp(j))
+      end if
+    end do
+
+    call dhtosq(nat3,self%H(:,:),self%hess(:)) !>B needs to be renamed eventually!
+
+  end subroutine construct_hessian
+
+  subroutine update_hessian(nat3,gnorm,grd1,gold,dx,hess,hu_type)
+  !==============================================
+  !Wrapper for hessian update scheme selection
+  !==============================================
+    !class(cashed_hessian),intent(inout) :: self
+    integer,intent(in) :: nat3
+    real(wp),intent(in) :: dx(:), grd1(:),gold(:)
+    real(wp),intent(in) :: gnorm 
+    real(wp),intent(inout) :: hess(:)
+    integer,intent(in) :: hu_type
+
+    select case (hu_type)
+    case (0)
+      call bfgs(nat3,gnorm,grd1,gold,dx,hess)
+    case (1)
+      call powell(nat3,gnorm,grd1,gold,dx,hess)
+    case (2)
+      call sr1(nat3,gnorm,grd1,gold,dx,hess)
+    case (3)
+      call bofill(nat3,gnorm,grd1,gold,dx,hess)
+    case (4)
+      call schlegel(nat3,gnorm,grd1,gold,dx,hess)
+    case default
+      write (*,*) 'invalid update selection for hessian reconstruction'
+      stop
+    end select
+
+  end subroutine update_hessian
+
+end module hessian_reconstruct
diff --git a/src/calculator/hr_utils.f90 b/src/calculator/hr_utils.f90
new file mode 100644
index 00000000..039553df
--- /dev/null
+++ b/src/calculator/hr_utils.f90
@@ -0,0 +1,152 @@
+module hr_utils
+  use iso_fortran_env,only:wp => real64
+  use crest_calculator
+  use crest_parameters
+  use optimize_maths
+  use modelhessian_module
+  use axis_module
+  use strucrd
+  implicit none
+  private
+
+  public initialize_hessian
+
+contains
+
+  subroutine initialize_hessian(calc,type,xyz,nat,at,hess,hguess,pr) !>Matrix is forced to be positive definite
+    type(calcdata),intent(inout) :: calc
+    integer,intent(in) :: type
+    real(wp),intent(in) :: xyz(3,nat)
+    integer,intent(in) :: at(nat),nat
+    real(wp),intent(inout) :: hess(:)
+    real(wp),optional,intent(in) :: hguess
+    logical,intent(in) :: pr
+    type(calcdata),allocatable :: newcalc
+    type(mhparam) :: mhset
+    integer :: k,i,j,idx,io,nat3
+
+    real(wp),allocatable :: hess_full(:,:)
+
+    real(wp),allocatable :: pmode(:,:),grad(:,:)
+    real(wp) :: rot(3),dumi
+    logical :: linear
+    type(coord) :: mol
+
+    nat3 = 3*nat
+
+    !!$omp critical
+    !allocate (pmode(nat3,1)) ! dummy allocated
+    !!$omp end critical
+
+    !$omp critical
+    allocate (newcalc)
+    allocate (hess_full(nat3,nat3),source=0.0_wp)
+    !$omp end critical
+
+    select case (type)
+    case (0) !>Initialize as a scaled identity
+      if (present(hguess)) then
+        k = 0
+        do i = 1,nat3
+          do j = 1,i
+            k = k+1
+            if (i /= j) then
+              hess(k) = 0.0_wp
+            else
+              hess(k) = hguess
+            end if
+          end do
+        end do
+      else
+        write (stdout,*) "No hguess provided"
+      end if
+    case (1)
+      !$omp critical
+      !write(stdout,*) calc%calcs(1)%chrg
+      call newcalc%create('gfnff',chrg=calc%calcs(1)%chrg,uhf=calc%calcs(1)%uhf) !> Different levels?? and what happens to solvent??
+      !$omp end critical
+      call numhess1(nat,at,xyz,newcalc,hess_full(:,:),io)
+      call dsqtoh(nat3,hess_full(:,:),hess(:)) !>Pack Hessian
+    case (2)
+        !$omp critical
+      call newcalc%create('gfn0',chrg=calc%calcs(1)%chrg,uhf=calc%calcs(1)%uhf) !> Different levels?? and what happens to solvent??
+      !$omp end critical
+      call numhess1(nat,at,xyz,newcalc,hess_full(:,:),io)
+      call dsqtoh(nat3,hess_full(:,:),hess(:))
+    case (3)
+        !$omp critical
+      call newcalc%create('gfn1',chrg=calc%calcs(1)%chrg,uhf=calc%calcs(1)%uhf) !> Different levels?? and what happens to solvent??
+      !$omp end critical
+      call numhess1(nat,at,xyz,newcalc,hess_full(:,:),io)
+      call dsqtoh(nat3,hess_full(:,:),hess(:))
+    case (4)
+        !$omp critical
+      call newcalc%create('gfn2',chrg=calc%calcs(1)%chrg,uhf=calc%calcs(1)%uhf) !> Different levels?? and what happens to solvent??
+      !$omp end critical
+      call numhess1(nat,at,xyz,newcalc,hess_full(:,:),io)
+      call dsqtoh(nat3,hess_full(:,:),hess(:))
+    case (5)
+      !$omp critical
+      mhset%model = calc%mh_type
+      call modhes(calc,mhset,nat,xyz,at,hess(:),pr)
+      !$omp end critical
+    end select
+
+    !call axis(nat,at,xyz,rot,dumi)
+    !linear = (rot(3) .lt. 1.d-10).or.(nat == 2)
+
+    !if (.not.linear) then
+    !    if (calc%nfreeze == 0) then
+    !      call trproj(nat,nat3,xyz,hess,.false.,0,pmode,1)  !> normal
+    !    else
+    !      call trproj(nat,nat3,xyz,hess,.false.,calc%freezelist) !> fozen atoms
+    !    end if
+    !end if
+
+    call force_positive_definiteness(hess,nat3)
+
+  end subroutine initialize_hessian
+
+  subroutine force_positive_definiteness(hess,nat3)
+    real(wp),intent(inout) :: hess(:)
+    integer,intent(in) :: nat3
+    real(wp),allocatable :: eigvec(:,:),eigval(:)
+    real(wp),allocatable :: work(:)
+    integer,allocatable :: iwork(:)
+    integer :: lwork,liwork,info,i,j,k,l
+    real(wp) :: elow,damp
+
+    allocate (eigvec(nat3,nat3),eigval(nat3))
+    lwork = 1+6*nat3+2*nat3*nat3
+    liwork = 8*nat3
+    allocate (work(lwork),iwork(liwork))
+
+    call dspevd('V','U',nat3,hess(:),eigval,eigvec,nat3, &
+                work,lwork,iwork,liwork,info)
+
+    if (info /= 0) then
+      write (*,*) "dspevd failed, info = ",info
+      stop
+    end if
+
+    elow = minval(eigval)
+    damp = max(1.0e-4_wp-elow,0.0_wp)
+    eigval = eigval+damp
+
+    hess(:) = 0.0_wp
+    k = 0
+    do j = 1,nat3
+      do i = 1,j
+        k = k+1
+        hess(k) = 0.0_wp
+        do l = 1,nat3
+          hess(k) = hess(k)+eigval(l)*eigvec(i,l)*eigvec(j,l)
+        end do
+      end do
+    end do
+
+    deallocate (eigvec,eigval,work,iwork)
+
+  end subroutine force_positive_definiteness
+
+end module hr_utils
diff --git a/src/calculator/meson.build b/src/calculator/meson.build
index da3d2598..57f15256 100644
--- a/src/calculator/meson.build
+++ b/src/calculator/meson.build
@@ -29,11 +29,22 @@ srcs += files(
   'api_helpers.F90',
   'api_engrad.f90', 
   'gradreader.f90',
-  'libpvol.F90',
+  'components/libpvol.F90',
   'xtb_sc.f90',
   'subprocess_types.f90',
   'orca_sc.f90',
   'generic_sc.f90',
   'turbom_sc.f90',
   'subprocess_engrad.f90',
+  'hr_utils.f90',
+  'modelhessians.f90',
+  'approxg.f90',
+  'penalty.f90',
+  'mlip_sc.F90',
+  'hessian_reconstruct.f90',
+  'components/rmsdpot.f90',
+  'components/ddx_pc.F90',
+  'components/electrostatic.F90',
+  'components/surface.F90',
+  'components/solvation.F90',
 )
diff --git a/src/calculator/mlip_sc.F90 b/src/calculator/mlip_sc.F90
new file mode 100644
index 00000000..97682706
--- /dev/null
+++ b/src/calculator/mlip_sc.F90
@@ -0,0 +1,234 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!> module mlip_sc
+!> A module containing routines for calling MLIPs though persistent python instances
+!> enabled through the fmlip_relay submodule
+
+!=========================================================================================!
+module mlip_sc
+  use crest_parameters
+  use strucrd
+  use iomod
+#ifdef WITH_FMLIP_RELAY
+  use fmlip_relay_client
+#endif
+  implicit none
+  !>--- private module variables and parameters
+  private
+
+  character(len=*),parameter :: basebin = 'fmlip-relay-server'
+
+  public :: mlip_params
+  type :: mlip_params
+    integer :: BASE_PORT = 54320
+    integer :: TIMEOUT_SEC = 120
+    character(len=:),allocatable :: backend
+    character(len=:),allocatable :: modelpath
+    character(len=:),allocatable :: modelsize
+    !> shared neural-network options (mace* / uma backends)
+    character(len=:),allocatable :: device    !> torch device: cpu | cuda | cuda:0
+    !> FairChem UMA backend options (--backend uma)
+    character(len=:),allocatable :: umamodel  !> checkpoint, e.g. uma-s-1p2 (default), uma-m-1
+    character(len=:),allocatable :: umatask   !> task head: omol | omat | omc | oc20 | odac
+    integer :: iid = 0
+  end type mlip_params
+
+  public :: mlip_engrad_core,fmlip_relay_init,mlips_shutdown
+
+  integer,parameter  :: nopbc(3) = (/0,0,0/)
+  integer,parameter  :: allpbc(3) = (/1,1,1/)
+  real(wp),parameter :: bigcell(3,3) = reshape( &
+    & (/10000.0_wp,0.0_wp,0.0_wp, &
+    &   0.0_wp,10000.0_wp,0.0_wp, &
+    &   0.0_wp,0.0_wp,10000.0_wp/), [3,3])
+
+  external creststop
+!========================================================================================!
+!========================================================================================!
+contains  !>--- Module routines start here
+!========================================================================================!
+!========================================================================================!
+
+  subroutine fmlip_relay_init(MPAR,iid)
+    type(mlip_params),intent(inout) :: MPAR
+    integer,intent(in) :: iid
+    integer :: io,tmpport
+    character(len=256) :: cmd,cmd_0,cmd_1
+#ifdef WITH_FMLIP_RELAY
+    if (.not.allocated(MPAR%backend)) then
+      write (stdout,*)
+      write (stdout,*) '** ERROR ** No model backend selected for MLIP'
+      write (stdout,*)
+      call creststop(20)
+    end if
+
+    ! ── fast path: instance already running, nothing to do ───────────────────
+    call mlip_ping(iid,io)
+    if (io == MLIP_OK) then
+      MPAR%iid = iid
+      return
+    end if
+
+    call checkprog_silent(basebin,verbose=.false.,iostat=io)
+    if (io .ne. 0) then
+      write (stdout,*)
+      write (stdout,*) '** ERROR ** can not find socket server for MLIPs '//basebin
+      write (stdout,*) ' Make sure you install it from the fmlip_relay subproject via pip'
+      write (stdout,*)
+      call creststop(20)
+    end if
+
+    !> check if we have limitations for parallelity
+    if (iid > MLIP_MAX_INSTANCES) then
+      write (stdout,*)
+      write (stdout,*) '** ERROR ** exeeding the max number of parallel socket servers for MLIPs '
+      write (stdout,*) ' Please request fewer than '//to_str(MLIP_MAX_INSTANCES)
+      write (stdout,*)
+      call creststop(20)
+    end if
+
+    !> options prepping
+    tmpport = MPAR%BASE_PORT+iid
+    write (cmd_1,'("--dtype float64")')
+
+    select case (MPAR%backend)
+    case ('mace_off','mace_mp')
+
+      if (allocated(MPAR%modelpath)) then
+        if (.not.file_exists(MPAR%modelpath)) then
+          write (stdout,*)
+          write (stdout,*) '** ERROR ** model path allocated but can not find '//trim(MPAR%modelpath)
+          write (stdout,*)
+          call creststop(20)
+        end if
+        !> a user-provided checkpoint is served through the generic 'mace' backend
+        cmd_0 = '--backend mace --model '//trim(MPAR%modelpath)
+      else
+        cmd_0 = '--backend '//trim(MPAR%backend)
+        if (allocated(MPAR%modelsize)) cmd_0 = trim(cmd_0)//' --mace-model '//trim(MPAR%modelsize)
+      end if
+      if (allocated(MPAR%device)) cmd_0 = trim(cmd_0)//' --device '//trim(MPAR%device)
+      write (cmd,'(a,1x,a,1x,i0,1x,a,1x,a)') basebin,'--port',tmpport,trim(adjustl(cmd_0)),trim(cmd_1)
+
+    case ('uma')
+      !> FairChem UMA foundation model (fairchem-core v2). Charge and spin
+      !> multiplicity are forwarded per-call via the relay protocol; only the
+      !> checkpoint, task head and torch device are fixed at server startup.
+      cmd_0 = ''
+      if (allocated(MPAR%umamodel)) cmd_0 = trim(cmd_0)//' --uma-model '//trim(MPAR%umamodel)
+      if (allocated(MPAR%umatask))  cmd_0 = trim(cmd_0)//' --uma-task '//trim(MPAR%umatask)
+      if (allocated(MPAR%device))   cmd_0 = trim(cmd_0)//' --device '//trim(MPAR%device)
+      write (cmd,'(a,1x,a,1x,i0,1x,a,1x,a,1x,a)') basebin,'--port',tmpport, &
+        & '--backend uma',trim(adjustl(cmd_0)),trim(cmd_1)
+
+    case default
+
+      if (allocated(MPAR%modelpath)) then
+        if (.not.file_exists(MPAR%modelpath)) then
+          write (stdout,*)
+          write (stdout,*) '** ERROR ** model path allocated but can not find '//trim(MPAR%modelpath)
+          write (stdout,*)
+          call creststop(20)
+        end if
+        write (cmd,'(a,1x,a,1x,i0,2(1x,a,1x,a),1x,a)') basebin,'--port',tmpport,'--backend', &
+          & trim(MPAR%backend),'--model',trim(MPAR%modelpath),trim(cmd_1)
+      else
+        !> no model path (e.g. lj, dummy backends that need no model file)
+        write (cmd,'(a,1x,a,1x,i0,1x,a,1x,a,1x,a)') basebin,'--port',tmpport, &
+          & '--backend',trim(MPAR%backend),trim(cmd_1)
+      end if
+    end select
+
+    !> spawn the server and verify
+    call mlip_init(iid,tmpport,trim(cmd)//' 2>/dev/null',MPAR%TIMEOUT_SEC,io)
+    if (io /= MLIP_OK) then
+      write (stdout,*)
+      write (stdout,*) '** ERROR ** failed to initialize MLIP server'
+      write (stdout,*)
+      call creststop(1)
+    end if
+    call mlip_ping(iid,io)
+    if (io /= MLIP_OK) then
+      write (stdout,*)
+      write (stdout,*) '** ERROR ** failed to ping MLIP server'
+      call creststop(1)
+    end if
+
+    MPAR%iid = iid
+
+#else /* WITH_FMLIP_RELAY */
+    write (stdout,*) 'Error: Compiled without fmlip-relay support!'
+    write (stdout,*) 'Use -DWITH_FMLIP_RELAY=true in the setup to enable this function'
+    write (stdout,*)
+    call creststop(20)
+#endif
+  end subroutine fmlip_relay_init
+
+  subroutine mlip_engrad_core(mol,MPAR,energy,gradient,iostatus, &
+      &                       charge,spin,iid)
+    type(coord),intent(in) :: mol
+    type(mlip_params),intent(in)    :: MPAR
+    integer,intent(in),optional :: charge
+    integer,intent(in),optional :: spin
+    integer,intent(in),optional :: iid
+    real(wp),intent(out)   :: energy
+    real(wp),intent(out)   :: gradient(3,mol%nat)
+    integer,intent(out)    :: iostatus
+
+    integer :: chrg,spn,instance_id
+    real(wp) :: stress(3,3)
+
+    energy = 0.0_wp
+    gradient(:,:) = 0.0_wp
+    iostatus = 1
+
+    chrg = 0
+    spn = 1
+    if (present(charge)) chrg = charge
+    if (present(spin)) spn = spin
+    instance_id = MPAR%iid
+    if (present(iid)) instance_id = iid
+
+#ifdef WITH_FMLIP_RELAY
+    if (allocated(mol%lat)) then
+      call mlip_compute(instance_id,mol%nat,mol%at,mol%xyz*autoaa,mol%lat,allpbc,0,chrg,spn, &
+      &                 energy,gradient,stress,iostatus)
+    else
+      call mlip_compute(instance_id,mol%nat,mol%at,mol%xyz*autoaa,bigcell,nopbc,0,chrg,spn, &
+      &                 energy,gradient,stress,iostatus)
+    end if
+
+    !> CREST always works with atomic units, convert from eV and Angstroem:
+    energy = energy/autoev
+    gradient(:,:) = -gradient(:,:)*(1.0_wp/(autoev*aatoau))
+#endif
+  end subroutine mlip_engrad_core
+
+!========================================================================================!
+
+  subroutine mlips_shutdown()
+    integer :: io
+#ifdef WITH_FMLIP_RELAY
+    call mlip_finalize_all(io)
+#endif
+  end subroutine mlips_shutdown
+
+!========================================================================================!
+end module mlip_sc
diff --git a/src/calculator/modelhessians.f90 b/src/calculator/modelhessians.f90
new file mode 100644
index 00000000..cd15ecb4
--- /dev/null
+++ b/src/calculator/modelhessians.f90
@@ -0,0 +1,3145 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2021 - 2022 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!
+! Routines were adapted from the xtb code (github.com/grimme-lab/xtb)
+! under the Open-source software LGPL-3.0 Licencse.
+!================================================================================!
+module modelhessian_core
+  use iso_fortran_env,only:wp => real64,stdout => output_unit
+  implicit none
+
+!> a modelhessian type to save settings
+  type :: mhparam
+    integer :: model = 0       !> model hessian selection
+    real(wp) :: s6 = 20.0_wp   !> dispersion scaling
+    real(wp) :: rcut = 70.0_wp !> cutoff parameter
+    !> force constants
+    real(wp) :: kr = 0.4000_wp
+    real(wp) :: kf = 0.1300_wp
+    real(wp) :: kt = 0.0075_wp
+    real(wp) :: ko = 0.0000_wp
+    real(wp) :: kd = 0.0000_wp
+    real(wp) :: kq = 0.0000_wp
+  end type mhparam
+
+!> Parameters & constants
+  real(wp),parameter :: bohr = 0.52917726_wp
+  real(wp),parameter :: aatoau = 1.0/bohr
+  real(wp),parameter :: pi = 3.141592653589793_wp
+  real(wp),parameter :: Zero = 0.0_wp
+  real(wp),parameter :: One = 1.0_wp
+  real(wp),parameter :: Two = 2.0_wp
+  real(wp),parameter :: Three = 3.0_wp
+  real(wp),parameter :: Four = 4.0_wp
+  real(wp),parameter :: Five = 5.0_wp
+  real(wp),parameter :: Six = 6.0_wp
+  real(wp),parameter :: Seven = 7.0_wp
+  real(wp),parameter :: Eight = 8.0_wp
+  real(wp),parameter :: RNine = 9.0_wp
+  real(wp),parameter :: Ten = 10.0_wp
+  real(wp),parameter :: Half = 0.5_wp
+  real(wp),parameter :: SqrtP2 = 0.8862269254527579_wp
+  real(wp),parameter :: TwoP34 = 0.2519794355383808_wp
+  real(wp),parameter :: TwoP54 = 5.914967172795612_wp
+  real(wp),parameter :: One2C2 = 0.2662567690426443D-04
+
+  !>  van-der-Waals radii used in the D2 model (NOTE: here not in a.u.)
+  real(wp),parameter :: vander(86) = (/ &
+  & 0.91_wp,0.92_wp, & ! H, He
+  & 0.75_wp,1.28_wp,1.35_wp,1.32_wp,1.27_wp,1.22_wp,1.17_wp,1.13_wp, & ! Li-Ne
+  & 1.04_wp,1.24_wp,1.49_wp,1.56_wp,1.55_wp,1.53_wp,1.49_wp,1.45_wp, & ! Na-Ar
+  & 1.35_wp,1.34_wp, & ! K, Ca
+  & 1.42_wp,1.42_wp,1.42_wp,1.42_wp,1.42_wp, & ! Sc-Zn
+  & 1.42_wp,1.42_wp,1.42_wp,1.42_wp,1.42_wp, &
+  & 1.50_wp,1.57_wp,1.60_wp,1.61_wp,1.59_wp,1.57_wp, & ! Ga-Kr
+  & 1.48_wp,1.46_wp, & ! Rb, Sr
+  & 1.49_wp,1.49_wp,1.49_wp,1.49_wp,1.49_wp, & ! Y-Cd
+  & 1.49_wp,1.49_wp,1.49_wp,1.49_wp,1.49_wp, &
+  & 1.52_wp,1.64_wp,1.71_wp,1.72_wp,1.72_wp,1.71_wp, & ! In-Xe
+  & 2.00_wp,2.00_wp, &
+  & 2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp, & ! La-Yb
+  & 2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp, &
+  & 2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp, & ! Lu-Hg
+  & 2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp, &
+  & 2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp/) ! Tl-Rn
+  !>  C6 coefficients used in the D2 model
+  real(wp),parameter :: c6(86) = (/ &
+  & 0.14_wp,0.08_wp, & ! H,He
+  & 1.61_wp,1.61_wp,3.13_wp,1.75_wp,1.23_wp,0.70_wp,0.75_wp,0.63_wp, &
+  & 5.71_wp,5.71_wp,10.79_wp,9.23_wp,7.84_wp,5.57_wp,5.07_wp,4.61_wp, &
+  & 10.80_wp,10.80_wp, & ! K,Ca
+  & 10.80_wp,10.80_wp,10.80_wp,10.80_wp,10.80_wp, & ! Sc-Zn
+  & 10.80_wp,10.80_wp,10.80_wp,10.80_wp,10.80_wp, &
+  & 16.99_wp,17.10_wp,16.37_wp,12.64_wp,12.47_wp,12.01_wp, & ! Ga-Kr
+  & 24.67_wp,24.67_wp, & ! Rb,Sr
+  & 24.67_wp,24.67_wp,24.67_wp,24.67_wp,24.67_wp, & ! Y-Cd
+  & 24.67_wp,24.67_wp,24.67_wp,24.67_wp,24.67_wp, &
+  & 37.32_wp,38.71_wp,38.44_wp,31.74_wp,31.50_wp,29.99_wp, & ! In-Xe
+  & 50.00_wp,50.00_wp, & ! Cs,Ba
+  & 50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp, & ! La-Yb
+  & 50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp, &
+  & 50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp, & ! Lu-Hg
+  & 50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp, &
+  & 50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp/) ! Tl-Rn
+
+!&<
+  integer, private, parameter :: max_elem = 118
+  !> covalent radii (taken from Pyykko and Atsumi, Chem. Eur. J. 15, 2009,
+  !  188-197), values for metals decreased by 10 %
+  real(wp),parameter :: covrad_2009(max_elem) = aatoau * [ &
+  & 0.32_wp,0.46_wp, & ! H,He
+  & 1.20_wp,0.94_wp,0.77_wp,0.75_wp,0.71_wp,0.63_wp,0.64_wp,0.67_wp, & ! Li-Ne
+  & 1.40_wp,1.25_wp,1.13_wp,1.04_wp,1.10_wp,1.02_wp,0.99_wp,0.96_wp, & ! Na-Ar
+  & 1.76_wp,1.54_wp, & ! K,Ca
+  &                 1.33_wp,1.22_wp,1.21_wp,1.10_wp,1.07_wp, & ! Sc-
+  &                 1.04_wp,1.00_wp,0.99_wp,1.01_wp,1.09_wp, & ! -Zn
+  &                 1.12_wp,1.09_wp,1.15_wp,1.10_wp,1.14_wp,1.17_wp, & ! Ga-Kr
+  & 1.89_wp,1.67_wp, & ! Rb,Sr
+  &                 1.47_wp,1.39_wp,1.32_wp,1.24_wp,1.15_wp, & ! Y-
+  &                 1.13_wp,1.13_wp,1.08_wp,1.15_wp,1.23_wp, & ! -Cd
+  &                 1.28_wp,1.26_wp,1.26_wp,1.23_wp,1.32_wp,1.31_wp, & ! In-Xe
+  & 2.09_wp,1.76_wp, & ! Cs,Ba
+  &         1.62_wp,1.47_wp,1.58_wp,1.57_wp,1.56_wp,1.55_wp,1.51_wp, & ! La-Eu
+  &         1.52_wp,1.51_wp,1.50_wp,1.49_wp,1.49_wp,1.48_wp,1.53_wp, & ! Gd-Yb
+  &                 1.46_wp,1.37_wp,1.31_wp,1.23_wp,1.18_wp, & ! Lu-
+  &                 1.16_wp,1.11_wp,1.12_wp,1.13_wp,1.32_wp, & ! -Hg
+  &                 1.30_wp,1.30_wp,1.36_wp,1.31_wp,1.38_wp,1.42_wp, & ! Tl-Rn
+  & 2.01_wp,1.81_wp, & ! Fr,Ra
+  &      1.67_wp,1.58_wp,1.52_wp,1.53_wp,1.54_wp,1.55_wp,1.49_wp, & ! Ac-Am
+  &      1.49_wp,1.51_wp,1.51_wp,1.48_wp,1.50_wp,1.56_wp,1.58_wp, & ! Cm-No
+  &                 1.45_wp,1.41_wp,1.34_wp,1.29_wp,1.27_wp, & ! Lr-
+  &                 1.21_wp,1.16_wp,1.15_wp,1.09_wp,1.22_wp, & ! -Cn
+  &                 1.36_wp,1.43_wp,1.46_wp,1.58_wp,1.48_wp,1.57_wp ] ! Nh-Og
+!&>
+
+  public :: ddvopt,mh_lindh_d2,mh_lindh,mh_swart
+
+!==============================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!==============================================================================!
+
+  subroutine ddvopt(Cart,nAtoms,Hess,iANr,mhset)
+!***********************************************************
+!* subroutine ddvopt
+!* generates a Lindh Model Hessian
+!* Chem. Phys. Let. 241(1995) 423-428
+!*
+!* Input:
+!*     Cart  - cartesian coordinates
+!*    nAtoms - number of atoms
+!*     iANr  - atom types as integers
+!*    mhset  - model Hessian parameters
+!*
+!* Output:
+!*     Hess  - the (packed) model Hessian
+!**********************************************************
+    Implicit Integer(i-n)
+    Implicit Real(wp) (a-h,o-z)
+    type(mhparam) :: mhset
+
+    real(wp) :: s6
+    real(wp) :: rcut
+
+    Real(wp) :: Cart(3,nAtoms),rij(3),rjk(3),rkl(3), &
+   &       Hess((3*nAtoms)*(3*nAtoms+1)/2),si(3),sj(3),sk(3), &
+   &       sl(3),sm(3),x(2),y(2),z(2), &
+   &       xyz(3,4),C(3,4),Dum(3,4,3,4)
+    Integer iANr(nAtoms)
+
+! include  "common/ddvdt.inc" (molpro 2002.6)
+    Real(wp) :: rAV(3,3),aAV(3,3), &
+   &       B_Str(6),A_Bend(2),A_Trsn(2),A_StrH(2), &
+   &       rkr,rkf,A_Str,RF_Const, &
+   &       wthr
+
+    Data rAv/1.3500d+00,2.1000d+00,2.5300d+00, &
+   &         2.1000d+00,2.8700d+00,3.4000d+00, &
+   &         2.5300d+00,3.4000d+00,3.4000d+00/
+    Data aAv/1.0000d+00,0.3949d+00,0.3949d+00, &
+   &         0.3949d+00,0.2800d+00,0.2800d+00, &
+   &         0.3949d+00,0.2800d+00,0.2800d+00/
+!org  Data rkr,rkf,rkt/0.4500D+00,0.1500D+00,0.5000D-02/
+    Data rkr,rkf,rkt/0.4000D+00,0.1300D+00,0.7500D-02/
+    Data A_Str/1.734d0/
+    Data B_Str/-.244d0,0.352d0,1.085d0,0.660d0,1.522d0,2.068d0/
+    Data A_Bend/0.160d0,0.250d0/
+    Data A_Trsn/0.0023d0,0.07d0/
+    Data A_StrH/0.3601d0,1.944d0/
+    Data RF_Const/1.0D-2/
+    Data wthr/0.2/
+
+!cc VDWx-Parameters (Grimme) used for vdw-correction of model hessian
+    real(wp) :: alphavdw,damp,c6k,c6l,c66,vdw(3,3),dr(3)
+    integer :: kxyz,lxyz
+!cc End: VDWx ccccccccccccccccc
+
+    !> BLAS
+    external :: dcopy
+
+    s6 = mhset%s6
+    rcut = mhset%rcut
+
+!
+!------- Statement functions
+!
+!      ixyz(i,iAtom) = (iAtom-1)*3 + i
+!      Jnd(i,j) = i*(i-1)/2 +j
+!      Ind(i,iAtom,j,jAtom)=Jnd(Max(ixyz(i,iAtom),ixyz(j,jAtom)), &
+!     &                         Min(ixyz(i,iAtom),ixyz(j,jAtom)))
+!end
+
+    Fact = One
+!hjw threshold reduced
+    rZero = 1.0d-10
+    n3 = 3*nAtoms
+    Hess = 0.0d0
+
+!
+!     Hessian for tension
+!
+    Do kAtom = 1,nAtoms
+      kr = iTabRow(iANr(kAtom))
+!        If (kr.eq.0) Go To 5
+
+      Do lAtom = 1,kAtom-1
+        lr = iTabRow(iANr(lAtom))
+!           If (lr.eq.0) Go To 10
+        xkl = Cart(1,kAtom)-Cart(1,lAtom)
+        ykl = Cart(2,kAtom)-Cart(2,lAtom)
+        zkl = Cart(3,kAtom)-Cart(3,lAtom)
+        rkl2 = xkl**2+ykl**2+zkl**2
+        r0 = rAv(kr,lr)
+        alpha = aAv(kr,lr)
+
+!cccccc VDWx ccccccccccccccccccccccccccccccccc
+        c6k = c6(iANr(katom))
+        c6l = c6(iANr(latom))
+        c66 = sqrt(c6k*c6l)
+        Rv = (vander(iANr(katom))+vander(iANr(latom)))/bohr
+
+        call getvdwxx(xkl,ykl,zkl,c66,s6,Rv,vdw(1,1))
+        call getvdwxy(xkl,ykl,zkl,c66,s6,Rv,vdw(1,2))
+        call getvdwxy(xkl,zkl,ykl,c66,s6,Rv,vdw(1,3))
+        call getvdwxx(ykl,xkl,zkl,c66,s6,Rv,vdw(2,2))
+        call getvdwxy(ykl,zkl,xkl,c66,s6,Rv,vdw(2,3))
+        call getvdwxx(zkl,xkl,ykl,c66,s6,Rv,vdw(3,3))
+!cccccc Ende VDWx ccccccccccccccccccccccccccccccc
+
+        gamma = rkr*Exp(alpha*r0**2)
+! not better: *sqrt(abs(wb(kAtom,lAtom)))
+        gmm = gamma*Exp(-alpha*rkl2)
+        Hxx = gmm*xkl*xkl/rkl2-vdw(1,1)
+        Hxy = gmm*xkl*ykl/rkl2-vdw(1,2)
+        Hxz = gmm*xkl*zkl/rkl2-vdw(1,3)
+        Hyy = gmm*ykl*ykl/rkl2-vdw(2,2)
+        Hyz = gmm*ykl*zkl/rkl2-vdw(2,3)
+        Hzz = gmm*zkl*zkl/rkl2-vdw(3,3)
+
+!
+        Hess(Ind(1,kAtom,1,kAtom)) = Hess(Ind(1,kAtom,1,kAtom))+Hxx
+        Hess(Ind(2,kAtom,1,kAtom)) = Hess(Ind(2,kAtom,1,kAtom))+Hxy
+        Hess(Ind(2,kAtom,2,kAtom)) = Hess(Ind(2,kAtom,2,kAtom))+Hyy
+        Hess(Ind(3,kAtom,1,kAtom)) = Hess(Ind(3,kAtom,1,kAtom))+Hxz
+        Hess(Ind(3,kAtom,2,kAtom)) = Hess(Ind(3,kAtom,2,kAtom))+Hyz
+        Hess(Ind(3,kAtom,3,kAtom)) = Hess(Ind(3,kAtom,3,kAtom))+Hzz
+!
+        Hess(Ind(1,kAtom,1,lAtom)) = Hess(Ind(1,kAtom,1,lAtom))-Hxx
+        Hess(Ind(1,kAtom,2,lAtom)) = Hess(Ind(1,kAtom,2,lAtom))-Hxy
+        Hess(Ind(1,kAtom,3,lAtom)) = Hess(Ind(1,kAtom,3,lAtom))-Hxz
+        Hess(Ind(2,kAtom,1,lAtom)) = Hess(Ind(2,kAtom,1,lAtom))-Hxy
+        Hess(Ind(2,kAtom,2,lAtom)) = Hess(Ind(2,kAtom,2,lAtom))-Hyy
+        Hess(Ind(2,kAtom,3,lAtom)) = Hess(Ind(2,kAtom,3,lAtom))-Hyz
+        Hess(Ind(3,kAtom,1,lAtom)) = Hess(Ind(3,kAtom,1,lAtom))-Hxz
+        Hess(Ind(3,kAtom,2,lAtom)) = Hess(Ind(3,kAtom,2,lAtom))-Hyz
+        Hess(Ind(3,kAtom,3,lAtom)) = Hess(Ind(3,kAtom,3,lAtom))-Hzz
+!
+        Hess(Ind(1,lAtom,1,lAtom)) = Hess(Ind(1,lAtom,1,lAtom))+Hxx
+        Hess(Ind(2,lAtom,1,lAtom)) = Hess(Ind(2,lAtom,1,lAtom))+Hxy
+        Hess(Ind(2,lAtom,2,lAtom)) = Hess(Ind(2,lAtom,2,lAtom))+Hyy
+        Hess(Ind(3,lAtom,1,lAtom)) = Hess(Ind(3,lAtom,1,lAtom))+Hxz
+        Hess(Ind(3,lAtom,2,lAtom)) = Hess(Ind(3,lAtom,2,lAtom))+Hyz
+        Hess(Ind(3,lAtom,3,lAtom)) = Hess(Ind(3,lAtom,3,lAtom))+Hzz
+!
+10      Continue
+      End Do
+
+5     Continue
+    End Do
+
+!
+!     Hessian for bending
+!
+    Do mAtom = 1,nAtoms
+      mr = iTabRow(iANr(mAtom))
+!        If (mr.eq.0) Go To 20
+      Do iAtom = 1,nAtoms
+        If (iAtom .eq. mAtom) Go To 30
+        ir = iTabRow(iANr(iAtom))
+!          If (ir.eq.0) Go To 30
+        if (rcutoff(cart,iatom,matom,rcut)) cycle
+!          if(wb(iatom,matom).lt.wthr) cycle
+        Do jAtom = 1,iAtom-1
+          If (jAtom .eq. mAtom) Go To 40
+          jr = iTabRow(iANr(jAtom))
+!           If (jr.eq.0) Go To 40
+          if (rcutoff(cart,jatom,iatom,rcut)) cycle
+          if (rcutoff(cart,jatom,matom,rcut)) cycle
+!           if(wb(jatom,iatom).lt.wthr) cycle
+!           if(wb(jatom,matom).lt.wthr) cycle
+
+          xmi = (Cart(1,iAtom)-Cart(1,mAtom))
+          ymi = (Cart(2,iAtom)-Cart(2,mAtom))
+          zmi = (Cart(3,iAtom)-Cart(3,mAtom))
+          rmi2 = xmi**2+ymi**2+zmi**2
+          rmi = sqrt(rmi2)
+          r0mi = rAv(mr,ir)
+          ami = aAv(mr,ir)
+!
+          xmj = (Cart(1,jAtom)-Cart(1,mAtom))
+          ymj = (Cart(2,jAtom)-Cart(2,mAtom))
+          zmj = (Cart(3,jAtom)-Cart(3,mAtom))
+          rmj2 = xmj**2+ymj**2+zmj**2
+          rmj = sqrt(rmj2)
+          r0mj = rAv(mr,jr)
+          amj = aAv(mr,jr)
+!
+!---------- Test if zero angle
+!
+          Test = xmi*xmj+ymi*ymj+zmi*zmj
+          Test = Test/(rmi*rmj)
+          If (Test .eq. One) Go To 40
+!
+          xij = (Cart(1,jAtom)-Cart(1,iAtom))
+          yij = (Cart(2,jAtom)-Cart(2,iAtom))
+          zij = (Cart(3,jAtom)-Cart(3,iAtom))
+          rij2 = xij**2+yij**2+zij**2
+          rrij = sqrt(rij2)
+!
+          alpha = rkf*exp((ami*r0mi**2+amj*r0mj**2))
+!
+          r = sqrt(rmj2+rmi2)
+          gij = alpha*exp(-(ami*rmi2+amj*rmj2))
+!           Write (*,*) ' gij=',gij
+          rL2 = (ymi*zmj-zmi*ymj)**2+(zmi*xmj-xmi*zmj)**2+ &
+   &         (xmi*ymj-ymi*xmj)**2
+!hjw modified
+          if (rL2 .lt. 1.d-14) then
+            rL = 0
+          else
+            rL = sqrt(rL2)
+          end if
+!
+          if ((rmj .gt. rZero).and.(rmi .gt. rZero).and. &
+   &                                (rrij .gt. rZero)) Then
+            SinPhi = rL/(rmj*rmi)
+            rmidotrmj = xmi*xmj+ymi*ymj+zmi*zmj
+            CosPhi = rmidotrmj/(rmj*rmi)
+!
+!-------------None linear case
+!
+            If (SinPhi .gt. rZero) Then
+!               Write (*,*) ' None linear case'
+              si(1) = (xmi/rmi*cosphi-xmj/rmj)/(rmi*sinphi)
+              si(2) = (ymi/rmi*cosphi-ymj/rmj)/(rmi*sinphi)
+              si(3) = (zmi/rmi*cosphi-zmj/rmj)/(rmi*sinphi)
+              sj(1) = (cosphi*xmj/rmj-xmi/rmi)/(rmj*sinphi)
+              sj(2) = (cosphi*ymj/rmj-ymi/rmi)/(rmj*sinphi)
+              sj(3) = (cosphi*zmj/rmj-zmi/rmi)/(rmj*sinphi)
+              sm(1) = -si(1)-sj(1)
+              sm(2) = -si(2)-sj(2)
+              sm(3) = -si(3)-sj(3)
+              Do icoor = 1,3
+                Do jCoor = 1,3
+                  If (mAtom .gt. iAtom) Then
+                    Hess(Ind(icoor,mAtom,jcoor,iAtom)) = &
+  &                        Hess(Ind(icoor,mAtom,jcoor,iAtom)) &
+  &                        +gij*sm(icoor)*si(jcoor)
+                  else
+                    Hess(Ind(icoor,iAtom,jcoor,mAtom)) = &
+   &                        Hess(Ind(icoor,iAtom,jcoor,mAtom)) &
+   &                        +gij*si(icoor)*sm(jcoor)
+                  End If
+                  If (mAtom .gt. jAtom) Then
+                    Hess(Ind(icoor,mAtom,jcoor,jAtom)) = &
+ &                        Hess(Ind(icoor,mAtom,jcoor,jAtom)) &
+ &                        +gij*sm(icoor)*sj(jcoor)
+                  else
+                    Hess(Ind(icoor,jAtom,jcoor,mAtom)) = &
+   &                        Hess(Ind(icoor,jAtom,jcoor,mAtom)) &
+   &                        +gij*sj(icoor)*sm(jcoor)
+                  End If
+                  If (iAtom .gt. jAtom) Then
+                    Hess(Ind(icoor,iAtom,jcoor,jAtom)) = &
+ &                        Hess(Ind(icoor,iAtom,jcoor,jAtom)) &
+ &                        +gij*si(icoor)*sj(jcoor)
+                  else
+                    Hess(Ind(icoor,jAtom,jcoor,iAtom)) = &
+ &                        Hess(Ind(icoor,jAtom,jcoor,iAtom)) &
+ &                        +gij*sj(icoor)*si(jcoor)
+                  End If
+                End Do
+              End Do
+              Do icoor = 1,3
+                Do jCoor = 1,icoor
+                  Hess(Ind(icoor,iAtom,jcoor,iAtom)) = &
+   &                        Hess(Ind(icoor,iAtom,jcoor,iAtom)) &
+   &                        +gij*si(icoor)*si(jcoor)
+                  Hess(Ind(icoor,mAtom,jcoor,mAtom)) = &
+   &                        Hess(Ind(icoor,mAtom,jcoor,mAtom)) &
+   &                        +gij*sm(icoor)*sm(jcoor)
+                  Hess(Ind(icoor,jAtom,jcoor,jAtom)) = &
+   &                        Hess(Ind(icoor,jAtom,jcoor,jAtom)) &
+   &                        +gij*sj(icoor)*sj(jcoor)
+
+!
+                End Do
+              End Do
+            Else
+!
+!----------------Linear case
+!
+              if ((abs(ymi) .gt. rZero).or. &
+&                 (abs(xmi) .gt. rZero)) Then
+                x(1) = -ymi
+                y(1) = xmi
+                z(1) = Zero
+                x(2) = -xmi*zmi
+                y(2) = -ymi*zmi
+                z(2) = xmi*xmi+ymi*ymi
+              Else
+                x(1) = One
+                y(1) = Zero
+                z(1) = Zero
+                x(2) = Zero
+                y(2) = One
+                z(2) = Zero
+              End If
+              Do i = 1,2
+                r1 = sqrt(x(i)**2+y(i)**2+z(i)**2)
+                cosThetax = x(i)/r1
+                cosThetay = y(i)/r1
+                cosThetaz = z(i)/r1
+                si(1) = -cosThetax/rmi
+                si(2) = -cosThetay/rmi
+                si(3) = -cosThetaz/rmi
+                sj(1) = -cosThetax/rmj
+                sj(2) = -cosThetay/rmj
+                sj(3) = -cosThetaz/rmj
+                sm(1) = -(si(1)+sj(1))
+                sm(2) = -(si(2)+sj(2))
+                sm(3) = -(si(3)+sj(3))
+!
+                Do icoor = 1,3
+                  Do jCoor = 1,3
+                    If (mAtom .gt. iAtom) Then
+                      Hess(Ind(icoor,mAtom,jcoor,iAtom)) = &
+ &                        Hess(Ind(icoor,mAtom,jcoor,iAtom)) &
+ &                         +gij*sm(icoor)*si(jcoor)
+                    else
+                      Hess(Ind(icoor,iAtom,jcoor,mAtom)) = &
+&                        Hess(Ind(icoor,iAtom,jcoor,mAtom)) &
+&                         +gij*si(icoor)*sm(jcoor)
+                    End If
+                    If (mAtom .gt. jAtom) Then
+                      Hess(Ind(icoor,mAtom,jcoor,jAtom)) = &
+ &                        Hess(Ind(icoor,mAtom,jcoor,jAtom)) &
+ &                         +gij*sm(icoor)*sj(jcoor)
+                    else
+                      Hess(Ind(icoor,jAtom,jcoor,mAtom)) = &
+ &                        Hess(Ind(icoor,jAtom,jcoor,mAtom)) &
+ &                         +gij*sj(icoor)*sm(jcoor)
+                    End If
+                    If (iAtom .gt. jAtom) Then
+                      Hess(Ind(icoor,iAtom,jcoor,jAtom)) = &
+&                        Hess(Ind(icoor,iAtom,jcoor,jAtom)) &
+&                         +gij*si(icoor)*sj(jcoor)
+                    else
+                      Hess(Ind(icoor,jAtom,jcoor,iAtom)) = &
+&                        Hess(Ind(icoor,jAtom,jcoor,iAtom)) &
+&                         +gij*sj(icoor)*si(jcoor)
+                    End If
+                  End Do
+                End Do
+                Do icoor = 1,3
+                  Do jCoor = 1,icoor
+                    Hess(Ind(icoor,iAtom,jcoor,iAtom)) = &
+&                        Hess(Ind(icoor,iAtom,jcoor,iAtom)) &
+&                         +gij*si(icoor)*si(jcoor)
+                    Hess(Ind(icoor,mAtom,jcoor,mAtom)) = &
+&                        Hess(Ind(icoor,mAtom,jcoor,mAtom)) &
+&                         +gij*sm(icoor)*sm(jcoor)
+                    Hess(Ind(icoor,jAtom,jcoor,jAtom)) = &
+&                         Hess(Ind(icoor,jAtom,jcoor,jAtom)) &
+&                         +gij*sj(icoor)*sj(jcoor)
+                  End Do
+                End Do
+              End Do
+            End If
+          End If
+!
+40        Continue
+        End Do
+30      Continue
+      End Do
+20    Continue
+    End Do
+!
+!     Hessian for torsion
+!
+    Do jAtom = 1,nAtoms
+      jr = iTabRow(iANr(jAtom))
+!       If (jr.eq.0) Go To 444
+!
+      Call DCopy(3,Cart(1,jAtom),1,xyz(1,2),1)
+!
+      Do kAtom = 1,nAtoms
+        If (kAtom .eq. jAtom) Go To 111
+        kr = iTabRow(iANr(kAtom))
+!          If (kr.eq.0) Go To 111
+
+        if (rcutoff(cart,katom,jatom,rcut)) cycle
+!          if(wb(katom,jatom).lt.wthr) cycle
+!
+        Call DCopy(3,Cart(1,kAtom),1,xyz(1,3),1)
+!
+        Do iAtom = 1,nAtoms
+          ij_ = nAtoms*(jAtom-1)+iAtom
+          If (iAtom .eq. jAtom) Go To 333
+          If (iAtom .eq. kAtom) Go To 333
+          ir = iTabRow(iANr(iAtom))
+!             If (ir.eq.0) Go To 333
+!
+          if (rcutoff(cart,iatom,katom,rcut)) cycle
+          if (rcutoff(cart,iatom,jatom,rcut)) cycle
+!             if(wb(iatom,katom).lt.wthr) cycle
+!             if(wb(iatom,jatom).lt.wthr) cycle
+
+          Call DCopy(3,Cart(1,iAtom),1,xyz(1,1),1)
+!
+          Do lAtom = 1,nAtoms
+            lk_ = nAtoms*(kAtom-1)+lAtom
+            If (ij_ .le. lk_) Go To 222
+            If (lAtom .eq. iAtom) Go To 222
+            If (lAtom .eq. jAtom) Go To 222
+            If (lAtom .eq. kAtom) Go To 222
+            lr = iTabRow(iANr(lAtom))
+!                If (lr.eq.0) Go To 222
+!
+            if (rcutoff(cart,latom,iatom,rcut)) cycle
+            if (rcutoff(cart,latom,katom,rcut)) cycle
+            if (rcutoff(cart,latom,jatom,rcut)) cycle
+!                if(wb(latom,iatom).lt.wthr) cycle
+!                if(wb(latom,katom).lt.wthr) cycle
+!                if(wb(latom,jatom).lt.wthr) cycle
+
+            Call DCopy(3,Cart(1,lAtom),1,xyz(1,4),1)
+!
+            rij(1) = Cart(1,iAtom)-Cart(1,jAtom)
+            rij(2) = Cart(2,iAtom)-Cart(2,jAtom)
+            rij(3) = Cart(3,iAtom)-Cart(3,jAtom)
+            rij0 = rAv(ir,jr)**2
+            aij = aAv(ir,jr)
+!
+            rjk(1) = Cart(1,jAtom)-Cart(1,kAtom)
+            rjk(2) = Cart(2,jAtom)-Cart(2,kAtom)
+            rjk(3) = Cart(3,jAtom)-Cart(3,kAtom)
+            rjk0 = rAv(jr,kr)**2
+            ajk = aAv(jr,kr)
+!
+            rkl(1) = Cart(1,kAtom)-Cart(1,lAtom)
+            rkl(2) = Cart(2,kAtom)-Cart(2,lAtom)
+            rkl(3) = Cart(3,kAtom)-Cart(3,lAtom)
+            rkl0 = rAv(kr,lr)**2
+            akl = aAv(kr,lr)
+!
+            rij2 = rij(1)**2+rij(2)**2+rij(3)**2
+            rjk2 = rjk(1)**2+rjk(2)**2+rjk(3)**2
+            rkl2 = rkl(1)**2+rkl(2)**2+rkl(3)**2
+!              Allow only angles in the range of 35-145
+            A35 = (35.0D0/180.D0)*Pi
+            CosFi_Max = Cos(A35)
+            CosFi2 = (rij(1)*rjk(1)+rij(2)*rjk(2)+rij(3)*rjk(3)) &
+  &               /Sqrt(rij2*rjk2)
+            If (Abs(CosFi2) .gt. CosFi_Max) Go To 222
+            CosFi3 = (rkl(1)*rjk(1)+rkl(2)*rjk(2)+rkl(3)*rjk(3)) &
+  &               /Sqrt(rkl2*rjk2)
+            If (Abs(CosFi3) .gt. CosFi_Max) Go To 222
+
+            beta = rkt* &
+  &                       exp((aij*rij0+ajk*rjk0+akl*rkl0))
+            tij = beta*exp(-(aij*rij2+ajk*rjk2+akl*rkl2))
+
+            Call Trsn(xyz,4,Tau,C,.False.,.False.,'        ', &
+  &                  Dum,.False.)
+            Call DCopy(3,C(1,1),1,si,1)
+            Call DCopy(3,C(1,2),1,sj,1)
+            Call DCopy(3,C(1,3),1,sk,1)
+            Call DCopy(3,C(1,4),1,sl,1)
+!
+!-------------Off diagonal block
+!
+            Do icoor = 1,3
+              Do jCoor = 1,3
+                Hess(Ind(icoor,iAtom,jcoor,jAtom)) = &
+    &           Hess(Ind(icoor,iAtom,jcoor,jAtom)) &
+    &            +tij*si(icoor)*sj(jcoor)
+                Hess(Ind(icoor,iAtom,jcoor,kAtom)) = &
+    &           Hess(Ind(icoor,iAtom,jcoor,kAtom)) &
+    &            +tij*si(icoor)*sk(jcoor)
+                Hess(Ind(icoor,iAtom,jcoor,lAtom)) = &
+    &           Hess(Ind(icoor,iAtom,jcoor,lAtom)) &
+    &            +tij*si(icoor)*sl(jcoor)
+                Hess(Ind(icoor,jAtom,jcoor,kAtom)) = &
+    &           Hess(Ind(icoor,jAtom,jcoor,kAtom)) &
+    &            +tij*sj(icoor)*sk(jcoor)
+                Hess(Ind(icoor,jAtom,jcoor,lAtom)) = &
+    &           Hess(Ind(icoor,jAtom,jcoor,lAtom)) &
+    &            +tij*sj(icoor)*sl(jcoor)
+                Hess(Ind(icoor,kAtom,jcoor,lAtom)) = &
+    &           Hess(Ind(icoor,kAtom,jcoor,lAtom)) &
+    &            +tij*sk(icoor)*sl(jcoor)
+
+              End Do
+            End Do
+!
+!-------------Diagonal block
+!
+            Do icoor = 1,3
+              Do jCoor = 1,icoor
+                Hess(Ind(icoor,iAtom,jcoor,iAtom)) = &
+    &           Hess(Ind(icoor,iAtom,jcoor,iAtom)) &
+    &            +tij*si(icoor)*si(jcoor)
+                Hess(Ind(icoor,jAtom,jcoor,jAtom)) = &
+    &           Hess(Ind(icoor,jAtom,jcoor,jAtom)) &
+    &            +tij*sj(icoor)*sj(jcoor)
+                Hess(Ind(icoor,kAtom,jcoor,kAtom)) = &
+    &           Hess(Ind(icoor,kAtom,jcoor,kAtom)) &
+    &            +tij*sk(icoor)*sk(jcoor)
+                Hess(Ind(icoor,lAtom,jcoor,lAtom)) = &
+    &           Hess(Ind(icoor,lAtom,jcoor,lAtom)) &
+    &            +tij*sl(icoor)*sl(jcoor)
+
+!
+              End Do
+            End Do
+222         Continue
+          End Do        ! lAtom
+333       Continue
+        End Do          ! iAtom
+111     Continue
+      End Do             ! kAtom
+444   Continue
+    End Do               ! jAtom
+    Return
+
+  contains
+    function ixyz(i,iatom)
+      integer :: ixyz
+      integer,intent(in) :: i,iatom
+      ixyz = (iatom-1)*3+i
+    end function ixyz
+    function jnd(i,j)
+      integer :: jnd
+      integer,intent(in) :: i,j
+      jnd = i*(i-1)/2+j
+    end function jnd
+    function ind(i,iatom,j,jatom)
+      integer :: ind
+      integer,intent(in) :: i,iatom,j,jatom
+      ind = jnd(max(ixyz(i,iatom),ixyz(j,jatom)),min(ixyz(i,iatom),ixyz(j,jatom)))
+    end function ind
+  end subroutine ddvopt
+
+!========================================================================================!
+!########################################################################################!
+!========================================================================================!
+
+  subroutine mh_swart(xyz,n,hess,at,modh)
+!****************************************************************************
+!* Swart's Model Hessian augmented with D2
+!* ------------------------------------------------------------------------
+!* Implemented after:
+!* M. Swart, F. M. Bickelhaupt, Int. J. Quantum Chem., 2006, 106, 2536–2544.
+!* DOI:10.1002/qua.21049
+!*
+!* gij = exp[-(Rij/Cij-1)]
+!* kij   = rkr·gij
+!* kijk  = rkf·gij·gjk
+!* kijkl = rkt·gij·gjk·gkl
+!*
+!* The proposed force constants by Swart are:
+!* rkr = 0.35, rkf = 0.15, rkt = 0.005
+!*
+!* This Hessian is additionally augmented with D2, please note that D2
+!* is not implemented in atomic units and requires some magical conversion
+!* factor somewhere hidden in the implementation below.
+!****************************************************************************
+    implicit none
+
+    integer,intent(in)  :: n
+    real(wp),intent(in)  :: xyz(3,n)
+    real(wp),intent(out) :: hess((3*n)*(3*n+1)/2)
+    integer,intent(in)  :: at(n)
+    type(mhparam),intent(in) :: modh
+
+    integer  :: n3
+    real(wp),parameter :: rzero = 1.0e-10_wp
+    logical,allocatable :: lcutoff(:,:)
+    real(wp) :: kd
+
+    allocate (lcutoff(n,n),source=.false.)
+
+    n3 = 3*n
+    hess = 0.0d0
+
+!  the dispersion force constant is used relative to the stretch force constant
+    kd = modh%kd/modh%kr
+
+    associate (rad => covrad_2009)
+
+      call mh_swart_stretch(n,at,xyz,hess,modh%kr,kd,modh%s6,rad,rad,lcutoff,modh%rcut)
+      if (modh%kf .ne. 0.0_wp) &
+        call mh_swart_bend(n,at,xyz,hess,modh%kf,kd,rad,rad,lcutoff)
+      if (modh%kt .ne. 0.0_wp) &
+        call mh_swart_torsion(n,at,xyz,hess,modh%kt,kd,rad,rad,lcutoff)
+      if (modh%ko .ne. 0.0_wp) &
+        call mh_swart_outofp(n,at,xyz,hess,modh%ko,kd,rad,rad,lcutoff)
+      if (modh%kq .ne. 0.0_wp) then
+!      call new_charge_model_2019(chrgeq,n,at)
+        call mh_eeq(n,at,xyz,0.0_wp,modh%kq,hess)
+      end if
+
+    end associate
+
+  end subroutine mh_swart
+
+  pure subroutine mh_swart_stretch(n,at,xyz,hess,kr,kd,s6,rcov,rvdw,lcutoff,rcut)
+    implicit none
+
+    integer,intent(in)    :: n
+    integer,intent(in)    :: at(n)
+    real(wp),intent(in)    :: xyz(3,n)
+    real(wp),intent(inout) :: hess((3*n)*(3*n+1)/2)
+    real(wp),intent(in)    :: kr
+    real(wp),intent(in)    :: kd
+    real(wp),intent(in)    :: s6
+    real(wp),intent(in)    :: rcov(:)
+    real(wp),intent(in)    :: rvdw(:)
+    logical,intent(out)   :: lcutoff(n,n)
+    real(wp),intent(in)    :: rcut
+
+    integer  :: i,j
+    real(wp) :: xij,yij,zij,rij2,r0,d0
+    real(wp) :: gmm
+    real(wp) :: c6i,c6j,c6ij,rv
+    real(wp) :: hxx,hxy,hxz,hyy,hyz,hzz
+    real(wp) :: vdw(3,3)
+
+!! ------------------------------------------------------------------------
+!  Hessian for stretch
+!! ------------------------------------------------------------------------
+    stretch_iAt: do i = 1,n
+
+      stretch_jAt: do j = 1,i-1
+
+        ! save for later
+        lcutoff(i,j) = rcutoff(xyz,i,j,rcut)
+        lcutoff(j,i) = lcutoff(i,j)
+
+        xij = xyz(1,i)-xyz(1,j)
+        yij = xyz(2,i)-xyz(2,j)
+        zij = xyz(3,i)-xyz(3,j)
+        rij2 = xij**2+yij**2+zij**2
+        r0 = rcov(at(i))+rcov(at(j))
+        d0 = rvdw(at(i))+rvdw(at(j))
+
+        !cccccc vdwx ccccccccccccccccccccccccccccccccc
+        c6i = c6(at(i))
+        c6j = c6(at(j))
+        c6ij = sqrt(c6i*c6j)
+        rv = (vander(at(i))+vander(at(j)))*aatoau
+
+        call getvdwxx(xij,yij,zij,c6ij,s6,rv,vdw(1,1))
+        call getvdwxy(xij,yij,zij,c6ij,s6,rv,vdw(1,2))
+        call getvdwxy(xij,zij,yij,c6ij,s6,rv,vdw(1,3))
+        call getvdwxx(yij,xij,zij,c6ij,s6,rv,vdw(2,2))
+        call getvdwxy(yij,zij,xij,c6ij,s6,rv,vdw(2,3))
+        call getvdwxx(zij,xij,yij,c6ij,s6,rv,vdw(3,3))
+        !cccccc ende vdwx ccccccccccccccccccccccccccccccc
+
+        gmm = kr*fk_swart(1.0_wp,r0,rij2) &
+              +kr*kd*fk_vdw(5.0_wp,d0,rij2)
+
+        !gmm = max(gmm,min_fk)
+
+        hxx = gmm*xij*xij/rij2-vdw(1,1)
+        hxy = gmm*xij*yij/rij2-vdw(1,2)
+        hxz = gmm*xij*zij/rij2-vdw(1,3)
+        hyy = gmm*yij*yij/rij2-vdw(2,2)
+        hyz = gmm*yij*zij/rij2-vdw(2,3)
+        hzz = gmm*zij*zij/rij2-vdw(3,3)
+
+        ! save diagonal elements for atom i
+        hess(ind(1,i,1,i)) = hess(ind(1,i,1,i))+hxx
+        hess(ind(2,i,1,i)) = hess(ind(2,i,1,i))+hxy
+        hess(ind(2,i,2,i)) = hess(ind(2,i,2,i))+hyy
+        hess(ind(3,i,1,i)) = hess(ind(3,i,1,i))+hxz
+        hess(ind(3,i,2,i)) = hess(ind(3,i,2,i))+hyz
+        hess(ind(3,i,3,i)) = hess(ind(3,i,3,i))+hzz
+        ! save elements between atom i and atom j
+        hess(ind(1,i,1,j)) = hess(ind(1,i,1,j))-hxx
+        hess(ind(1,i,2,j)) = hess(ind(1,i,2,j))-hxy
+        hess(ind(1,i,3,j)) = hess(ind(1,i,3,j))-hxz
+        hess(ind(2,i,1,j)) = hess(ind(2,i,1,j))-hxy
+        hess(ind(2,i,2,j)) = hess(ind(2,i,2,j))-hyy
+        hess(ind(2,i,3,j)) = hess(ind(2,i,3,j))-hyz
+        hess(ind(3,i,1,j)) = hess(ind(3,i,1,j))-hxz
+        hess(ind(3,i,2,j)) = hess(ind(3,i,2,j))-hyz
+        hess(ind(3,i,3,j)) = hess(ind(3,i,3,j))-hzz
+        ! save diagonal elements for atom j
+        hess(ind(1,j,1,j)) = hess(ind(1,j,1,j))+hxx
+        hess(ind(2,j,1,j)) = hess(ind(2,j,1,j))+hxy
+        hess(ind(2,j,2,j)) = hess(ind(2,j,2,j))+hyy
+        hess(ind(3,j,1,j)) = hess(ind(3,j,1,j))+hxz
+        hess(ind(3,j,2,j)) = hess(ind(3,j,2,j))+hyz
+        hess(ind(3,j,3,j)) = hess(ind(3,j,3,j))+hzz
+
+      end do stretch_jAt
+    end do stretch_iAt
+
+  end subroutine mh_swart_stretch
+
+  pure subroutine mh_swart_bend(n,at,xyz,hess,kf,kd,rcov,rvdw,lcutoff)
+    implicit none
+
+    integer,intent(in)    :: n
+    integer,intent(in)    :: at(n)
+    real(wp),intent(in)    :: xyz(3,n)
+    real(wp),intent(inout) :: hess((3*n)*(3*n+1)/2)
+    real(wp),intent(in)    :: kf
+    real(wp),intent(in)    :: kd
+    real(wp),intent(in)    :: rcov(:)
+    real(wp),intent(in)    :: rvdw(:)
+    logical,intent(in)    :: lcutoff(n,n)
+
+    integer  :: i,j,m,ic,jc,ii
+    real(wp),parameter :: rzero = 1.0e-10_wp
+    real(wp) :: xij,yij,zij,rij2,rrij,r1
+    real(wp) :: xmi,ymi,zmi,rmi2,rmi,r0mi,d0mj,gmi
+    real(wp) :: xmj,ymj,zmj,rmj2,rmj,r0mj,d0mi,gmj
+    real(wp) :: test,gij,rl2,rl,rmidotrmj
+    real(wp) :: sinphi,cosphi,costhetax,costhetay,costhetaz
+    real(wp) :: alpha
+    real(wp) :: si(3),sj(3),sm(3),x(2),y(2),z(2)
+
+!! ------------------------------------------------------------------------
+!  Hessian for bending
+!! ------------------------------------------------------------------------
+    bend_mAt: do m = 1,n
+      bend_iAt: do i = 1,n
+        if (i .eq. m) cycle bend_iAt
+        if (lcutoff(i,m)) cycle bend_iAt
+
+        xmi = (xyz(1,i)-xyz(1,m))
+        ymi = (xyz(2,i)-xyz(2,m))
+        zmi = (xyz(3,i)-xyz(3,m))
+        rmi2 = xmi**2+ymi**2+zmi**2
+        rmi = sqrt(rmi2)
+        r0mi = rcov(at(m))+rcov(at(i))
+        d0mi = rvdw(at(m))+rvdw(at(i))
+
+        bend_jAt: do j = 1,i-1
+          if (j .eq. m) cycle bend_jAt
+          if (lcutoff(j,i)) cycle bend_jAt
+          if (lcutoff(j,m)) cycle bend_jAt
+
+          xmj = (xyz(1,j)-xyz(1,m))
+          ymj = (xyz(2,j)-xyz(2,m))
+          zmj = (xyz(3,j)-xyz(3,m))
+          rmj2 = xmj**2+ymj**2+zmj**2
+          rmj = sqrt(rmj2)
+          r0mj = rcov(at(m))+rcov(at(j))
+          d0mj = rvdw(at(m))+rvdw(at(j))
+
+          ! test if zero angle
+          test = xmi*xmj+ymi*ymj+zmi*zmj
+          test = test/(rmi*rmj)
+          if (abs(test-1.0_wp) .lt. 1.0e-12_wp) cycle bend_jAt
+
+          xij = (xyz(1,j)-xyz(1,i))
+          yij = (xyz(2,j)-xyz(2,i))
+          zij = (xyz(3,j)-xyz(3,i))
+          rij2 = xij**2+yij**2+zij**2
+          rrij = sqrt(rij2)
+
+          gmi = fk_swart(1.0_wp,r0mi,rmi2) &
+                +0.5_wp*kd*fk_vdw(5.0_wp,d0mi,rmi2)
+          gmj = fk_swart(1.0_wp,r0mj,rmj2) &
+                +0.5_wp*kd*fk_vdw(5.0_wp,d0mj,rmj2)
+
+          gij = kf*gmi*gmj
+
+          rl2 = (ymi*zmj-zmi*ymj)**2+(zmi*xmj-xmi*zmj)**2+(xmi*ymj-ymi*xmj)**2
+
+          if (rl2 .lt. 1.e-14_wp) then
+            rl = 0.0_wp
+          else
+            rl = sqrt(rl2)
+          end if
+
+          !gij = max(gij,min_fk)
+
+          if ((rmj .gt. rzero).and.(rmi .gt. rzero).and.(rrij .gt. rzero)) then
+            sinphi = rl/(rmj*rmi)
+            rmidotrmj = xmi*xmj+ymi*ymj+zmi*zmj
+            cosphi = rmidotrmj/(rmj*rmi)
+            ! none linear case
+            if (sinphi .gt. rzero) then
+              si(1) = (xmi/rmi*cosphi-xmj/rmj)/(rmi*sinphi)
+              si(2) = (ymi/rmi*cosphi-ymj/rmj)/(rmi*sinphi)
+              si(3) = (zmi/rmi*cosphi-zmj/rmj)/(rmi*sinphi)
+              sj(1) = (cosphi*xmj/rmj-xmi/rmi)/(rmj*sinphi)
+              sj(2) = (cosphi*ymj/rmj-ymi/rmi)/(rmj*sinphi)
+              sj(3) = (cosphi*zmj/rmj-zmi/rmi)/(rmj*sinphi)
+              sm(1) = -si(1)-sj(1)
+              sm(2) = -si(2)-sj(2)
+              sm(3) = -si(3)-sj(3)
+              do ic = 1,3
+                do jc = 1,3
+                  if (m .gt. i) then
+                    hess(ind(ic,m,jc,i)) = hess(ind(ic,m,jc,i)) &
+                                           +gij*sm(ic)*si(jc)
+                  else
+                    hess(ind(ic,i,jc,m)) = hess(ind(ic,i,jc,m)) &
+                                           +gij*si(ic)*sm(jc)
+                  end if
+                  if (m .gt. j) then
+                    hess(ind(ic,m,jc,j)) = hess(ind(ic,m,jc,j)) &
+                                           +gij*sm(ic)*sj(jc)
+                  else
+                    hess(ind(ic,j,jc,m)) = hess(ind(ic,j,jc,m)) &
+                                           +gij*sj(ic)*sm(jc)
+                  end if
+                  if (i .gt. j) then
+                    hess(ind(ic,i,jc,j)) = hess(ind(ic,i,jc,j)) &
+                                           +gij*si(ic)*sj(jc)
+                  else
+                    hess(ind(ic,j,jc,i)) = hess(ind(ic,j,jc,i)) &
+                                           +gij*sj(ic)*si(jc)
+                  end if
+                end do
+              end do
+              do ic = 1,3
+                do jc = 1,ic
+                  hess(ind(ic,i,jc,i)) = hess(ind(ic,i,jc,i))+gij*si(ic)*si(jc)
+                  hess(ind(ic,m,jc,m)) = hess(ind(ic,m,jc,m))+gij*sm(ic)*sm(jc)
+                  hess(ind(ic,j,jc,j)) = hess(ind(ic,j,jc,j))+gij*sj(ic)*sj(jc)
+                end do
+              end do
+            else
+              ! linear case
+              if ((abs(ymi) .gt. rzero).or.(abs(xmi) .gt. rzero)) then
+                x(1) = -ymi
+                y(1) = xmi
+                z(1) = 0.0_wp
+                x(2) = -xmi*zmi
+                y(2) = -ymi*zmi
+                z(2) = xmi*xmi+ymi*ymi
+              else
+                x(1) = 1.0_wp
+                y(1) = 0.0_wp
+                z(1) = 0.0_wp
+                x(2) = 0.0_wp
+                y(2) = 1.0_wp
+                z(2) = 0.0_wp
+              end if
+              do ii = 1,2
+                r1 = sqrt(x(ii)**2+y(ii)**2+z(ii)**2)
+                costhetax = x(ii)/r1
+                costhetay = y(ii)/r1
+                costhetaz = z(ii)/r1
+                si(1) = -costhetax/rmi
+                si(2) = -costhetay/rmi
+                si(3) = -costhetaz/rmi
+                sj(1) = -costhetax/rmj
+                sj(2) = -costhetay/rmj
+                sj(3) = -costhetaz/rmj
+                sm(1) = -(si(1)+sj(1))
+                sm(2) = -(si(2)+sj(2))
+                sm(3) = -(si(3)+sj(3))
+                !
+                do ic = 1,3
+                  do jc = 1,3
+                    if (m .gt. i) then
+                      hess(ind(ic,m,jc,i)) = hess(ind(ic,m,jc,i)) &
+                                             +gij*sm(ic)*si(jc)
+                    else
+                      hess(ind(ic,i,jc,m)) = hess(ind(ic,i,jc,m)) &
+                                             +gij*si(ic)*sm(jc)
+                    end if
+                    if (m .gt. j) then
+                      hess(ind(ic,m,jc,j)) = hess(ind(ic,m,jc,j)) &
+                                             +gij*sm(ic)*sj(jc)
+                    else
+                      hess(ind(ic,j,jc,m)) = hess(ind(ic,j,jc,m)) &
+                                             +gij*sj(ic)*sm(jc)
+                    end if
+                    if (i .gt. j) then
+                      hess(ind(ic,i,jc,j)) = hess(ind(ic,i,jc,j)) &
+                                             +gij*si(ic)*sj(jc)
+                    else
+                      hess(ind(ic,j,jc,i)) = hess(ind(ic,j,jc,i)) &
+                                             +gij*sj(ic)*si(jc)
+                    end if
+                  end do
+                end do
+                do ic = 1,3
+                  do jc = 1,ic
+                    hess(ind(ic,i,jc,i)) = hess(ind(ic,i,jc,i)) &
+                                           +gij*si(ic)*si(jc)
+                    hess(ind(ic,m,jc,m)) = hess(ind(ic,m,jc,m)) &
+                                           +gij*sm(ic)*sm(jc)
+                    hess(ind(ic,j,jc,j)) = hess(ind(ic,j,jc,j)) &
+                                           +gij*sj(ic)*sj(jc)
+                  end do
+                end do
+              end do
+
+            end if
+          end if
+
+        end do bend_jAt
+      end do bend_iAt
+    end do bend_mAt
+
+  end subroutine mh_swart_bend
+
+  pure subroutine mh_swart_torsion(n,at,xyz,hess,kt,kd,rcov,rvdw,lcutoff)
+    implicit none
+
+    integer,intent(in)    :: n
+    integer,intent(in)    :: at(n)
+    real(wp),intent(in)    :: xyz(3,n)
+    real(wp),intent(inout) :: hess((3*n)*(3*n+1)/2)
+    real(wp),intent(in)    :: kt
+    real(wp),intent(in)    :: kd
+    real(wp),intent(in)    :: rcov(:)
+    real(wp),intent(in)    :: rvdw(:)
+    logical,intent(in)    :: lcutoff(n,n)
+
+    integer  :: i,j,k,l,ic,jc,ij,kl
+!  allow only angles in the range of 35-145
+    real(wp),parameter :: a35 = (35.0d0/180.d0)*pi
+    real(wp),parameter :: cosfi_max = cos(a35)
+    real(wp) :: txyz(3,4),c(3,4)
+    real(wp) :: rij(3),rij0,aij,rij2,d0ij,gij
+    real(wp) :: rjk(3),rjk0,ajk,rjk2,d0jk,gjk
+    real(wp) :: rkl(3),rkl0,akl,rkl2,d0kl,gkl
+    real(wp) :: cosfi2,cosfi3,cosfi4
+    real(wp) :: beta,tij,tau
+    real(wp) :: si(3),sj(3),sk(3),sl(3)
+
+!! ------------------------------------------------------------------------
+!  Hessian for torsion
+!! ------------------------------------------------------------------------
+    torsion_jAt: do j = 1,n
+      txyz(:,2) = xyz(:,j)
+      torsion_kAt: do k = 1,n
+        if (k .eq. j) cycle torsion_kAt
+        if (lcutoff(k,j)) cycle torsion_kAt
+        txyz(:,3) = xyz(:,k)
+        torsion_iAt: do i = 1,n
+          ij = n*(j-1)+i
+          if (i .eq. j) cycle torsion_iAt
+          if (i .eq. k) cycle torsion_iAt
+          if (lcutoff(i,k)) cycle torsion_iAt
+          if (lcutoff(i,j)) cycle torsion_iAt
+
+          txyz(:,1) = xyz(:,i)
+          torsion_lAt: do l = 1,n
+            kl = n*(l-1)+k
+            if (ij .le. kl) cycle torsion_lAt
+            if (l .eq. i) cycle torsion_lAt
+            if (l .eq. j) cycle torsion_lAt
+            if (l .eq. k) cycle torsion_lAt
+!
+            if (lcutoff(l,i)) cycle torsion_lAt
+            if (lcutoff(l,k)) cycle torsion_lAt
+            if (lcutoff(l,j)) cycle torsion_lAt
+
+            txyz(:,4) = xyz(:,l)
+
+            rij = xyz(:,i)-xyz(:,j)
+            d0ij = rvdw(at(i))+rvdw(at(j))
+            rij0 = rcov(at(i))+rcov(at(j))
+
+            rjk = xyz(:,j)-xyz(:,k)
+            d0jk = rvdw(at(j))+rvdw(at(k))
+            rjk0 = rcov(at(j))+rcov(at(k))
+
+            rkl = xyz(:,k)-xyz(:,l)
+            d0kl = rvdw(at(k))+rvdw(at(l))
+            rkl0 = rcov(at(k))+rcov(at(l))
+
+            rij2 = sum(rij**2)
+            rjk2 = sum(rjk**2)
+            rkl2 = sum(rjk**2)
+
+            cosfi2 = dot_product(rij,rjk)/sqrt(rij2*rjk2)
+            if (abs(cosfi2) .gt. cosfi_max) cycle
+            cosfi3 = dot_product(rkl,rjk)/sqrt(rkl2*rjk2)
+            if (abs(cosfi3) .gt. cosfi_max) cycle
+
+            gij = fk_swart(1.0_wp,rij0,rij2) &
+                  +0.5_wp*kd*fk_vdw(5.0_wp,d0ij,rij2)
+            gjk = fk_swart(1.0_wp,rjk0,rjk2) &
+                  +0.5_wp*kd*fk_vdw(5.0_wp,d0jk,rjk2)
+            gkl = fk_swart(1.0_wp,rkl0,rkl2) &
+                  +0.5_wp*kd*fk_vdw(5.0_wp,d0kl,rkl2)
+
+            tij = kt*gij*gjk*gkl
+
+            !tij = max(tij,10*min_fk)
+
+            call trsn2(txyz,tau,c)
+            si = c(:,1)
+            sj = c(:,2)
+            sk = c(:,3)
+            sl = c(:,4)
+
+            ! off diagonal block
+            do ic = 1,3
+              do jc = 1,3
+                hess(ind(ic,i,jc,j)) = hess(ind(ic,i,jc,j))+tij*si(ic)*sj(jc)
+                hess(ind(ic,i,jc,k)) = hess(ind(ic,i,jc,k))+tij*si(ic)*sk(jc)
+                hess(ind(ic,i,jc,l)) = hess(ind(ic,i,jc,l))+tij*si(ic)*sl(jc)
+                hess(ind(ic,j,jc,k)) = hess(ind(ic,j,jc,k))+tij*sj(ic)*sk(jc)
+                hess(ind(ic,j,jc,l)) = hess(ind(ic,j,jc,l))+tij*sj(ic)*sl(jc)
+                hess(ind(ic,k,jc,l)) = hess(ind(ic,k,jc,l))+tij*sk(ic)*sl(jc)
+              end do
+            end do
+
+            ! diagonal block
+            do ic = 1,3
+              do jc = 1,ic
+                hess(ind(ic,i,jc,i)) = hess(ind(ic,i,jc,i))+tij*si(ic)*si(jc)
+                hess(ind(ic,j,jc,j)) = hess(ind(ic,j,jc,j))+tij*sj(ic)*sj(jc)
+                hess(ind(ic,k,jc,k)) = hess(ind(ic,k,jc,k))+tij*sk(ic)*sk(jc)
+                hess(ind(ic,l,jc,l)) = hess(ind(ic,l,jc,l))+tij*sl(ic)*sl(jc)
+              end do
+            end do
+
+          end do torsion_lAt
+        end do torsion_iAt
+      end do torsion_kAt
+    end do torsion_jAt
+
+  end subroutine mh_swart_torsion
+
+  pure subroutine mh_swart_outofp(n,at,xyz,hess,ko,kd,rcov,rvdw,lcutoff)
+    implicit none
+
+    integer,intent(in)    :: n
+    integer,intent(in)    :: at(n)
+    real(wp),intent(in)    :: xyz(3,n)
+    real(wp),intent(inout) :: hess((3*n)*(3*n+1)/2)
+    real(wp),intent(in)    :: ko
+    real(wp),intent(in)    :: kd
+    real(wp),intent(in)    :: rcov(:)
+    real(wp),intent(in)    :: rvdw(:)
+    logical,intent(in)    :: lcutoff(n,n)
+
+    integer  :: i,ir,j,jr,k,kr,l,lr,ic,jc
+    real(wp) :: txyz(3,4),c(3,4)
+    real(wp) :: rij(3),rij0,d0ij,rij2,gij
+    real(wp) :: rik(3),rik0,d0ik,rik2,gik
+    real(wp) :: ril(3),ril0,d0il,ril2,gil
+    real(wp) :: cosfi2,cosfi3,cosfi4
+    real(wp) :: beta,tij,tau
+    real(wp) :: si(3),sj(3),sk(3),sl(3)
+
+!! ------------------------------------------------------------------------
+!  Hessian for out-of-plane
+!! ------------------------------------------------------------------------
+    outofplane_iAt: do i = 1,n
+      txyz(:,4) = xyz(:,i)
+      outofplane_jAt: do j = 1,n
+        if (j .eq. i) cycle outofplane_jAt
+        if (lcutoff(j,i)) cycle outofplane_jAt
+        txyz(:,1) = xyz(:,j)
+        outofplane_kAt: do k = 1,n
+          if (i .eq. k) cycle outofplane_kAt
+          if (j .eq. k) cycle outofplane_kat
+          if (lcutoff(k,i)) cycle outofplane_kAt
+          if (lcutoff(k,j)) cycle outofplane_kAt
+          txyz(:,2) = xyz(:,k)
+          outofplane_lAt: do l = 1,n
+            txyz(:,3) = xyz(:,l)
+            if (l .eq. i) cycle outofplane_lAt
+            if (l .eq. j) cycle outofplane_lAt
+            if (l .eq. k) cycle outofplane_lAt
+            if (lcutoff(l,i)) cycle outofplane_lAt
+            if (lcutoff(l,k)) cycle outofplane_lAt
+            if (lcutoff(l,j)) cycle outofplane_lAt
+
+            rij = xyz(:,i)-xyz(:,j)
+            rij0 = rcov(at(i))+rcov(at(j))
+            d0ij = rvdw(at(i))+rvdw(at(j))
+
+            rik = xyz(:,i)-xyz(:,k)
+            rik0 = rcov(at(i))+rcov(at(k))
+            d0ik = rvdw(at(i))+rvdw(at(k))
+
+            ril = xyz(:,i)-xyz(:,l)
+            ril0 = rcov(at(i))+rcov(at(l))
+            d0il = rvdw(at(i))+rvdw(at(l))
+
+            rij2 = sum(rij**2)
+            rik2 = sum(rik**2)
+            ril2 = sum(ril**2)
+
+            cosfi2 = dot_product(rij,rik)/sqrt(rij2*rik2)
+            if (abs(abs(cosfi2)-1.0_wp) .lt. 1.0e-1_wp) cycle
+            cosfi3 = dot_product(rij,ril)/sqrt(rij2*ril2)
+            if (abs(abs(cosfi3)-1.0_wp) .lt. 1.0e-1_wp) cycle
+            cosfi4 = dot_product(rik,ril)/sqrt(rik2*ril2)
+            if (abs(abs(cosfi4)-1.0_wp) .lt. 1.0e-1_wp) cycle
+
+            gij = fk_swart(1.0_wp,rij0,rij2) &
+                  +0.5_wp*kd*fk_vdw(5.0_wp,d0ij,rij2)
+            gik = fk_swart(1.0_wp,rik0,rik2) &
+                  +0.5_wp*kd*fk_vdw(5.0_wp,d0ik,rik2)
+            gil = fk_swart(1.0_wp,ril0,ril2) &
+                  +0.5_wp*kd*fk_vdw(5.0_wp,d0il,ril2)
+
+            tij = ko*gij*gik*gil
+
+            !tij = max(tij,10*min_fk)
+
+            call outofp2(xyz,tau,c)
+            If (abs(tau) .gt. 45.0d0*(pi/180.d0)) cycle
+
+            si = c(:,4)
+            sj = c(:,1)
+            sk = c(:,2)
+            sl = c(:,3)
+
+            ! off diagonal block
+            do ic = 1,3
+              do jc = 1,3
+                hess(ind(ic,i,jc,j)) = hess(ind(ic,i,jc,j))+tij*si(ic)*sj(jc)
+                hess(ind(ic,i,jc,k)) = hess(ind(ic,i,jc,k))+tij*si(ic)*sk(jc)
+                hess(ind(ic,i,jc,l)) = hess(ind(ic,i,jc,l))+tij*si(ic)*sl(jc)
+                hess(ind(ic,j,jc,k)) = hess(ind(ic,j,jc,k))+tij*sj(ic)*sk(jc)
+                hess(ind(ic,j,jc,l)) = hess(ind(ic,j,jc,l))+tij*sj(ic)*sl(jc)
+                hess(ind(ic,k,jc,l)) = hess(ind(ic,k,jc,l))+tij*sk(ic)*sl(jc)
+              end do
+            end do
+
+            ! diagonal block
+            do ic = 1,3
+              do jc = 1,ic
+                hess(ind(ic,i,jc,i)) = hess(ind(ic,i,jc,i))+tij*si(ic)*si(jc)
+                hess(ind(ic,j,jc,j)) = hess(ind(ic,j,jc,j))+tij*sj(ic)*sj(jc)
+                hess(ind(ic,k,jc,k)) = hess(ind(ic,k,jc,k))+tij*sk(ic)*sk(jc)
+                hess(ind(ic,l,jc,l)) = hess(ind(ic,l,jc,l))+tij*sl(ic)*sl(jc)
+              end do
+            end do
+
+          end do outofplane_lAt
+        end do outofplane_kAt
+      end do outofplane_jAt
+    end do outofplane_iAt
+
+  end subroutine mh_swart_outofp
+
+!========================================================================================!
+!########################################################################################!
+!========================================================================================!
+
+  subroutine mh_lindh(xyz,n,hess,at,modh)
+!**************************************************************************
+!*  Lindh's Model Hessian updated around 2007
+!* ------------------------------------------------------------------------
+!*  R. Lindh, personal communication.
+!*
+!*  gij = exp[αij(R²ref - R²ij)]
+!*  dij = exp[-4·(Rvdw - Rij)²]
+!*  kij   = rkr·gij + rkd·dij
+!*  kijk  = rkf·(gij+½·rkd/rkr·dij)·(gjk+½·rkd/rkr·djk)
+!*  kijkl = rkt·(gij+½·rkd/rkr·dij)·(gjk+½·rkd/rkr·djk)·(gkl+½·rkd/rkr·dkl)
+!*
+!*  parameters tweaked by R. Lindh in 2007:
+!*  rkr = 0.45, rkf = 0.10, rkt = 0.0025, rko = 0.16, rkd = 0.05
+!*
+!*  the reference distances are divided by rows in the PSE:
+!*  rAv:        1        2        3       aAv:        1        2        3
+!*    1    1.3500   2.1000   2.5300         1    1.0000   0.3949   0.3949
+!*    2    2.1000   2.8700   3.8000         2    0.3949   0.2800   0.1200
+!*    3    2.5300   3.8000   4.5000         3    0.3949   0.1200   0.0600
+!*
+!*  dAv:        1        2        3
+!*    1    0.0000   3.6000   3.6000
+!*    2    3.6000   5.3000   5.3000
+!*    3    3.6000   5.3000   5.3000
+!*
+!**************************************************************************
+    implicit none
+
+    integer,intent(in)  :: n
+    real(wp),intent(in)  :: xyz(3,n)
+    real(wp),intent(out) :: hess((3*n)*(3*n+1)/2)
+    integer,intent(in)  :: at(n)
+    type(mhparam),intent(in) :: modh
+
+    real(wp),parameter :: rAv(3,3) = reshape( &
+                          (/1.3500_wp,2.1000_wp,2.5300_wp, &
+                            2.1000_wp,2.8700_wp,3.8000_wp, &
+                            2.5300_wp,3.8000_wp,4.5000_wp/),shape(rAv))
+    real(wp),parameter :: aAv(3,3) = reshape( &
+                          (/1.0000_wp,0.3949_wp,0.3949_wp, &
+                            0.3949_wp,0.2800_wp,0.1200_wp, &
+                            0.3949_wp,0.1200_wp,0.0600_wp/),shape(aAv))
+    real(wp),parameter :: dAv(3,3) = reshape( &
+                          (/0.0000_wp,3.6000_wp,3.6000_wp, &
+                            3.6000_wp,5.3000_wp,5.3000_wp, &
+                            3.6000_wp,5.3000_wp,5.3000_wp/),shape(aAv))
+
+    integer  :: n3
+    real(wp) :: kd
+    logical,allocatable :: lcutoff(:,:)
+    !type(chrg_parameter) :: chrgeq
+
+    allocate (lcutoff(n,n),source=.false.)
+
+    n3 = 3*n
+    hess = 0.0d0
+
+!  the dispersion force constant is used relative to the stretch force constant
+    kd = modh%kd/modh%kr
+
+    call mh_lindh_stretch(n,at,xyz,hess,modh%kr,kd,modh%s6,aav,rav,dav,lcutoff,modh%rcut)
+    if (modh%kf .ne. 0.0_wp) &
+      call mh_lindh_bend(n,at,xyz,hess,modh%kf,kd,aav,rav,dav,lcutoff)
+    if (modh%kt .ne. 0.0_wp) &
+      call mh_lindh_torsion(n,at,xyz,hess,modh%kt,kd,aav,rav,dav,lcutoff)
+    if (modh%ko .ne. 0.0_wp) &
+      call mh_lindh_outofp(n,at,xyz,hess,modh%ko,0.0_wp,aav,rav,dav,lcutoff)
+    if (modh%kq .ne. 0.0_wp) then
+      !call new_charge_model_2019(chrgeq,n,at)
+      call mh_eeq(n,at,xyz,0.0_wp,modh%kq,hess)
+    end if
+
+  end subroutine mh_lindh
+
+  subroutine mh_lindh_d2(xyz,n,hess,at,modh)
+!**************************************************************************
+!*  Lindh's Model Hessian augmented with D2
+!* ------------------------------------------------------------------------
+!*  Implemented after:
+!*  Lindh, R., Bernhardsson, A., Karlström, G., & Malmqvist, P.-Å. (1995).
+!*  On the use of a Hessian model function in molecular geometry optimizations.
+!*  Chem. Phys. Lett., 241(4), 423–428. doi:10.1016/0009-2614(95)00646-l
+!*
+!*  gij = exp[αij(R²ref - R²ij)]
+!*  kij   = rkr·gij
+!*  kijk  = rkf·gij·gjk
+!*  kijkl = rkt·gij·gjk·gkl
+!*
+!*  Originally Lindh proposed (we tweaked those a little bit):
+!*  rkr = 0.45, rkf = 0.15, rkt = 0.005
+!*
+!*  the reference distances are divided by rows in the PSE:
+!*  rAv:        1        2        3       aAv:        1        2        3
+!*    1    1.3500   2.1000   2.5300         1    1.0000   0.3949   0.3949
+!*    2    2.1000   2.8700   3.4000         2    0.3949   0.2800   0.2800
+!*    3    2.5300   3.4000   3.4000         3    0.3949   0.2800   0.2800
+!*
+!*  This Hessian is additionally augmented with D2, please note that D2
+!*  is not implemented in atomic units and requires some magical conversion
+!*  factor somewhere hidden in the implementation below.
+!*************************************************************************
+    implicit none
+
+    integer,intent(in)  :: n
+    real(wp),intent(in)  :: xyz(3,n)
+    real(wp),intent(out) :: hess((3*n)*(3*n+1)/2)
+    integer,intent(in)  :: at(n)
+    type(mhparam),intent(in) :: modh
+
+    real(wp),parameter :: rAv(3,3) = reshape( &
+                          (/1.3500_wp,2.1000_wp,2.5300_wp, &
+                            2.1000_wp,2.8700_wp,3.4000_wp, &
+                            2.5300_wp,3.4000_wp,3.4000_wp/),shape(rAv))
+    real(wp),parameter :: aAv(3,3) = reshape( &
+                          (/1.0000_wp,0.3949_wp,0.3949_wp, &
+                            0.3949_wp,0.2800_wp,0.2800_wp, &
+                            0.3949_wp,0.2800_wp,0.2800_wp/),shape(aAv))
+    real(wp),parameter :: dAv(3,3) = reshape( &
+                          (/0.0000_wp,0.0000_wp,0.0000_wp, &
+                            0.0000_wp,0.0000_wp,0.0000_wp, &
+                            0.0000_wp,0.0000_wp,0.0000_wp/),shape(aAv))
+
+    integer  :: n3
+    real(wp) :: kd
+    logical,allocatable :: lcutoff(:,:)
+
+    allocate (lcutoff(n,n),source=.false.)
+
+    n3 = 3*n
+    hess = 0.0d0
+
+!  the dispersion force constant is used relative to the stretch force constant
+    kd = modh%kd/modh%kr
+
+    call mh_lindh_stretch(n,at,xyz,hess,modh%kr,kd,modh%s6,aav,rav,dav,lcutoff,modh%rcut)
+    if (modh%kf .ne. 0.0_wp) &
+      call mh_lindh_bend(n,at,xyz,hess,modh%kf,kd,aav,rav,dav,lcutoff)
+    if (modh%kt .ne. 0.0_wp) &
+      call mh_lindh_torsion(n,at,xyz,hess,modh%kt,kd,aav,rav,dav,lcutoff)
+    if (modh%ko .ne. 0.0_wp) &
+      call mh_lindh_outofp(n,at,xyz,hess,modh%ko,kd,aav,rav,dav,lcutoff)
+    if (modh%kq .ne. 0.0_wp) then
+      call mh_eeq(n,at,xyz,0.0_wp,modh%kq,hess)
+    end if
+  end subroutine mh_lindh_d2
+
+  pure subroutine mh_lindh_stretch(n,at,xyz,hess,kr,kd,s6,aav,rav,dav,lcutoff,rcut)
+    implicit none
+
+    integer,intent(in)    :: n
+    integer,intent(in)    :: at(n)
+    real(wp),intent(in)    :: xyz(3,n)
+    real(wp),intent(inout) :: hess((3*n)*(3*n+1)/2)
+    real(wp),intent(in)    :: kr
+    real(wp),intent(in)    :: kd
+    real(wp),intent(in)    :: s6
+    real(wp),intent(in)    :: aav(3,3)
+    real(wp),intent(in)    :: rav(3,3)
+    real(wp),intent(in)    :: dav(3,3)
+    logical,intent(out)   :: lcutoff(n,n)
+    real(wp),intent(in)    :: rcut
+
+    integer  :: i,ir,j,jr
+    real(wp) :: xij,yij,zij,rij2,r0,d0
+    real(wp) :: alpha,gmm
+    real(wp) :: c6i,c6j,c6ij,rv
+    real(wp) :: hxx,hxy,hxz,hyy,hyz,hzz
+    real(wp) :: vdw(3,3)
+
+!! ------------------------------------------------------------------------
+!  Hessian for stretch
+!! ------------------------------------------------------------------------
+    stretch_iAt: do i = 1,n
+      ir = itabrow(at(i))
+
+      stretch_jAt: do j = 1,i-1
+        jr = itabrow(at(j))
+
+        ! save for later
+        lcutoff(i,j) = rcutoff(xyz,i,j,rcut)
+        lcutoff(j,i) = lcutoff(i,j)
+
+        xij = xyz(1,i)-xyz(1,j)
+        yij = xyz(2,i)-xyz(2,j)
+        zij = xyz(3,i)-xyz(3,j)
+        rij2 = xij**2+yij**2+zij**2
+        r0 = rav(ir,jr)
+        d0 = dav(ir,jr)
+        alpha = aav(ir,jr)
+
+        !cccccc vdwx ccccccccccccccccccccccccccccccccc
+        c6i = c6(at(i))
+        c6j = c6(at(j))
+        c6ij = sqrt(c6i*c6j)
+        rv = (vander(at(i))+vander(at(j)))*aatoau
+
+        call getvdwxx(xij,yij,zij,c6ij,s6,rv,vdw(1,1))
+        call getvdwxy(xij,yij,zij,c6ij,s6,rv,vdw(1,2))
+        call getvdwxy(xij,zij,yij,c6ij,s6,rv,vdw(1,3))
+        call getvdwxx(yij,xij,zij,c6ij,s6,rv,vdw(2,2))
+        call getvdwxy(yij,zij,xij,c6ij,s6,rv,vdw(2,3))
+        call getvdwxx(zij,xij,yij,c6ij,s6,rv,vdw(3,3))
+        !cccccc ende vdwx ccccccccccccccccccccccccccccccc
+
+        gmm = kr*fk_lindh(alpha,r0,rij2) &
+              +kr*kd*fk_vdw(4.0_wp,d0,rij2)
+
+        !gmm = max(gmm,min_fk)
+
+        hxx = gmm*xij*xij/rij2-vdw(1,1)
+        hxy = gmm*xij*yij/rij2-vdw(1,2)
+        hxz = gmm*xij*zij/rij2-vdw(1,3)
+        hyy = gmm*yij*yij/rij2-vdw(2,2)
+        hyz = gmm*yij*zij/rij2-vdw(2,3)
+        hzz = gmm*zij*zij/rij2-vdw(3,3)
+
+        ! save diagonal elements for atom i
+        hess(ind(1,i,1,i)) = hess(ind(1,i,1,i))+hxx
+        hess(ind(2,i,1,i)) = hess(ind(2,i,1,i))+hxy
+        hess(ind(2,i,2,i)) = hess(ind(2,i,2,i))+hyy
+        hess(ind(3,i,1,i)) = hess(ind(3,i,1,i))+hxz
+        hess(ind(3,i,2,i)) = hess(ind(3,i,2,i))+hyz
+        hess(ind(3,i,3,i)) = hess(ind(3,i,3,i))+hzz
+        ! save elements between atom i and atom j
+        hess(ind(1,i,1,j)) = hess(ind(1,i,1,j))-hxx
+        hess(ind(1,i,2,j)) = hess(ind(1,i,2,j))-hxy
+        hess(ind(1,i,3,j)) = hess(ind(1,i,3,j))-hxz
+        hess(ind(2,i,1,j)) = hess(ind(2,i,1,j))-hxy
+        hess(ind(2,i,2,j)) = hess(ind(2,i,2,j))-hyy
+        hess(ind(2,i,3,j)) = hess(ind(2,i,3,j))-hyz
+        hess(ind(3,i,1,j)) = hess(ind(3,i,1,j))-hxz
+        hess(ind(3,i,2,j)) = hess(ind(3,i,2,j))-hyz
+        hess(ind(3,i,3,j)) = hess(ind(3,i,3,j))-hzz
+        ! save diagonal elements for atom j
+        hess(ind(1,j,1,j)) = hess(ind(1,j,1,j))+hxx
+        hess(ind(2,j,1,j)) = hess(ind(2,j,1,j))+hxy
+        hess(ind(2,j,2,j)) = hess(ind(2,j,2,j))+hyy
+        hess(ind(3,j,1,j)) = hess(ind(3,j,1,j))+hxz
+        hess(ind(3,j,2,j)) = hess(ind(3,j,2,j))+hyz
+        hess(ind(3,j,3,j)) = hess(ind(3,j,3,j))+hzz
+
+      end do stretch_jAt
+    end do stretch_iAt
+
+  end subroutine mh_lindh_stretch
+
+  pure subroutine mh_lindh_bend(n,at,xyz,hess,kf,kd,aav,rav,dav,lcutoff)
+    implicit none
+
+    integer,intent(in)    :: n
+    integer,intent(in)    :: at(n)
+    real(wp),intent(in)    :: xyz(3,n)
+    real(wp),intent(inout) :: hess((3*n)*(3*n+1)/2)
+    real(wp),intent(in)    :: kf
+    real(wp),intent(in)    :: kd
+    real(wp),intent(in)    :: aav(3,3)
+    real(wp),intent(in)    :: rav(3,3)
+    real(wp),intent(in)    :: dav(3,3)
+    logical,intent(in)    :: lcutoff(n,n)
+
+    integer  :: i,ir,j,jr,m,mr,ic,jc,ii
+    real(wp),parameter :: rzero = 1.0e-10_wp
+    real(wp) :: xij,yij,zij,rij2,rrij,r1
+    real(wp) :: xmi,ymi,zmi,rmi2,rmi,r0mi,ami,d0mj,gmi
+    real(wp) :: xmj,ymj,zmj,rmj2,rmj,r0mj,amj,d0mi,gmj
+    real(wp) :: test,gij,rl2,rl,rmidotrmj
+    real(wp) :: sinphi,cosphi,costhetax,costhetay,costhetaz
+    real(wp) :: alpha
+    real(wp) :: si(3),sj(3),sm(3),x(2),y(2),z(2)
+
+!! ------------------------------------------------------------------------
+!  Hessian for bending
+!! ------------------------------------------------------------------------
+    bend_mAt: do m = 1,n
+      mr = itabrow(at(m))
+      bend_iAt: do i = 1,n
+        if (i .eq. m) cycle bend_iAt
+        ir = itabrow(at(i))
+        if (lcutoff(i,m)) cycle bend_iAt
+
+        xmi = (xyz(1,i)-xyz(1,m))
+        ymi = (xyz(2,i)-xyz(2,m))
+        zmi = (xyz(3,i)-xyz(3,m))
+        rmi2 = xmi**2+ymi**2+zmi**2
+        rmi = sqrt(rmi2)
+        r0mi = rav(mr,ir)
+        d0mi = dav(mr,ir)
+        ami = aav(mr,ir)
+
+        bend_jAt: do j = 1,i-1
+          if (j .eq. m) cycle bend_jAt
+          jr = itabrow(at(j))
+          if (lcutoff(j,i)) cycle bend_jAt
+          if (lcutoff(j,m)) cycle bend_jAt
+
+          xmj = (xyz(1,j)-xyz(1,m))
+          ymj = (xyz(2,j)-xyz(2,m))
+          zmj = (xyz(3,j)-xyz(3,m))
+          rmj2 = xmj**2+ymj**2+zmj**2
+          rmj = sqrt(rmj2)
+          r0mj = rav(mr,jr)
+          d0mj = dav(mr,jr)
+          amj = aav(mr,jr)
+
+          ! test if zero angle
+          test = xmi*xmj+ymi*ymj+zmi*zmj
+          test = test/(rmi*rmj)
+          if (abs(test-1.0_wp) .lt. 1.0e-12_wp) cycle bend_jAt
+
+          xij = (xyz(1,j)-xyz(1,i))
+          yij = (xyz(2,j)-xyz(2,i))
+          zij = (xyz(3,j)-xyz(3,i))
+          rij2 = xij**2+yij**2+zij**2
+          rrij = sqrt(rij2)
+
+          gmi = fk_lindh(ami,r0mi,rmi2) &
+                +0.5_wp*kd*fk_vdw(4.0_wp,d0mi,rmi2)
+          gmj = fk_lindh(amj,r0mj,rmj2) &
+                +0.5_wp*kd*fk_vdw(4.0_wp,d0mj,rmj2)
+
+          gij = kf*gmi*gmj
+
+          rl2 = (ymi*zmj-zmi*ymj)**2+(zmi*xmj-xmi*zmj)**2+(xmi*ymj-ymi*xmj)**2
+
+          if (rl2 .lt. 1.e-14_wp) then
+            rl = 0.0_wp
+          else
+            rl = sqrt(rl2)
+          end if
+
+          !gij = max(gij,min_fk)
+
+          if ((rmj .gt. rzero).and.(rmi .gt. rzero).and.(rrij .gt. rzero)) then
+            sinphi = rl/(rmj*rmi)
+            rmidotrmj = xmi*xmj+ymi*ymj+zmi*zmj
+            cosphi = rmidotrmj/(rmj*rmi)
+            ! none linear case
+            if (sinphi .gt. rzero) then
+              si(1) = (xmi/rmi*cosphi-xmj/rmj)/(rmi*sinphi)
+              si(2) = (ymi/rmi*cosphi-ymj/rmj)/(rmi*sinphi)
+              si(3) = (zmi/rmi*cosphi-zmj/rmj)/(rmi*sinphi)
+              sj(1) = (cosphi*xmj/rmj-xmi/rmi)/(rmj*sinphi)
+              sj(2) = (cosphi*ymj/rmj-ymi/rmi)/(rmj*sinphi)
+              sj(3) = (cosphi*zmj/rmj-zmi/rmi)/(rmj*sinphi)
+              sm(1) = -si(1)-sj(1)
+              sm(2) = -si(2)-sj(2)
+              sm(3) = -si(3)-sj(3)
+              do ic = 1,3
+                do jc = 1,3
+                  if (m .gt. i) then
+                    hess(ind(ic,m,jc,i)) = hess(ind(ic,m,jc,i)) &
+                                           +gij*sm(ic)*si(jc)
+                  else
+                    hess(ind(ic,i,jc,m)) = hess(ind(ic,i,jc,m)) &
+                                           +gij*si(ic)*sm(jc)
+                  end if
+                  if (m .gt. j) then
+                    hess(ind(ic,m,jc,j)) = hess(ind(ic,m,jc,j)) &
+                                           +gij*sm(ic)*sj(jc)
+                  else
+                    hess(ind(ic,j,jc,m)) = hess(ind(ic,j,jc,m)) &
+                                           +gij*sj(ic)*sm(jc)
+                  end if
+                  if (i .gt. j) then
+                    hess(ind(ic,i,jc,j)) = hess(ind(ic,i,jc,j)) &
+                                           +gij*si(ic)*sj(jc)
+                  else
+                    hess(ind(ic,j,jc,i)) = hess(ind(ic,j,jc,i)) &
+                                           +gij*sj(ic)*si(jc)
+                  end if
+                end do
+              end do
+              do ic = 1,3
+                do jc = 1,ic
+                  hess(ind(ic,i,jc,i)) = hess(ind(ic,i,jc,i))+gij*si(ic)*si(jc)
+                  hess(ind(ic,m,jc,m)) = hess(ind(ic,m,jc,m))+gij*sm(ic)*sm(jc)
+                  hess(ind(ic,j,jc,j)) = hess(ind(ic,j,jc,j))+gij*sj(ic)*sj(jc)
+                end do
+              end do
+            else
+              ! linear case
+              if ((abs(ymi) .gt. rzero).or.(abs(xmi) .gt. rzero)) then
+                x(1) = -ymi
+                y(1) = xmi
+                z(1) = 0.0_wp
+                x(2) = -xmi*zmi
+                y(2) = -ymi*zmi
+                z(2) = xmi*xmi+ymi*ymi
+              else
+                x(1) = 1.0_wp
+                y(1) = 0.0_wp
+                z(1) = 0.0_wp
+                x(2) = 0.0_wp
+                y(2) = 1.0_wp
+                z(2) = 0.0_wp
+              end if
+              do ii = 1,2
+                r1 = sqrt(x(ii)**2+y(ii)**2+z(ii)**2)
+                costhetax = x(ii)/r1
+                costhetay = y(ii)/r1
+                costhetaz = z(ii)/r1
+                si(1) = -costhetax/rmi
+                si(2) = -costhetay/rmi
+                si(3) = -costhetaz/rmi
+                sj(1) = -costhetax/rmj
+                sj(2) = -costhetay/rmj
+                sj(3) = -costhetaz/rmj
+                sm(1) = -(si(1)+sj(1))
+                sm(2) = -(si(2)+sj(2))
+                sm(3) = -(si(3)+sj(3))
+                !
+                do ic = 1,3
+                  do jc = 1,3
+                    if (m .gt. i) then
+                      hess(ind(ic,m,jc,i)) = hess(ind(ic,m,jc,i)) &
+                                             +gij*sm(ic)*si(jc)
+                    else
+                      hess(ind(ic,i,jc,m)) = hess(ind(ic,i,jc,m)) &
+                                             +gij*si(ic)*sm(jc)
+                    end if
+                    if (m .gt. j) then
+                      hess(ind(ic,m,jc,j)) = hess(ind(ic,m,jc,j)) &
+                                             +gij*sm(ic)*sj(jc)
+                    else
+                      hess(ind(ic,j,jc,m)) = hess(ind(ic,j,jc,m)) &
+                                             +gij*sj(ic)*sm(jc)
+                    end if
+                    if (i .gt. j) then
+                      hess(ind(ic,i,jc,j)) = hess(ind(ic,i,jc,j)) &
+                                             +gij*si(ic)*sj(jc)
+                    else
+                      hess(ind(ic,j,jc,i)) = hess(ind(ic,j,jc,i)) &
+                                             +gij*sj(ic)*si(jc)
+                    end if
+                  end do
+                end do
+                do ic = 1,3
+                  do jc = 1,ic
+                    hess(ind(ic,i,jc,i)) = hess(ind(ic,i,jc,i)) &
+                                           +gij*si(ic)*si(jc)
+                    hess(ind(ic,m,jc,m)) = hess(ind(ic,m,jc,m)) &
+                                           +gij*sm(ic)*sm(jc)
+                    hess(ind(ic,j,jc,j)) = hess(ind(ic,j,jc,j)) &
+                                           +gij*sj(ic)*sj(jc)
+                  end do
+                end do
+              end do
+
+            end if
+          end if
+
+        end do bend_jAt
+      end do bend_iAt
+    end do bend_mAt
+
+  end subroutine mh_lindh_bend
+
+  subroutine mh_lindh_torsion(n,at,xyz,hess,kt,kd,aav,rav,dav,lcutoff)
+    implicit none
+
+    integer,intent(in)    :: n
+    integer,intent(in)    :: at(n)
+    real(wp),intent(in)    :: xyz(3,n)
+    real(wp),intent(inout) :: hess((3*n)*(3*n+1)/2)
+    real(wp),intent(in)    :: kt
+    real(wp),intent(in)    :: kd
+    real(wp),intent(in)    :: aav(3,3)
+    real(wp),intent(in)    :: rav(3,3)
+    real(wp),intent(in)    :: dav(3,3)
+    logical,intent(in)    :: lcutoff(n,n)
+
+    integer  :: i,ir,j,jr,k,kr,l,lr,ic,jc,ij,kl
+!  allow only angles in the range of 35-145
+    real(wp),parameter :: a35 = (35.0d0/180.d0)*pi
+    real(wp),parameter :: cosfi_max = cos(a35)
+    real(wp) :: txyz(3,4),c(3,4)
+    real(wp) :: rij(3),rij0,aij,rij2,d0ij,gij
+    real(wp) :: rjk(3),rjk0,ajk,rjk2,d0jk,gjk
+    real(wp) :: rkl(3),rkl0,akl,rkl2,d0kl,gkl
+    real(wp) :: cosfi2,cosfi3,cosfi4
+    real(wp) :: beta,tij,tau,dum(3,4,3,4)
+    real(wp) :: si(3),sj(3),sk(3),sl(3)
+
+!! ------------------------------------------------------------------------
+!  Hessian for torsion
+!! ------------------------------------------------------------------------
+    torsion_jAt: do j = 1,n
+      jr = itabrow(at(j))
+      txyz(:,2) = xyz(:,j)
+      torsion_kAt: do k = 1,n
+        if (k .eq. j) cycle torsion_kAt
+        kr = itabrow(at(k))
+        if (lcutoff(k,j)) cycle torsion_kAt
+        txyz(:,3) = xyz(:,k)
+        torsion_iAt: do i = 1,n
+          ij = n*(j-1)+i
+          if (i .eq. j) cycle torsion_iAt
+          if (i .eq. k) cycle torsion_iAt
+          ir = itabrow(at(i))
+          if (lcutoff(i,k)) cycle torsion_iAt
+          if (lcutoff(i,j)) cycle torsion_iAt
+
+          txyz(:,1) = xyz(:,i)
+          torsion_lAt: do l = 1,n
+            kl = n*(k-1)+l
+            if (ij .le. kl) cycle torsion_lAt
+            if (l .eq. i) cycle torsion_lAt
+            if (l .eq. j) cycle torsion_lAt
+            if (l .eq. k) cycle torsion_lAt
+            lr = itabrow(at(l))
+!
+            if (lcutoff(l,i)) cycle torsion_lAt
+            if (lcutoff(l,k)) cycle torsion_lAt
+            if (lcutoff(l,j)) cycle torsion_lAt
+
+            txyz(:,4) = xyz(:,l)
+
+            rij = xyz(:,i)-xyz(:,j)
+            d0ij = dav(ir,jr)
+            rij0 = rav(ir,jr)
+            aij = aav(ir,jr)
+
+            rjk = xyz(:,j)-xyz(:,k)
+            d0jk = dav(jr,kr)
+            rjk0 = rav(jr,kr)
+            ajk = aav(jr,kr)
+
+            rkl = xyz(:,k)-xyz(:,l)
+            d0kl = dav(kr,lr)
+            rkl0 = rav(kr,lr)
+            akl = aav(kr,lr)
+
+            rij2 = sum(rij**2)
+            rjk2 = sum(rjk**2)
+            rkl2 = sum(rjk**2)
+
+            cosfi2 = dot_product(rij,rjk)/sqrt(rij2*rjk2)
+            if (abs(cosfi2) .gt. cosfi_max) cycle
+            cosfi3 = dot_product(rkl,rjk)/sqrt(rkl2*rjk2)
+            if (abs(cosfi3) .gt. cosfi_max) cycle
+
+            gij = fk_lindh(aij,rij0,rij2) &
+                  +0.5_wp*kd*fk_vdw(4.0_wp,d0ij,rij2)
+            gjk = fk_lindh(ajk,rjk0,rjk2) &
+                  +0.5_wp*kd*fk_vdw(4.0_wp,d0jk,rjk2)
+            gkl = fk_lindh(akl,rkl0,rkl2) &
+                  +0.5_wp*kd*fk_vdw(4.0_wp,d0kl,rkl2)
+
+            tij = kt*gij*gjk*gkl
+
+            !tij = max(tij,10*min_fk)
+
+            !call trsn2(txyz,tau,c)
+            Call Trsn(txyz,4,Tau,C,.False.,.False.,'        ', &
+   &                  Dum,.False.)
+            si = c(:,1)
+            sj = c(:,2)
+            sk = c(:,3)
+            sl = c(:,4)
+
+            ! off diagonal block
+            do ic = 1,3
+              do jc = 1,3
+                hess(ind(ic,i,jc,j)) = hess(ind(ic,i,jc,j))+tij*si(ic)*sj(jc)
+                hess(ind(ic,i,jc,k)) = hess(ind(ic,i,jc,k))+tij*si(ic)*sk(jc)
+                hess(ind(ic,i,jc,l)) = hess(ind(ic,i,jc,l))+tij*si(ic)*sl(jc)
+                hess(ind(ic,j,jc,k)) = hess(ind(ic,j,jc,k))+tij*sj(ic)*sk(jc)
+                hess(ind(ic,j,jc,l)) = hess(ind(ic,j,jc,l))+tij*sj(ic)*sl(jc)
+                hess(ind(ic,k,jc,l)) = hess(ind(ic,k,jc,l))+tij*sk(ic)*sl(jc)
+              end do
+            end do
+
+            ! diagonal block
+            do ic = 1,3
+              do jc = 1,ic
+                hess(ind(ic,i,jc,i)) = hess(ind(ic,i,jc,i))+tij*si(ic)*si(jc)
+                hess(ind(ic,j,jc,j)) = hess(ind(ic,j,jc,j))+tij*sj(ic)*sj(jc)
+                hess(ind(ic,k,jc,k)) = hess(ind(ic,k,jc,k))+tij*sk(ic)*sk(jc)
+                hess(ind(ic,l,jc,l)) = hess(ind(ic,l,jc,l))+tij*sl(ic)*sl(jc)
+              end do
+            end do
+
+          end do torsion_lAt
+        end do torsion_iAt
+      end do torsion_kAt
+    end do torsion_jAt
+
+  end subroutine mh_lindh_torsion
+
+  pure subroutine mh_lindh_outofp(n,at,xyz,hess,ko,kd,aav,rav,dav,lcutoff)
+    implicit none
+
+    integer,intent(in)    :: n
+    integer,intent(in)    :: at(n)
+    real(wp),intent(in)    :: xyz(3,n)
+    real(wp),intent(inout) :: hess((3*n)*(3*n+1)/2)
+    real(wp),intent(in)    :: ko
+    real(wp),intent(in)    :: kd
+    real(wp),intent(in)    :: aav(3,3)
+    real(wp),intent(in)    :: rav(3,3)
+    real(wp),intent(in)    :: dav(3,3)
+    logical,intent(in)    :: lcutoff(n,n)
+
+    integer  :: i,ir,j,jr,k,kr,l,lr,ic,jc
+    real(wp) :: txyz(3,4),c(3,4)
+    real(wp) :: rij(3),rij0,aij,rij2,gij,d0ij
+    real(wp) :: rik(3),rik0,aik,rik2,gik,d0ik
+    real(wp) :: ril(3),ril0,ail,ril2,gil,d0il
+    real(wp) :: cosfi2,cosfi3,cosfi4
+    real(wp) :: beta,tij,tau
+    real(wp) :: si(3),sj(3),sk(3),sl(3)
+
+!! ------------------------------------------------------------------------
+!  Hessian for out-of-plane
+!! ------------------------------------------------------------------------
+    outofplane_iAt: do i = 1,n
+      ir = itabrow(at(i))
+      txyz(:,4) = xyz(:,i)
+      outofplane_jAt: do j = 1,n
+        if (j .eq. i) cycle outofplane_jAt
+        if (lcutoff(j,i)) cycle outofplane_jAt
+        jr = itabrow(at(j))
+        txyz(:,1) = xyz(:,j)
+        outofplane_kAt: do k = 1,n
+          if (i .eq. k) cycle outofplane_kAt
+          if (j .eq. k) cycle outofplane_kat
+          if (lcutoff(k,i)) cycle outofplane_kAt
+          if (lcutoff(k,j)) cycle outofplane_kAt
+          kr = itabrow(at(k))
+          txyz(:,2) = xyz(:,k)
+          outofplane_lAt: do l = 1,n
+            lr = itabrow(at(l))
+            txyz(:,3) = xyz(:,l)
+            if (l .eq. i) cycle outofplane_lAt
+            if (l .eq. j) cycle outofplane_lAt
+            if (l .eq. k) cycle outofplane_lAt
+            if (lcutoff(l,i)) cycle outofplane_lAt
+            if (lcutoff(l,k)) cycle outofplane_lAt
+            if (lcutoff(l,j)) cycle outofplane_lAt
+
+            rij = xyz(:,i)-xyz(:,j)
+            d0ij = dav(ir,jr)
+            rij0 = rav(ir,jr)
+            aij = aav(ir,jr)
+
+            rik = xyz(:,i)-xyz(:,k)
+            d0ik = dav(ir,kr)
+            rik0 = rav(ir,kr)
+            aik = aav(ir,kr)
+
+            ril = xyz(:,i)-xyz(:,l)
+            d0il = dav(ir,lr)
+            ril0 = rav(ir,lr)
+            ail = aav(ir,lr)
+
+            rij2 = sum(rij**2)
+            rik2 = sum(rik**2)
+            ril2 = sum(ril**2)
+
+            cosfi2 = dot_product(rij,rik)/sqrt(rij2*rik2)
+            if (abs(abs(cosfi2)-1.0_wp) .lt. 1.0e-1_wp) cycle
+            cosfi3 = dot_product(rij,ril)/sqrt(rij2*ril2)
+            if (abs(abs(cosfi3)-1.0_wp) .lt. 1.0e-1_wp) cycle
+            cosfi4 = dot_product(rik,ril)/sqrt(rik2*ril2)
+            if (abs(abs(cosfi4)-1.0_wp) .lt. 1.0e-1_wp) cycle
+
+            gij = fk_lindh(aij,rij0,rij2) &
+                  +0.5_wp*kd*fk_vdw(4.0_wp,d0ij,rij2)
+            gik = fk_lindh(aik,rik0,rik2) &
+                  +0.5_wp*kd*fk_vdw(4.0_wp,d0ik,rik2)
+            gil = fk_lindh(ail,ril0,ril2) &
+                  +0.5_wp*kd*fk_vdw(4.0_wp,d0il,ril2)
+
+            tij = ko*gij*gik*gil
+
+            !tij = max(tij,10*min_fk)
+
+            call outofp2(xyz,tau,c)
+            If (abs(tau) .gt. 45.0d0*(pi/180.d0)) cycle
+
+            si = c(:,4)
+            sj = c(:,1)
+            sk = c(:,2)
+            sl = c(:,3)
+
+            ! off diagonal block
+            do ic = 1,3
+              do jc = 1,3
+                hess(ind(ic,i,jc,j)) = hess(ind(ic,i,jc,j))+tij*si(ic)*sj(jc)
+                hess(ind(ic,i,jc,k)) = hess(ind(ic,i,jc,k))+tij*si(ic)*sk(jc)
+                hess(ind(ic,i,jc,l)) = hess(ind(ic,i,jc,l))+tij*si(ic)*sl(jc)
+                hess(ind(ic,j,jc,k)) = hess(ind(ic,j,jc,k))+tij*sj(ic)*sk(jc)
+                hess(ind(ic,j,jc,l)) = hess(ind(ic,j,jc,l))+tij*sj(ic)*sl(jc)
+                hess(ind(ic,k,jc,l)) = hess(ind(ic,k,jc,l))+tij*sk(ic)*sl(jc)
+              end do
+            end do
+
+            ! diagonal block
+            do ic = 1,3
+              do jc = 1,ic
+                hess(ind(ic,i,jc,i)) = hess(ind(ic,i,jc,i))+tij*si(ic)*si(jc)
+                hess(ind(ic,j,jc,j)) = hess(ind(ic,j,jc,j))+tij*sj(ic)*sj(jc)
+                hess(ind(ic,k,jc,k)) = hess(ind(ic,k,jc,k))+tij*sk(ic)*sk(jc)
+                hess(ind(ic,l,jc,l)) = hess(ind(ic,l,jc,l))+tij*sl(ic)*sl(jc)
+              end do
+            end do
+
+          end do outofplane_lAt
+        end do outofplane_kAt
+      end do outofplane_jAt
+    end do outofplane_iAt
+
+  end subroutine mh_lindh_outofp
+
+!========================================================================================!
+!########################################################################################!
+!========================================================================================!
+
+  pure function rcutoff(xyz,katom,latom,rcut)
+    implicit none
+    logical  :: rcutoff
+    real(wp),intent(in) :: xyz(3,*)
+    real(wp),intent(in) :: rcut
+    real(wp) :: rkl(3),rkl2
+    integer,intent(in) :: katom,latom
+    rcutoff = .false.
+    rkl = xyz(:,kAtom)-xyz(:,lAtom)
+    rkl2 = sum(rkl**2)
+    if (rkl2 .gt. rcut) rcutoff = .true.
+  end function rcutoff
+
+  pure elemental function itabrow(i)
+    integer :: itabrow
+    integer,intent(in) :: i
+
+    itabrow = 0
+    if (i .gt. 0.and.i .le. 2) then
+      itabrow = 1
+    else if (i .gt. 2.and.i .le. 10) then
+      itabrow = 2
+    else if (i .gt. 10.and.i .le. 18) then
+      itabrow = 3
+    else if (i .gt. 18.and.i .le. 36) then
+      itabrow = 3
+    else if (i .gt. 36.and.i .le. 54) then
+      itabrow = 3
+    else if (i .gt. 54.and.i .le. 86) then
+      itabrow = 3
+    else if (i .gt. 86) then
+      itabrow = 3
+    end if
+
+    return
+  end function itabrow
+
+  pure subroutine getvdwxy(rx,ry,rz,c66,s6,r0,vdw)
+    !cc Ableitung nach rx und ry
+    implicit none
+    real(wp),intent(in)  :: rx,ry,rz,c66,s6,r0
+    real(wp),intent(out) :: vdw
+    real(wp) :: t1,t2,t3,t4,t5,t6,t7,t11,t12,t16,t17,t25,t26,t35
+    real(wp) :: t40,t41,t43,t44,t56,avdw
+
+    !    write(*,*) 's6:', s6
+    avdw = 20.0
+    t1 = s6*C66
+    t2 = rx**2
+    t3 = ry**2
+    t4 = rz**2
+    t5 = t2+t3+t4
+    t6 = t5**2
+    t7 = t6**2
+    t11 = sqrt(t5)
+    t12 = 0.1D1/r0
+    t16 = exp(-avdw*(t11*t12-0.1D1))
+    t17 = 0.1D1+t16
+    t25 = t17**2
+    t26 = 0.1D1/t25
+    t35 = 0.1D1/t7
+    t40 = avdw**2
+    t41 = r0**2
+    t43 = t40/t41
+    t44 = t16**2
+    t56 = -0.48D2*t1/t7/t5/t17*rx*ry+0.13D2*t1/t11/&
+       & t7*t26*rx*avdw*t12*ry*t16-0.2D1*t1*t35/t25/&
+       &t17*t43*rx*t44*ry+t1*t35*t26*t43*rx*ry*t16
+    vdw = t56
+    return
+  end subroutine getvdwxy
+
+  pure subroutine getvdwxx(rx,ry,rz,c66,s6,r0,vdw)
+    !cc Ableitung nach rx und rx
+    Implicit none
+    real(wp),intent(in)  :: rx,ry,rz,c66,s6,r0
+    real(wp),intent(out) :: vdw
+    real(wp) :: t1,t2,t3,t4,t5,t6,t7,t10,t11,t15,t16,t17,t24,t25,t29
+    real(wp) :: t33,t41,t42,t44,t45,t62,avdw
+    avdw = 20.0
+    !      write(*,*) 's6:', s6
+    t1 = s6*C66
+    t2 = rx**2
+    t3 = ry**2
+    t4 = rz**2
+    t5 = t2+t3+t4
+    t6 = t5**2
+    t7 = t6**2
+    t10 = sqrt(t5)
+    t11 = 0.1D1/r0
+    t15 = exp(-avdw*(t10*t11-0.1D1))
+    t16 = 0.1D1+t15
+    t17 = 0.1D1/t16
+    t24 = t16**2
+    t25 = 0.1D1/t24
+    t29 = t11*t15
+    t33 = 0.1D1/t7
+    t41 = avdw**2
+    t42 = r0**2
+    t44 = t41/t42
+    t45 = t15**2
+    t62 = -0.48D2*t1/t7/t5*t17*t2+0.13D2*t1/t10/t7*&
+       & t25*t2*avdw*t29+0.6D1*t1*t33*t17-0.2D1*t1*t33&
+       & /t24/t16*t44*t2*t45-t1/t10/t6/t5*t25*avdw*&
+       &t29+t1*t33*t25*t44*t2*t15
+    vdw = t62
+  end subroutine getvdwxx
+
+  pure subroutine trsn2(xyz,tau,bt)
+    implicit none
+    real(wp),intent(out) :: bt(3,4)
+    real(wp),intent(out) :: tau
+    real(wp),intent(in)  :: xyz(3,4)
+    real(wp) :: rij(3),rij1,brij(3,2)
+    real(wp) :: rjk(3),rjk1,brjk(3,2)
+    real(wp) :: rkl(3),rkl1,brkl(3,2)
+    real(wp) :: bf2(3,3),fi2,sinfi2,cosfi2
+    real(wp) :: bf3(3,3),fi3,sinfi3,cosfi3
+    real(wp) :: costau,sintau
+    integer  :: ix,iy,iz
+    call strtch2(xyz(1,1),rij1,brij)
+    call strtch2(xyz(1,2),rjk1,brjk)
+    call strtch2(xyz(1,3),rkl1,brkl)
+    call bend2(xyz(1,1),fi2,bf2)
+    sinfi2 = sin(fi2)
+    cosfi2 = cos(fi2)
+    call bend2(xyz(1,2),fi3,bf3)
+    sinfi3 = sin(fi3)
+    cosfi3 = cos(fi3)
+    costau = ((brij(2,1)*brjk(3,2)-brij(3,1)*brjk(2,2))* &
+              (brjk(2,1)*brkl(3,2)-brjk(3,1)*brkl(2,2))+ &
+              (brij(3,1)*brjk(1,2)-brij(1,1)*brjk(3,2))* &
+              (brjk(3,1)*brkl(1,2)-brjk(1,1)*brkl(3,2))+ &
+              (brij(1,1)*brjk(2,2)-brij(2,1)*brjk(1,2))* &
+              (brjk(1,1)*brkl(2,2)-brjk(2,1)*brkl(1,2))) &
+             /(sinfi2*sinfi3)
+    sintau = (brij(1,2)*(brjk(2,1)*brkl(3,2)-brjk(3,1)*brkl(2,2)) &
+              +brij(2,2)*(brjk(3,1)*brkl(1,2)-brjk(1,1)*brkl(3,2)) &
+              +brij(3,2)*(brjk(1,1)*brkl(2,2)-brjk(2,1)*brkl(1,2))) &
+             /(sinfi2*sinfi3)
+    tau = atan2(sintau,costau)
+    if (abs(tau) .eq. pi) tau = pi
+    do ix = 1,3
+      iy = ix+1
+      if (iy .gt. 3) iy = iy-3
+      iz = iy+1
+      if (iz .gt. 3) iz = iz-3
+      bt(ix,1) = (brij(iy,2)*brjk(iz,2)-brij(iz,2)*brjk(iy,2)) &
+         &           /(rij1*sinfi2**2)
+      bt(ix,4) = (brkl(iy,1)*brjk(iz,1)-brkl(iz,1)*brjk(iy,1)) &
+         &           /(rkl1*sinfi3**2)
+      bt(ix,2) = -((rjk1-rij1*cosfi2)*bt(ix,1) &
+         &             +rkl1*cosfi3*bt(ix,4))/rjk1
+      bt(ix,3) = -(bt(ix,1)+bt(ix,2)+bt(ix,4))
+    end do
+  end subroutine trsn2
+  pure subroutine strtch2(xyz,avst,b)
+    implicit none
+    real(wp),intent(out) :: b(3,2)
+    real(wp),intent(in)  :: xyz(3,2)
+    real(wp) :: r(3)
+    real(wp) :: rr
+    real(wp),intent(out) :: avst
+    r = xyz(:,2)-xyz(:,1)
+    rr = norm2(r)
+    avst = rr
+    b(:,1) = -r/rr
+    b(:,2) = -b(:,1)
+  end subroutine strtch2
+  pure subroutine bend2(xyz,fir,bf)
+    implicit none
+    real(wp),intent(out) :: bf(3,3)
+    real(wp),intent(in)  :: xyz(3,3)
+    real(wp) :: brij(3,2)
+    real(wp) :: brjk(3,2)
+    real(wp) :: co,crap
+    real(wp),intent(out) :: fir
+    real(wp) :: si
+    real(wp) :: rij1,rjk1
+    integer  :: i
+    call strtch2(xyz(1,1),rij1,brij)
+    call strtch2(xyz(1,2),rjk1,brjk)
+    co = 0.0_wp
+    crap = 0.0_wp
+    do i = 1,3
+      co = co+brij(i,1)*brjk(i,2)
+      crap = crap+(brjk(i,2)+brij(i,1))**2
+    end do
+    if (sqrt(crap) .lt. 1.0d-6) then
+      fir = pi-asin(sqrt(crap))
+      si = sqrt(crap)
+    else
+      fir = acos(co)
+      si = sqrt(1.0_wp-co**2)
+    end if
+    if (abs(fir-pi) .lt. 1.0d-13) then
+      fir = pi
+      return
+    end if
+    do i = 1,3
+      bf(i,1) = (co*brij(i,1)-brjk(i,2))/(si*rij1)
+      bf(i,3) = (co*brjk(i,2)-brij(i,1))/(si*rjk1)
+      bf(i,2) = -(bf(i,1)+bf(i,3))
+    end do
+  end subroutine bend2
+
+  pure subroutine outofp2(xyz,teta,bt)
+    implicit none
+    real(wp),intent(out) :: teta
+    real(wp),intent(out) :: bt(3,4)
+    real(wp),intent(in)  :: xyz(3,4)
+    real(wp) :: r1(3),r2(3),r3(3)
+    real(wp) :: q41,q42,q43,e41(3),e42(3),e43(3)
+    real(wp) :: cosfi1,fi1,dfi1,cosfi2,fi2,dfi2,cosfi3,fi3,dfi3
+    real(wp) :: c14(3,3),br14(3,3)
+    real(wp) :: r42(3),r43(3)
+    integer  :: ix,iy,iz
+!  4 -> 1 (bond)
+    r1 = xyz(:,1)-xyz(:,4)
+    q41 = norm2(r1)
+    e41 = r1/q41
+!  4 -> 2 (bond in plane)
+    r2 = xyz(:,2)-xyz(:,4)
+    q42 = norm2(r2)
+    e42 = r2/q42
+!  4 -> 3 (bond in plane)
+    r3 = xyz(:,3)-xyz(:,4)
+    q43 = norm2(r3)
+    e43 = r3/q43
+!
+!  get the angle between e43 and e42
+!
+    cosfi1 = dot_product(e43,e42)
+
+    fi1 = acos(cosfi1)
+    dfi1 = 180.d0*fi1/pi
+!
+!  dirty exit! this happens when an earlier structure is ill defined.
+!
+    if (abs(fi1-pi) .lt. 1.0d-13) then
+      teta = 0.0_wp
+      bt = 0.0_wp
+      return
+    end if
+!
+!  get the angle between e41 and e43
+!
+    cosfi2 = dot_product(e41,e43)
+
+    fi2 = acos(cosfi2)
+    dfi2 = 180.d0*fi2/pi
+!
+!  get the angle between e41 and e42
+!
+    cosfi3 = dot_product(e41,e42)
+
+    fi3 = acos(cosfi3)
+    dfi3 = 180.d0*fi3/pi
+!
+!  the first two centers are trivially
+!
+    c14(:,1) = xyz(:,1)
+    c14(:,2) = xyz(:,4)
+!
+!  the 3rd is
+!
+    r42 = xyz(:,2)-xyz(:,4)
+    r43 = xyz(:,3)-xyz(:,4)
+    c14(1,3) = r42(2)*r43(3)-r42(3)*r43(2)
+    c14(2,3) = r42(3)*r43(1)-r42(1)*r43(3)
+    c14(3,3) = r42(1)*r43(2)-r42(2)*r43(1)
+!
+!  exit if 2-3-4 are collinear
+!  (equivalent to the above check, but this is more concrete)
+!
+    if ((c14(1,3)**2+c14(2,3)**2+c14(3,3)**2) .lt. 1.0d-10) then
+      teta = 0.0d0
+      bt = 0.0_wp
+      return
+    end if
+    c14(1,3) = c14(1,3)+xyz(1,4)
+    c14(2,3) = c14(2,3)+xyz(2,4)
+    c14(3,3) = c14(3,3)+xyz(3,4)
+
+    call bend2(c14,teta,br14)
+
+    teta = teta-0.5_wp*pi
+!
+!--compute the wdc matrix
+!
+    do ix = 1,3
+      iy = mod(ix+1,4)+(ix+1)/4
+      iz = mod(iy+1,4)+(iy+1)/4
+
+      bt(ix,1) = -br14(ix,1)
+      bt(ix,2) = r43(iz)*br14(iy,3)-r43(iy)*br14(iz,3)
+      bt(ix,3) = -r42(iz)*br14(iy,3)+r42(iy)*br14(iz,3)
+
+      bt(ix,4) = -(bt(ix,1)+bt(ix,2)+bt(ix,3))
+
+    end do
+
+    bt = -bt
+  end subroutine outofp2
+
+  Subroutine Trsn(xyz,nCent,Tau,Bt,lWrite,lWarn,Label,dBt,ldB)
+!************************************************************************
+!*                                                                      *
+!* Reference: Molecular Vibrations, E. Bright Wilson, Jr, J. C. Decicius*
+!*             nd Paul C. Cross, Sec. 4-1, Eq. 20-24                    *
+!*                                                                      *
+!* R.Lindh May-June '96                                                 *
+!************************************************************************
+    Implicit Real(wp) (a-h,o-z)
+
+    integer :: nCent,mCent,i,j,ix,iy,iz,jx,jy,jz
+    Real(wp) Bt(3,nCent),xyz(3,nCent),Rij(3),Eij(3),Rjk(3),Ejk(3),&
+       &       Rkl(3),Ekl(3),Rijk(3),Eijk(3),dBt(3,nCent,3,nCent),&
+       &       BRij(3,2),dBRij(3,2,3,2),BRjk(3,2),dBRjk(3,2,3,2),&
+       &       BRkl(3,2),dBRkl(3,2,3,2),Bf2(3,3),dum(3,4,3,4),&
+       &       Bf3(3,3)
+    Logical :: lWrite,lWarn,ldB
+    Character(len=8) :: Label
+    !
+    !     Call qEnter('Trsn')
+    mCent = 2
+    Call Strtch(xyz(1,1),mCent,Rij1,BRij,.False.,Label,dBRij,ldB)
+    Call Strtch(xyz(1,2),mCent,Rjk1,BRjk,.False.,Label,dBRjk,ldB)
+    Call Strtch(xyz(1,3),mCent,Rkl1,BRkl,.False.,Label,dBRkl,ldB)
+    mCent = 3
+    Call Bend(xyz(1,1),mCent,Fi2,Bf2,.False.,.False.,Label,Dum,&
+       &          .False.)
+    SinFi2 = Sin(Fi2)
+    CosFi2 = Cos(Fi2)
+    Call Bend(xyz(1,2),mCent,Fi3,Bf3,.False.,.False.,Label,Dum,&
+       &          .False.)
+    SinFi3 = Sin(Fi3)
+    CosFi3 = Cos(Fi3)
+    !
+    !     Get the angle between the two planes, i.e. the
+    !     angle between the normal vectors.
+    !
+    !     r123 * r234 = CosTau
+    !
+    CosTau = ((BRij(2,1)*BRjk(3,2)-BRij(3,1)*BRjk(2,2))*&
+       &           (BRjk(2,1)*BRkl(3,2)-BRjk(3,1)*BRkl(2,2))+&
+       &           (BRij(3,1)*BRjk(1,2)-BRij(1,1)*BRjk(3,2))*&
+       &           (BRjk(3,1)*BRkl(1,2)-BRjk(1,1)*BRkl(3,2))+&
+       &           (BRij(1,1)*BRjk(2,2)-BRij(2,1)*BRjk(1,2))*&
+       &           (BRjk(1,1)*BRkl(2,2)-BRjk(2,1)*BRkl(1,2)))&
+       &         /(SinFi2*SinFi3)
+    !
+    !     For the vector product of the two vectors. This
+    !     will give a vector parallell to e23. The direction
+    !     relative to e23 defines the sign.
+    !
+    !     e123 X e234 = SinTau * e23
+    !
+    SinTau = (BRij(1,2)*(BRjk(2,1)*BRkl(3,2)-BRjk(3,1)*BRkl(2,2))&
+       &         +BRij(2,2)*(BRjk(3,1)*BRkl(1,2)-BRjk(1,1)*BRkl(3,2))&
+       &         +BRij(3,2)*(BRjk(1,1)*BRkl(2,2)-BRjk(2,1)*BRkl(1,2)))&
+       &         /(SinFi2*SinFi3)
+    !
+    !     (-Pi < Tau <= Pi)
+    !
+    Tau = ATan2(SinTau,CosTau)
+    If (Abs(Tau) .eq. Pi) Tau = Pi
+    !
+    dTau = 180.0D+00*Tau/Pi
+    dFi2 = 180.0D+00*Fi2/Pi
+    dFi3 = 180.0D+00*Fi3/Pi
+    If (lWarn) Then
+      If (dTau .gt. 177.5.or.dTau .lt. -177.5) Then
+        Write (*,*) ' Warning: dihedral angle close to'&
+           &         //' end of range'
+      End If
+      If (dFi2 .gt. 177.5.or.dFi2 .lt. 2.5) Then
+        Write (*,*) ' Warning: bond angle close to'&
+           &         //' end of range'
+      End If
+      If (dFi3 .gt. 177.5.or.dFi3 .lt. 2.5) Then
+        Write (*,*) ' Warning: bond angle close to'&
+           &         //' end of range'
+      End If
+    End If
+    If (LWRITE) Write (*,1) Label,dTau,Tau
+1   FORMAT(1X,A,' : Dihedral Angle=',F10.4,&
+                                                 & '/degree,',F10.4,'/rad')
+    !
+    !---- Compute the WDC matrix.
+    !
+    Do ix = 1,3
+      iy = ix+1
+      If (iy .gt. 3) iy = iy-3
+      iz = iy+1
+      If (iz .gt. 3) iz = iz-3
+      Bt(ix,1) = (BRij(iy,2)*BRjk(iz,2)-BRij(iz,2)*BRjk(iy,2))&
+         &           /(Rij1*SinFi2**2)
+      Bt(ix,4) = (BRkl(iy,1)*BRjk(iz,1)-BRkl(iz,1)*BRjk(iy,1))&
+         &           /(Rkl1*SinFi3**2)
+      Bt(ix,2) = -((Rjk1-Rij1*CosFi2)*Bt(ix,1)&
+         &             +Rkl1*CosFi3*Bt(ix,4))/Rjk1
+      Bt(ix,3) = -(Bt(ix,1)+Bt(ix,2)+Bt(ix,4))
+    End Do
+    !
+    If (ldB) Then
+      !
+      !------- Compute the derivative of the WDC matrix.
+      !
+      Do ix = 1,3
+        iy = ix+1
+        If (iy .gt. 3) iy = iy-3
+        iz = iy+1
+        If (iz .gt. 3) iz = iz-3
+        Do jx = 1,ix
+          jy = jx+1
+          If (jy .gt. 3) jy = jy-3
+          jz = jy+1
+          If (jz .gt. 3) jz = jz-3
+          !
+          dBt(ix,1,jx,1) = (dBRij(ix,1,jy,2)*BRjk(jz,2)&
+             &                       -dBRij(ix,1,jz,2)*BRjk(jy,2)&
+             &                       -Bt(jx,1)*(BRij(ix,1)*SinFi2**2&
+             &                       +Rij1*Two*SinFi2*CosFi2*Bf2(ix,1)))&
+             &                       /(Rij1*SinFi2**2)
+          dBt(ix,1,jx,2) = -((-BRij(ix,1)*CosFi2&
+             &                         +Rij1*SinFi2*Bf2(ix,1))*Bt(jx,1)&
+             &                         +(Rjk1-Rij1*CosFi2)*dBt(ix,1,jx,1))&
+             &                       /Rjk1
+          dBt(jx,2,ix,1) = dBt(ix,1,jx,2)
+          dBt(ix,1,jx,4) = Zero
+          dBt(jx,4,ix,1) = dBt(ix,1,jx,4)
+          dBt(ix,1,jx,3) = -(dBt(ix,1,jx,1)+dBt(ix,1,jx,2))
+          dBt(jx,3,ix,1) = dBt(ix,1,jx,3)
+          dBt(ix,4,jx,4) = (dBRkl(ix,2,jy,1)*BRjk(jz,1)&
+             &                       -dBRkl(ix,2,jz,1)*BRjk(jy,1)&
+             &                       -Bt(jx,4)*(BRkl(ix,2)*SinFi3**2&
+             &                       +Rkl1*Two*SinFi3*CosFi3*Bf3(ix,3)))&
+             &                       /(Rkl1*SinFi3**2)
+          dBt(ix,4,jx,3) = -((-BRkl(ix,2)*CosFi3&
+             &                         +Rkl1*SinFi3*Bf3(ix,3))*Bt(jx,4)&
+             &                         +(Rjk1-Rkl1*CosFi3)*dBt(ix,4,jx,4))&
+             &                       /Rjk1
+          dBt(jx,3,ix,4) = dBt(ix,4,jx,3)
+          dBt(ix,4,jx,2) = -(dBt(ix,4,jx,4)+dBt(ix,4,jx,3))
+          dBt(jx,2,ix,4) = dBt(ix,4,jx,2)
+          If (ix .ne. jx) Then
+            dBt(jx,1,ix,1) = dBt(ix,1,jx,1)
+            dBt(ix,4,jx,1) = Zero
+            dBt(jx,4,ix,4) = dBt(ix,4,jx,4)
+            dBt(jx,1,ix,4) = dBt(ix,4,jx,1)
+            dBt(jx,1,ix,2) = -((-BRij(jx,1)*CosFi2&
+               &                            +Rij1*SinFi2*Bf2(jx,1))*Bt(ix,1)&
+               &                            +(Rjk1-Rij1*CosFi2)*dBt(jx,1,ix,1))&
+               &                          /Rjk1
+            dBt(ix,2,jx,1) = dBt(jx,1,ix,2)
+            dBt(ix,3,jx,1) = -(dBt(ix,1,jx,1)+dBt(ix,2,jx,1)&
+               &                          +dBt(ix,4,jx,1))
+            dBt(jx,1,ix,3) = dBt(ix,3,jx,1)
+            dBt(jx,4,ix,3) = -((-BRkl(jx,2)*CosFi3&
+               &                            +Rkl1*SinFi3*Bf3(jx,3))*Bt(ix,4)&
+               &                            +(Rjk1-Rkl1*CosFi3)*dBt(jx,4,ix,4))&
+               &                          /Rjk1
+            dBt(ix,3,jx,4) = dBt(jx,4,ix,3)
+            dBt(ix,2,jx,4) = -(dBt(ix,4,jx,4)+dBt(ix,3,jx,4))
+            dBt(jx,4,ix,2) = dBt(ix,2,jx,4)
+          End If
+          dBt(ix,2,jx,3) = -((BRjk(ix,1)&
+             &                           +Rkl1*SinFi3*Bf3(ix,1))*Bt(jx,4)&
+             &                         +(Rjk1-Rkl1*CosFi3)*dBt(ix,2,jx,4)&
+             &                         +(BRij(ix,2)*CosFi2&
+             &                           -Rij1*SinFi2*Bf2(ix,2))*Bt(jx,1)&
+             &                         +Rij1*CosFi2*dBt(ix,2,jx,1)&
+             &                         +Bt(jx,3)*BRjk(ix,1))/Rjk1
+          dBt(jx,3,ix,2) = dBt(ix,2,jx,3)
+          dBt(ix,2,jx,2) = -(dBt(ix,2,jx,1)+dBt(ix,2,jx,4)&
+             &                         +dBt(ix,2,jx,3))
+          dBt(ix,3,jx,3) = -(dBt(ix,2,jx,3)+dBt(ix,1,jx,3)&
+             &                         +dBt(ix,4,jx,3))
+          If (ix .ne. jx) Then
+            dBt(ix,3,jx,2) = -(dBt(ix,2,jx,2)+dBt(ix,1,jx,2)&
+               &                            +dBt(ix,4,jx,2))
+            dBt(jx,2,ix,3) = dBt(ix,3,jx,2)
+            dBt(jx,2,ix,2) = dBt(ix,2,jx,2)
+            dBt(jx,3,ix,3) = dBt(ix,3,jx,3)
+          End If
+          !
+        End Do
+      End Do
+      !
+    End If
+    !     Call qExit('Trsn')
+    Return
+  contains
+    Subroutine Strtch(xyz,nCent,Avst,B,lWrite,Label,dB,ldB)
+      Implicit Real(wp) (a-h,o-z)
+      !      include "common/real.inc"
+      !comdeck real.inc $Revision: 2002.3 $
+      Real(wp) :: Zero,One,Two,Three,Four,Five,Six,Seven,&
+         &       Eight,RNine,Ten,Half,Pi,SqrtP2,TwoP34,&
+         &       TwoP54,One2C2
+      Parameter(Zero=0.0D0,One=1.0D0,Two=2.0D0,Three=3.0D0,&
+         &          Four=4.0D0,Five=5.0D0,Six=6.0D0,Seven=7.0D0,&
+         &          Eight=8.0D0,rNine=9.0D0,Ten=1.0D1,Half=0.5D0,&
+         &          Pi=3.141592653589793D0,&
+         &          SqrtP2=0.8862269254527579D0,&
+         &          TwoP34=0.2519794355383808D0,&
+         &          TwoP54=5.914967172795612D0,&
+         &          One2C2=0.2662567690426443D-04)
+
+      integer :: nCent
+      Real(wp) :: B(3,nCent),xyz(3,nCent),dB(3,nCent,3,nCent),R(3)
+      Logical :: lWrite,ldB
+      Character(len=8) :: Label
+      !      include "common/angstr.inc"
+      !comdeck angstr.inc $Revision: 2002.3 $
+      !
+      !     Conversion factor angstrom to bohr from the IUPAC
+      !     publication
+      !     .529177249(24) angstrom / bohr
+      !     "Quantities, Units and Symbols in Physical Chemistry"
+      !     I. Mills, T. Cvitas, K. Homann, N. Kallay and
+      !     K. Kuchitsu, Blackwell Scientific Publications,
+      !     Oxford, 1988.
+      !
+      Data Angstr/0.529177249D+00/
+      !
+      R(1) = xyz(1,2)-xyz(1,1)
+      R(2) = xyz(2,2)-xyz(2,1)
+      R(3) = xyz(3,2)-xyz(3,1)
+      R2 = R(1)**2+R(2)**2+R(3)**2
+      RR = Sqrt(R2)
+      Avst = RR
+      !
+      aRR = RR*Angstr
+      If (lWrite) Write (*,'(1X,A,A,2(F10.6,A))') Label,&
+         &      ' : Bond Length=',aRR,' / Angstrom',RR,' / bohr'
+      !
+      !---- Compute the WDC B-matrix.
+      !
+      B(1,1) = -R(1)/RR
+      B(2,1) = -R(2)/RR
+      B(3,1) = -R(3)/RR
+      !.... Utilize translational invariance.
+      B(1,2) = -B(1,1)
+      B(2,2) = -B(2,1)
+      B(3,2) = -B(3,1)
+      !
+      !---- Compute the cartesian derivative of the B-matrix.
+      !
+      If (ldB) Then
+        !
+        Do i = 1,3
+          Do j = 1,i
+            If (i .eq. j) Then
+              dB(i,1,j,1) = (One-B(j,1)*B(i,1))/RR
+            Else
+              dB(i,1,j,1) = (-B(j,1)*B(i,1))/RR
+            End If
+            dB(j,1,i,1) = dB(i,1,j,1)
+            !
+            dB(i,2,j,1) = -dB(i,1,j,1)
+            dB(j,1,i,2) = dB(i,2,j,1)
+            !
+            dB(i,1,j,2) = -dB(i,1,j,1)
+            dB(j,2,i,1) = dB(i,1,j,2)
+            !
+            dB(i,2,j,2) = -dB(i,2,j,1)
+            dB(j,2,i,2) = dB(i,2,j,2)
+          End Do
+        End Do
+        !
+      End If
+      !     Call qExit('Strtch')
+      !     Call GetMem('Exit Strtch','Chec','Real',ipMass,2*msAtom)
+      Return
+    End subroutine strtch
+    Subroutine Bend(xyz,nCent,Fir,Bf,lWrite,lWarn,Label,dBf,ldB)
+      Implicit Real(wp) (a-h,o-z)
+
+      integer :: nCent
+      !Real(wp) ::   Bf(3,nCent),xyz(3,nCent),dBf(3,nCent,3,nCent),&
+      Real(wp) ::   Bf(3,3),xyz(3,nCent),dBf(3,nCent,3,nCent),&
+         &        BRij(3,2),dBRij(3,2,3,2),&
+         &        BRjk(3,2),dBRjk(3,2,3,2)
+      Logical lWrite,ldB,lWarn
+      Character(len=8) :: Label
+      !
+      !     Call QEnter('Bend')
+      !
+      mCent = 2
+      Call Strtch(xyz(1,1),mCent,Rij1,BRij,.False.,Label,dBRij,ldB)
+      Call Strtch(xyz(1,2),mCent,Rjk1,BRjk,.False.,Label,dBRjk,ldB)
+      Co = Zero
+      Crap = Zero
+      Do i = 1,3
+        Co = Co+BRij(i,1)*BRjk(i,2)
+        Crap = Crap+(BRjk(i,2)+BRij(i,1))**2
+      End Do
+      !
+      !.... Special care for cases close to linearity
+      !
+      If (Sqrt(Crap) .lt. 1.0D-6) Then
+        Fir = Pi-ArSin(Sqrt(Crap))
+        Si = Sqrt(Crap)
+      Else
+        Fir = ArCos(Co)
+        Si = Sqrt(One-Co**2)
+      End If
+      !
+      If (Abs(Fir-Pi) .lt. 1.0d-13) Then
+        Fir = Pi
+        Return
+      End If
+      dFir = 180.0D0*Fir/Pi
+      If ((Abs(dFir) .gt. 177.5.or.Abs(dFir) .lt. 2.5).and.lWarn)&
+         &   Write (*,*) ' Valence angle close to end in '//&
+         &               'range of definition'
+      If (lWrite) Write (*,'(1X,A,A,F10.4,A,F10.6,A)') Label,&
+         &            ' : Angle=',dFir,'/degree, ',Fir,'/rad'
+      !
+      !---- Compute the WDC B-matrix
+      !
+      !     Bf=-11.1111
+      Do i = 1,3
+        Bf(i,1) = (Co*BRij(i,1)-BRjk(i,2))/(Si*Rij1)
+        Bf(i,3) = (Co*BRjk(i,2)-BRij(i,1))/(Si*Rjk1)
+        !....... Utilize translational invariance.
+        Bf(i,2) = -(Bf(i,1)+Bf(i,3))
+      End Do
+      !     Call RecPrt('Bf',' ',Bf,9,1)
+      !
+      !---- Compute the cartesian derivative of the B-Matrix.
+      !
+      If (ldB) Then
+        !
+        !        dBf=-11.11111
+        Do i = 1,3
+          Do j = 1,i
+            dBf(i,1,j,1) = (-Si*Bf(i,1)*BRij(j,1)&
+               &                        +Co*dBRij(i,1,j,1)&
+               &                        -Bf(j,1)*(Co*Bf(i,1)*Rij1&
+               &                        +Si*BRij(i,1)))/(Si*Rij1)
+            dBf(i,1,j,3) = (-Si*Bf(i,1)*BRjk(j,2)&
+               &                       +dBRij(i,1,j,2)&
+               &                       -Bf(j,3)*Co*Bf(i,1)*Rjk1)&
+               &                       /(Si*Rjk1)
+            !              Write (*,*) '13',dBf(i,1,j,3), i, j
+            dBf(i,3,j,1) = (-Si*Bf(i,3)*BRij(j,1)&
+               &                       +dBRjk(i,2,j,1)&
+               &                       -Bf(j,1)*Co*Bf(i,3)*Rij1)&
+               &                       /(Si*Rij1)
+            dBf(i,3,j,3) = (-Si*Bf(i,3)*BRjk(j,2)&
+               &                        +Co*dBRjk(i,2,j,2)&
+               &                        -Bf(j,3)*(Co*Bf(i,3)*Rjk1&
+               &                        +Si*BRjk(i,2)))/(Si*Rjk1)
+            !
+            dBf(j,1,i,1) = dBf(i,1,j,1)
+            dBf(j,3,i,1) = dBf(i,1,j,3)
+            dBf(j,1,i,3) = dBf(i,3,j,1)
+            dBf(j,3,i,3) = dBf(i,3,j,3)
+            !
+            dBf(i,1,j,2) = -(dBf(i,1,j,1)+dBf(i,1,j,3))
+            dBf(j,2,i,1) = dBf(i,1,j,2)
+            dBf(j,1,i,2) = -(dBf(j,1,i,1)+dBf(j,1,i,3))
+            dBf(i,2,j,1) = dBf(j,1,i,2)
+            dBf(i,3,j,2) = -(dBf(i,3,j,1)+dBf(i,3,j,3))
+            dBf(j,2,i,3) = dBf(i,3,j,2)
+            dBf(j,3,i,2) = -(dBf(j,3,i,1)+dBf(j,3,i,3))
+            dBf(i,2,j,3) = dBf(j,3,i,2)
+            !
+            dBf(i,2,j,2) = -(dBf(i,2,j,1)+dBf(i,2,j,3))
+            dBf(j,2,i,2) = dBf(i,2,j,2)
+            !
+          End Do
+        End Do
+        !        Call RecPrt('dBf','(9F9.1)',dBf,9,9)
+        !
+      End If
+      !
+      !     Call QExit('Bend')
+      Return
+    End subroutine bend
+    Function arSin(Arg)
+      Implicit Real*8(a-h,o-z)
+      Real*8 ArSin
+
+      A = Arg
+      IF (ABS(A) .GT. One) Then
+        PRINT 3,A
+3       FORMAT(1X,'Warning argument of aSin= ',1F21.18)
+        A = Sign(One,A)
+      End If
+      !
+      ArSin = ASin(A)
+      Return
+    End function arSin
+    Function arCos(Arg)
+      Implicit Real(wp) (a-h,o-z)
+      Real(wp) :: ArCos
+      A = Arg
+      IF (ABS(A) .GT. One) Then
+        A = Sign(One,A)
+      End If
+      ArCos = ACos(A)
+      Return
+    End function arCos
+  End subroutine trsn
+
+  pure elemental function ixyz(i,iatom)
+    integer :: ixyz
+    integer,intent(in) :: i,iatom
+    ixyz = (iatom-1)*3+i
+  end function ixyz
+  pure elemental function jnd(i,j)
+    integer :: jnd
+    integer,intent(in) :: i,j
+    jnd = i*(i-1)/2+j
+  end function jnd
+  pure elemental function ind(i,iatom,j,jatom)
+    integer :: ind
+    integer,intent(in) :: i,iatom,j,jatom
+    ind = jnd(max(ixyz(i,iatom),ixyz(j,jatom)),min(ixyz(i,iatom),ixyz(j,jatom)))
+  end function ind
+
+  pure elemental function fk_lindh(alpha,r0,r2) result(gmm)
+    implicit none
+    real(wp),intent(in) :: alpha,r0,r2
+    real(wp) :: gmm
+    gmm = exp(alpha*(r0**2-r2))
+  end function fk_lindh
+
+  pure elemental function fk_swart(alpha,r0,r2) result(gmm)
+    implicit none
+    real(wp),intent(in) :: alpha,r0,r2
+    real(wp) :: gmm
+    gmm = exp(-alpha*(sqrt(r2)/r0-1.0_wp))
+  end function fk_swart
+
+  pure elemental function fk_vdw(alpha,r0,r2) result(gmm)
+    implicit none
+    real(wp),intent(in) :: alpha,r0,r2
+    real(wp) :: gmm
+    gmm = exp(-alpha*(r0-sqrt(r2))**2)
+  end function fk_vdw
+
+!========================================================================================!
+!########################################################################################!
+!========================================================================================!
+
+  subroutine mh_eeq(n,at,xyz,chrg,kq,hess)
+    implicit none
+
+!! ------------------------------------------------------------------------
+!  Input
+!! ------------------------------------------------------------------------
+    integer,intent(in)     :: n                ! number of atoms
+    integer,intent(in)     :: at(n)            ! ordinal numbers
+    real(wp),intent(in)    :: xyz(3,n)         ! geometry
+    real(wp),intent(in)    :: chrg             ! total charge
+    real(wp),intent(in)    :: kq               ! scaling parameter
+!    type(chrg_parameter),intent(in) :: chrgeq  ! charge model
+!! ------------------------------------------------------------------------
+!  Output
+!! ------------------------------------------------------------------------
+    real(wp),intent(out)   :: hess((3*n)*(3*n+1)/2)
+    real(wp),allocatable   :: hessian(:,:,:,:) ! molecular hessian of IES
+
+!  π itself
+    real(wp),parameter :: pi = 3.1415926535897932384626433832795029_wp
+!  √π
+    real(wp),parameter :: sqrtpi = sqrt(pi)
+!  √(2/π)
+    real(wp),parameter :: sqrt2pi = sqrt(2.0_wp/pi)
+!
+!! ------------------------------------------------------------------------
+!  charge model
+!! ------------------------------------------------------------------------
+    integer  :: m ! dimension of the Lagrangian
+    real(wp),allocatable :: Amat(:,:)
+    real(wp),allocatable :: Xvec(:)
+    real(wp),allocatable :: Ainv(:,:)
+    real(wp),allocatable :: dAmat(:,:,:)
+    real(wp),allocatable :: dqdr(:,:,:)
+
+!! ------------------------------------------------------------------------
+!  local variables
+!! ------------------------------------------------------------------------
+    integer  :: i,j,k,l
+    real(wp) :: r,rij(3),r2
+    real(wp) :: gamij,gamij2
+    real(wp) :: arg,arg2,tmp,dtmp
+    real(wp) :: lambda
+    real(wp) :: es,expterm,erfterm
+    real(wp) :: htmp,rxr(3,3)
+    real(wp) :: rcovij,rr
+
+!! ------------------------------------------------------------------------
+!  scratch variables
+!! ------------------------------------------------------------------------
+    real(wp),allocatable :: alpha(:)
+    real(wp),allocatable :: xtmp(:)
+    real(wp),allocatable :: atmp(:,:)
+
+!! ------------------------------------------------------------------------
+!  Lapack work variables
+!! ------------------------------------------------------------------------
+    integer,allocatable :: ipiv(:)
+    real(wp),allocatable :: temp(:)
+    real(wp),allocatable :: work(:)
+    integer  :: lwork
+    integer  :: info
+    real(wp) :: test(1)
+
+!! ------------------------------------------------------------------------
+!  EEQ parameters
+!  PARAMETRISATION BY S. SPICHER (Fri, 14 Dec 2018 16:13:08 +0100)
+!! ------------------------------------------------------------------------
+    integer,parameter :: max_elem = 86
+!&<
+    real(wp),parameter :: enparam(max_elem) = (/ &
+     1.23695041_wp, 1.26590957_wp, 0.54341808_wp, 0.99666991_wp, 1.26691604_wp, &
+     1.40028282_wp, 1.55819364_wp, 1.56866440_wp, 1.57540015_wp, 1.15056627_wp, &
+     0.55936220_wp, 0.72373742_wp, 1.12910844_wp, 1.12306840_wp, 1.52672442_wp, &
+     1.40768172_wp, 1.48154584_wp, 1.31062963_wp, 0.40374140_wp, 0.75442607_wp, &
+     0.76482096_wp, 0.98457281_wp, 0.96702598_wp, 1.05266584_wp, 0.93274875_wp, &
+     1.04025281_wp, 0.92738624_wp, 1.07419210_wp, 1.07900668_wp, 1.04712861_wp, &
+     1.15018618_wp, 1.15388455_wp, 1.36313743_wp, 1.36485106_wp, 1.39801837_wp, &
+     1.18695346_wp, 0.36273870_wp, 0.58797255_wp, 0.71961946_wp, 0.96158233_wp, &
+     0.89585296_wp, 0.81360499_wp, 1.00794665_wp, 0.92613682_wp, 1.09152285_wp, &
+     1.14907070_wp, 1.13508911_wp, 1.08853785_wp, 1.11005982_wp, 1.12452195_wp, &
+     1.21642129_wp, 1.36507125_wp, 1.40340000_wp, 1.16653482_wp, 0.34125098_wp, &
+     0.58884173_wp, 0.68441115_wp, 0.56999999_wp, 0.56999999_wp, 0.56999999_wp, &
+     0.56999999_wp, 0.56999999_wp, 0.56999999_wp, 0.56999999_wp, 0.56999999_wp, &
+     0.56999999_wp, 0.56999999_wp, 0.56999999_wp, 0.56999999_wp, 0.56999999_wp, &
+     0.56999999_wp, 0.87936784_wp, 1.02761808_wp, 0.93297476_wp, 1.10172128_wp, &
+     0.97350071_wp, 1.16695666_wp, 1.23997927_wp, 1.18464453_wp, 1.14191734_wp, &
+     1.12334192_wp, 1.01485321_wp, 1.12950808_wp, 1.30804834_wp, 1.33689961_wp, &
+     1.27465977_wp /)
+    real(wp),parameter :: gamparam(max_elem) = (/ &
+    -0.35015861_wp, 1.04121227_wp, 0.09281243_wp, 0.09412380_wp, 0.26629137_wp, &
+     0.19408787_wp, 0.05317918_wp, 0.03151644_wp, 0.32275132_wp, 1.30996037_wp, &
+     0.24206510_wp, 0.04147733_wp, 0.11634126_wp, 0.13155266_wp, 0.15350650_wp, &
+     0.15250997_wp, 0.17523529_wp, 0.28774450_wp, 0.42937314_wp, 0.01896455_wp, &
+     0.07179178_wp,-0.01121381_wp,-0.03093370_wp, 0.02716319_wp,-0.01843812_wp, &
+    -0.15270393_wp,-0.09192645_wp,-0.13418723_wp,-0.09861139_wp, 0.18338109_wp, &
+     0.08299615_wp, 0.11370033_wp, 0.19005278_wp, 0.10980677_wp, 0.12327841_wp, &
+     0.25345554_wp, 0.58615231_wp, 0.16093861_wp, 0.04548530_wp,-0.02478645_wp, &
+     0.01909943_wp, 0.01402541_wp,-0.03595279_wp, 0.01137752_wp,-0.03697213_wp, &
+     0.08009416_wp, 0.02274892_wp, 0.12801822_wp,-0.02078702_wp, 0.05284319_wp, &
+     0.07581190_wp, 0.09663758_wp, 0.09547417_wp, 0.07803344_wp, 0.64913257_wp, &
+     0.15348654_wp, 0.05054344_wp, 0.11000000_wp, 0.11000000_wp, 0.11000000_wp, &
+     0.11000000_wp, 0.11000000_wp, 0.11000000_wp, 0.11000000_wp, 0.11000000_wp, &
+     0.11000000_wp, 0.11000000_wp, 0.11000000_wp, 0.11000000_wp, 0.11000000_wp, &
+     0.11000000_wp,-0.02786741_wp, 0.01057858_wp,-0.03892226_wp,-0.04574364_wp, &
+    -0.03874080_wp,-0.03782372_wp,-0.07046855_wp, 0.09546597_wp, 0.21953269_wp, &
+     0.02522348_wp, 0.15263050_wp, 0.08042611_wp, 0.01878626_wp, 0.08715453_wp, &
+     0.10500484_wp /)
+    real(wp),parameter :: kappa(max_elem) = (/ &
+     0.04916110_wp, 0.10937243_wp,-0.12349591_wp,-0.02665108_wp,-0.02631658_wp, &
+     0.06005196_wp, 0.09279548_wp, 0.11689703_wp, 0.15704746_wp, 0.07987901_wp, &
+     -0.10002962_wp,-0.07712863_wp,-0.02170561_wp,-0.04964052_wp, 0.14250599_wp, &
+     0.07126660_wp, 0.13682750_wp, 0.14877121_wp,-0.10219289_wp,-0.08979338_wp, &
+    -0.08273597_wp,-0.01754829_wp,-0.02765460_wp,-0.02558926_wp,-0.08010286_wp, &
+    -0.04163215_wp,-0.09369631_wp,-0.03774117_wp,-0.05759708_wp, 0.02431998_wp, &
+    -0.01056270_wp,-0.02692862_wp, 0.07657769_wp, 0.06561608_wp, 0.08006749_wp, &
+     0.14139200_wp,-0.05351029_wp,-0.06701705_wp,-0.07377246_wp,-0.02927768_wp, &
+    -0.03867291_wp,-0.06929825_wp,-0.04485293_wp,-0.04800824_wp,-0.01484022_wp, &
+     0.07917502_wp, 0.06619243_wp, 0.02434095_wp,-0.01505548_wp,-0.03030768_wp, &
+     0.01418235_wp, 0.08953411_wp, 0.08967527_wp, 0.07277771_wp,-0.02129476_wp, &
+    -0.06188828_wp,-0.06568203_wp,-0.11000000_wp,-0.11000000_wp,-0.11000000_wp, &
+    -0.11000000_wp,-0.11000000_wp,-0.11000000_wp,-0.11000000_wp,-0.11000000_wp, &
+    -0.11000000_wp,-0.11000000_wp,-0.11000000_wp,-0.11000000_wp,-0.11000000_wp, &
+    -0.11000000_wp,-0.03585873_wp,-0.03132400_wp,-0.05902379_wp,-0.02827592_wp, &
+    -0.07606260_wp,-0.02123839_wp, 0.03814822_wp, 0.02146834_wp, 0.01580538_wp, &
+    -0.00894298_wp,-0.05864876_wp,-0.01817842_wp, 0.07721851_wp, 0.07936083_wp, &
+     0.05849285_wp /)
+    real(wp),parameter :: alphaparam(max_elem) = (/ &
+     0.55159092_wp, 0.66205886_wp, 0.90529132_wp, 1.51710827_wp, 2.86070364_wp, &
+     1.88862966_wp, 1.32250290_wp, 1.23166285_wp, 1.77503721_wp, 1.11955204_wp, &
+     1.28263182_wp, 1.22344336_wp, 1.70936266_wp, 1.54075036_wp, 1.38200579_wp, &
+     2.18849322_wp, 1.36779065_wp, 1.27039703_wp, 1.64466502_wp, 1.58859404_wp, &
+     1.65357953_wp, 1.50021521_wp, 1.30104175_wp, 1.46301827_wp, 1.32928147_wp, &
+     1.02766713_wp, 1.02291377_wp, 0.94343886_wp, 1.14881311_wp, 1.47080755_wp, &
+     1.76901636_wp, 1.98724061_wp, 2.41244711_wp, 2.26739524_wp, 2.95378999_wp, &
+     1.20807752_wp, 1.65941046_wp, 1.62733880_wp, 1.61344972_wp, 1.63220728_wp, &
+     1.60899928_wp, 1.43501286_wp, 1.54559205_wp, 1.32663678_wp, 1.37644152_wp, &
+     1.36051851_wp, 1.23395526_wp, 1.65734544_wp, 1.53895240_wp, 1.97542736_wp, &
+     1.97636542_wp, 2.05432381_wp, 3.80138135_wp, 1.43893803_wp, 1.75505957_wp, &
+     1.59815118_wp, 1.76401732_wp, 1.63999999_wp, 1.63999999_wp, 1.63999999_wp, &
+     1.63999999_wp, 1.63999999_wp, 1.63999999_wp, 1.63999999_wp, 1.63999999_wp, &
+     1.63999999_wp, 1.63999999_wp, 1.63999999_wp, 1.63999999_wp, 1.63999999_wp, &
+     1.63999999_wp, 1.47055223_wp, 1.81127084_wp, 1.40189963_wp, 1.54015481_wp, &
+     1.33721475_wp, 1.57165422_wp, 1.04815857_wp, 1.78342098_wp, 2.79106396_wp, &
+     1.78160840_wp, 2.47588882_wp, 2.37670734_wp, 1.76613217_wp, 2.66172302_wp, &
+     2.82773085_wp /)
+!&>
+
+!! ------------------------------------------------------------------------
+!  initizialization
+!! ------------------------------------------------------------------------
+    m = n+1
+    allocate (ipiv(m),source=0)
+    allocate (Amat(m,m),Xvec(m),alpha(n),dqdr(3,n,m),source=0.0_wp)
+
+!! ------------------------------------------------------------------------
+!  set up the A matrix and X vector
+!! ------------------------------------------------------------------------
+!  αi -> alpha(i), ENi -> xi(i), κi -> kappa(i), Jii -> gam(i)
+!  γij = 1/√(αi+αj)
+!  Xi  = -ENi + κi·√CNi
+!  Aii = Jii + 2/√π·γii
+!  Aij = erf(γij·Rij)/Rij = 2/√π·F0(γ²ij·R²ij)
+!! ------------------------------------------------------------------------
+!  prepare some arrays
+!$omp parallel default(none) &
+!!$omp shared(n,at,chrgeq) &
+!$omp shared(n,at) &
+!$omp private(i) &
+!$omp shared(Xvec,alpha)
+!$omp do schedule(dynamic)
+    do i = 1,n
+!      Xvec(i) = -chrgeq%en(i)
+!      alpha(i) = chrgeq%alpha(i)**2
+      Xvec(i) = -enparam(at(i))
+      alpha(i) = alphaparam(at(i))**2
+    end do
+!$omp enddo
+!$omp endparallel
+
+!$omp parallel default(none) &
+!!$omp shared(n,at,xyz,chrgeq,alpha) &
+!$omp shared(n,at,xyz,alpha) &
+!$omp private(i,j,r,gamij) &
+!$omp shared(Amat)
+!$omp do schedule(dynamic)
+    ! prepare A matrix
+    do i = 1,n
+      ! EN of atom i
+      do j = 1,i-1
+        r = sqrt(sum((xyz(:,j)-xyz(:,i))**2))
+        gamij = 1.0_wp/sqrt(alpha(i)+alpha(j))
+        Amat(j,i) = erf(gamij*r)/r
+        Amat(i,j) = Amat(j,i)
+      end do
+!      Amat(i,i) = chrgeq%gam(i)+sqrt2pi/sqrt(alpha(i))
+      Amat(i,i) = gamparam(at(i))+sqrt2pi/sqrt(alpha(i))
+    end do
+!$omp enddo
+!$omp endparallel
+
+!! ------------------------------------------------------------------------
+!  solve the linear equations to obtain partial charges
+!! ------------------------------------------------------------------------
+    Amat(m,1:m) = 1.0_wp
+    Amat(1:m,m) = 1.0_wp
+    Amat(m,m) = 0.0_wp
+    Xvec(m) = chrg
+    ! generate temporary copy
+    allocate (Atmp(m,m),source=Amat)
+    allocate (Xtmp(m),source=Xvec)
+
+    ! assume work space query, set best value to test after first dsysv call
+    call dsysv('u',m,1,Atmp,m,ipiv,Xtmp,m,test,-1,info)
+    lwork = int(test(1))
+    allocate (work(lwork),source=0.0_wp)
+
+    call dsysv('u',m,1,Atmp,m,ipiv,Xtmp,m,work,lwork,info)
+    if (info > 0) error stop '** ERROR ** (goedecker_solve) DSYSV failed'
+
+    if (abs(sum(Xtmp(:n))-chrg) > 1.e-6_wp) &
+      error stop '** ERROR ** (goedecker_solve) charge constrain error'
+    !print'(3f20.14)',Xtmp
+
+!! ------------------------------------------------------------------------
+!  calculate isotropic electrostatic (IES) energy
+!! ------------------------------------------------------------------------
+!  E = ∑i (ENi - κi·√CNi)·qi + ∑i (Jii + 2/√π·γii)·q²i
+!      + ½ ∑i ∑j,j≠i qi·qj·2/√π·F0(γ²ij·R²ij)
+!    = q·(½A·q - X)
+!! ------------------------------------------------------------------------
+!   work(:m) = Xvec
+!   call dsymv('u',m,0.5_wp,Amat,m,Xtmp,1,-1.0_wp,work,1)
+!   es = dot_product(Xtmp,work(:m))
+!   energy = es + energy
+
+!! ------------------------------------------------------------------------
+!  calculate molecular gradient of the IES energy
+!! ------------------------------------------------------------------------
+!  dE/dRj -> g(:,j), ∂Xi/∂Rj -> -dcn(:,i,j), ½∂Aij/∂Rj -> dAmat(:,j,i)
+!  dE/dR = (½∂A/∂R·q - ∂X/∂R)·q
+!  ∂Aij/∂Rj = ∂Aij/∂Ri
+!! ------------------------------------------------------------------------
+    allocate (dAmat(3,n,m),source=0.0_wp)
+!$omp parallel default(none) &
+!$omp shared(n,xyz,alpha,Amat,Xtmp) &
+!$omp private(i,j,rij,r2,gamij,arg,dtmp) &
+!$omp reduction(+:dAmat)
+!$omp do schedule(dynamic)
+    do i = 1,n
+      do j = 1,i-1
+        rij = xyz(:,i)-xyz(:,j)
+        r2 = sum(rij**2)
+        gamij = 1.0_wp/sqrt(alpha(i)+alpha(j))
+        arg = gamij**2*r2
+        dtmp = 2.0_wp*gamij*exp(-arg)/(sqrtpi*r2)-Amat(j,i)/r2
+        dAmat(:,i,i) = +dtmp*rij*Xtmp(j)+dAmat(:,i,i)
+        dAmat(:,j,j) = -dtmp*rij*Xtmp(i)+dAmat(:,j,j)
+        dAmat(:,i,j) = +dtmp*rij*Xtmp(i)
+        dAmat(:,j,i) = -dtmp*rij*Xtmp(j)
+      end do
+    end do
+!$omp enddo
+!$omp endparallel
+
+!! ------------------------------------------------------------------------
+!  invert the A matrix using a Bunch-Kaufman factorization
+!  A⁻¹ = (L·D·L^T)⁻¹ = L^T·D⁻¹·L
+!! ------------------------------------------------------------------------
+    allocate (Ainv(m,m),source=Amat)
+
+    ! assume work space query, set best value to test after first dsytrf call
+    call dsytrf('L',m,Ainv,m,ipiv,test,-1,info)
+    if (int(test(1)) > lwork) then
+      deallocate (work)
+      lwork = int(test(1))
+      allocate (work(lwork),source=0.0_wp)
+    end if
+
+    ! Bunch-Kaufman factorization A = L*D*L**T
+    call dsytrf('L',m,Ainv,m,ipiv,work,lwork,info)
+    if (info > 0) then
+      error stop '** ERROR ** (goedecker_inversion) DSYTRF failed'
+
+    end if
+
+    ! A⁻¹ from factorized L matrix, save lower part of A⁻¹ in Ainv matrix
+    ! Ainv matrix is overwritten with lower triangular part of A⁻¹
+    call dsytri('L',m,Ainv,m,ipiv,work,info)
+    if (info > 0) then
+      error stop '** ERROR ** (goedecker_inversion) DSYTRI failed'
+    end if
+
+    ! symmetrizes A⁻¹ matrix from lower triangular part of inverse matrix
+    do i = 1,m
+      do j = i+1,m
+        Ainv(i,j) = Ainv(j,i)
+      end do
+    end do
+
+!! ------------------------------------------------------------------------
+!  calculate gradient of the partial charge w.r.t. the nuclear coordinates
+!! ------------------------------------------------------------------------
+    !call dsymm('r','l',3*n,m,-1.0_wp,Ainv,m,dAmat,3*n,1.0_wp,dqdr,3*n)
+    call dgemm('n','n',3*n,m,m,-1.0_wp,dAmat,3*n,Ainv,m,1.0_wp,dqdr,3*n)
+    !print'(/,"analytical gradient")'
+    !print'(3f20.14)',dqdr(:,:,:n)
+
+!! ------------------------------------------------------------------------
+!  molecular Hessian calculation
+!! ------------------------------------------------------------------------
+    do i = 1,n
+      do j = 1,i-1
+        rij = xyz(:,j)-xyz(:,i)
+        r2 = sum(rij**2)
+        r = sqrt(r2)
+        gamij = 1.0_wp/sqrt(alpha(i)+alpha(j))
+        gamij2 = gamij**2
+        arg2 = gamij2*r2
+        arg = sqrt(arg2)
+        erfterm = Xtmp(i)*Xtmp(j)*erf(arg)/r
+        expterm = Xtmp(i)*Xtmp(j)*2*gamij*exp(-arg2)/sqrtpi
+        ! ∂²(qAq)/(∂Ri∂Rj):
+        ! ∂²(qAq)/(∂Xi∂Xi) = (1-3X²ij/R²ij-2γ²ijX²ij) 2γij/√π exp[-γ²ij·R²ij]/R²ij
+        !                  - (R²ij-3X²ij) erf[γij·Rij]/R⁵ij
+        ! ∂²(qAq)/(∂Xi∂Xj) = (R²ij-3X²ij) erf[γij·Rij]/R⁵ij
+        !                  - (1-3X²ij/R²ij-2γ²ijX²ij) 2γij/√π exp[-γ²ij·R²ij]/R²ij
+        ! ∂²(qAq)/(∂Xi∂Yi) = 3X²ij erf[γij·Rij]/R⁵ij
+        !                  - (3X²ij/R²ij+2γ²ijX²ij) 2γij/√π exp[-γ²ij·R²ij]/R²ij
+        ! ∂²(qAq)/(∂Xi∂Yj) = (3X²ij/R²ij+2γ²ijX²ij) 2γij/√π exp[-γ²ij·R²ij]/R²ij
+        !                  - 3X²ij erf[γij·Rij]/R⁵ij
+        rxr(1,1) = erfterm*(3*rij(1)**2/r2**2-1.0_wp/r2) &
+                   -expterm*(3*rij(1)**2/r2**2+2*gamij2*rij(1)**2/r2-1/r2)
+        rxr(2,2) = erfterm*(3*rij(2)**2/r2**2-1.0_wp/r2) &
+                   -expterm*(3*rij(2)**2/r2**2+2*gamij2*rij(2)**2/r2-1/r2)
+        rxr(3,3) = erfterm*(3*rij(3)**2/r2**2-1.0_wp/r2) &
+                   -expterm*(3*rij(3)**2/r2**2+2*gamij2*rij(3)**2/r2-1/r2)
+        rxr(2,1) = erfterm*3*rij(2)*rij(1)/r2**2 &
+                   -expterm*(3*rij(2)*rij(1)/r2**2+2*gamij2*rij(2)*rij(1)/r2)
+        rxr(3,1) = erfterm*3*rij(3)*rij(1)/r2**2 &
+                   -expterm*(3*rij(3)*rij(1)/r2**2+2*gamij2*rij(3)*rij(1)/r2)
+        rxr(3,2) = erfterm*3*rij(3)*rij(2)/r2**2 &
+                   -expterm*(3*rij(3)*rij(2)/r2**2+2*gamij2*rij(3)*rij(2)/r2)
+
+        do k = 1,m
+          rxr(1,1) = rxr(1,1)+0.5_wp*dqdr(1,i,k)*dAmat(1,j,k) &
+                     +0.5_wp*dqdr(1,j,k)*dAmat(1,i,k)
+          rxr(2,1) = rxr(2,1)+0.5_wp*dqdr(2,i,k)*dAmat(1,j,k) &
+                     +0.5_wp*dqdr(2,j,k)*dAmat(1,i,k)
+          rxr(3,1) = rxr(3,1)+0.5_wp*dqdr(3,i,k)*dAmat(1,j,k) &
+                     +0.5_wp*dqdr(3,j,k)*dAmat(1,i,k)
+          rxr(2,2) = rxr(2,2)+0.5_wp*dqdr(2,i,k)*dAmat(2,j,k) &
+                     +0.5_wp*dqdr(2,j,k)*dAmat(2,i,k)
+          rxr(3,2) = rxr(3,2)+0.5_wp*dqdr(3,i,k)*dAmat(2,j,k) &
+                     +0.5_wp*dqdr(3,j,k)*dAmat(2,i,k)
+          rxr(3,3) = rxr(3,3)+0.5_wp*dqdr(3,i,k)*dAmat(3,j,k) &
+                     +0.5_wp*dqdr(3,j,k)*dAmat(3,i,k)
+        end do
+        ! symmetrize
+        rxr(1,2) = rxr(2,1)
+        rxr(1,3) = rxr(3,1)
+        rxr(2,3) = rxr(3,2)
+
+        ! save diagonal elements for atom i
+        hess(ind(1,i,1,i)) = hess(ind(1,i,1,i))+kq*rxr(1,1)
+        hess(ind(2,i,1,i)) = hess(ind(2,i,1,i))+kq*rxr(2,1)
+        hess(ind(2,i,2,i)) = hess(ind(2,i,2,i))+kq*rxr(2,2)
+        hess(ind(3,i,1,i)) = hess(ind(3,i,1,i))+kq*rxr(3,1)
+        hess(ind(3,i,2,i)) = hess(ind(3,i,2,i))+kq*rxr(3,2)
+        hess(ind(3,i,3,i)) = hess(ind(3,i,3,i))+kq*rxr(3,3)
+        ! save elements between atom i and atom j
+        hess(ind(1,i,1,j)) = hess(ind(1,i,1,j))-kq*rxr(1,1)
+        hess(ind(1,i,2,j)) = hess(ind(1,i,2,j))-kq*rxr(2,1)
+        hess(ind(1,i,3,j)) = hess(ind(1,i,3,j))-kq*rxr(3,1)
+        hess(ind(2,i,1,j)) = hess(ind(2,i,1,j))-kq*rxr(2,1)
+        hess(ind(2,i,2,j)) = hess(ind(2,i,2,j))-kq*rxr(2,2)
+        hess(ind(2,i,3,j)) = hess(ind(2,i,3,j))-kq*rxr(3,2)
+        hess(ind(3,i,1,j)) = hess(ind(3,i,1,j))-kq*rxr(3,1)
+        hess(ind(3,i,2,j)) = hess(ind(3,i,2,j))-kq*rxr(3,2)
+        hess(ind(3,i,3,j)) = hess(ind(3,i,3,j))-kq*rxr(3,3)
+        ! save diagonal elements for atom j
+        hess(ind(1,j,1,j)) = hess(ind(1,j,1,j))+kq*rxr(1,1)
+        hess(ind(2,j,1,j)) = hess(ind(2,j,1,j))+kq*rxr(2,1)
+        hess(ind(2,j,2,j)) = hess(ind(2,j,2,j))+kq*rxr(2,2)
+        hess(ind(3,j,1,j)) = hess(ind(3,j,1,j))+kq*rxr(3,1)
+        hess(ind(3,j,2,j)) = hess(ind(3,j,2,j))+kq*rxr(3,2)
+        hess(ind(3,j,3,j)) = hess(ind(3,j,3,j))+kq*rxr(3,3)
+      end do
+    end do
+
+    ! ∂²(qA)/(∂Ri∂q)·∂q/∂Rj
+    ! hessian = hessian + reshape(matmul(reshape(dqdr,(/3*n,m/)),&
+    !    transpose(reshape(dAmat,(/3*n,m/)))),(/3,n,3,n/))
+    !call dgemm('n','t',3*n,m,3*n,+1.0_wp,dqdr,3*n,dAmat,3*n,1.0_wp,hessian,3*n)
+    !call dgemm('n','t',3*n,m,3*n,+1.0_wp,dAmat,3*n,dqdr,3*n,1.0_wp,hessian,3*n)
+
+  end subroutine mh_eeq
+
+!========================================================================================!
+!########################################################################################!
+!========================================================================================!
+end module modelhessian_core
diff --git a/src/calculator/orca_sc.f90 b/src/calculator/orca_sc.f90
index 90ffd9e5..09e206d4 100644
--- a/src/calculator/orca_sc.f90
+++ b/src/calculator/orca_sc.f90
@@ -155,8 +155,9 @@ subroutine ORCA_setup(mol,calc)
     else
       fname = calc%calcfile
     end if
-    if(calc%uhf < 1) calc%uhf = 1 !> ORCA uses multiplicity, not n_alpha - n_beta!
-    call calc%ORCA%write(fname,mol,calc%chrg,calc%uhf)
+    !> ORCA uses the spin multiplicity (2S+1), not uhf = Nα-Nβ
+    call calc%sync_multiplicity()
+    call calc%ORCA%write(fname,mol,calc%chrg,calc%multiplicity)
     deallocate (fname)
 
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
diff --git a/src/calculator/penalty.f90 b/src/calculator/penalty.f90
new file mode 100644
index 00000000..efa7e2ee
--- /dev/null
+++ b/src/calculator/penalty.f90
@@ -0,0 +1,94 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!> a small module for getting a penalty contribution, e.g. from the RMSD potential used in metadynamics
+
+module penalty_module
+  use crest_parameters
+  use strucrd
+  use irmsd_module
+  implicit none
+  private
+
+  public :: penalty_params
+  type :: penalty_params
+    type(coord),pointer  :: biaslist(:)
+
+    real(wp) :: alpha = 1.0_wp
+    real(wp) :: kpush = 0.002_wp
+    real(wp),allocatable :: ramp(:)
+    real(wp),allocatable :: gradtmp(:,:)
+    type(rmsd_core_cache) :: ccache
+
+    character(len=:),allocatable :: biasfile
+    type(coord),allocatable :: biastmp(:)
+  end type penalty_params
+
+  public :: rmsd_penalty_engrad
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  subroutine rmsd_penalty_engrad(mol,ppars,energy,grad,iostatus)
+    type(coord),intent(in) :: mol
+    type(penalty_params),intent(inout) :: ppars
+    real(wp),intent(out) :: energy
+    real(wp),intent(out) :: grad(:,:)
+    integer,intent(out) :: iostatus
+    integer :: nall,io,ii
+    real(wp) :: etmp,rmsdval,dEdr,knat
+    real(wp),parameter :: thr = sqrt(epsilon(thr))
+
+    iostatus = 0
+    energy = 0.0_wp
+    grad(:,:) = 0.0_wp
+    rmsdval = 0.0_wp
+    nall = size(ppars%biaslist,1)
+    knat = ppars%kpush*mol%nat
+
+    do ii = 1,nall
+
+      rmsdval = rmsd(mol,ppars%biaslist(ii),gradient=ppars%gradtmp,ccache=ppars%ccache)
+
+      !> energy contribution
+      call penalty_potential_gauss(knat,ppars%alpha,rmsdval,etmp,dEdr)
+      energy = energy+etmp
+      !> fallback: exactly matching structures will produce NaN gradients!
+      if (rmsdval < thr) cycle
+      !> gradient contribution
+      grad(:,:) = grad(:,:)+dEdr*ppars%gradtmp(:,:)
+    end do
+
+  end subroutine rmsd_penalty_engrad
+
+!========================================================================================!
+
+  subroutine penalty_potential_gauss(k,a,r,etmp,dEdr)
+    real(wp),intent(in) :: k,a,r
+    real(wp),intent(out) :: etmp,dEdr
+    etmp = k*exp(-a*r**2)
+    dEdr = -2.0_wp*a*etmp*r
+  end subroutine penalty_potential_gauss
+
+!========================================================================================!
+!========================================================================================!
+end module penalty_module
diff --git a/src/calculator/tblite_api.F90 b/src/calculator/tblite_api.F90
index 34e72df4..6eddc612 100644
--- a/src/calculator/tblite_api.F90
+++ b/src/calculator/tblite_api.F90
@@ -23,21 +23,26 @@
 !====================================================!
 
 module tblite_api
-  use iso_fortran_env,only:wp => real64,stdout => output_unit
+  use crest_parameters
   use strucrd
 #ifdef WITH_TBLITE
   use mctc_env,only:error_type
   use mctc_io,only:structure_type,new
   use tblite_context_type,only:tblite_ctx => context_type
   use tblite_wavefunction_type,only:wavefunction_type,new_wavefunction
-  use tblite_wavefunction,only:sad_guess,eeq_guess
+  use tblite_wavefunction,only:sad_guess,eeq_guess,shell_partition
   use tblite_xtb,xtb_calculator => xtb_calculator
   use tblite_xtb_calculator,only:new_xtb_calculator
+#ifdef WITH_GXTB
+  use tblite_xtb,only:new_gxtb_calculator
+#endif
   use tblite_param,only:param_record
   use tblite_results,only:tblite_resultstype => results_type
   use tblite_wavefunction_mulliken,only:get_molecular_dipole_moment
   use tblite_ceh_singlepoint,only:ceh_singlepoint
   use tblite_ceh_ceh,only:new_ceh_calculator
+  use tblite_spin,only:spin_polarization,new_spin_polarization
+  use tblite_container,only:container_type
 #endif
   use wiberg_mayer
   implicit none
@@ -68,10 +73,12 @@ module tblite_api
     integer  :: lvl = 0
     real(wp) :: accuracy = 1.0_wp
     character(len=:),allocatable :: paramfile
-    type(wavefunction_type)     :: wfn
+    type(wavefunction_type)              :: wfn
+    type(wavefunction_type),allocatable  :: wfn_aux
     type(xtb_calculator)        :: calc
     type(tblite_ctx)            :: ctx
     type(tblite_resultstype)    :: res
+    logical :: spin_polarized = .false.
   end type tblite_data
   public :: tblite_data
 
@@ -85,9 +92,16 @@ module tblite_api
     integer :: eeq = 4
     integer :: ceh = 5
     integer :: param = 6
+    integer :: gxtb = 7
   end type enum_tblite_method
   type(enum_tblite_method),parameter,public :: xtblvl = enum_tblite_method()
 
+#ifdef WITH_GXTB
+  logical,parameter,public :: have_gxtb = .true.
+#else
+  logical,parameter,public :: have_gxtb = .false.
+#endif
+
   !> Conversion factor from Kelvin to Hartree
   real(wp),parameter :: ktoau = 3.166808578545117e-06_wp
 
@@ -96,8 +110,10 @@ module tblite_api
   public :: tblite_setup,tblite_singlepoint,tblite_addsettings
   public :: tblite_getwbos
   public :: tblite_add_solv
+  public :: tblite_add_efield
   public :: tblite_getcharges
   public :: tblite_getdipole
+  public :: tblite_quick_ceh_q
 
 !========================================================================================!
 !========================================================================================!
@@ -105,11 +121,16 @@ module tblite_api
 !========================================================================================!
 !========================================================================================!
 
-  subroutine tblite_setup(mol,chrg,uhf,lvl,etemp,tblite)
+  subroutine tblite_setup(mol,chrg,uhf,lvl,etemp,tblite,ceh_guess)
 !*****************************************************************
 !* subroutine tblite_setup initializes the tblite object which is
 !* passed between the CREST calculators and this module
 !*****************************************************************
+#ifdef WITH_TBLITE
+#ifdef WITH_GXTB
+    use multicharge,only:get_charges
+#endif
+#endif
     implicit none
     type(coord),intent(in)  :: mol
     integer,intent(in)      :: chrg
@@ -117,6 +138,7 @@ subroutine tblite_setup(mol,chrg,uhf,lvl,etemp,tblite)
     type(tblite_data),intent(inout) :: tblite
     integer,intent(in)      :: lvl
     real(wp),intent(in)     :: etemp
+    logical,intent(in),optional :: ceh_guess
 #ifdef WITH_TBLITE
     type(structure_type) :: mctcmol
     type(error_type),allocatable :: error
@@ -125,7 +147,7 @@ subroutine tblite_setup(mol,chrg,uhf,lvl,etemp,tblite)
     real(wp) :: etemp_au,energy
     real(wp),allocatable :: grad(:,:)
     logical :: pr
-    integer :: io
+    integer :: io,nspin
 
     pr = (tblite%ctx%verbosity > 0)
 
@@ -136,22 +158,22 @@ subroutine tblite_setup(mol,chrg,uhf,lvl,etemp,tblite)
     tblite%lvl = lvl
     select case (tblite%lvl)
     case (xtblvl%gfn1)
-      if (pr) call tblite%ctx%message("tblite> setting up GFN1-xTB calculation")
+      if (pr) call tblite%ctx%message("tblite> Setting up GFN1-xTB calculation")
       call new_gfn1_calculator(tblite%calc,mctcmol,error)
     case (xtblvl%gfn2)
-      if (pr) call tblite%ctx%message("tblite> setting up GFN2-xTB calculation")
+      if (pr) call tblite%ctx%message("tblite> Setting up GFN2-xTB calculation")
       call new_gfn2_calculator(tblite%calc,mctcmol,error)
     case (xtblvl%ipea1)
-      if (pr) call tblite%ctx%message("tblite> setting up IPEA1-xTB calculation")
+      if (pr) call tblite%ctx%message("tblite> Setting up IPEA1-xTB calculation")
       call new_ipea1_calculator(tblite%calc,mctcmol,error)
     case (xtblvl%ceh)
-      if (pr) call tblite%ctx%message("tblite> setting up CEH calculation")
+      if (pr) call tblite%ctx%message("tblite> Setting up CEH calculation")
       call new_ceh_calculator(tblite%calc,mctcmol,error)
     case (xtblvl%eeq)
-      if (pr) call tblite%ctx%message("tblite> setting up D4 EEQ charges calculation")
+      if (pr) call tblite%ctx%message("tblite> Setting up D4 EEQ charges calculation")
       call new_ceh_calculator(tblite%calc,mctcmol,error) !> doesn't matter but needs initialization
     case (xtblvl%param)
-      if (pr) call tblite%ctx%message("tblite> setting up xtb calculator from parameter file")
+      if (pr) call tblite%ctx%message("tblite> Setting up xtb calculator from parameter file")
       if (allocated(tblite%paramfile)) then
         call tblite_read_param_record(tblite%paramfile,param,io)
         call new_xtb_calculator(tblite%calc,mctcmol,param,error)
@@ -163,15 +185,59 @@ subroutine tblite_setup(mol,chrg,uhf,lvl,etemp,tblite)
         if (pr) call tblite%ctx%message("tblite> parameter file does not exist, defaulting to GFN2-xTB")
         call new_gfn2_calculator(tblite%calc,mctcmol,error)
       end if
+#ifdef WITH_GXTB
+    case (xtblvl%gxtb)
+      if (pr) call tblite%ctx%message("tblite> Setting up g-xTB calculation")
+      call new_gxtb_calculator(tblite%calc,mctcmol,error)
+#else
+    case (xtblvl%gxtb)
+      write (stdout,'(a)') 'Error: g-xTB via tblite not available (compiled without WITH_GXTB).'
+      write (stdout,'(a)') 'This code path should not be reached — use the xtb binary fallback.'
+      error stop
+#endif
     case default
       call tblite%ctx%message("Error: Unknown method in tblite!")
       error stop
     end select
+    if (pr) call tblite%ctx%message('')
 
 !>-- setup wavefunction object
     etemp_au = etemp*ktoau
+    nspin = merge(2,1,tblite%spin_polarized)
     call new_wavefunction(tblite%wfn,mol%nat,tblite%calc%bas%nsh,  &
-    &              tblite%calc%bas%nao,1,etemp_au)
+    &              tblite%calc%bas%nao,nspin,etemp_au)
+#ifdef WITH_GXTB
+    if (tblite%lvl == xtblvl%gxtb) then
+      call sad_guess(mctcmol,tblite%calc,tblite%wfn)
+    end if
+#endif
+    if (ceh_guess) then
+      call tblite_internal_ceh_guess(mctcmol,tblite)
+    end if
+
+!>--- spin-polarization setup (spGFN2-xTB etc.)
+    if (tblite%spin_polarized) then
+      block
+        class(container_type),allocatable :: cont
+        type(spin_polarization),allocatable :: spin
+        real(wp),allocatable :: wll(:,:,:)
+        allocate (spin)
+        call get_spin_constants(wll,mctcmol,tblite%calc%bas)
+        call new_spin_polarization(spin,mctcmol,wll,tblite%calc%bas%nsh_id)
+        call move_alloc(spin,cont)
+        call tblite%calc%push_back(cont)
+      end block
+    end if
+
+!>--- for methods with an auxiliary charge model (e.g., gxTB), pre-allocate wfn_aux.
+!>--- Charges are updated at each singlepoint call (geometry-dependent).
+#ifdef WITH_GXTB
+    if (allocated(tblite%calc%charge_model)) then
+      if (allocated(tblite%wfn_aux)) deallocate (tblite%wfn_aux)
+      allocate (tblite%wfn_aux)
+      call new_wavefunction(tblite%wfn_aux,mctcmol%nat,tblite%calc%bas%nsh,0,1,0.0_wp,.true.)
+    end if
+#endif
 
 #else /* WITH_TBLITE */
     write (stdout,*) 'Error: Compiled without tblite support!'
@@ -190,8 +256,9 @@ subroutine tblite_add_solv(mol,chrg,uhf,tblite,smodel,solvent)
     use tblite_container,only:container_type
     use tblite_solvation,only:new_solvation,tblite_solvation_type => solvation_type, &
     &                         solvent_data,get_solvent_data,solvation_input,  &
-    &                         cpcm_input,alpb_input,alpb_solvation, &
+    &                         ddx_input,ddx_solvation_model,alpb_input,alpb_solvation, &
     &                         cds_input,new_solvation_cds,shift_input,new_solvation_shift
+    use tblite_features,only:get_tblite_feature
 #endif
     implicit none
     type(coord),intent(in)  :: mol
@@ -226,7 +293,7 @@ subroutine tblite_add_solv(mol,chrg,uhf,tblite,smodel,solvent)
     end if
     select case (tblite%lvl)
     case (xtblvl%gfn1)
-      method ='gfn1'
+      method = 'gfn1'
     case (xtblvl%gfn2)
       method = 'gfn2'
     end select
@@ -243,61 +310,71 @@ subroutine tblite_add_solv(mol,chrg,uhf,tblite,smodel,solvent)
     end if
     solv_data = get_solvent_data(solvdum)
     if (solv_data%eps <= 0.0_wp) then
-      if (pr) call tblite%ctx%message("tblite> Unknown solvent!")
-      return
+      write (stdout,'(a)') 'Error: unknown solvent "'//solvdum//'" for tblite implicit solvation!'
+      error stop
     end if
     allocate (solv_inp)
     select case (trim(smodel))
     case ('gbsa')
       if (pr) call tblite%ctx%message("tblite> using GBSA/"//solvdum)
       alpb_tmp%dielectric_const = solv_data%eps
-      alpb_tmp%alpb=.false.
+      alpb_tmp%alpb = .false.
       !alpb_tmp%method=method
-      alpb_tmp%solvent=solv_data%solvent
+      alpb_tmp%solvent = solv_data%solvent
       !alpb_tmp%xtb=.true.
-      allocate (solv_inp%alpb, source=alpb_tmp)
-      cds_tmp%alpb=.false.
-      cds_tmp%solvent=solv_data%solvent
-      !cds_tmp%method=method 
-      allocate (solv_inp%cds, source=cds_tmp)
-      shift_tmp%alpb=.false.
-      shift_tmp%solvent=solv_data%solvent
+      allocate (solv_inp%alpb,source=alpb_tmp)
+      cds_tmp%alpb = .false.
+      cds_tmp%solvent = solv_data%solvent
+      !cds_tmp%method=method
+      allocate (solv_inp%cds,source=cds_tmp)
+      shift_tmp%alpb = .false.
+      shift_tmp%solvent = solv_data%solvent
       !shift_tmp%method=method
-      allocate (solv_inp%shift, source=shift_tmp)
-    case ('cpcm')
-      if (pr) call tblite%ctx%message("tblite> using CPCM/"//solvdum)
-      allocate (solv_inp%cpcm)
-      solv_inp%cpcm = cpcm_input(solv_data%eps)
+      allocate (solv_inp%shift,source=shift_tmp)
+    case ('cpcm','cosmo','pcm')
+      !> Continuum solvation models are provided via the ddX library since
+      !> tblite 0.6.x and require tblite compiled with ddX support (ddx=true)
+      if (.not.get_tblite_feature('ddx')) then
+        write (stdout,'(a)') 'Error: "'//trim(smodel)//'" solvation requires '// &
+        &                    'tblite compiled with ddX support!'
+        error stop
+      end if
+      if (pr) call tblite%ctx%message("tblite> using "//trim(smodel)//"/"//solvdum)
+      allocate (solv_inp%ddx)
+      select case (trim(smodel))
+      case ('cosmo')
+        solv_inp%ddx = ddx_input(ddx_solvation_model%cosmo,solv_data%eps)
+      case ('pcm')
+        solv_inp%ddx = ddx_input(ddx_solvation_model%pcm,solv_data%eps)
+      case default !> cpcm
+        solv_inp%ddx = ddx_input(ddx_solvation_model%cpcm,solv_data%eps)
+      end select
     case ('alpb')
       if (pr) call tblite%ctx%message("tblite> using ALPB/"//solvdum)
       alpb_tmp%dielectric_const = solv_data%eps
-      alpb_tmp%alpb=.true.
+      alpb_tmp%alpb = .true.
       !alpb_tmp%method=method
-      alpb_tmp%solvent=solv_data%solvent
+      alpb_tmp%solvent = solv_data%solvent
       !alpb_tmp%xtb=.true.
-      allocate (solv_inp%alpb, source=alpb_tmp)
-      cds_tmp%alpb=.true.
-      cds_tmp%solvent=solv_data%solvent
-      !cds_tmp%method=method 
-      allocate (solv_inp%cds, source=cds_tmp)
-      shift_tmp%alpb=.true.
-      shift_tmp%solvent=solv_data%solvent
+      allocate (solv_inp%alpb,source=alpb_tmp)
+      cds_tmp%alpb = .true.
+      cds_tmp%solvent = solv_data%solvent
+      !cds_tmp%method=method
+      allocate (solv_inp%cds,source=cds_tmp)
+      shift_tmp%alpb = .true.
+      shift_tmp%solvent = solv_data%solvent
       !shift_tmp%method=method
-      allocate (solv_inp%shift, source=shift_tmp)
+      allocate (solv_inp%shift,source=shift_tmp)
     case default
-      if (pr) call tblite%ctx%message("tblite> Unknown tblite implicit solvation model!")
-      return
+      write (stdout,'(a)') 'Error: unknown tblite implicit solvation model "'//trim(smodel)//'"!'
+      error stop
     end select
 
-    str = 'tblite> WARNING: implicit solvation energies are not entirely '// &
-    &'consistent with the xtb implementation.'
-    if (pr) call tblite%ctx%message(str)
-
 !>--- add electrostatic (Born part) to calculator
     call new_solvation(solv,mctcmol,solv_inp,error,method)
     if (allocated(error)) then
-      if (pr) call tblite%ctx%message("tblite> failed to set up tblite implicit solvation!")
-      return
+      write (stdout,'(a)') 'Error: failed to set up tblite implicit solvation: '//error%message
+      error stop
     end if
     call move_alloc(solv,cont)
     call tblite%calc%push_back(cont)
@@ -338,6 +415,11 @@ subroutine tblite_singlepoint(mol,chrg,uhf,tblite,energy,gradient,iostatus)
 !* The actual calculator call.
 !* The tblite object must be set up at this point
 !**************************************************
+#ifdef WITH_TBLITE
+#ifdef WITH_GXTB
+    use multicharge,only:get_charges
+#endif
+#endif
     implicit none
     type(coord),intent(in)   :: mol
     integer,intent(in)       :: chrg
@@ -366,17 +448,39 @@ subroutine tblite_singlepoint(mol,chrg,uhf,tblite,energy,gradient,iostatus)
 !>--- make an mctcmol object from mol
     call tblite_mol2mol(mol,chrg,uhf,mctcmol)
 
+!>--- update geometry-dependent EEQ-BC charges in wfn_aux (allocated once in tblite_setup)
+#ifdef WITH_GXTB
+    if (allocated(tblite%wfn_aux)) then
+      call get_charges(tblite%calc%charge_model,mctcmol,error,tblite%wfn_aux%qat(:,1), &
+      &                dqdr=tblite%wfn_aux%dqatdr(:,:,:,1),dqdL=tblite%wfn_aux%dqatdL(:,:,:,1))
+      if (allocated(error)) then
+        if (pr) call tblite%ctx%message("tblite> auxiliary charge model failed: "//error%message)
+        iostatus = 1
+        return
+      end if
+    end if
+#endif
+
 !>--- call the singlepoint routine
     select case (tblite%lvl)
     case default
+#ifdef WITH_GXTB
+      if (allocated(tblite%wfn_aux)) then
+        call xtb_singlepoint(tblite%ctx,mctcmol,tblite%calc,tblite%wfn,tblite%accuracy, &
+        &                    energy,gradient,sigma,verbosity,results=tblite%res,wfn_aux=tblite%wfn_aux)
+      else
+        call xtb_singlepoint(tblite%ctx,mctcmol,tblite%calc,tblite%wfn,tblite%accuracy, &
+        &                    energy,gradient,sigma,verbosity,results=tblite%res)
+      end if
+#else
       call xtb_singlepoint(tblite%ctx,mctcmol,tblite%calc,tblite%wfn,tblite%accuracy, &
-     &                    energy,gradient, &
-     &                    sigma,verbosity,results=tblite%res)
+      &                    energy,gradient,sigma,verbosity,results=tblite%res)
+#endif
     case (xtblvl%ceh)
       call ceh_singlepoint(tblite%ctx,tblite%calc,mctcmol,tblite%wfn, &
       &              tblite%accuracy,verbosity)
     case (xtblvl%eeq)
-      call eeq_guess(mctcmol,tblite%calc,tblite%wfn)
+      call eeq_guess(mctcmol,tblite%calc,tblite%wfn,error)
     end select
 
     if (tblite%ctx%failed()) then
@@ -444,6 +548,37 @@ subroutine tblite_addsettings(tblite,maxscc,rdwbo,saveint,accuracy)
 #endif
   end subroutine tblite_addsettings
 
+  subroutine tblite_add_efield(tblite,efield)
+!**********************************************************
+!* tblite_add_efield
+!* if efield is allocated, add it to the tblite calculator
+!**********************************************************
+#ifdef WITH_TBLITE
+    use tblite_container,only:container_type
+    use tblite_external_field,only:electric_field
+#endif
+    implicit none
+    type(tblite_data),intent(inout) :: tblite
+    real(wp),intent(in),allocatable :: efield(:)
+    class(container_type),allocatable :: cont
+    logical :: pr
+    character(len=90) :: str
+#ifdef WITH_TBLITE
+    pr = (tblite%ctx%verbosity > 0)
+    if (allocated(efield)) then
+      if (pr) then
+        write (str,'(a,3(es10.3),a)') "tblite> Calculation includes the following electric field:"
+        call tblite%ctx%message(trim(str))
+        write (str,'(8x, a,3(es15.5,1x),a)') "[",efield,"] V/Å"
+        call tblite%ctx%message(trim(str))
+        call tblite%ctx%message('')
+      end if
+      cont = electric_field(efield*vatoau)
+      call tblite%calc%push_back(cont)
+    end if
+#endif
+  end subroutine tblite_add_efield
+
 !========================================================================================!
 
   subroutine tblite_getwbos(tblite,nat,wbo)
@@ -565,6 +700,161 @@ subroutine tblite_read_param_record(paramfile,param,io)
   end subroutine tblite_read_param_record
 #endif
 
+!========================================================================================!
+
+#ifdef WITH_TBLITE
+  subroutine tblite_internal_ceh_guess(mctcmol,tblite)
+    !*********************************************************
+    !* Init the tblite calculator with a set of CEH charges
+    !*********************************************************
+    implicit none
+    type(tblite_data),intent(inout) :: tblite
+    type(structure_type),intent(in) :: mctcmol
+    !> LOCAL
+    type(wavefunction_type) :: wfn_ceh
+    type(xtb_calculator)    :: calc_ceh
+    type(error_type),allocatable :: error
+    integer :: verbosity
+    logical :: pr
+    real(wp),parameter :: etemp_guess_au = 4000.0_wp*ktoau
+
+    !> if we only do a eeq or ceh calc, we don't need this, so return
+    select case (tblite%lvl)
+    case default
+      continue
+    case (xtblvl%ceh,xtblvl%eeq)
+      return
+    end select
+
+    pr = (tblite%ctx%verbosity > 0)
+    if (tblite%ctx%verbosity > 1) then
+      verbosity = tblite%ctx%verbosity
+    else
+      verbosity = 0
+    end if
+
+    !> ceh guess calculator and wavefunction
+    call new_ceh_calculator(calc_ceh,mctcmol,error)
+    if (allocated(error)) return
+    call new_wavefunction(wfn_ceh,mctcmol%nat,calc_ceh%bas%nsh, &
+    &                     calc_ceh%bas%nao,1,etemp_guess_au)
+
+    !> TODO ceh guess efield
+
+    call ceh_singlepoint(tblite%ctx,calc_ceh,mctcmol,wfn_ceh, &
+    &              tblite%accuracy,verbosity)
+
+    if (tblite%ctx%failed()) then
+      if (pr) then
+        call tblite%ctx%get_error(error)
+        call tblite%ctx%message("CEH singlepoint calculation failed")
+        call tblite%ctx%message("-> "//error%message)
+      end if
+      return
+    end if
+
+    !> pass on to actual calculator
+    tblite%wfn%qat(:,1) = wfn_ceh%qat(:,1)
+    call shell_partition(mctcmol,tblite%calc,tblite%wfn)
+
+  end subroutine tblite_internal_ceh_guess
+#endif
+
+!========================================================================================!
+
+  subroutine tblite_quick_ceh_q(mol,q,chrg,uhf,pr,prch)
+    !*********************************************************
+    !* Calculate CEH charges
+    !*********************************************************
+    implicit none
+    type(coord),intent(in) :: mol
+    integer,intent(in) :: chrg
+    real(wp),intent(out),allocatable :: q(:)
+    integer,intent(in),optional :: uhf
+    logical,intent(in),optional :: pr
+    integer,intent(in),optional :: prch
+#ifdef WITH_TBLITE
+    type(structure_type) :: mctcmol
+    !> LOCAL
+    type(wavefunction_type) :: wfn_ceh
+    type(xtb_calculator)    :: calc_ceh
+    type(tblite_ctx)        :: ctx
+    type(error_type),allocatable :: error
+#endif
+    integer :: verbosity,uhf_loc
+    logical :: pr_loc
+    real(wp),parameter :: etemp_guess_au = 4000.0_wp*ktoau
+    real(wp),parameter :: accuracy = 1.0_wp
+
+    pr_loc = .false.
+    if (present(pr)) pr_loc = pr
+    verbosity = 0
+    if (pr_loc) verbosity = 2
+
+    allocate (q(mol%nat),source=0.0_wp)
+
+#ifdef WITH_TBLITE
+    uhf_loc = 0
+    if (present(uhf)) uhf_loc = uhf
+    if (present(prch)) ctx%unit = prch
+
+    !>--- make an mctcmol object from mol
+    call tblite_mol2mol(mol,chrg,uhf_loc,mctcmol)
+
+    !> ceh guess calculator and wavefunction
+    call new_ceh_calculator(calc_ceh,mctcmol,error)
+    if (allocated(error)) return
+    call new_wavefunction(wfn_ceh,mctcmol%nat,calc_ceh%bas%nsh, &
+    &                     calc_ceh%bas%nao,1,etemp_guess_au)
+
+    !> TODO ceh guess efield
+
+    call ceh_singlepoint(ctx,calc_ceh,mctcmol,wfn_ceh, &
+    &              accuracy,verbosity)
+
+    if (ctx%failed()) then
+      if (pr_loc) then
+        call ctx%get_error(error)
+        call ctx%message("CEH singlepoint calculation failed")
+        call ctx%message("-> "//error%message)
+      end if
+      return
+    end if
+
+    !> pass on the charges
+    q(:) = wfn_ceh%qat(:,1)
+#else /* WITH_TBLITE */
+    write (stdout,*) 'Error: Compiled without tblite support!'
+    write (stdout,*) 'Use -DWITH_TBLITE=true in the setup to enable this function'
+    error stop
+#endif
+  end subroutine tblite_quick_ceh_q
+
+! ══════════════════════════════════════════════════════════════════════════════
+#ifdef WITH_TBLITE
+  subroutine get_spin_constants(wll,mol,bas)
+    use tblite_basis_type,only:basis_type
+    use tblite_data_spin,only:get_spin_constant
+    real(wp),allocatable,intent(out) :: wll(:,:,:)
+    type(structure_type),intent(in) :: mol
+    type(basis_type),intent(in) :: bas
+
+    integer :: izp,ish,jsh,il,jl
+
+    allocate (wll(bas%nsh,bas%nsh,mol%nid),source=0.0_wp)
+
+    do izp = 1,mol%nid
+      do ish = 1,bas%nsh_id(izp)
+        il = bas%cgto(ish,izp)%ang
+        do jsh = 1,bas%nsh_id(izp)
+          jl = bas%cgto(jsh,izp)%ang
+          wll(jsh,ish,izp) = get_spin_constant(jl,il,mol%num(izp))
+        end do
+      end do
+    end do
+  end subroutine get_spin_constants
+#endif
+
 !========================================================================================!
 !========================================================================================!
 end module tblite_api
diff --git a/src/ccegen.f90 b/src/ccegen.f90
deleted file mode 100644
index bd991425..00000000
--- a/src/ccegen.f90
+++ /dev/null
@@ -1,1373 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2020 Philipp Pracht, Stefan Grimme
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!================================================================================!
-
-!=========================================================================================!
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC!
-!=========================================================================================!
-!===============================================================================!
-!
-!  This is the CCEGEN routine, used for clustering a conformational ensemble
-!  and determine representative structures for the molecule.
-!
-!  A principal component analysis (PCA) is performed, and the generated data
-!  is clustered.
-!
-!
-!  On Input:   pr - printout boolean
-!              fname - name of the ensemble file
-!
-!==============================================================================!
-subroutine CCEGEN(env,pr,fname)
-  use crest_parameters,idp => dp
-  use crest_data
-  use zdata
-  use strucrd
-  use utilities
-  implicit none
-  type(systemdata) :: env    ! MAIN STORAGE OS SYSTEM DATA
-  type(timer) :: ctimer
-  logical,intent(in)   :: pr
-  character(len=*),intent(in) :: fname
-  type(zmolecule) :: zmol
-  type(zequal) :: groups
-  type(zequal) :: subgroups
-  integer,allocatable :: inc(:)
-  logical :: heavyonly
-  integer :: i,j,k,l,ich,c
-  real(wp) :: dum,dum2
-  type(ensemble) :: zens
-
-  character(len=:),allocatable :: measuretype
-
-  !>--- SVD params
-  integer :: ntaken
-  integer :: nallnew
-  real(wp),allocatable :: xyznew(:,:,:)
-  !integer,allocatable  :: atnew(:)
-  real(wp),allocatable :: measure(:,:) !this is what is passed to the SVD
-  integer :: mn,mm                     !--> measure(mn,mm)
-  real(wp),allocatable :: pc(:)        !the principal components
-  real(wp),allocatable :: pcvec(:,:)   !the principal component eigenvectors
-  real(wp),allocatable :: pcdum(:,:)
-  integer :: nbnd,ndied
-  integer,allocatable :: diedat(:,:)   !atoms spanning relevant dihedral angles
-  real(wp),allocatable :: diedr(:)
-  real(wp) :: pcsum
-  real(wp) :: pcthr
-  real(wp) :: pcmin
-  integer :: pccap
-  integer :: npc
-  real(wp),allocatable :: geo(:,:)
-  integer,allocatable :: na(:),nb(:),nc(:)
-
-  !>--- CLUSTERING params
-  character(len=:),allocatable :: clusteralgo
-  integer :: nclust                    !number of clusters
-  integer :: nclustiter                !iterator for nclust
-  integer :: nclustmin,nclustmax
-  integer,allocatable :: member(:)     !track cluster correspondence
-  real(ap),allocatable :: p(:),q(:)
-  real(sp),allocatable :: dist(:)
-  real(ap),allocatable :: centroid(:,:)
-  integer(idp) :: ndist,klong
-  real(ap) :: eucdist !this is a function
-  real(wp) :: DBI,pSF,SSRSST,SSRSSTthr
-  real(wp) :: csthr
-  integer :: ncb,ancb
-  real(wp),allocatable :: eclust(:)
-  integer,allocatable :: clustbest(:),ind(:)
-  real(wp),allocatable :: statistics(:,:)
-  logical,allocatable :: extrema(:,:)
-  logical :: autolimit
-  real(wp) :: fraclimit
-
-  !>--- printout and params
-  real(wp) :: emin,erel
-  real(wp),parameter :: kcal = 627.5095d0
-  !real(wp),parameter :: pi =  3.14159265358979D0
-  real(wp),parameter :: rad = 180.0d0/pi
-
-  call ctimer%init(20)
-  if (pr) then
-    call largehead('Principal Component Analysis (PCA) and Clustering')
-    write (stdout,'(1x,a,a)') 'Input file: ',trim(fname)
-  end if
-
-!=========================================================!
-! set threads
-!=========================================================!
-  call cregen_setthreads(stdout,env,pr)
-
-!=========================================================!
-! Prepare a coordinate ensemble for the clustering
-!=========================================================!
-  !>--- 0. Set defaults, read ensemble
-  call zens%open(fname) !read in the ensemble
-  if (zens%nall < 1) then
-    error stop "Ensemble is empty! must stop"
-  else if (zens%nall == 1) then
-    if (pr) then
-      write (stdout,*) 'Only one structure in ensemble!'
-      write (stdout,*) 'Write structure to ',clusterfile,' and skip PCA parts'
-    end if
-    open (newunit=ich,file=clusterfile)
-    dum = zens%er(1)
-    call wrxyz(ich,zens%nat,zens%at,zens%xyz(:,:,1),dum)
-    close (ich)
-    call zens%deallocate()
-    return
-  end if
-
-  heavyonly = .true.
-  !measuretype = 'dihedral'
-  measuretype = env%pcmeasure
-  clusteralgo = 'kmeans'
-  !pcthr = 0.85d0  !PCs must add up to this amount of "representability"
-  pcthr = env%pcthr
-  pcmin = env%pcmin
-  !csthr = 0.80d0  !threshold for SSR/SST to select a suitable cluster count
-  csthr = env%csthr
-  !pccap = 100   !a cap for the number of principal components used in the clustering
-  pccap = env%pccap
-  autolimit = .true. !if the ensemble is very large, take only a fraction to speed up things
-  !(only for predefined clustersizes with "-cluster N" )
-  fraclimit = 0.25d0 !if autolimit=true, 1/4 of the ensemble is taken
-
-  !>--- 1. topology for reference strucuture
-  if (env%wbotopo) then
-    env%wbofile = 'wbo'
-  else
-    env%wbofile = 'none given'
-  end if
-  zens%xyz = zens%xyz/bohr  !ANG to Bohr for topo
-  call simpletopo(zens%nat,zens%at,zens%xyz,zmol,pr,.false.,env%wbofile)
-  zens%xyz = zens%xyz*bohr  !Bohr to ANG
-  allocate (inc(zmol%nat),source=0)
-
-!===========================================================!
-  if (measuretype .ne. 'dihedral') then
-!===========================================================!
-    !>--- 2. read nuclear equivalencies
-    if (pr) then
-      write (stdout,*)
-      call smallhead('READING NUCLEAR EQUIVALENCIES')
-    end if
-    call readequals('anmr_nucinfo',zmol,groups)
-    if (pr) then
-      call groups%prsum(6) !--- print summary to screen
-      write (stdout,'(1x,a)') 'Unlisted nuclei (groups) are unique.'
-    end if
-
-    !>--- 3. distribute groups into subgroups basedon topology
-    if (pr) then
-      write (stdout,*)
-      call smallhead('ANALYZING EQUIVALENCIES')
-    end if
-    call distsubgr(zmol,groups,subgroups,inc,pr)
-
-    !>--- 4. Equivalent atoms must be excluded in clustering to reduce noise
-    if (pr) then
-      write (stdout,*)
-      call smallhead('DETERMINE ATOMS TO INCLUDE IN PCA')
-    end if
-    call excludeFromRMSD(zmol,inc)
-    if (sum(inc) == 0) then
-      if (pr) then
-        write (stdout,*) 'WARNING: No atoms included in PCA'
-        write (stdout,*) 'Including more atoms ...'
-      end if
-      inc = 1
-      !-- for this exclude the equivalent atoms from anmr_nucinfo directly
-      do i = 1,groups%ng
-        if (groups%grp(i)%nm > 1) then
-          write (stdout,*) groups%grp(i)%mem
-          do j = 1,groups%grp(i)%nm
-            k = groups%grp(i)%mem(j)
-            inc(k) = 0
-          end do
-        end if
-      end do
-    end if
-    !>-- exclude user set atoms
-    if (env%pcaexclude) then
-      call excludeSelected(zmol,inc,env%atlist)
-    end if
-    !>-- exclude H atoms
-    if (heavyonly) then
-      call excludeLight(zmol,inc)
-    end if
-    if (pr) then
-      do i = 1,zmol%nat
-        if (inc(i) == 1) then
-          write (stdout,'(1x,a,a,i0,a,5x,a)') zmol%zat(i)%el,'(',i,')','taken'
-        end if
-      end do
-    end if
-    ntaken = sum(inc)
-    !>--- if we have too few, include the heav atoms at least
-    if (ntaken <= 3) then
-      do i = 1,zmol%nat
-        if (zmol%at(i) /= 1) then
-          inc(i) = 1
-          if (pr) write (stdout,'(1x,a,a,i0,a,5x,a)') zmol%zat(i)%el,'(',i,')','taken'
-        end if
-      end do
-    end if
-    ntaken = sum(inc)
-
-    call zmol%deallocate
-
-    !>-- for very large ensemble files limit the clustering
-    if (autolimit) then
-      if ((env%nclust /= 0).and.(env%nclust*100 < zens%nall)) then
-        dum = float(zens%nall)*fraclimit
-        dum2 = float(env%nclust)
-        nallnew = nint(max(dum,dum2))
-      else
-        nallnew = zens%nall
-      end if
-    else
-      nallnew = zens%nall
-    end if
-
-    !>--- 5. Transfer the relevant atoms to a new array
-    allocate (xyznew(3,ntaken,nallnew))!,atnew(ntaken))
-    do i = 1,nallnew
-      k = 0
-      do j = 1,zens%nat
-        if (inc(j) == 1) then
-          k = k+1
-          xyznew(:,k,i) = zens%xyz(:,j,i)
-          !atnew(k) = zens%at(j)
-        end if
-      end do
-    end do
-
-!===================================================!
-  else !measuretype=='dihedral'
-!===================================================!
-
-    !-- for very large ensemble files limit the clustering
-    if (autolimit) then
-      if ((env%nclust /= 0).and.(env%nclust*100 < zens%nall)) then
-        dum = float(zens%nall)*fraclimit
-        dum2 = float(env%nclust)
-        nallnew = nint(max(dum,dum2))
-      else
-        nallnew = zens%nall
-      end if
-    else
-      nallnew = zens%nall
-    end if
-
-    inc = 1
-    ntaken = sum(inc)
-
-    call zmol%countbonds()
-    nbnd = zmol%nb
-    allocate (diedat(4,zmol%nb),source=0)
-    call getdiederatoms(zmol,zmol%nat,inc,nbnd,diedat,ndied)
-    ntaken = ndied
-!==================================================!
-  end if
-!==================================================!
-
-!===================================================================================================!
-! do the SVD to get the principal components
-!===================================================================================================!
-  if (ntaken > 3) then !> all of this only makes sense if we have something to compare
-    call ctimer%start(1,'PCA')
-    if (pr) then
-      write (stdout,*)
-      call smallhead('PRINCIPAL COMPONENT ANALYSIS')
-    end if
-    !mm = zens%nall
-    mm = nallnew
-    select case (measuretype)
-      !==========================================================================!
-    case ('cma','CMA','cmadist')
-      if (pr) then
-        write (stdout,'(1x,a)') 'Using CMA DISTANCES as descriptors:'
-      end if
-      !>-- all structures should have been shifted to the CMA by CREGEN
-      !>   therefore assume the CMA is at (0,0,0).
-      !>   somewhat robust measure, but provides less information.
-      mn = min(ntaken,mm)
-      allocate (measure(mn,mm),pc(mn),pcvec(mm,mn))
-      do i = 1,mm
-        do j = 1,mn
-          measure(j,i) = xyznew(1,j,i)**2+ &
-       &                 xyznew(2,j,i)**2+ &
-       &                 xyznew(3,j,i)**2
-          measure(j,i) = sqrt(measure(j,i))
-        end do
-      end do
-      !==========================================================================!
-    case ('cartesian','coords')
-      if (pr) then
-        write (stdout,'(1x,a)') 'Using CARTESIAN COORDINATES as descriptors:'
-      end if
-      !>-- all Cartesian components of the selected atoms
-      !>   REQUIRES PERFECT ALIGNMENT(!), hence not very robust
-      mn = min(ntaken*3,mm)
-      allocate (measure(mn,mm),pc(mn),pcvec(mm,mn))
-      do i = 1,mm
-        l = 0
-        do j = 1,ntaken
-          do k = 1,3
-            l = l+1
-            measure(j,l) = xyznew(k,j,i)
-          end do
-        end do
-      end do
-      !==========================================================================!
-    case default !case( 'zmat','zmatrix' )
-      if (pr) then
-        write (stdout,'(1x,a)') 'Using ZMATRIX as descriptors:'
-      end if
-      !>-- dihedral angles
-      mn = ntaken-3 !>--- first three dihedral angles are zero
-      mn = min(mm,mn) !>--- no more descriptors than structures for SVD!
-      if (mn < 1) then !> we need at least 2 dihedral angles, and therefore 5 descriptors
-        if (pr) then
-          write (stdout,*) "Not enough descriptors for PCA!"
-          return
-        end if
-      end if
-      allocate (measure(mn,mm),pc(mn),pcvec(mm,mn))
-      allocate (geo(3,ntaken),source=0.0d0)
-      allocate (na(ntaken),nb(ntaken),nc(ntaken))
-      do i = 1,mm
-        na = 0; nb = 0; nc = 0
-        geo = 0.0d0
-        call xyzint(xyznew(1:3,1:ntaken,i),ntaken,na,nb,nc,rad,geo)
-        do j = 1,mn
-          k = j+3
-          measure(j,i) = geo(3,k)
-        end do
-      end do
-      deallocate (nc,nb,na,geo)
-      !=========================================================================!
-    case ('dihedral')
-      mn = min(mm,ntaken) !>--- no more descriptors than structures for SVD!
-      allocate (measure(mn,mm),diedr(ndied))
-      if (pr) then
-        write (stdout,'(1x,a)') 'Using DIHEDRAL ANGLES as descriptors:'
-        do i = 1,mn
-          write (stdout,'(1x,a,4i6)') 'Atoms: ',diedat(1:4,i)
-        end do
-        write (stdout,*)
-      end if
-      do i = 1,mm
-        call calc_dieders(zens%nat,zens%xyz(:,:,i),ndied,diedat,diedr)
-        do j = 1,mn
-          !   if(i<5 .and. pr)then
-          !   write(*,'(1x,4i6,1x,f8.2)') diedat(1:4,j),diedr(j)
-          !   endif
-          measure(j,i) = diedr(j)
-        end do
-      end do
-      if (allocated(diedat)) deallocate (diedat)
-      if (allocated(diedr)) deallocate (diedr)
-      allocate (pc(mn),pcvec(mm,mn))
-      !=====================================================!
-    end select
-    !=====================================================!
-    if (pr) then
-      write (stdout,*)
-      write (stdout,'(1x,a,i0,a,i0,a)') 'Performing SVD for ', &
-&          mm,' structures and ',mn,' props'
-    end if
-    !>--- do the SVD  ! MM must not be smaller than MN !
-    call SVD_to_PC(measure,mm,mn,pc,pcvec,.false.)
-!=========================================================================================!
-    call ctimer%stop(1)
-  else
-    write (stdout,*) 'There are not enough descriptors for a PCA!'
-    write (stdout,*) 'Taking all structures as representative and writing ',clusterfile
-    open (newunit=ich,file=clusterfile)
-    do i = 1,zens%nall
-      dum = zens%er(i)
-      call wrxyz(ich,zens%nat,zens%at,zens%xyz(:,:,i),dum)
-    end do
-    close (ich)
-    return
-  end if
-!========================================================================================!
-  if (allocated(measure)) deallocate (measure)
-  if (allocated(xyznew)) deallocate (xyznew)
-  if (allocated(inc)) deallocate (inc)
-
-  !>--- normalize PC eigenvalues
-  pcsum = sum(pc)
-  pc = pc/pcsum
-  !>--- get the contributing principal components
-  pcsum = 0.0d0
-  npc = 0
-  do i = 1,mn
-    if (pc(i) < pcmin) exit
-    pcsum = pcsum+pc(i)
-    npc = npc+1
-    if (pcsum .ge. pcthr) exit
-  end do
-  !npc = max(npc,2) !>-- at least 2 principal components should be used
-  npc = min(npc,pccap)
-  pcsum = 0.0d0
-  do i = 1,npc
-    pcsum = pcsum+pc(i)
-  end do
-
-  if (pr) then
-    i = min(100,MM)
-    k = min(npc,6)
-    write (stdout,*)
-    call smallhead('EIGENVECTORS AND NORMALIZED EIGENVALUES OF SVD ANALYIS')
-    call PRMAT(6,pcvec,i,k,'Eigenvectors of principal components')
-    write (stdout,'(1x,a,i0,a)') 'NOTE: eigenvectors are only shown for the first ',i,' structures'
-    write (stdout,'(1x,a,i0,a)') '      and the first ',k,' contributing principal components.'
-    write (stdout,*)
-
-    write (stdout,*) mn,'principal component eigenvalues (normalized)'
-    write (stdout,*) pc
-    !call PRMAT(6,pc,mn,1,'Principal components (eigenvalues)')
-    write (stdout,*)
-    write (stdout,'(1x,a,i0,a,f6.2,a)') 'The first ',npc,' components account for a total of ',100.d0*pcsum,'% of the'
-    write (stdout,'(1x,a)') 'ensembles unique structural features and are used for the clustering'
-  end if
-
-  !>--- use some less memory and rearrange the eigenvectors (COLUMNS AND ROWS ARE SWAPPED)
-  !>    untaken PCs are not considered further
-  allocate (pcdum(npc,mm))
-  do i = 1,mm
-    pcdum(1:npc,i) = pcvec(i,1:npc)
-  end do
-  call move_alloc(pcdum,pcvec)  !>THIS CHANGES THE SHAPE OF pcvec (COLUMNS AND ROWS ARE SWAPPED)
-
-!=========================================================!
-! do the Clustering
-!=========================================================!
-
-  if (pr) then
-    write (stdout,*)
-    call smallhead('CLUSTERING ANALYSIS OF PRINCIPAL COMPONENTS')
-  end if
-
-  allocate (member(mm),source=0)
-
-  !>--- get Euclidean distances (packed matrix) between all structures
-  !> ndist = (mm*(mm+1))/2 ! overflows for large ensembles
-  ndist = mm
-  ndist = ndist*(mm+1)
-  ndist = ndist/2
-  allocate (dist(ndist),source=0.0_sp)
-  allocate (p(npc),q(npc),source=0.0_ap)
-
-  do i = 1,mm
-    p(1:npc) = pcvec(1:npc,i)
-!$OMP PARALLEL PRIVATE ( j, klong, q, dum ) &
-!$OMP SHARED ( i, dist, npc, p, pcvec )
-!$OMP DO
-    do j = 1,i
-      q(1:npc) = pcvec(1:npc,j)
-      dum = eucdist(npc,p,q)
-      klong = lina(i,j)
-      dist(klong) = real(dum,sp)
-    end do
-!$OMP END DO
-!$OMP END PARALLEL
-  end do
-
-  !>-- NOTE
-  !>-- different clustering algorithms exist, but what is common
-  !>-- among them is, that no optimal number of clusters is known
-  !>-- at the beginning. The lower bound for the number of
-  !>-- clusters is the number of investigated PCs, the upper
-  !>-- bound is the number of structures
-  if (pr) then
-    select case (clusteralgo)
-    case ('means','kmeans')
-      write (stdout,'(1x,a)') 'Using a MEANS cluster algorithm.'
-    end select
-    write (stdout,'(1x,a)') 'For a good review of cluster algorithms see'
-    write (stdout,'(1x,a)') 'JCTC, 2007, 3, 2312 (doi.org/10.1021/ct700119m)'
-    write (stdout,*)
-    write (stdout,'(1x,a)') 'DBI = Davies-Bouldin index'
-    write (stdout,'(1x,a)') 'pSF = pseudo F-statistic'
-    write (stdout,'(1x,a)') 'SSR/SST = ratio of explained and unexplained variation'
-    write (stdout,*)
-    write (stdout,'(1x,a8,4x,a14,4x,a14,4x,a14)') 'Nclust','DBI','pSF','SSR/SST'
-    write (stdout,'(1x,a8,4x,a14,4x,a14,4x,a14)') '------','-------------','-------------','-------------'
-  end if
-
-!-----------------------------------------------------------------------!
-! Cluster evaluation settings
-!-----------------------------------------------------------------------!
-  if (env%maxcluster == 0) then
-    !nclustmax=100  !some random default value
-    call clustleveval(env,nclustmax,csthr,SSRSSTthr) ! defaults
-    nclustmax = min(mm,nclustmax)
-    !SSRSSTthr=0.90  !exit if this value is reached  for SSR/SST
-  else
-    nclustmax = max(2,env%maxcluster)  !no less than 2 clusters
-    nclustmax = min(mm,env%maxcluster) !there cannot be more clustes than structures.
-  end if
-  if (env%nclust == 0) then
-    nclustmin = 1
-  else
-    !>-- predefined number of clusters
-    nclust = min(mm,env%nclust)
-    nclustmin = nclust
-    nclustmax = nclust
-  end if
-
-  allocate (statistics(3,nclustmax),source=0.0d0)
-  CLUSTERSIZES: do nclustiter = nclustmin,nclustmax
-
-    !>-- regular case: test continuous cluster sizes
-    nclust = nclustiter
-    !>-- special case: test cluster sizes incrementally (good for large ensembles)
-    if (env%clustlev >= 10) then
-      dum = float(mm)/float(nclustmax)
-      dum2 = dum*float(nclustiter)
-      nclust = nint(dum2)
-    end if
-
-    allocate (centroid(npc,nclust),source=0.0_ap)
-    centroid = 0.0_ap
-
-    select case (clusteralgo)
-    case ('means','kmeans')
-      call ctimer%start(2,'k-Means clustering')
-      call kmeans(nclust,npc,mm,centroid,pcvec,ndist,dist,member)
-      call ctimer%stop(2)
-    end select
-
-    call ctimer%start(3,'statistics')
-    call cluststat(nclust,npc,mm,centroid,pcvec,member,DBI,pSF,SSRSST)
-    if (pr) then
-      write (stdout,'(1x,i8,4x,f14.6,4x,f14.6,4x,f14.6)') nclust,DBI,pSF,SSRSST
-    end if
-    call ctimer%stop(3)
-    deallocate (centroid)
-
-    statistics(1,nclust) = DBI
-    statistics(2,nclust) = pSF
-    statistics(3,nclust) = SSRSST
-
-    if (nclust == env%nclust) exit
-    if (SSRSST > SSRSSTthr) exit
-  end do CLUSTERSIZES
-  if (allocated(centroid)) deallocate (centroid)
-
-  write (stdout,*)
-  if (env%nclust == 0) then
-    if (pr) then
-      write (stdout,'(1x,a,i0,a)') 'Ensemble checked up to a partitioning into ',nclust,' clusters.'
-      write (stdout,'(1x,a)') 'Local MINIMA of the DBI indicate adequate cluster counts.'
-      write (stdout,'(1x,a)') 'Local MAXIMA of the pSF indicate adequate cluster counts.'
-      write (stdout,'(1x,a)') 'Higher SSR/SST vaules indicate more distinct clusters.'
-      write (stdout,'(1x,a)') 'Analyzing statistical values ...'
-    end if
-    k = nclust
-    allocate (extrema(2,k))
-    call ctimer%start(3,'statistics')
-    call statanal(k,nclustmax,statistics,extrema,pr)
-    if (pr) call statwarning(fname)
-    !>-- determine a suggested cluster size (smallest suggested cluster with good SSR/SST)
-    do i = 2,k
-      if ((extrema(1,i).or.extrema(2,i)).and.(statistics(3,i) > csthr)) then
-        nclust = i
-        exit
-      end if
-    end do
-    call ctimer%stop(3)
-    deallocate (extrema)
-    if (pr) then
-      write (stdout,*)
-      write (stdout,'(1x,a,f4.2,a,i0)') 'Suggested (SSR/SST >',csthr,') cluster count: ',nclust
-    end if
-    !>-- calculate the determined partition into clusters again for final file
-    allocate (centroid(npc,nclust),source=0.0_ap)
-    select case (clusteralgo)
-    case ('means','kmeans')
-      call ctimer%start(2,'k-Means clustering')
-      call kmeans(nclust,npc,mm,centroid,pcvec,ndist,dist,member)
-      call ctimer%stop(2)
-    end select
-    deallocate (centroid)
-  else
-    if (pr) then
-      write (stdout,'(1x,a,i0,a)') 'Ensemble partitioning into ',nclust,' clsuters.'
-    end if
-  end if
-  deallocate (statistics)
-
-  deallocate (q,p,dist)
-  !>-- finally, assign a representative structure to each group (based on lowest energy)
-  !>-- and write the new ensemble file
-  call PCA_grpwrite(nclust,npc,mm,pcvec,member)
-
-  !ncb=maxval(member,1) !--total number of cluster
-  ncb = nclust
-  ancb = ncb           !>--actual number of clusters
-
-  if (ancb .le. 1) return
-
-  if (pr) then
-    write (stdout,*)
-    write (stdout,'(1x,a)') 'Representative structures'
-    write (stdout,'(1x,a6,1x,a6,3x,a6,1x,a16,1x,a16)') 'Nr.','conf.','clust.','Etot/Eh','Erel/ kcal/mol'
-    write (stdout,'(1x,a6,1x,a6,3x,a6,1x,a16,1x,a16)') '---','-----','------','-------','--------------'
-  end if
-  allocate (eclust(ncb),source=0.0d0)
-  allocate (clustbest(ncb),ind(ncb),source=0)
-  !>--- initialize eclust and clustbest
-  iiincb: do i = 1,ncb
-    do j = 1,mm
-      if (member(j) == i) then
-        eclust(i) = zens%er(j)
-        clustbest(i) = j
-        cycle iiincb
-      end if
-    end do
-  end do iiincb
-  !>--- then, look for the lowest energy
-  do i = 1,ncb
-    ind(i) = i
-    c = 0
-    do j = 1,mm
-      if (member(j) == i) then
-        c = c+1
-        if (zens%er(j) < eclust(i)) then
-          eclust(i) = zens%er(j)
-          clustbest(i) = j
-        end if
-      end if
-    end do
-    !>-- if there are clusters without structures
-    if (c == 0) then
-      clustbest(i) = -1
-      ancb = ancb-1
-    end if
-  end do
-  call qsort(eclust,1,ncb,ind)
-  emin = minval(eclust,1)
-  open (newunit=ich,file=clusterfile)
-  do i = 1,ncb
-    k = clustbest(ind(i))
-    if (k > 0) then
-      dum = zens%er(k)
-      call wrxyz(ich,zens%nat,zens%at,zens%xyz(:,:,k),dum)
-      if (pr) then
-        erel = (dum-emin)*kcal
-        write (stdout,'(1x,i6,1x,i6,3x,i6,1x,f16.8,1x,f16.4)') i,k,member(k),dum,erel
-      end if
-    end if
-  end do
-  close (ich)
-  if (pr) then
-    write (stdout,'(/,1x,a)') '(The "clust." column refers to the cluster "ID")'
-    write (stdout,*)
-    write (stdout,'(1x,a,a,a,i0,a)') 'File ',clusterfile,' written with ',ancb,' representative structures.'
-    if (ancb < ncb) then
-      write (stdout,'(1x,a,i0,a)') '(',ncb-ancb,' clusters discarded due to cluster merge)'
-    end if
-  end if
-  call zens%deallocate()
-
-  if (pr) then
-    write (stdout,*)
-    !write(*,'(1x,a)') 'Timings:'
-    !call eval_sub_timer(ctimer)
-    call ctimer%write(stdout,'PCA/k-Means clustering')
-  end if
-  call ctimer%clear()
-  return
-end subroutine CCEGEN
-
-!=======================================================================================!
-! set clustering level defaults
-!=======================================================================================!
-subroutine clustleveval(env,maxclust,csthr,SSRSSTthr)
-  use crest_parameters,idp => dp
-  use crest_data
-  implicit none
-  type(systemdata) :: env    ! MAIN STORAGE OS SYSTEM DATA
-  integer :: clev
-  integer :: maxclust
-  real(wp) :: csthr
-  real(wp) :: SSRSSTthr
-
-  SSRSSTthr = 0.90  !exit if this value is reached  for SSR/SST
-
-  clev = env%clustlev
-  if (env%clustlev >= 10) then  !for incremental modes
-    clev = env%clustlev-10
-  end if
-
-  select case (clev)
-  case (-1) !-- loose
-    maxclust = 25
-    csthr = 0.80d0
-  case (1)  !-- tight
-    maxclust = 400
-    if (env%clustlev >= 10) maxclust = 50
-    csthr = 0.85d0
-  case (2)  !-- vtight
-    maxclust = 400
-    if (env%clustlev >= 10) maxclust = 100
-    csthr = 0.9d0
-    SSRSSTthr = 0.92d0
-  case default !-- normal
-    maxclust = 100
-    if (env%clustlev >= 10) maxclust = 25
-    csthr = 0.80d0
-  end select
-
-  return
-end subroutine clustleveval
-
-!=======================================================================================!
-! write a file with the 2 most contributing principal components of each structure
-! and the cluster to which the structure belongs
-!=======================================================================================!
-subroutine PCA_grpwrite(nclust,npc,mm,pcvec,member)
-  use crest_parameters,idp => dp
-  implicit none
-  integer,intent(in) :: nclust  ! number of required centroids
-  integer,intent(in) :: npc,mm
-  real(wp),intent(in) :: pcvec(npc,mm)
-  integer,intent(in) :: member(mm)  ! membership for each structure
-  integer :: ich,i
-  open (newunit=ich,file='cluster.order')
-  write (ich,'(4x,i0,4x,i0,4x,i0)') mm,nclust,npc
-  if (npc > 1) then
-    do i = 1,mm
-      write (ich,'(i8,1x,f16.8,1x,f16.8,1x,i8)') i,pcvec(1,i),pcvec(2,i),member(i)
-    end do
-  else
-    do i = 1,mm
-      write (ich,'(i8,1x,f16.8,1x,i8)') i,pcvec(1,i),member(i)
-    end do
-  end if
-  close (ich)
-  return
-end subroutine PCA_grpwrite
-
-!=======================================================================================!
-! Exclude light - exclude H atoms in the inc array
-!=======================================================================================!
-subroutine excludeLight(zmol,inc)
-  use crest_parameters,idp => dp
-  use zdata
-  implicit none
-  type(zmolecule) :: zmol
-  integer :: inc(zmol%nat)
-  integer :: i
-  do i = 1,zmol%nat
-    if (zmol%at(i) == 1) then
-      inc(i) = 0
-    end if
-  end do
-  return
-end subroutine excludeLight
-
-!=======================================================================================!
-! Exclude Specified Atoms
-!=======================================================================================!
-subroutine excludeSelected(zmol,inc,atlist)
-  use crest_parameters,idp => dp
-  use zdata
-  implicit none
-  type(zmolecule) :: zmol
-  integer :: inc(zmol%nat)
-  character(len=*) :: atlist   !a string containing atom numbers, needs parsing
-  integer :: i,ncon
-  integer,allocatable :: inc2(:)
-  allocate (inc2(zmol%nat),source=0)
-  call parse_atlist_new(atlist,ncon,zmol%nat,zmol%at,inc2)
-  do i = 1,zmol%nat
-    if (inc2(i) == 1) inc(i) = 0
-  end do
-  deallocate (inc2)
-  return
-end subroutine excludeSelected
-
-!=======================================================================================!
-! Perform a single value decomposition (SVD) and get the principal components
-!
-! X = U*sig*V^(T)
-!
-! The eigenvalues saved in sig are the principal components
-! The SVD only works if M >= N
-!
-!=======================================================================================!
-subroutine svd_to_pc(measure,m,n,sig,U,pr)
-  use crest_parameters,idp => dp
-  implicit none
-  integer :: n,m
-  real(wp) :: measure(n,m)
-  real(wp) :: sig(n)
-  real(wp) :: U(m,n)
-  integer :: i,j,info,lwork
-  real(wp),allocatable :: mean(:),tmp(:)
-  integer,allocatable :: ind(:)
-  real(wp),allocatable :: X(:,:),V(:,:),work(:)
-  integer,allocatable :: iwork(:)
-  logical :: pr
-  if (pr) then
-    write (stdout,*) m,' mesaurements'
-    write (stdout,*) n,' props'
-  end if
-  allocate (mean(n),ind(m),tmp(m))
-  lwork = max(2*M+N,6*N+2*N*N)
-  allocate (X(m,n),V(n,n),iwork(m+3*n),work(lwork))
-  mean = 0.0d0
-  do i = 1,m
-    do j = 1,n
-      mean(j) = mean(j)+measure(j,i)
-    end do
-  end do
-  mean = mean/float(m)
-  if (pr) write (stdout,*) mean
-  do i = 1,m
-    do j = 1,n
-      X(i,j) = (mean(j)-measure(j,i))
-    end do
-  end do
-  if (pr) then
-    call PRMAT(6,X,m,n,'X')
-  end if
-!>--- LAPACKs' DGEJSV
-  call DGEJSV('C','U','V','N','N','N', &
- &              m,n,X,m,sig,U,m,V,n,                &
- &              WORK,LWORK,IWORK,INFO)
-  if (pr) then
-    write (stdout,*) info
-    write (stdout,*) sig
-    call PRMAT(6,U**2,M,N,'U')
-    call PRMAT(6,V,N,N,'V')
-  end if
-  deallocate (work,iwork,V,X,tmp,ind,mean)
-  return
-end subroutine svd_to_pc
-
-!======================================================================!
-! calculate the Euclidian distance between two points p and q
-!======================================================================!
-function eucdist(ndim,p,q) result(dist)
-  use crest_parameters,idp => dp
-  implicit none
-  real(ap) :: dist
-  integer :: ndim
-  real(ap) :: p(ndim)
-  real(ap) :: q(ndim)
-  integer :: i
-  dist = 0.0d0
-  do i = 1,ndim
-    dist = dist+(q(i)-p(i))**2
-  end do
-  dist = sqrt(dist)
-  return
-end function eucdist
-
-!======================================================================!
-! K-means clustering algorithm
-!
-! determine a position of cluster centroids iteratively for a given
-! number of centroids.
-!
-!======================================================================!
-subroutine kmeans(nclust,npc,mm,centroid,pcvec,ndist,dist,member)
-  use crest_parameters,idp => dp
-  implicit none
-  integer,intent(in) :: nclust  ! number of required centroids
-  integer,intent(in) :: npc,mm
-  real(wp),intent(in) :: pcvec(npc,mm)
-  integer(idp),intent(in) :: ndist
-  real(sp),intent(in)   :: dist(ndist)
-  integer,intent(inout) :: member(mm)  ! membership for each structure
-  real(ap),intent(inout):: centroid(npc,nclust)
-  integer,allocatable :: refmember(:)
-
-  if (nclust .le. 1) return !no singular clusters!
-
-  allocate (refmember(mm),source=0)
-
-  !>-- determine seeds for the centroids (i.e., initial positions)
-  call kmeans_seeds(nclust,npc,mm,centroid,pcvec,ndist,dist)
-
-  do
-    !>-- determine cluster membership for all structures
-    !>   (by shortest Euc. distance to the respective centroid)
-    member = 0 !reset
-    call kmeans_assign(nclust,npc,mm,centroid,pcvec,member)
-
-    !>-- check if memberships changed w.r.t. previous memberships
-    if (all(member == refmember)) then
-      exit
-    else
-      refmember = member
-    end if
-    !>-- update centroids if necessary
-    call kmeans_recenter(nclust,npc,mm,centroid,pcvec,member)
-  end do
-
-  deallocate (refmember)
-  return
-end subroutine kmeans
-!===================================================================!
-! determine cluster seeds for the K-means algo
-!===================================================================!
-subroutine kmeans_seeds(nclust,npc,mm,centroid,pcvec,ndist,dist)
-  use crest_parameters,idp => dp
-  use utilities
-  implicit none
-  integer :: nclust,npc,mm
-  real(ap) :: centroid(npc,nclust)
-  real(wp) :: pcvec(npc,mm)
-  integer(idp) :: ndist
-  real(sp) :: dist(ndist)
-  real(sp) :: ddum
-  integer(idp) :: k,kiter
-  integer :: i,j,l,c
-  real(wp) :: distsum,maxdistsum
-  real(ap) :: eucdist !this is a function
-  real(ap),allocatable :: p(:),q(:)
-  integer,allocatable :: taken(:)
-
-  !>--- first two centroids are located at the most apart points
-  !>    in the PC space
-  ddum = 0.0_sp
-  do kiter = 1,ndist
-    if (dist(kiter) > ddum) then
-      ddum=dist(kiter)
-      k = kiter
-    end if
-  end do
-  call revlin(k,j,i) !> reverse of the lin function, get indices i and j
-
-  centroid(1:npc,1) = pcvec(1:npc,i)
-  centroid(1:npc,2) = pcvec(1:npc,j)
-
-  if (nclust .le. 2) return !>-- if we only need two centroids, return
-
-  !>-- If more centroids are needed, search for one point which has the maximal sum of
-  !>-- the distances between the already determined centroids and itself.
-  allocate (p(npc),q(npc),taken(nclust))
-  taken = 0
-  taken(1) = i
-  taken(2) = j
-  do i = 3,nclust
-    maxdistsum = 0.0d0
-    c = 0
-!$OMP PARALLEL PRIVATE ( l, q, p, j, distsum ) &
-!$OMP SHARED ( i, centroid, npc, mm, maxdistsum, pcvec, c, taken )
-!$OMP DO
-    do j = 1,mm
-      distsum = 0.0d0
-      p(1:npc) = pcvec(1:npc,j)
-      do l = 1,i-1
-        q(1:npc) = centroid(1:npc,l)
-        distsum = distsum+eucdist(npc,p,q)
-      end do
-      !$OMP CRITICAL
-      if (.not.any(taken == j)) then
-        if (distsum .gt. maxdistsum) then
-          maxdistsum = distsum
-          c = j
-          taken(i) = c
-        end if
-      end if
-      !$OMP END CRITICAL
-    end do
-!$OMP END DO
-!$OMP END PARALLEL
-    if (c == 0) then
-      exit
-    else
-      centroid(1:npc,i) = pcvec(1:npc,c)
-    end if
-  end do
-
-  deallocate (taken,q,p)
-
-  return
-end subroutine kmeans_seeds
-!===================================================================!
-! assign structures as members to a centroid
-!===================================================================!
-subroutine kmeans_assign(nclust,npc,mm,centroid,pcvec,member)
-  use crest_parameters,idp => dp
-  implicit none
-  integer :: nclust,npc,mm
-  real(ap) :: centroid(npc,nclust)
-  real(wp) :: pcvec(npc,mm)
-  integer :: member(mm)
-  real(ap) :: eucdist  !this is a function
-  integer :: i,j,c
-  real(ap),allocatable :: centdist(:)
-  real(ap),allocatable :: p(:),q(:)
-
-  allocate (centdist(nclust),source=0.0_ap)
-  allocate (p(npc),q(npc))
-!$OMP PARALLEL PRIVATE ( i, j, p, q, c, centdist ) &
-!$OMP SHARED ( mm, nclust, member, centroid, npc, pcvec )
-!$OMP DO
-  do i = 1,mm
-    p(1:npc) = pcvec(1:npc,i)
-    do j = 1,nclust
-      q(1:npc) = centroid(1:npc,j)
-      centdist(j) = eucdist(npc,p,q)
-    end do
-    c = minloc(centdist,1)
-    member(i) = c
-  end do
-!$OMP END DO
-!$OMP END PARALLEL
-  deallocate (q,p)
-  deallocate (centdist)
-  return
-end subroutine kmeans_assign
-
-!===================================================================!
-! re-center centroids for given (sorted) structures
-!===================================================================!
-subroutine kmeans_recenter(nclust,npc,mm,centroid,pcvec,member)
-  use crest_parameters,idp => dp
-  implicit none
-  integer :: nclust,npc,mm
-  real(ap) :: centroid(npc,nclust)
-  real(wp) :: pcvec(npc,mm)
-  integer :: member(mm)
-  integer :: i,j,c
-  real(ap),allocatable :: p(:),q(:)
-
-  allocate (p(npc),q(npc))
-  do i = 1,nclust
-    c = 0
-    p = 0.0d0
-    do j = 1,mm
-      if (member(j) == i) then
-        c = c+1
-        p(1:npc) = p(1:npc)+pcvec(1:npc,j)
-      end if
-    end do
-    if (c > 0) then
-      p = p/float(c)
-      centroid(1:npc,i) = p(1:npc)
-    else
-      p = 999.9d0
-    end if
-  end do
-  deallocate (q,p)
-
-  return
-end subroutine kmeans_recenter
-
-!======================================================================!
-! calculate statistical values for the given cluster size
-! Values to compute:
-! DBI - the Davies-Bouldin index
-! pSF - the "pseudo-F statistic"
-! SSR/SST ratio
-!======================================================================!
-subroutine cluststat(nclust,npc,mm,centroid,pcvec,member,DBI,pSF,SSRSST)
-  use crest_parameters,idp => dp
-  implicit none
-  integer,intent(in) :: nclust  ! number of required centroids
-  integer,intent(in) :: npc,mm
-  real(wp),intent(in) :: pcvec(npc,mm)
-  integer,intent(in) :: member(mm)  ! membership for each structure
-  real(ap),intent(in):: centroid(npc,nclust)
-  real(wp),intent(out) :: DBI,pSF,SSRSST
-  real(wp) :: SSE,SSR,SST
-  real(ap),allocatable :: p(:),q(:)
-  real(wp),allocatable :: compact(:)
-  real(wp),allocatable :: DBmat(:,:)
-  real(ap) :: eucdist !this is a function
-  real(wp) :: d,Rij,maxDB,weight
-  integer :: i,c,k,c2
-
-  DBI = 0.0d0
-  pSF = 0.0d0
-  SSRSST = 0.0d0
-
-  if (nclust < 2) return
-
-  allocate (p(npc),q(npc))
-
-  !>-- Sum of squares error
-  SSE = 0.0d0
-  do c = 1,nclust
-    p(1:npc) = centroid(1:npc,c)
-    do i = 1,mm
-      if (member(i) == c) then
-        q(1:npc) = pcvec(1:npc,i)
-        d = eucdist(npc,p,q)
-        SSE = SSE+d**2
-      end if
-    end do
-  end do
-  SSE = SSE
-
-  !>-- Total sum of squares
-  SST = 0.0d0
-  p = 0.0d0
-  do c = 1,nclust
-    weight = real(count(member(:)==c,1),wp)/real(mm,wp)
-    p(1:npc) = p(1:npc)+centroid(1:npc,c)*weight
-  end do
-  !p = p/float(nclust)
-  do i = 1,mm
-    q(1:npc) = pcvec(1:npc,i)
-    d = eucdist(npc,p,q)
-    SST = SST+d**2
-  end do
-  SST = SST
-
-  !>-- Sum of squares regression
-  SSR = SST-SSE
-
-  !>-- SSR/SST ratio
-  SSRSST = SSR/SST
-
-  !>-- pseudo-F statistic
-  if (nclust > 1) then
-    pSF = (SSR/(float(nclust)-1.0d0))
-    if (mm == nclust) then
-      pSF = 0.0d0
-    else
-      pSF = pSF/(SSE/(float(mm)-float(nclust)))
-    end if
-  else
-    pSF = 0.0d0
-  end if
-
-  !>-- Davies-Bouldin index (DBI)
-  allocate (compact(nclust),source=0.0d0) !cluster compactness
-  do c = 1,nclust
-    p(1:npc) = centroid(1:npc,c)
-    k = 0
-    do i = 1,mm
-      if (member(i) == c) then
-        k = k+1
-        q(1:npc) = pcvec(1:npc,i)
-        d = eucdist(npc,p,q)
-        compact(c) = compact(c)+d
-      end if
-    end do
-    if (k > 0) then
-      compact(c) = compact(c)/float(k)
-    else
-      compact(c) = 0
-    end if
-  end do
-  allocate (DBmat(nclust,nclust),source=0.0d0)
-  do c = 1,nclust
-    p(1:npc) = centroid(1:npc,c)
-    do c2 = 1,nclust
-      if (c2 == c) cycle
-      q(1:npc) = centroid(1:npc,c2)
-      d = eucdist(npc,p,q)
-      Rij = (compact(c)+compact(c2))/d
-      DBmat(c,c2) = Rij
-    end do
-  end do
-  do c = 1,nclust
-    maxDB = maxval(DBmat(:,c),1)
-    DBI = DBI+maxDB
-  end do
-  DBI = DBI/float(nclust)
-  deallocate (DBmat)
-  deallocate (compact)
-
-  deallocate (q,p)
-  return
-end subroutine cluststat
-
-!==============================================================!
-! analyze the statistical values DBI and pSF to get the
-! respective extrema
-!==============================================================!
-subroutine statanal(n,nmax,statistics,extrema,pr)
-  use crest_parameters
-  implicit none
-  integer :: n,nmax
-  real(wp) :: statistics(3,nmax)
-  logical,intent(inout) :: extrema(2,n)
-  logical :: pr
-  real(wp) :: last,next,current
-  integer :: i
-
-  extrema = .false.
-!>--- identify local extrema of the DBI and pSF
-  do i = 2,n-1
-    !>-- DBI
-    last = statistics(1,i-1)
-    next = statistics(1,i+1)
-    current = statistics(1,i)
-    if ((current < last).and.(current < next)) then
-      extrema(1,i) = .true.
-    end if
-    !>-- pSF
-    last = statistics(2,i-1)
-    next = statistics(2,i+1)
-    current = statistics(2,i)
-    if ((current > last).and.(current > next)) then
-      extrema(2,i) = .true.
-    end if
-  end do
-
-  if (pr) then
-    write (stdout,*)
-    write (stdout,'(1x,a,/)') 'Suggestions for cluster sizes:'
-    do i = 1,n
-      if (extrema(1,i).or.extrema(2,i)) then
-        if (extrema(1,i).and.extrema(2,i)) then
-          write (stdout,'(1x,i8,''*'',3x,a,f8.4)') i,'SSR/SST',statistics(3,i)
-        else
-          write (stdout,'(1x,i8,4x,a,f8.4)') i,'SSR/SST',statistics(3,i)
-        end if
-      end if
-    end do
-    write (stdout,'(/,1x,a)') 'Cluster counts marked with a star (*) are reasonable'
-    write (stdout,'(1x,a)') 'suggestions according to BOTH the DBI and pSF.'
-  end if
-
-  return
-end subroutine statanal
-
-!==============================================================!
-! print a warning regarding the nature of the cluster partitioning
-!==============================================================!
-subroutine statwarning(fname)
-  use crest_parameters
-  implicit none
-  character(len=*) :: fname
-  write (stdout,*)
-  write (stdout,'(1x,a)') '!---------------------------- NOTE ----------------------------!'
-  write (stdout,'(2x,a)') 'The partitioning of data (the ensemble) into clusters'
-  write (stdout,'(2x,a)') 'of similar characteristics (structures) is ARBITRARY'
-  write (stdout,'(2x,a)') 'and depends on many criteria (e.g. choice of PCs).'
-  write (stdout,'(2x,a)') 'The selected cluster count is the smallest reasonable'
-  write (stdout,'(2x,a)') 'number of clusters that can be formed according to'
-  write (stdout,'(2x,a)') 'the DBI and pSF values for the given data.'
-  write (stdout,*)
-  write (stdout,'(2x,a)') 'If other cluster sizes are desired, rerun CREST with'
-  write (stdout,'(2x,3a)') '"crest --for ',trim(fname),' --cluster <number of clusters>"'
-  write (stdout,*)
-  write (stdout,'(2x,a)') 'Other default evaluation settings can be chosen with the'
-  write (stdout,'(2x,a)') 'keywords "loose","normal", and "tight" as <level> via'
-  write (stdout,'(2x,3a)') '"crest --for ',trim(fname),' --cluster <level>"'
-  write (stdout,'(1x,a)') '!--------------------------------------------------------------!'
-end subroutine statwarning
-
-!====================================================================!
-subroutine getdiederatoms(zmol,nat,inc,nb,diedat,ndied)
-  use crest_parameters,idp => dp
-  use zdata
-  use strucrd
-  implicit none
-  type(zmolecule) :: zmol
-  integer :: nat
-  integer :: inc(nat) !contains 1 (=include) or 0 (=ignore)
-  integer :: nb
-  integer :: diedat(4,nb)
-  integer,intent(out) :: ndied
-  integer :: a,b,c,d
-  integer :: i,j,k
-
-  ndied = 0
-  do i = 1,nb
-    a = zmol%bondpairs(1,i)
-    b = zmol%bondpairs(2,i)
-    if (inc(a) == 0) cycle          !ignored by user?
-    if (inc(b) == 0) cycle          !ignored by user?
-    if (zmol%zat(a)%nei == 1) cycle !terminal atom?
-    if (zmol%zat(b)%nei == 1) cycle !terminal atom?
-    if (zmol%methyl(a)) cycle !methyl C?
-    if (zmol%methyl(b)) cycle !methyl C?
-    !>-- passed all checks, so let's get atoms
-    !>-- a neighbour for a
-    do j = 1,zmol%zat(a)%nei
-      c = zmol%zat(a)%ngh(j)
-      if (c == b) then
-        cycle
-      else
-        exit
-      end if
-    end do
-    !>-- a neighbour for b
-    do k = 1,zmol%zat(b)%nei
-      d = zmol%zat(b)%ngh(k)
-      if (d == a) then
-        cycle
-      else
-        exit
-      end if
-    end do
-    ndied = ndied+1
-    !>the bond is between a and b
-    !>c is a neighbour of a, d is a neighbour of b
-    diedat(2,ndied) = a
-    diedat(3,ndied) = b
-    diedat(1,ndied) = c
-    diedat(4,ndied) = d
-  end do
-
-  return
-end subroutine getdiederatoms
-
-subroutine calc_dieders(nat,xyz,ndied,diedat,diedr)
-  use crest_parameters,idp => dp
-  use crest_data
-  use zdata
-  use strucrd
-  implicit none
-  integer :: nat,ndied
-  real(wp) :: xyz(3,nat)
-  integer :: diedat(4,ndied)
-  real(wp),intent(out) :: diedr(ndied)
-  integer :: i
-  integer :: a,b,c,d
-  real(wp) :: coords(3,4)
-  real(wp) :: angle
-  real(wp),parameter :: rad2degree = 57.29578_wp
-  real(wp),parameter :: tol = 5.0_wp !tolerance for almost 360 degree
-
-  diedr = 0.0_wp
-  do i = 1,ndied
-    a = diedat(2,i)
-    b = diedat(3,i)
-    c = diedat(1,i)
-    d = diedat(4,i)
-    coords(1:3,1) = xyz(1:3,c)
-    coords(1:3,2) = xyz(1:3,a)
-    coords(1:3,3) = xyz(1:3,b)
-    coords(1:3,4) = xyz(1:3,d)
-    call DIHED(coords,1,2,3,4,angle)
-    angle = abs(angle)*rad2degree
-    if (abs(angle-360.0_wp) < tol) angle = 0.0_wp
-    diedr(i) = angle
-  end do
-
-  return
-end subroutine calc_dieders
-
diff --git a/src/rigidconf/CMakeLists.txt b/src/chelpers/CMakeLists.txt
similarity index 88%
rename from src/rigidconf/CMakeLists.txt
rename to src/chelpers/CMakeLists.txt
index c70e846d..7e2992ab 100644
--- a/src/rigidconf/CMakeLists.txt
+++ b/src/chelpers/CMakeLists.txt
@@ -17,16 +17,8 @@
 set(dir "${CMAKE_CURRENT_SOURCE_DIR}")
 
 list(APPEND srcs
-  "${dir}/rigidconf.f90"
-  "${dir}/tree.f90"
-  "${dir}/analyze.f90"
-  "${dir}/reconstruct.f90"
+  "${dir}/mempeak.c"
+  "${dir}/signal.c"
 )
 
 set(srcs ${srcs} PARENT_SCOPE)
-
-
-
-
-
-
diff --git a/src/chelpers/mempeak.c b/src/chelpers/mempeak.c
new file mode 100644
index 00000000..b3d98555
--- /dev/null
+++ b/src/chelpers/mempeak.c
@@ -0,0 +1,48 @@
+/*
+! This file is part of crest.
+!
+! Copyright (C) 2025 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+
+*/
+#ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#include <psapi.h>
+#include <windows.h>
+__declspec(dllexport) long long get_peak_rss_kb(void) {
+  PROCESS_MEMORY_COUNTERS pmc;
+  if (GetProcessMemoryInfo(GetCurrentProcess(), &pmc, sizeof(pmc))) {
+    // bytes -> kilobytes
+    return (long long)(pmc.PeakWorkingSetSize / 1024);
+  }
+  return -1;
+}
+#else
+#include <sys/resource.h>
+#include <sys/time.h>
+long long get_peak_rss_kb(void) {
+  struct rusage ru;
+  if (getrusage(RUSAGE_SELF, &ru) == 0) {
+// On Linux: ru_maxrss is in kilobytes
+// On macOS/BSD: ru_maxrss is in bytes — convert to KB
+#ifdef __APPLE__
+    return (long long)(ru.ru_maxrss / 1024);
+#else
+    return (long long)ru.ru_maxrss;
+#endif
+  }
+  return -1;
+}
+#endif
diff --git a/src/rigidconf/meson.build b/src/chelpers/meson.build
similarity index 91%
rename from src/rigidconf/meson.build
rename to src/chelpers/meson.build
index 22aebeda..e700225e 100644
--- a/src/rigidconf/meson.build
+++ b/src/chelpers/meson.build
@@ -15,8 +15,6 @@
 # along with crest.  If not, see <https://www.gnu.org/licenses/>.
 
 srcs += files(
-  'rigidconf.f90',
-  'tree.f90',
-  'analyze.f90',
-  'reconstruct.f90',
+  'mempeak.c',
+  'signal.c',
 )
diff --git a/src/signal.c b/src/chelpers/signal.c
similarity index 58%
rename from src/signal.c
rename to src/chelpers/signal.c
index d6a4007e..9954719d 100644
--- a/src/signal.c
+++ b/src/chelpers/signal.c
@@ -14,3 +14,11 @@ void signal_( int* signum, sighandler_t handler)
 {
    signal(*signum, handler);
 }
+
+/* Called from Fortran via ISO_C_BINDING for ifx builds.
+ * handler is a BIND(C) Fortran subroutine with no dummy arguments;
+ * the int signum passed by the OS is silently ignored. */
+void crest_install_signal(int signum, void (*handler)(void))
+{
+    signal(signum, (sighandler_t)handler);
+}
diff --git a/src/choose_settings.f90 b/src/choose_settings.f90
index 901d5d7d..13c38b29 100644
--- a/src/choose_settings.f90
+++ b/src/choose_settings.f90
@@ -30,17 +30,17 @@ subroutine md_length_setup(env)
   use crest_parameters
   use crest_data
   use strucrd
-  use zdata, only:readwbo
+  use zdata,only:readwbo
   implicit none
   !> IN/OUTPUT
   type(systemdata) :: env    !> MAIN STORAGE OS SYSTEM DATA
   !> LOCAL
   real(wp) :: total,minimum,lenthr
   real(wp) :: flex,av1,rfac,nciflex
-  type(coord) :: mol 
+  type(coord) :: mol
   logical :: ex
-!> get reference geometry  
-  call env%ref%to( mol ) 
+!> get reference geometry
+  call env%ref%to(mol)
 
 !> at least 5ps per MTD
   minimum = 5.0d0
@@ -50,19 +50,19 @@ subroutine md_length_setup(env)
   call smallhead('Generating MTD length from a flexibility measure')
 
   if ((env%crestver .ne. crest_solv).and..not.env%NCI) then
-    write(stdout,'(1x,a)',advance='no') 'Calculating GFN0-xTB WBOs   ...'
+    write (stdout,'(1x,a)',advance='no') 'Calculating GFN0-xTB WBOs   ...'
 !>-- xtb singlepoint to get WBOs (always GFN0)
     call xtbsp(env,0)
     write (stdout,'(1x,a)') 'done.'
 !>-- save those WBOs to the reference
-    inquire(file='wbo',exist = ex)
-    if(ex)then
-    if(.not.allocated(env%ref%wbo)) allocate(env%ref%wbo( mol%nat, mol%nat), source=0.0_wp)   
-    call readwbo('wbo',mol%nat, env%ref%wbo)
-    endif
+    inquire (file='wbo',exist=ex)
+    if (ex) then
+      if (.not.allocated(env%ref%wbo)) allocate (env%ref%wbo(mol%nat,mol%nat),source=0.0_wp)
+      call readwbo('wbo',mol%nat,env%ref%wbo)
+    end if
 
 !>-- covalent flexibility measure based on WBO and structure only
-    call flexi( mol, env%rednat, env%includeRMSD, flex)
+    call flexi(mol,env%rednat,env%includeRMSD,flex)
 !>-- NCI flexi based on E(HB)/Nat and E(disp)/Nat
     call nciflexi(env,nciflex)
     write (stdout,'(1x,''    covalent flexibility measure :'',f8.3)') flex
@@ -118,9 +118,9 @@ subroutine md_length_setup(env)
 
 !>-- ONLY use generated MD length if not already set by the user
   if (env%mdtime .le. 0.0d0) then
-    if(env%mddat%length_ps > 0.0_wp)then
+    if (env%mddat%length_ps > 0.0_wp) then
       total = env%mddat%length_ps
-      write(stdout,'(1x,"t(MTD) / ps set via calculator :",  f8.1)') total
+      write (stdout,'(1x,"t(MTD) / ps set via calculator :",  f8.1)') total
     else if (total .gt. lenthr) then
       total = lenthr
       call mtdwarning(lenthr*rfac)
@@ -135,9 +135,9 @@ subroutine md_length_setup(env)
   & env%mdtime*float(env%nmetadyn),env%nmetadyn
 
 !> A MTD Vbias snapshot is taken every 1 ps
-  if(allocated(env%metadlist))then
+  if (allocated(env%metadlist)) then
     env%metadlist(:) = ceiling(env%mdtime)
-  endif
+  end if
 
   return
 end subroutine md_length_setup
@@ -149,7 +149,7 @@ subroutine defaultGF(env)
 !* Setmetadynamics default Guiding Force Parameter
 !* There are different combinations depending on the runtype
 !************************************************************
-  use crest_parameters 
+  use crest_parameters
   use crest_data
   use filemod
   implicit none
@@ -200,7 +200,7 @@ subroutine defaultGF(env)
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++!
       select case (env%runver)
 !---------- "-quick","-squick"
-      case (2,5) 
+      case (2,5)
         na = 3
         nk = 2
         nmtdyn = na*nk
@@ -209,7 +209,7 @@ subroutine defaultGF(env)
         alpinc = 2.0 ! increment
         kinc = 2.0     ! increment
 !---------- "-mquick"
-      case (6) 
+      case (6)
         na = 3
         nk = 2
         nmtdyn = na*nk
@@ -218,7 +218,7 @@ subroutine defaultGF(env)
         alpinc = 2.0 ! increment
         kinc = 2.0     ! increment
 !---------- "-qcg"
-      case (3) 
+      case (3)
         na = 4
         nk = 3
         nmtdyn = na*nk
@@ -227,7 +227,7 @@ subroutine defaultGF(env)
         alpinc = (3./2.) ! increment
         kinc = (3./2.)   ! increment
 !---------- "-nci"
-      case (4) 
+      case (4)
         na = 3
         nk = 2
         nmtdyn = na*nk
@@ -236,7 +236,7 @@ subroutine defaultGF(env)
         alpinc = 2.0 ! increment
         kinc = 2.0     ! increment
 !---------- "-singlerun"
-      case (45) 
+      case (45)
         na = 1
         nk = 1
         nmtdyn = na*nk
@@ -254,7 +254,7 @@ subroutine defaultGF(env)
         alpinc = 2.0 ! increment
         kinc = 2.0     ! increment
 !---------- "-compress"
-      case (77) 
+      case (77)
         na = 3
         nk = 3
         nmtdyn = na*nk
@@ -263,7 +263,7 @@ subroutine defaultGF(env)
         alpinc = 1.61803 ! increment
         kinc = 2.0     ! increment
 !--------- "search_1"
-      case (crest_s1,crest_mecp) 
+      case (crest_s1,crest_mecp)
         na = 3
         nk = 3
         nmtdyn = (na*nk)
@@ -280,7 +280,7 @@ subroutine defaultGF(env)
         alpinc = (5./3.) ! increment
         kinc = 1.5d0     ! increment
 !---------- "-entropy"
-      case (111) 
+      case (111)
         na = 6
         nk = 4
         nmtdyn = (na*nk)
@@ -395,13 +395,13 @@ subroutine adjustnormmd(env)
 !>--- first the number of normMDs on low conformers
     if (env%nrotammds .le. 0) then !> if no user input was set
       !> multiple short MDs, which has a better parallel efficiency
-      !> default is 4 
-      env%nrotammds = max(1,nint(float(env%nmetadyn)/4.0d0)) 
+      !> default is 4
+      env%nrotammds = max(1,nint(float(env%nmetadyn)/4.0d0))
     end if
 
 !>--- then the temperature range
     if (env%temps .le. 0) then
-      !> at how many different temperatures? 
+      !> at how many different temperatures?
       !> starting at 400k and increasing 100K for each (200 K for -entropy mode)
       env%temps = 2
       if (env%entropic) then
@@ -414,7 +414,7 @@ subroutine adjustnormmd(env)
 !==============================================!
 !>--- settings for static MTDS in entropy mode
 !==============================================!
-  if (env%entropymd) then 
+  if (env%entropymd) then
     env%emtd%iter = 20    !> max number of iterations
     env%emtd%nbias = min(150,nint(env%tmtd/4)) !> max number of bias structures
     env%emtd%nbiasgrow = min(1.4d0,1.2d0+env%tmtd*1.d-3) !> increase of nBias in each cycle
@@ -476,55 +476,71 @@ subroutine env_to_mddat(env)
   implicit none
   type(systemdata) :: env
   real(wp) :: dum
+  integer :: i,j,nat
 !!>--- dont override user-defined settings
 !  if(env%mddat%requested) return
 !> we will check if any default settings were already set individually, instead
 !> the if-statements in the following take care of that
 
 !>--- necessary transfer global settings into mddat object
-   if(env%mddat%length_ps <= 0.0_wp)then
-   !> total runtime in ps
-     env%mddat%length_ps    = env%mdtime
-   else
-     env%mdtime = env%mddat%length_ps
-   endif
-   if(env%mddat%tstep <= 0.0_wp)then
-   !> time step in fs 
-     env%mddat%tstep        = env%mdstep
-   endif
-   !> simulation steps (would be recovered automatically later, but just to make sure)
-   env%mddat%length_steps = nint(env%mddat%length_ps*1000.0_wp / env%mddat%tstep)
-   if(env%mddat%tsoll <= 0.0_wp)then
-   !> target temperature
-     env%mddat%tsoll = env%mdtemp
-   endif
-
-   if( env%mddat%dumpstep <= 0.0_wp ) then 
-   !> dump frequency in fs
-     env%mddat%dumpstep = float(env%mddumpxyz)
-   endif
-   if(env%mddat%sdump <= 0)then
-   !> trajectory structure dump every x steps 
-     dum = max(1.0_wp, (env%mddat%dumpstep / env%mddat%tstep))
-     env%mddat%sdump = nint(dum)
-   endif
-
-   !> The SHAKE setup (special condition referring to the default)
-   env%mddat%shake = env%mddat%shake .and.(env%shake > 0) !> SHAKE algorithm?
-   if( env%mddat%shake .and. env%mddat%shk%shake_mode == 0)then
-   env%mddat%shk%shake_mode = env%shake     !> H-only shake =1, all atom =2
-   endif 
-
-   if(env%mddat%md_hmass <= 0.0_wp)then
-   !> hydrogen mass (to enable longer timesteps)
-     env%mddat%md_hmass = env%hmass 
-   endif
-
-   ! TODO: WBO reader if shake is applied and wbo file is present
+  if (env%mddat%length_ps <= 0.0_wp) then
+    !> total runtime in ps
+    env%mddat%length_ps = env%mdtime
+  else
+    env%mdtime = env%mddat%length_ps
+  end if
+  if (env%mddat%tstep <= 0.0_wp) then
+    !> time step in fs
+    env%mddat%tstep = env%mdstep
+  end if
+  !> simulation steps (would be recovered automatically later, but just to make sure)
+  env%mddat%length_steps = nint(env%mddat%length_ps*1000.0_wp/env%mddat%tstep)
+  if (env%mddat%tsoll <= 0.0_wp) then
+    !> target temperature
+    env%mddat%tsoll = env%mdtemp
+  end if
+
+  if (env%mddat%dumpstep <= 0.0_wp) then
+    !> dump frequency in fs
+    env%mddat%dumpstep = real(env%mddumpxyz,wp)
+  end if
+  if (env%mddat%sdump <= 0) then
+    !> trajectory structure dump every x steps
+    dum = max(1.0_wp, (env%mddat%dumpstep/env%mddat%tstep))
+    env%mddat%sdump = nint(dum)
+  end if
+
+  !> The SHAKE setup (special condition referring to the default)
+  env%mddat%shake = env%mddat%shake.and.(env%shake > 0) !> SHAKE algorithm?
+  if (env%mddat%shake.and.env%mddat%shk%shake_mode == 0) then
+    env%mddat%shk%shake_mode = env%shake     !> H-only shake =1, all atom =2
+  end if
+
+  if (env%mddat%md_hmass <= 0.0_wp) then
+    !> hydrogen mass (to enable longer timesteps)
+    env%mddat%md_hmass = env%hmass
+  end if
+
+  if (allocated(env%mddat%mtd)) then
+    nat = env%ref%nat
+    if (sum(env%includeRMSD) < nat) then
+      do i = 1,env%mddat%npot
+        if (.not.allocated(env%mddat%mtd(i)%atinclude)) then
+          allocate (env%mddat%mtd(i)%atinclude(nat),source=.false.)
+        else
+          env%mddat%mtd(i)%atinclude = .false.
+        end if
+        do j = 1,nat
+          if (env%includeRMSD(j) == 1) env%mddat%mtd(i)%atinclude(j) = .true.
+        end do
+      end do
+    end if
+  end if
+
+  ! TODO: WBO reader if shake is applied and wbo file is present
 
 !>--- set flag to signal present settings
   env%mddat%requested = .true.
 
 end subroutine env_to_mddat
 
-
diff --git a/src/classes.f90 b/src/classes.f90
index f24dbd9d..b3e4afbe 100644
--- a/src/classes.f90
+++ b/src/classes.f90
@@ -25,15 +25,18 @@ module crest_data
   use iso_fortran_env,wp => real64,dp => int64
   use crest_calculator,only:calcdata
   use dynamics_module,only:mddata
+  use bh_module,only:bh_class
   use strucrd,only:coord
   use crest_type_timer,only:timer
-  use lwoniom_module, only: lwoniom_input
+  use lwoniom_module,only:lwoniom_input
+  use molbuilder_construct_list !> from molbuilder dir
+  use term_ui,only:progress_state
   implicit none
 
   public :: systemdata
   public :: timer   !> RE-EXPORT from crest_type_timer
   public :: protobj
-  public :: constra
+  public :: legacy_constraints
   public :: optlevflag,optlevnum,optlevmap_alt
   public :: optlev_to_multilev
 
@@ -74,6 +77,7 @@ module crest_data
   integer,parameter,public :: crest_protonate = 16
   integer,parameter,public :: crest_deprotonate = 17
   integer,parameter,public :: crest_tautomerize = 18
+  integer,parameter,public :: crest_sorting = 19
 !>> runtypes with IDs between use non-legacy routines  <<!
   integer,parameter,public :: crest_sp         = 264
   integer,parameter,public :: crest_optimize   = 265
@@ -85,6 +89,10 @@ module crest_data
   integer,parameter,public :: crest_rigcon     = 271
   integer,parameter,public :: crest_trialopt   = 272
   integer,parameter,public :: crest_ensemblesp = 273
+  integer,parameter,public :: crest_bh         = 274
+  integer,parameter,public :: crest_bhpt       = 275
+  integer,parameter,public :: crest_dryrun     = 276
+  integer,parameter,public :: crest_ensemblehess = 277
 !>> <<!
   integer,parameter,public :: crest_test       = 456
 
@@ -110,12 +118,22 @@ module crest_data
   integer,parameter,public :: p_thermo       = -3654
   integer,parameter,public :: p_useonly      = -227
   integer,parameter,public :: p_qcg          = 37
+!>---- propcalc sub-modes (imode argument of propcalc / values in env%pqueue)
+  integer,parameter,public :: p_prop_hess        =   1  !> Hessian for all conformers
+  integer,parameter,public :: p_prop_autoir      =   2  !> IR spectrum averaging
+  integer,parameter,public :: p_prop_ohess       =  10  !> Optimization + Hessian
+  integer,parameter,public :: p_prop_finalhess   =  11  !> Hessian+thermo for final conformer ensemble
+  integer,parameter,public :: p_prop_gsolv       =  13  !> Free energy in solvation (2-step)
+  integer,parameter,public :: p_prop_reopt       =  20  !> Vtight reoptimization
+  integer,parameter,public :: p_prop_multilevel  =  50  !> Multilevel/hybrid reopt base (range 50:59)
+  integer,parameter,public :: p_prop_dipole      = 998  !> Singlepoint + dipole extraction
+  integer,parameter,public :: p_prop_rerank      = 999  !> Singlepoint + reranking
 
 !>--- exit status
   integer,parameter,public :: status_normal = 0    !> success
   integer,parameter,public :: status_error  = 1    !> general error
   integer,parameter,public :: status_ioerr  = 2    !> general I/O error
-  integer,parameter,public :: status_args   = 4    !> invalid subroutine arguments 
+  integer,parameter,public :: status_args   = 4    !> invalid subroutine arguments
   integer,parameter,public :: status_input  = 10   !> Input file read error
   integer,parameter,public :: status_config = 20   !> invalid configuration
   integer,parameter,public :: status_failed = 155  !> general calculation failure
@@ -127,7 +145,14 @@ module crest_data
     integer :: singlepoint = 1
     integer :: correction  = 2
     integer :: geoopt      = 3
-    integer :: ConfSolv    = 4
+    integer :: deltaG      = 5
+    !> post_opt   (= 10): post-search re-optimization via pqueue job 51 (e.g. A@B)
+    !> post_sp    (= 11): post-search SP reranking       via pqueue job 52 (--rerank)
+    !> post_reopt (= 12): post-search geo-opt standalone via pqueue job 53 (--reopt)
+    !> Values 6-9 reserved for future inline stages.
+    integer :: post_opt    = 10
+    integer :: post_sp     = 11
+    integer :: post_reopt  = 12
   end type refine_type
   type(refine_type), parameter,public :: refine = refine_type()
 
@@ -139,7 +164,7 @@ module crest_data
 !========================================================================================!
 !========================================================================================!
 
-  type :: constra
+  type :: legacy_constraints
 !****************************************************
 !* separate settings for LEGACY constraint handling
 !****************************************************
@@ -169,9 +194,10 @@ module crest_data
     logical :: usermsdpot = .false.
     logical :: gesc_heavy = .false.
   contains
-    procedure :: allocate => allocate_constraints
-    procedure :: deallocate => deallocate_constraints
-  end type constra
+    procedure :: allocate => allocate_legacy_constraints
+    procedure :: deallocate => deallocate_legacy_constraints
+    procedure :: info => legacy_constraints_info
+  end type legacy_constraints
 
 !========================================================================================!
 
@@ -179,7 +205,7 @@ module crest_data
 !************************************************************
 !* separate settings for protonation and related procedures
 !************************************************************
-    integer :: nfrag  = 0 
+    integer :: nfrag = 0
     integer :: newchrg = 0
     integer :: iter = 1
     real(wp) :: ewin = 30.0_wp       !> separate EWIN threshold
@@ -285,10 +311,12 @@ module crest_data
     integer  :: pcap = 50000       !> limit number of structures
     logical :: avbhess = .false.   !> use bhess in the msRRHO average calc. for all structures (expensive!)
     logical :: constrhess = .false. !> apply constraints in rrhoav?
-    logical :: printpop   = .false. !> print a file with populations at different T
+    logical :: printpop = .false. !> print a file with populations at different T
+    character(len=:),allocatable :: emodel
   contains
     procedure :: get_temps => thermo_get_temps
     procedure :: read_temps => thermo_read_temps
+    procedure :: get_close_rt => thermo_get_close_rt
   end type thermodata
 
 !========================================================================================!
@@ -307,7 +335,9 @@ module crest_data
     integer,allocatable :: topo(:)
     real(wp),allocatable :: charges(:)
     real(wp),allocatable :: wbo(:,:)
+    real(wp),allocatable :: efield(:)
   contains
+    procedure :: init => ref_init
     procedure :: rdcharges => read_charges
     procedure :: to => ref_to_mol
     procedure :: load => ref_load_mol
@@ -343,6 +373,7 @@ module crest_data
     real(wp) :: pthrsum
     real(wp) :: tboltz
     logical  :: cgf(6)           !> collection of CREGEN options
+    integer  :: iinversion = 0   !> 0=auto,1=on, 2=off
 
     real(wp) :: mdtemps(10)      !> different temperatures for the QMDFF-MDs in V1
     real(wp) :: mdtime           !> MD length (V1&2)
@@ -378,24 +409,29 @@ module crest_data
     logical :: omp_allow_nested = .true.  !> allow nested OpenMP threadding
 
     !>--- various names and flags
-    character(len=128) :: ensemblename   !> ensemble input name for SCREEN,MDOPT and CREGEN
-    character(len=128) :: ensemblename2  !> another ensemble input name
-    character(len=128) :: fixfile
-    character(len=512) :: constraints    !> name of the constraint file
-    character(len=20)  :: solvent        !> the solvent
+    character(len=128) :: ensemblename = '' !> ensemble input name for SCREEN,MDOPT and CREGEN
+    character(len=128) :: ensemblename2 = '' !> another ensemble input name
+    character(len=128) :: fixfile = ''
+    character(len=512) :: constraints = ''   !> name of the constraint file
+    character(len=20)  :: solvent = ''       !> the solvent
     character(len=:),allocatable :: solv !> the entrie gbsa flag including solvent
-    character(len=20)  :: gfnver         !> GFN version
-    character(len=20)  :: gfnver2        !> GFN version (multilevel)
-    character(len=20)  :: lmover         !> GFN version for LMO computation in xtb_lmo subroutine
-    character(len=512) :: ProgName       !> name of the xtb executable (+ path)
-    character(len=512) :: ProgIFF        !> name of xtbiff for QCG-mode
-    character(len=512) :: homedir        !> original directory from which calculation was started
-    character(len=512) :: scratchdir     !> path to the scratch directory
+    character(len=20)  :: gfnver = ''        !> GFN version
+    character(len=20)  :: gfnver2 = ''       !> GFN version (multilevel)
+    character(len=:),allocatable :: orca_template !> ORCA input template (--orca)
+    character(len=:),allocatable :: orca_cmd      !> ORCA executable path (--orca)
+    character(len=40)  :: rerank_lvl = ''    !> method for post-search SP reranking (--rerank)
+    character(len=40)  :: reopt_lvl  = ''    !> method for post-search geo-opt standalone (--reopt)
+    character(len=20)  :: lmover = ''        !> GFN version for LMO computation in xtb_lmo subroutine
+    character(len=512) :: ProgName = ''      !> name of the xtb executable (+ path)
+    character(len=512) :: ProgIFF = ''       !> name of xtbiff for QCG-mode
+    character(len=512) :: homedir = ''       !> original directory from which calculation was started
+    character(len=512) :: scratchdir = ''    !> path to the scratch directory
     character(len=:),allocatable :: cmd
     character(len=:),allocatable :: inputcoords
     character(len=:),allocatable :: wbofile
     character(len=:),allocatable :: atlist
     character(len=:),allocatable :: chargesfilename
+    character(len=:),allocatable :: sortmode
 
     !>--- METADYN data
     real(wp) :: hmass
@@ -430,11 +466,11 @@ module crest_data
     type(protobj) :: protb
 
     !>--- saved constraints
-    type(constra) :: cts
+    type(legacy_constraints) :: cts
 
     !>--- NCI mode data
     real(wp) :: potscal = 1.0_wp
-    real(wp) :: potpad  = 0.0_wp
+    real(wp) :: potpad = 0.0_wp
     character(len=:),allocatable :: potatlist
 
     !>--- Nanoreactor data
@@ -451,6 +487,14 @@ module crest_data
 
     !>--- reference structure data (the input structure)
     type(refdata) :: ref
+    !>--- the reference mol may be partitioned into subfragments
+    !>    the corresponding bookkeeping data is saved here
+    logical :: substructure_queue = .false.
+    type(split_atms),allocatable :: splitqueue(:)
+    type(construct_heap) :: splitheap
+    integer  :: queue_iter = 0
+    integer  :: queue_maxreconstruct = 7500
+    real(wp) :: queue_depthfac = 0.85_wp
 
     !>--- QCG data
     integer :: qcg_runtype = 0      !> Default is grow, 1= ensemble & opt, 2= e_solv, 3= g_solv
@@ -458,11 +502,11 @@ module crest_data
     integer :: nqcgclust = 0        !> Number of cluster to be taken
     integer :: max_solv = 0         !> Maximal number of solvents added, if none is given
     integer :: ensemble_method = -1 !> Default -1 for qcgmtd, 0= crest, 1= standard MD, 2= MTD
-    character(len=:), allocatable :: directed_file !name of the directed list
-    character(len=64), allocatable :: directed_list(:,:) !How many solvents at which atom to add
-    integer, allocatable :: directed_number(:) !Numbers of solvents added per defined atom
-    character(len=20) :: ensemble_opt         !> Method for ensemble optimization in qcg mode
-    character(len=20) :: freqver              !> Method for frequency computation in qcg mode
+    character(len=:),allocatable :: directed_file !name of the directed list
+    character(len=64),allocatable :: directed_list(:,:) !How many solvents at which atom to add
+    integer,allocatable :: directed_number(:) !Numbers of solvents added per defined atom
+    character(len=20) :: ensemble_opt = ''     !> Method for ensemble optimization in qcg mode
+    character(len=20) :: freqver = ''          !> Method for frequency computation in qcg mode
     real(wp)          :: freq_scal            !> Frequency scaling factor
     character(len=:),allocatable :: solu_file,solv_file !> solute  and solvent input file
     character(len=5) :: docking_qcg_flag = '--qcg'
@@ -496,8 +540,9 @@ module crest_data
 
     !================================================!
     !>--- Calculation settings for newer implementations (version >= 3.0)
-    type(calcdata) :: calc
+    type(calcdata),pointer :: calc
     type(mddata)   :: mddat
+    type(bh_class),allocatable :: bh_ref
     !>--- rigidconf data
     integer :: rigidconf_algo = 0
     integer :: rigidconf_toposource = 0
@@ -510,14 +555,14 @@ module crest_data
     !================================================!
 
     !>--- msreact mode settings
-    logical :: msei =.true. ! use the ei mode as default
-    logical :: mscid =.false. ! use the cid mode
-    logical :: msnoiso =.false. ! print only dissociated structures in msreact
-    logical :: msiso =.false. ! only print non-dissociated structures in msreact
-    logical :: msmolbar =.false. ! sort out duplicates by molbar
-    logical :: msinchi =.false. ! sort out duplicates by inchi
-    logical :: mslargeprint=.false. ! dont remove temporary files
-    logical :: msattrh=.true. ! add attractive potential for H-atoms
+    logical :: msei = .true. ! use the ei mode as default
+    logical :: mscid = .false. ! use the cid mode
+    logical :: msnoiso = .false. ! print only dissociated structures in msreact
+    logical :: msiso = .false. ! only print non-dissociated structures in msreact
+    logical :: msmolbar = .false. ! sort out duplicates by molbar
+    logical :: msinchi = .false. ! sort out duplicates by inchi
+    logical :: mslargeprint = .false. ! dont remove temporary files
+    logical :: msattrh = .true. ! add attractive potential for H-atoms
     integer :: msnbonds = 3 ! distance of bonds up to nonds are stretched
     integer :: msnshifts = 0 ! number of random shifts applied to whole mol
     integer :: msnshifts2 = 0 ! number of random shifts applied to whole mol
@@ -526,11 +571,15 @@ module crest_data
 
     !>--- general logical data
     logical :: allrot = .true.       !> use all rotational constants for check instead of mean?
+    logical :: alkylize = .false.    !> alkylization setting
+    logical :: alkylizeskip = .true. !> alkylization sampling skip
     logical :: altopt = .false.
-    logical :: autothreads           !> automatically determine threads
-    logical :: autozsort             !> do the ZSORT in the beginning ?
+    logical :: autothreads = .true.  !> automatically determine threads
+    logical :: autozsort = .false.   !> do the ZSORT in the beginning ?
     logical :: allowrestart = .true. !> allow restart in crest algos?
-    logical :: better                !> found a better conformer and restart in V1
+    logical :: better = .false.      !> found a better conformer and restart in V1
+    logical :: ceh_guess = .false.   !> use CEH guess in tblite or gfnff, if available
+    logical :: spin_polarized = .false. !> enable spin-polarized calculations
     logical :: cff                   !> CFF used in QCG-energy calculation
     logical :: cluster = .false.     !> perform a clustering analysis
     logical :: checktopo = .true.    !> perform topolgy check in CREGEN
@@ -540,7 +589,7 @@ module crest_data
     logical :: confgo                !> perform only the CREGEN routine ?
     logical :: constrain_solu        !> constrain the solute
     logical :: crest_ohess = .false. !> append numerical Hessian after optimization
-    logical :: doNMR                 !> determine NMR equivalencies in CREGEN ?
+    logical :: doNMR = .false.       !> determine NMR equivalencies in CREGEN ?
     logical :: dryrun = .false.      !> dryrun to print settings
     logical :: ENSO                  !> some options for usage of CREST within ENSO
     logical :: ens_const = .false.   !> constrain solute also in Ensemble generation
@@ -551,24 +600,24 @@ module crest_data
     logical :: extLFER = .false.     !> read in external LFER parameters
     logical :: FINAL_GFN2_OPT = .false.
     logical :: fullcre = .false.     !> calculate exact rotamer degeneracies
-    logical :: gbsa                  !> use gbsa
+    logical :: gbsa = .false.        !> use gbsa
     logical :: gcmultiopt            !> 2 level optimization for GC in V2
     logical :: gradsp = .true.       !> turn on/off gradient calculation in singlepoint
     logical :: heavyrmsd = .false.   !> use only heavy atoms for RMSD in CREGEN?
     logical :: inplaceMode = .true.  !> in-place mode: optimization dirs are created "on-the-fly"
-    logical :: iterativeV2           !> iterative version of V2 (= V3)
+    logical :: iterativeV2 = .true.  !> iterative version of V2 (= V3)
     logical :: iru                   !> re-use previously found conformers as bias in iterative approach
     logical :: keepModef             !> keep MODEF* dirs in V1 ?
     logical :: keepScratch = .false. !> keep scratch directory or delete it?
     logical :: legacy = .false.       !> switch between the original system call routines of crest and newer, e.g. tblite implementations
     logical :: metadynset            !> is the number of MTDs already set (V2) ?
     logical :: methautocorr          !> try to automatically include Methyl equivalencies in CREGEN ?
-    logical :: multilevelopt =.true. !> perform the multileveloptimization
+    logical :: multilevelopt = .true. !> perform the multileveloptimization
     logical :: newcregen = .false.   !> use the CREGEN rewrite
-    logical :: NCI                   !> NCI special usage
-    logical :: niceprint             !> make a nice progress-bar printout
+    logical :: NCI = .false.         !> NCI special usage
+    logical :: niceprint = .false.   !> make a nice progress-bar printout
     logical :: noconst = .false.     !> no constrain of solute during QCG Growth
-    logical :: onlyZsort             !> do only the ZSORT routine ?
+    logical :: onlyZsort = .false.   !> do only the ZSORT routine ?
     logical :: optpurge = .false.    !> MDOPT purge application
     logical :: outputsdf = .false.   !> write output ensemble as sdf?
     logical :: pcaexclude = .false.  !> exclude user set atoms from PCA?
@@ -595,10 +644,10 @@ module crest_data
     logical :: riso = .false.        !> take only isomers in reactor mode
     logical :: rotamermds            !> do additional MDs after second  multilevel OPT step in V2 ?
     logical :: refine_presort = .false.  !> run CREGEN at the beginning of crest_refine?
-    logical :: refine_esort   = .false.  !> if CREGEN is run after crest_refine, only sort energy?
+    logical :: refine_esort = .false.  !> if CREGEN is run after crest_refine, only sort energy?
     logical :: sameRandomNumber = .false. !> QCG related, choose same random number for iff
     logical :: scallen               !> scale the automatically determined MD length by some factor?
-    logical :: scratch               !> use scratch directory
+    logical :: scratch = .false.     !> use scratch directory
     logical :: setgcmax = .false.    !> adjust the maxmimum number of structures taken into account for GC?
     logical :: sdfformat = .false.   !> was the SDF format used as input file?
     logical :: slow                  !> slowmode (counterpart to quick mode)
@@ -617,10 +666,11 @@ module crest_data
     logical :: user_nclust = .false. !> true if number of cluster is set by user (only QCG)
     logical :: user_dumxyz = .false. !> true if dumpxyz is set by user
     logical :: user_wscal = .false.  !> true if wscal is set by user
-    logical :: useqmdff              !> use QMDFF in V2?
+    logical :: useqmdff = .false.    !> use QMDFF in V2?
     logical :: water = .false.       !> true if water is used as solvent (only QCG)
     logical :: wallsetup = .false.   !> set up a wall potential?
     logical :: wbotopo = .false.     !> set up topo with WBOs
+    type(progress_state) :: ps  !> terminal progress bar state
   contains
     procedure :: allocate => allocate_metadyn
     procedure :: deallocate => deallocate_metadyn
@@ -629,6 +679,8 @@ module crest_data
     procedure :: rmhy => pqueue_removehybrid
     procedure :: addrefine => add_to_refinequeue
     procedure :: wrtCHRG => wrtCHRG
+    procedure :: addsplitqueue => env_addsplitqueue
+    procedure :: copy => systemdata_copy
   end type systemdata
 
 !========================================================================================!
@@ -653,7 +705,6 @@ subroutine allocate_metadyn(self,n)
     end if
     return
   end subroutine allocate_metadyn
-!========================================================================================!
   subroutine deallocate_metadyn(self)
     implicit none
     class(systemdata) :: self
@@ -662,23 +713,56 @@ subroutine deallocate_metadyn(self)
     if (allocated(self%metadlist)) deallocate (self%metadlist)
   end subroutine deallocate_metadyn
 !========================================================================================!
-  subroutine allocate_constraints(self,n)
+  subroutine allocate_legacy_constraints(self,n)
     implicit none
-    class(constra) :: self
+    class(legacy_constraints) :: self
     integer,intent(in)  :: n
     self%ndim = n
     allocate (self%sett(n))
     allocate (self%buff(n))
     self%sett = ''
     self%buff = ''
-  end subroutine allocate_constraints
-!========================================================================================!
-  subroutine deallocate_constraints(self)
+  end subroutine allocate_legacy_constraints
+
+  subroutine deallocate_legacy_constraints(self)
     implicit none
-    class(constra) :: self
+    class(legacy_constraints) :: self
     if (allocated(self%sett)) deallocate (self%sett)
     if (allocated(self%buff)) deallocate (self%buff)
-  end subroutine deallocate_constraints
+  end subroutine deallocate_legacy_constraints
+
+  subroutine legacy_constraints_info(self)
+    implicit none
+    class(legacy_constraints) :: self
+    integer :: i
+    write (*,*) "legacy constraints set?",self%used
+    if (self%used) then
+      do i = 1,self%ndim
+        if (trim(self%sett(i)) .ne. '') then
+          write (*,'(a)') trim(self%sett(i))
+        end if
+      end do
+    end if
+
+    write (*,*) 'legacy constraints NCI?',self%NCI
+    if (self%NCI.and.allocated(self%pots)) then
+      do i = 1,10
+        if (trim(self%pots(i)) .ne. '') then
+          write (*,'(a)') trim(self%pots(i))
+        end if
+      end do
+    end if
+
+    write (*,*) 'legacy constraints CBONDS?',allocated(self%cbonds)
+    if (allocated(self%cbonds)) then
+      do i = 1,min(10,self%n_cbonds)
+        if (trim(self%cbonds(i)) .ne. '') then
+          write (*,'(a)') trim(self%cbonds(i))
+        end if
+      end do
+      if (self%n_cbonds > 10) write (*,*) '... and some more'
+    end if
+  end subroutine legacy_constraints_info
 
 !========================================================================================!
 !========================================================================================!
@@ -752,14 +836,13 @@ subroutine pqueue_removehybrid(self)
     return
   end subroutine pqueue_removehybrid
 
-
   subroutine add_to_refinequeue(self,refinetype)
     implicit none
     class(systemdata) :: self
     integer :: refinetype
     integer :: idum
     integer,allocatable :: qdum(:)
-    if( refinetype <= 0 ) return
+    if (refinetype <= 0) return
     if (.not.allocated(self%refine_queue)) then
       allocate (self%refine_queue(1))
       self%refine_queue(1) = refinetype
@@ -768,11 +851,18 @@ subroutine add_to_refinequeue(self,refinetype)
       allocate (qdum(idum+1))
       qdum(1:idum) = self%refine_queue(1:idum)
       qdum(idum+1) = refinetype
-      call move_alloc(qdum,self%pqueue)
+      call move_alloc(qdum,self%refine_queue)
     end if
     return
   end subroutine add_to_refinequeue
 
+  subroutine env_addsplitqueue(self,raw_split)
+    implicit none
+    class(systemdata) :: self
+    integer,intent(in) :: raw_split(:)
+    call add_to_splitqueue(self%splitqueue,raw_split)
+  end subroutine env_addsplitqueue
+
 !========================================================================================!
 !========================================================================================!
 !> write a .CHRG (and .UHF) file in the specified dir, but only if it is needed
@@ -827,6 +917,15 @@ subroutine wrtCHRG(self,dir)
   end subroutine wrtCHRG
 
 !========================================================================================!
+  subroutine ref_init(self,nat)
+    class(refdata) :: self
+    integer,intent(in) :: nat
+    if (allocated(self%at)) deallocate (self%at)
+    if (allocated(self%xyz)) deallocate (self%xyz)
+    allocate (self%at(nat),source=0)
+    allocate (self%xyz(3,nat),source=0.0_wp)
+  end subroutine ref_init
+
 !> read atomic charges from a file (one line per atom)
   subroutine read_charges(self,chargesfilename,totchrg)
     implicit none
@@ -858,10 +957,10 @@ end subroutine read_charges
   subroutine ref_to_mol(self,mol)
     implicit none
     class(refdata) :: self
-    type(coord) :: mol
+    class(coord) :: mol
     mol%nat = self%nat
-    if(allocated(self%at)) mol%at = self%at
-    if(allocated(self%xyz)) mol%xyz = self%xyz
+    if (allocated(self%at)) mol%at = self%at
+    if (allocated(self%xyz)) mol%xyz = self%xyz
     mol%chrg = self%ichrg
     mol%uhf = self%uhf
     return
@@ -870,12 +969,13 @@ end subroutine ref_to_mol
   subroutine ref_load_mol(self,mol)
     implicit none
     class(refdata) :: self
-    type(coord) :: mol
-    self%nat    = mol%nat 
-    self%at     = mol%at  
-    self%xyz    = mol%xyz 
-    self%ichrg  = mol%chrg
-    self%uhf    = mol%uhf 
+    class(coord) :: mol
+    call self%init(mol%nat)
+    self%nat = mol%nat
+    self%at = mol%at
+    self%xyz = mol%xyz
+    self%ichrg = mol%chrg
+    self%uhf = mol%uhf
     return
   end subroutine ref_load_mol
 
@@ -898,27 +998,31 @@ function optlevflag(optlev) result(flag)
     return
   end function optlevflag
 
-  function optlevnum(flag) result(optlev)
+  function optlevnum(flag,iostat) result(optlev)
     implicit none
     real(wp) :: optlev
-    character(len=*):: flag
+    character(len=*),intent(in) :: flag
+    integer,intent(out),optional :: iostat
+    if (present(iostat)) iostat = 0
     optlev = 0.0_wp
-    if (index(flag,'crude') .ne. 0) optlev = -3.0d0
-    if (index(flag,'loose') .ne. 0) optlev = -1.0d0
-    if (index(flag,'vloose') .ne. 0) optlev = -2.0d0
-    if (index(flag,'sloppy') .ne. 0) optlev = -2.0d0
-    if (index(flag,'normal') .ne. 0) optlev = 0.0d0
-    if (index(flag,'tight') .ne. 0) optlev = 1.0d0
-    if (index(flag,'verytight') .ne. 0) optlev = 2.0d0
-    if (index(flag,'vtight') .ne. 0) optlev = 2.0d0
-    if (index(flag,'extreme') .ne. 0) optlev = 3.0d0 
-    if (index(flag,'3') .ne. 0) optlev = 3.0d0
-    if (index(flag,'2') .ne. 0) optlev = 2.0d0
-    if (index(flag,'1') .ne. 0) optlev = 1.0d0
-    if (index(flag,'0') .ne. 0) optlev = 0.0d0
-    if (index(flag,'-3') .ne. 0) optlev = -3.0d0
-    if (index(flag,'-2') .ne. 0) optlev = -2.0d0
-    if (index(flag,'-1') .ne. 0) optlev = -1.0d0
+    select case (trim(adjustl(flag)))
+    case ('crude','-3')
+      optlev = -3.0_wp
+    case ('vloose','sloppy','-2')
+      optlev = -2.0_wp
+    case ('loose','-1')
+      optlev = -1.0_wp
+    case ('normal','0')
+      optlev = 0.0_wp
+    case ('tight','1')
+      optlev = 1.0_wp
+    case ('verytight','vtight','2')
+      optlev = 2.0_wp
+    case ('extreme','3')
+      optlev = 3.0_wp
+    case default
+      if (present(iostat)) iostat = 1
+    end select
     return
   end function optlevnum
 
@@ -939,23 +1043,23 @@ subroutine optlev_to_multilev(optlev,multilev)
     real(wp),intent(in) :: optlev
     logical,intent(out) :: multilev(6)
     integer :: j
-    if (optlev <= 3.0d0)then !> "extreme" thresholds
+    if (optlev <= 3.0d0) then !> "extreme" thresholds
       multilev(:) = .false.
       multilev(6) = .true.
       multilev(4) = .true.
       multilev(1) = .true.
-    endif
+    end if
     j = optlevmap_alt(optlev)
-    j = max(j-1, 1)  !> j is reduced by one
-    if (optlev <= 2.0d0)then  !> "normal" to "vtight"
-     multilev(:) = .false.
-     multilev(1) = .true.
-     multilev(j) = .true.
-    endif
-    if (optlev <= -1.0d0)then !> "loose" to "crude"
-     multilev(:) = .false.
-     multilev(j) = .true.
-    endif
+    j = max(j-1,1)  !> j is reduced by one
+    if (optlev <= 2.0d0) then  !> "normal" to "vtight"
+      multilev(:) = .false.
+      multilev(1) = .true.
+      multilev(j) = .true.
+    end if
+    if (optlev <= -1.0d0) then !> "loose" to "crude"
+      multilev(:) = .false.
+      multilev(j) = .true.
+    end if
   end subroutine optlev_to_multilev
 
 !========================================================================================!
@@ -1023,6 +1127,369 @@ subroutine thermo_read_temps(self,fname)
     return
   end subroutine thermo_read_temps
 
+  function thermo_get_close_rt(self,nrt) result(temp)
+    implicit none
+    class(thermodata) :: self
+    integer,intent(out) :: nrt
+    real(wp) :: temp
+    integer :: i,nt,io,ich
+    real(wp),allocatable :: tmptemps(:)
+    nrt = 0
+    nt = self%ntemps
+    allocate (tmptemps(nt),source=0.0_wp)
+    tmptemps(:) = abs(self%temps(:)-298.15_wp)
+    nrt = minloc(tmptemps,1)
+    temp = self%temps(nrt)
+  end function thermo_get_close_rt
+!========================================================================================!
+!========================================================================================!
+
+  subroutine systemdata_copy(self,src)
+!*************************************************************
+!* Deep copy of a systemdata object from src to self.        *
+!*                                                           *
+!* On Input:  src  - source systemdata object                *
+!* On Output: self - destination, populated with src data    *
+!*                                                           *
+!* NOTE: Some embedded derived types (mddat, splitqueue,     *
+!*       splitheap, bh_ref, ONIOM_input) are assigned via    *
+!*       Fortran intrinsic assignment, which may only be a   *
+!*       shallow copy if those types contain pointer         *
+!*       components. See individual placeholder comments.    *
+!*************************************************************
+    implicit none
+    class(systemdata),intent(out) :: self
+    type(systemdata),intent(in)   :: src
+
+! ── run-control integers ──────────────────────────────────────────────────────
+    self%iostatus_meta = src%iostatus_meta
+    self%crestver      = src%crestver
+    self%runver        = src%runver
+    self%properties    = src%properties
+    self%properties2   = src%properties2
+    self%npq           = src%npq
+    if (allocated(src%pqueue)) self%pqueue = src%pqueue
+
+! ── CREGEN thresholds ─────────────────────────────────────────────────────────
+    self%level      = src%level
+    self%thresholds = src%thresholds
+    self%ewin       = src%ewin
+    self%ethr       = src%ethr
+    self%ethrpurge  = src%ethrpurge
+    self%couthr     = src%couthr
+    self%rthr       = src%rthr
+    self%bthr       = src%bthr
+    self%bthr2      = src%bthr2
+    self%bthrmax    = src%bthrmax
+    self%bthrshift  = src%bthrshift
+    self%athr       = src%athr
+    self%pthr       = src%pthr
+    self%pthrsum    = src%pthrsum
+    self%tboltz     = src%tboltz
+    self%cgf        = src%cgf
+    self%iinversion = src%iinversion
+
+! ── MD / algo control ─────────────────────────────────────────────────────────
+    self%mdtemps    = src%mdtemps
+    self%mdtime     = src%mdtime
+    self%elowest    = src%elowest
+    self%eprivious  = src%eprivious
+    self%gcmax      = src%gcmax
+    self%gcmaxparent = src%gcmaxparent
+    self%icount     = src%icount
+    self%mdmode     = src%mdmode
+    self%nmodes     = src%nmodes
+    self%temps      = src%temps
+    self%snapshots  = src%snapshots
+    self%Maxrestart = src%Maxrestart
+    self%nreset     = src%nreset
+    self%nrotammds  = src%nrotammds
+    self%maxcompare = src%maxcompare
+    self%tsplit     = src%tsplit
+
+! ── molecular data ────────────────────────────────────────────────────────────
+    self%nat          = src%nat
+    self%chrg         = src%chrg
+    self%uhf          = src%uhf
+    self%rednat       = src%rednat
+    self%optlev       = src%optlev
+    self%forceconst   = src%forceconst
+    self%dummypercent = src%dummypercent
+
+! ── parallelization ───────────────────────────────────────────────────────────
+    self%MAXRUN          = src%MAXRUN
+    self%omp             = src%omp
+    self%Threads         = src%Threads
+    self%omp_allow_nested = src%omp_allow_nested
+
+! ── fixed-length names and flags ──────────────────────────────────────────────
+    self%ensemblename  = src%ensemblename
+    self%ensemblename2 = src%ensemblename2
+    self%fixfile       = src%fixfile
+    self%constraints   = src%constraints
+    self%solvent       = src%solvent
+    self%gfnver        = src%gfnver
+    self%gfnver2       = src%gfnver2
+    self%rerank_lvl    = src%rerank_lvl
+    self%reopt_lvl     = src%reopt_lvl
+    self%lmover        = src%lmover
+    self%ProgName      = src%ProgName
+    self%ProgIFF       = src%ProgIFF
+    self%homedir       = src%homedir
+    self%scratchdir    = src%scratchdir
+
+! ── allocatable character fields ──────────────────────────────────────────────
+    if (allocated(src%solv))            self%solv           = src%solv
+    if (allocated(src%cmd))             self%cmd            = src%cmd
+    if (allocated(src%inputcoords))     self%inputcoords    = src%inputcoords
+    if (allocated(src%wbofile))         self%wbofile        = src%wbofile
+    if (allocated(src%atlist))          self%atlist         = src%atlist
+    if (allocated(src%chargesfilename)) self%chargesfilename = src%chargesfilename
+    if (allocated(src%sortmode))        self%sortmode       = src%sortmode
+
+! ── METADYN scalar settings ───────────────────────────────────────────────────
+    self%hmass    = src%hmass
+    self%mdtemp   = src%mdtemp
+    self%nmdtemp  = src%nmdtemp
+    self%mdstep   = src%mdstep
+    self%mdlenfac = src%mdlenfac
+    self%tmtd     = src%tmtd
+    self%flexi    = src%flexi
+    self%shake    = src%shake
+    self%mddumpxyz = src%mddumpxyz
+    self%mdskip   = src%mdskip
+    self%mddump   = src%mddump
+    self%maxopt   = src%maxopt
+    self%hlowopt  = src%hlowopt
+    self%microopt = src%microopt
+    self%s6opt    = src%s6opt
+    self%mtd_kscal = src%mtd_kscal
+    self%nstatic  = src%nstatic
+
+! ── METADYN allocatable arrays ────────────────────────────────────────────────
+    self%nmetadyn = src%nmetadyn
+    if (allocated(src%metadfac))  self%metadfac  = src%metadfac
+    if (allocated(src%metadexp))  self%metadexp  = src%metadexp
+    if (allocated(src%metadlist)) self%metadlist = src%metadlist
+    if (allocated(src%mtdstaticfile)) self%mtdstaticfile = src%mtdstaticfile
+    if (allocated(src%includeRMSD))   self%includeRMSD   = src%includeRMSD
+    if (allocated(src%excludeTOPO))   self%excludeTOPO   = src%excludeTOPO
+
+! ── NCI / reactor settings ────────────────────────────────────────────────────
+    self%potscal  = src%potscal
+    self%potpad   = src%potpad
+    self%rdens    = src%rdens
+    self%tempfermi = src%tempfermi
+    self%XH3      = src%XH3
+    self%kappa    = src%kappa
+    if (allocated(src%potatlist)) self%potatlist = src%potatlist
+
+! ── embedded derived types (allocatable-only internals; intrinsic =) ──────────
+    self%protb  = src%protb   !> protobj:     allocatables only, intrinsic = is deep
+    self%cts    = src%cts     !> legacy_constraints: allocatables only, intrinsic = is deep
+    self%eMTD   = src%eMTD   !> entropyMTD:  allocatables only, intrinsic = is deep
+    self%thermo = src%thermo !> thermodata:  allocatables only, intrinsic = is deep
+    self%ref    = src%ref    !> refdata:     allocatables only, intrinsic = is deep
+
+! ── calc pointer: allocate new target and deep-copy ───────────────────────────
+    if (associated(src%calc)) then
+      if (.not. associated(self%calc)) allocate (self%calc)
+      call self%calc%copy(src%calc)
+    end if
+
+! ── placeholder: mddat (mddata) ───────────────────────────────────────────────
+!   mddata may contain pointer components; use intrinsic = as placeholder.
+    self%mddat = src%mddat
+
+! ── placeholder: bh_ref (bh_class) ───────────────────────────────────────────
+!   bh_class may contain pointer components; use intrinsic = as placeholder.
+    if (allocated(src%bh_ref)) then
+      if (.not. allocated(self%bh_ref)) allocate (self%bh_ref,source=src%bh_ref)
+    end if
+
+! ── rigidconf settings ────────────────────────────────────────────────────────
+    self%rigidconf_algo       = src%rigidconf_algo
+    self%rigidconf_toposource = src%rigidconf_toposource
+    if (allocated(src%rigidconf_userfile)) self%rigidconf_userfile = src%rigidconf_userfile
+    if (allocated(src%refine_queue))       self%refine_queue       = src%refine_queue
+    if (allocated(src%ONIOM_toml))         self%ONIOM_toml         = src%ONIOM_toml
+
+! ── placeholder: ONIOM_input (lwoniom_input) ──────────────────────────────────
+!   lwoniom_input may contain pointer components; use intrinsic = as placeholder.
+    if (allocated(src%ONIOM_input)) then
+      if (.not. allocated(self%ONIOM_input)) allocate (self%ONIOM_input,source=src%ONIOM_input)
+    end if
+
+! ── substructure queue ────────────────────────────────────────────────────────
+    self%substructure_queue    = src%substructure_queue
+    self%queue_iter            = src%queue_iter
+    self%queue_maxreconstruct  = src%queue_maxreconstruct
+    self%queue_depthfac        = src%queue_depthfac
+!   splitqueue (split_atms) and splitheap (construct_heap): placeholder
+    if (allocated(src%splitqueue)) self%splitqueue = src%splitqueue
+    self%splitheap = src%splitheap
+
+! ── QCG settings ─────────────────────────────────────────────────────────────
+    self%qcg_runtype    = src%qcg_runtype
+    self%nsolv          = src%nsolv
+    self%nqcgclust      = src%nqcgclust
+    self%max_solv       = src%max_solv
+    self%ensemble_method = src%ensemble_method
+    self%ensemble_opt   = src%ensemble_opt
+    self%freqver        = src%freqver
+    self%freq_scal      = src%freq_scal
+    self%docking_qcg_flag = src%docking_qcg_flag
+    if (allocated(src%directed_file))   self%directed_file   = src%directed_file
+    if (allocated(src%directed_list))   self%directed_list   = src%directed_list
+    if (allocated(src%directed_number)) self%directed_number = src%directed_number
+    if (allocated(src%solu_file))       self%solu_file       = src%solu_file
+    if (allocated(src%solv_file))       self%solv_file       = src%solv_file
+
+! ── clustering settings ───────────────────────────────────────────────────────
+    self%maxcluster = src%maxcluster
+    self%nclust     = src%nclust
+    self%pccap      = src%pccap
+    self%pcthr      = src%pcthr
+    self%pcmin      = src%pcmin
+    self%csthr      = src%csthr
+    self%clustlev   = src%clustlev
+    if (allocated(src%pcmeasure)) self%pcmeasure = src%pcmeasure
+
+! ── structure generation / bias settings ──────────────────────────────────────
+    self%doOHflip   = src%doOHflip
+    self%maxflip    = src%maxflip
+    self%rthr2      = src%rthr2
+    self%kshift     = src%kshift
+    self%kshiftnum  = src%kshiftnum
+    self%gescoptlev = src%gescoptlev
+    if (allocated(src%biasfile)) self%biasfile = src%biasfile
+
+! ── DFT driver (deprecated) ───────────────────────────────────────────────────
+    self%hardcutDFT  = src%hardcutDFT
+    self%harcutpthr  = src%harcutpthr
+    self%hardcutnst  = src%hardcutnst
+    if (allocated(src%dftrcfile)) self%dftrcfile = src%dftrcfile
+
+! ── msreact settings ──────────────────────────────────────────────────────────
+    self%msei         = src%msei
+    self%mscid        = src%mscid
+    self%msnoiso      = src%msnoiso
+    self%msiso        = src%msiso
+    self%msmolbar     = src%msmolbar
+    self%msinchi      = src%msinchi
+    self%mslargeprint = src%mslargeprint
+    self%msattrh      = src%msattrh
+    self%msnbonds     = src%msnbonds
+    self%msnshifts    = src%msnshifts
+    self%msnshifts2   = src%msnshifts2
+    self%msnfrag      = src%msnfrag
+    self%msinput      = src%msinput
+
+! ── general logical flags ─────────────────────────────────────────────────────
+    self%allrot         = src%allrot
+    self%alkylize       = src%alkylize
+    self%alkylizeskip   = src%alkylizeskip
+    self%altopt         = src%altopt
+    self%autothreads    = src%autothreads
+    self%autozsort      = src%autozsort
+    self%allowrestart   = src%allowrestart
+    self%better         = src%better
+    self%ceh_guess      = src%ceh_guess
+    self%spin_polarized = src%spin_polarized
+    self%cff            = src%cff
+    self%cluster        = src%cluster
+    self%checktopo      = src%checktopo
+    self%checkiso       = src%checkiso
+    self%chargesfile    = src%chargesfile
+    self%compareens     = src%compareens
+    self%confgo         = src%confgo
+    self%constrain_solu = src%constrain_solu
+    self%crest_ohess    = src%crest_ohess
+    self%doNMR          = src%doNMR
+    self%dryrun         = src%dryrun
+    self%ENSO           = src%ENSO
+    self%ens_const      = src%ens_const
+    self%entropic       = src%entropic
+    self%entropymd      = src%entropymd
+    self%esort          = src%esort
+    self%ext            = src%ext
+    self%extLFER        = src%extLFER
+    self%FINAL_GFN2_OPT = src%FINAL_GFN2_OPT
+    self%fullcre        = src%fullcre
+    self%gbsa           = src%gbsa
+    self%gcmultiopt     = src%gcmultiopt
+    self%gradsp         = src%gradsp
+    self%heavyrmsd      = src%heavyrmsd
+    self%inplaceMode    = src%inplaceMode
+    self%iterativeV2    = src%iterativeV2
+    self%iru            = src%iru
+    self%keepModef      = src%keepModef
+    self%keepScratch    = src%keepScratch
+    self%legacy         = src%legacy
+    self%metadynset     = src%metadynset
+    self%methautocorr   = src%methautocorr
+    self%multilevelopt  = src%multilevelopt
+    self%newcregen      = src%newcregen
+    self%NCI            = src%NCI
+    self%niceprint      = src%niceprint
+    self%noconst        = src%noconst
+    self%onlyZsort      = src%onlyZsort
+    self%optpurge       = src%optpurge
+    self%outputsdf      = src%outputsdf
+    self%pcaexclude     = src%pcaexclude
+    self%pclean         = src%pclean
+    self%performCross   = src%performCross
+    self%performMD      = src%performMD
+    self%performModef   = src%performModef
+    self%performMTD     = src%performMTD
+    self%preactormtd    = src%preactormtd
+    self%preactorpot    = src%preactorpot
+    self%preopt         = src%preopt
+    self%presp          = src%presp
+    self%printscoords   = src%printscoords
+    self%QCG            = src%QCG
+    self%qcg_flag       = src%qcg_flag
+    self%qcg_restart    = src%qcg_restart
+    self%nopreopt       = src%nopreopt
+    self%quick          = src%quick
+    self%readbias       = src%readbias
+    self%reftopo        = src%reftopo
+    self%relax          = src%relax
+    self%restartopt     = src%restartopt
+    self%reweight       = src%reweight
+    self%riso           = src%riso
+    self%rotamermds     = src%rotamermds
+    self%refine_presort = src%refine_presort
+    self%refine_esort   = src%refine_esort
+    self%sameRandomNumber = src%sameRandomNumber
+    self%scallen        = src%scallen
+    self%scratch        = src%scratch
+    self%setgcmax       = src%setgcmax
+    self%sdfformat      = src%sdfformat
+    self%slow           = src%slow
+    self%solv_md        = src%solv_md
+    self%staticmtd      = src%staticmtd
+    self%subRMSD        = src%subRMSD
+    self%superquick     = src%superquick
+    self%threadssetmanual = src%threadssetmanual
+    self%trackorigin    = src%trackorigin
+    self%testnumgrad    = src%testnumgrad
+    self%use_xtbiff     = src%use_xtbiff
+    self%user_enslvl    = src%user_enslvl
+    self%user_temp      = src%user_temp
+    self%user_mdtime    = src%user_mdtime
+    self%user_mdstep    = src%user_mdstep
+    self%user_nclust    = src%user_nclust
+    self%user_dumxyz    = src%user_dumxyz
+    self%user_wscal     = src%user_wscal
+    self%useqmdff       = src%useqmdff
+    self%water          = src%water
+    self%wallsetup      = src%wallsetup
+    self%wbotopo        = src%wbotopo
+
+    return
+  end subroutine systemdata_copy
+
 !========================================================================================!
 !========================================================================================!
 end module crest_data
diff --git a/src/cleanup.f90 b/src/cleanup.f90
index c3f43f06..8a6a0d0b 100644
--- a/src/cleanup.f90
+++ b/src/cleanup.f90
@@ -72,9 +72,9 @@ subroutine custom_cleanup(env)
     call rmrf('cregen_*.tmp')
     call rmrf('MDFILES')
     if(allocated(env%calc%calcs))then
-    if(.not.any(env%calc%calcs(:)%pr))then
+    !if(.not.any(env%calc%calcs(:)%pr))then
       call rmrfw('calculation.level.')
-    endif
+    !endif
     endif
    endif
    call rmrf('.CHRG .UHF')
diff --git a/src/confparse.f90 b/src/confparse.f90
index 203eec7e..014ebd91 100644
--- a/src/confparse.f90
+++ b/src/confparse.f90
@@ -46,7 +46,8 @@ subroutine parseflags(env,arg,nra)
   use optimize_module
   use parse_inputfile
   use crest_restartlog
-  use lwoniom_module
+  use parse_hybrid
+
   implicit none
   type(systemdata),intent(inout) :: env
   integer,intent(in) :: nra
@@ -61,10 +62,17 @@ subroutine parseflags(env,arg,nra)
   integer :: ctype
   logical :: ex,bondconst
   character(len=:),allocatable :: argument
+  logical,allocatable :: processedarg(:)
+  logical,allocatable :: atlist(:)
+  character(len=:),allocatable :: arg1,arg2,arg3
+  character(len=:),allocatable :: hybrid_quality,hybrid_workhorse
+  character(len=4) :: hybrid_mode
 
   allocate (xx(10),floats(3),strings(3))
   ctmp = ''
   dtmp = ''
+
+  allocate (processedarg(nra),source=.false.)
 !========================================================================================!
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
 !> Set the defaults
@@ -85,14 +93,15 @@ subroutine parseflags(env,arg,nra)
   if (.not.gui) then
     call confscript_head(.false.)
 
-    write (*,'(/,1x,a)') 'Command line input:'
-    write (*,'(1x,a,a,/)') '$ ',trim(cmd)
+    write (stdout,'(/,1x,a)') 'Command line input:'
+    write (stdout,'(1x,a,a,/)') '$ ',trim(cmd)
   end if
   env%cmd = trim(cmd)
 
 !=========================================================================================!
 !>--- check if help is requested or citations shall be diplayed
   do i = 1,nra
+    if (processedarg(i)) cycle
     if (any((/character(6)::'-h','-H','--h','--H','--help'/) == trim(arg(i)))) then
       if (nra > i) then
         ctmp = trim(arg(i+1))
@@ -107,12 +116,15 @@ subroutine parseflags(env,arg,nra)
     end if
     if (index(arg(i),'-newversion') .ne. 0) then !> as in CREST version >= 3.0
       env%legacy = .false.
+      !processedarg(i) = .true.
     end if
     if (index(arg(i),'-legacy') .ne. 0) then  !> as in CREST version <3.0
       env%legacy = .true.
+      !processedarg(i) = .true.
     end if
     if (index(arg(i),'-dry') .ne. 0) then   !> "dry" run to print settings
       env%dryrun = .true.
+      processedarg(i) = .true.
     end if
   end do
 
@@ -194,7 +206,7 @@ subroutine parseflags(env,arg,nra)
   env%multilevelopt = .true.   !> perform multilevel optimization
   env%trackorigin = .true.     !> for v2 track generation step by default
   env%compareens = .false.     !> compare two given ensembles
-  env%maxcompare = 10          !> maximum number of (lowest) conformers to compare when using "-compare"
+  env%maxcompare = 100         !> maximum number of (lowest) structures to compare when using "-compare"
   env%QCG = .false.          !> special QCG usage
 
 !>--- The following settings are mainly for v.1 (MF-MD-GC)
@@ -256,6 +268,7 @@ subroutine parseflags(env,arg,nra)
   end if
   inquire (file='.UHF',exist=ex)
   if (any(index(arg,'-uhf') .ne. 0)) ex = .false.
+  if (any(index(arg,'-mult') .ne. 0)) ex = .false.
   if (ex) then
     write(stdout,*) '**ERROR** CREST will not read .UHF files following version 3.0.2'
     write(stdout,*) 'Please use --uhf or the input file specifications.'
@@ -282,14 +295,15 @@ subroutine parseflags(env,arg,nra)
 !>--- options for principal component analysis (PCA) and clustering
   env%pcmeasure = 'dihedral'
 
-!>--- thermo options
+!>--- Standard THERMO options
   env%thermo%trange(1) = 278.15d0  !> T start
   env%thermo%trange(2) = 380.0d0   !> T stop (approx.)
   env%thermo%trange(3) = 10.0d0    !> T step
-  env%thermo%ptot = 0.9d0   !> for hessians take x% conformers
-  env%thermo%pcap = 50000   !> limit number of structures
-  env%thermo%sthr = 25.0d0  !> rotor cutoff
-  env%thermo%fscal = 1.0d0   !> frequency scaling factor
+  env%thermo%ptot = 0.9d0          !> for hessians take x% conformers
+  env%thermo%pcap = 50000          !> limit number of structures
+  env%thermo%sthr = 25.0d0         !> rotor cutoff
+  env%thermo%fscal = 1.0d0         !> frequency scaling factor
+  env%thermo%emodel = 'grimme'     !> Svib treatment
 
 !>--- other things
   env%crest_ohess = .false.
@@ -324,7 +338,7 @@ subroutine parseflags(env,arg,nra)
 !=========================================================================================!
 !=========================================================================================!
 !>--- get the CREST version/runtype
-  env%crestver = crest_imtd !> confscript version (v.1 = MF-MD-GC, v.2 = MTD)
+  env%crestver = crest_none !> no runtype selected — must be set explicitly
   env%runver = 1            !> default
   env%properties = p_none   !> additional calculations/options before or after confsearch
   env%properties2 = p_none  !> backup for env%properties
@@ -332,13 +346,21 @@ subroutine parseflags(env,arg,nra)
   env%preopt = .true.
 !>--- check for (TOML) input file
   call find_input_file(arg,nra,idum)
-  if(idum.ne.0)then
+  if (idum .ne. 0) then
     call parseinputfile(env,trim(arg(idum)))
-  endif
+    processedarg(idum) = .true.
+  end if
 
 !>--- first arg loop
   do i = 1,nra
+    if (processedarg(i)) cycle
     argument = trim(arg(i))
+    arg1 = ''
+    if (i+1 .le. nra) arg1 = trim(arg(i+1))
+    arg2 = ''
+    if (i+2 .le. nra) arg2 = trim(arg(i+2))
+    arg3 = ''
+    if (i+3 .le. nra) arg3 = trim(arg(i+3))
     if (argument(1:2) == '--') then
       argument = argument(2:)
     end if
@@ -346,77 +368,112 @@ subroutine parseflags(env,arg,nra)
       select case (argument) !> RUNTYPES
 
       case ('-v1') !> confscript version 1 (MF-MD-GC)
+        processedarg(i) = .true.
         env%crestver = crest_mfmdgc
-        write (*,'(2x,a,'' : MF-MD-GC'')') trim(arg(i))
+        write (stdout,'(2x,a,'' : MF-MD-GC'')') trim(arg(i))
         env%mdtime = 40.0d0       !> simulation length of the MD, 40ps total (2*20ps)(default for QMDFF would be 500)
         env%temps = 1             !> number of default MD cycles
         env%Maxrestart = 15
         env%performModef = .true. !> do the MF in V1
         env%trackorigin = .false. !> for v1 there is not much insight from this
+        call parseflags_deprecated(argument)
+        call creststop(status_safety)
         exit
 
       case ('-v2') !> confscript version 2 (MTD-GC)
+        processedarg(i) = .true.
         env%crestver = crest_imtd
-        write (*,'(2x,a,'' : MTD-GC'')') trim(arg(i))
+        write (stdout,'(2x,a,'' : MTD-GC'')') trim(arg(i))
         env%iterativeV2 = .false.  !> iterative crest V2 version
         env%Maxrestart = 1       !> for non-iterative MTD-GC only
         exit
 
-      case ('-v3','-v2i') !> confscript version 2 but iterativ (iMTD-GC)
+      case ('-v3','-v2i','-imtdgc') !> confscript version 2 but iterativ (iMTD-GC)
+        processedarg(i) = .true.
         env%crestver = crest_imtd
         env%iterativeV2 = .true.
-        write (*,'(2x,a,'' : iMTD-GC'')') trim(arg(i))
+        write (stdout,'(2x,a,'' : iMTD-GC'')') trim(arg(i))
+        exit
+
+      case ('-entropy') !> sMTD-iMTD+entropy extrapol
+        processedarg(i) = .false.  !> THIS IS IMPORTANT, WE READ FURTHER ENTROPY SETTINGS BELOW
+        env%crestver = crest_imtd
+        env%iterativeV2 = .true.
+        write (stdout,'(2x,a,'' : iMTD-sMTD + entropy extrapolation'')') trim(arg(i))
         exit
 
       case ('-v4') !> sMTD-iMTD (same as entropy mode)
+        processedarg(i) = .true.
         env%crestver = crest_imtd2
         env%iterativeV2 = .true.
         env%entropymd = .true.
         env%rotamermds = .false.
         env%performCross = .false.
         env%emtd%maxfallback = 1
-        write (*,'(2x,a,'' : iMTD-sMTD'')') trim(arg(i))
+        write (stdout,'(2x,a,'' : iMTD-sMTD'')') trim(arg(i))
         exit
 
       case ('-mdopt','-purge') !> MDOPT
+        processedarg(i) = .true.
         env%crestver = crest_mdopt
         atmp = ''
         env%preopt = .false.
         env%ensemblename = 'none selected'
         if (nra .ge. (i+1)) atmp = adjustl(arg(i+1))
         if ((atmp(1:1) /= '-').and.(len_trim(atmp) .ge. 1)) then
+          processedarg(i+1) = .true.
           env%ensemblename = trim(atmp)
+          call xyz2coord(env%ensemblename,'coord') !> write coord from lowest structure
+          env%inputcoords = env%ensemblename !> just for a printout
         end if
-        call xyz2coord(env%ensemblename,'coord') !> write coord from lowest structure
-        env%inputcoords = env%ensemblename !> just for a printout
         exit
 
       case ('-screen')  !> SCREEN
+        processedarg(i) = .true.
         env%crestver = crest_screen
         atmp = ''
         env%ensemblename = 'none selected'
         if (nra .ge. (i+1)) atmp = adjustl(arg(i+1))
         if ((atmp(1:1) /= '-').and.(len_trim(atmp) .ge. 1)) then
+          processedarg(i+1) = .true.
           env%ensemblename = trim(atmp)
+          call xyz2coord(env%ensemblename,'coord') !write coord from lowest structure
+          env%inputcoords = env%ensemblename !just for a printout
         end if
-        call xyz2coord(env%ensemblename,'coord') !write coord from lowest structure
-        env%inputcoords = env%ensemblename !just for a printout
         exit
 
       case ('-mdsp','-ensemblesp') !> Singlepoints along ensemble
+        processedarg(i) = .true.
         env%crestver = crest_ensemblesp
         atmp = ''
         env%preopt = .false.
         env%ensemblename = 'none selected'
         if (nra .ge. (i+1)) atmp = adjustl(arg(i+1))
         if ((atmp(1:1) /= '-').and.(len_trim(atmp) .ge. 1)) then
+          processedarg(i+1) = .true.
           env%ensemblename = trim(atmp)
+          call xyz2coord(env%ensemblename,'coord') !> write coord from lowest structure
+          env%inputcoords = env%ensemblename !> just for a printout
+        end if
+        exit
+
+      case ('-mdhess','-ensemblehess') !> Hessians + thermochemistry along ensemble
+        processedarg(i) = .true.
+        env%crestver = crest_ensemblehess
+        atmp = ''
+        env%preopt = .false.
+        env%ensemblename = 'none selected'
+        if (nra .ge. (i+1)) atmp = adjustl(arg(i+1))
+        if ((atmp(1:1) /= '-').and.(len_trim(atmp) .ge. 1)) then
+          processedarg(i+1) = .true.
+          env%ensemblename = trim(atmp)
+          call xyz2coord(env%ensemblename,'coord') !> write coord from lowest structure
+          env%inputcoords = env%ensemblename !> just for a printout
         end if
-        call xyz2coord(env%ensemblename,'coord') !> write coord from lowest structure
-        env%inputcoords = env%ensemblename !> just for a printout
         exit
 
       case ('-pka','-pKa')  !> pKa calculation script
+        processedarg(i) = .true.
         env%crestver = crest_pka
         env%runver = 33
         !env%relax=.true.
@@ -428,103 +485,111 @@ subroutine parseflags(env,arg,nra)
         env%solv = '--alpb h2o'
         env%protb%h_acidic = 0
         call pka_argparse(arg(i+1),env%protb%h_acidic)
-        if (env%protb%h_acidic == -2) env%protb%pka_baseinp = trim(arg(i+1))
+        if (env%protb%h_acidic == -2) env%protb%pka_baseinp = arg1
 
       case ('-compare')   !> flag for comparing two ensembles, analysis tool
+        processedarg(i) = .true.
         env%compareens = .true.
-        env%crestver = 5
-        env%properties = p_compare
+        env%crestver = crest_sorting
+        env%sortmode = 'compare'
+        env%preopt = .false.
         env%ensemblename = 'none selected'
         env%ensemblename2 = 'none selected'
         if (nra .ge. (i+2)) then
           atmp = adjustl(arg(i+1))
           btmp = adjustl(arg(i+2))
         else
-          write (*,'(a,a)') trim(arg(i)),' requires two arguments:'
-          write (*,'(2x,a,a)') trim(arg(i)),' [ensemble1] [ensemble2]'
+          write (stdout,'(a,a)') trim(arg(i)),' requires two arguments:'
+          write (stdout,'(2x,a,a)') trim(arg(i)),' [ensemble1] [ensemble2]'
           error stop
         end if
         if ((atmp(1:1) /= '-').and.(len_trim(atmp) .ge. 1).and. &
         &  (btmp(1:1) /= '-').and.(len_trim(btmp) .ge. 1)) then
           env%ensemblename = trim(atmp)
           env%ensemblename2 = trim(btmp)
+          processedarg(i+1) = .true.
+          processedarg(i+2) = .true.
         end if
-        write (*,'(1x,a,1x,a,1x,a)') trim(arg(i)),trim(env%ensemblename),trim(env%ensemblename2)
+        write (stdout,'(1x,a,1x,a,1x,a)') trim(arg(i)),trim(env%ensemblename),trim(env%ensemblename2)
         exit
 
       case ('-protonate') !> protonation tool
+        processedarg(i) = .true.
         env%properties = p_protonate
         env%crestver = crest_protonate
-        env%legacy = .true. !> TODO, set active at later version
-        write (*,'(2x,a,'' : automated protonation script'')') trim(arg(i))
+        env%legacy = .false.
+        write (stdout,'(2x,a,'' : automated protonation script'')') trim(arg(i))
         exit
 
       case ('-deprotonate') !> deprotonation tool
+        processedarg(i) = .true.
         env%properties = p_deprotonate
         env%crestver = crest_deprotonate
-        env%legacy = .true. !> TODO, set active at later version
-        write (*,'(2x,a,'' : automated deprotonation script'')') trim(arg(i))
+        env%legacy = .false. 
+        write (stdout,'(2x,a,'' : automated deprotonation script'')') trim(arg(i))
         exit
 
       case ('-tautomerize') !> tautomerization tool
+        processedarg(i) = .true.
         env%properties = p_tautomerize
         env%crestver = crest_tautomerize
-        env%legacy = .true. !> TODO, set active at later version
-        write (*,'(2x,a,'' : automated tautomerization script'')') trim(arg(i))
+        env%legacy = .false. 
+        write (stdout,'(2x,a,'' : automated tautomerization script'')') trim(arg(i))
         exit
 
       case ('-isomerize','-stereomers') !> isomerization tool
+        processedarg(i) = .true.
         env%properties = p_isomerize
-        write (*,'(2x,a,'' : automated stereoisomerization script'')') trim(arg(i))
-        write (*,'(2x,''Note: Use of GFN-FF required for stereoisomer generation.'')')
+        write (stdout,'(2x,a,'' : automated stereoisomerization script'')') trim(arg(i))
+        write (stdout,'(2x,''Note: Use of GFN-FF required for stereoisomer generation.'')')
         exit
 
-      case ('-forall','-for') !> property mode with ensemble as input
-        env%properties = p_propcalc
-        atmp = ''
-        env%ensemblename = 'none selected'
-        if (nra .ge. (i+1)) atmp = adjustl(arg(i+1))
-        if ((atmp(1:1) /= '-').and.(len_trim(atmp) .ge. 1)) then
-          env%ensemblename = trim(atmp)
-        end if
-        inquire (file=env%ensemblename,exist=ex)
-        if (.not.ex) then
-          write (*,'(1x,a,a,a)') 'invalid ensemble file <',trim(env%ensemblename),'>. exit.'
-          error stop
-        end if
-        call xyz2coord(env%ensemblename,'coord') !> write coord from lowest structure
-        env%inputcoords = env%ensemblename !> just for a printout
-        if (argument == '-forall') then
-          env%protb%alldivers = .true.
-        end if
+      case ('-forall','-for') !> property mode with ensemble as input (deprecated)
+        call parseflags_deprecated(argument)
         exit
 
       case ('-rrhoav')  !> Hessians along given ensemble and average
+        processedarg(i) = .true.
         env%properties = p_rrhoaverage
         atmp = ''
         env%ensemblename = 'none selected'
         if (nra .ge. (i+1)) atmp = adjustl(arg(i+1))
         if ((atmp(1:1) /= '-').and.(len_trim(atmp) .ge. 1)) then
           env%ensemblename = trim(atmp)
+          processedarg(i+1) = .true.
         end if
         inquire (file=env%ensemblename,exist=ex)
         if (.not.ex) then
-          write (*,'(1x,a,a,a)') 'invalid ensemble file <',trim(env%ensemblename),'>. exit.'
+          write (stdout,'(1x,a,a,a)') 'invalid ensemble file <',trim(env%ensemblename),'>. exit.'
           error stop
         end if
         exit
 
       case ('-reactor')  !> xtb nanoreactor workarounds
+        processedarg(i) = .true.
         env%preopt = .false.
         env%crestver = crest_nano
         exit
 
       case ('-solvtool','-qcg')
+        processedarg(i) = .true.
         !> Set solute file if present
-        if (i == 2) env%solu_file = trim(arg(i-1))
+        if (i == 2) then
+          env%solu_file = trim(arg(i-1))
+          inquire (file=env%solu_file,exist=ex)
+          if (ex) then
+            processedarg(i-1) = .true.
+          end if
+        end if
         !> Set solvent file if prensent
         !> If it is another argument, it doesent matter as solvent file is checke in solvtool
-        if (nra >= i+1) env%solv_file = trim(arg(i+1))
+        if (nra >= i+1) then
+          env%solv_file = arg1
+          inquire (file=env%solv_file,exist=ex)
+          if (ex) then
+            processedarg(i+1) = .true.
+          end if
+        end if
         !> Set QCG defaults
         env%preopt = .false.
         env%crestver = crest_solv
@@ -537,9 +602,10 @@ subroutine parseflags(env,arg,nra)
         env%doOHflip = .false. !> Switch off OH-flip
         if (env%iterativeV2) env%iterativeV2 = .false.
         exit
-        env%legacy = .true. !> force legacy routines for now
+        !env%legacy = .true. !> force legacy routines for now
 
       case ('-compress')
+        processedarg(i) = .true.
         env%crestver = crest_compr
         env%runver = 77
         env%mdstep = 2.5d0
@@ -548,149 +614,239 @@ subroutine parseflags(env,arg,nra)
         exit
 
       case ('-msreact')
+        processedarg(i) = .true.
         env%crestver = crest_msreac
         env%preopt = .false.
         env%presp = .true.
         env%ewin = 200.0d0 !> 200 kcal for msreact
 
       case ('-splitfile')
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
+        processedarg(i+1) = .true.
         k = huge(j)
         l = 1
         if (nra >= i+2) then
           read (arg(i+2),*,iostat=io) j
           if (io == 0) then
             k = j
+            processedarg(i+2) = .true.
           end if
         end if
         if (nra >= i+3) then
           read (arg(i+3),*,iostat=io) j
           if (io == 0) then
             l = j
+            processedarg(i+3) = .true.
           end if
         end if
         call splitfile(ctmp,k,l)
-        stop
+        call creststop(status_normal)
 
       case ('-printaniso')
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         inquire (file=ctmp,exist=ex)
         if (ex) then
+          processedarg(i+1) = .true.
           call printaniso(ctmp,0.01_wp,0.025_wp,0.5_wp)
         end if
         stop
 
+      case ('-rotalign')
+        processedarg(i) = .true.
+        ctmp = arg1
+        inquire (file=ctmp,exist=ex)
+        if (ex) then
+          processedarg(i+1) = .true.
+          call rotalign_tool(ctmp)
+        end if
+        stop
+
       case ('-printboltz')
+        processedarg(i) = .true.
         if (nra >= i+2) then
-          ctmp = trim(arg(i+1))
-          dtmp = trim(arg(i+2))
+          ctmp = arg1
+          dtmp = arg2
           call prbweight(ctmp,dtmp)
+          processedarg(i+1) = .true.
+          processedarg(i+2) = .true.
         else
-          ctmp = trim(arg(i+1))
+          ctmp = arg1
           call prbweight(ctmp,'')
+          processedarg(i+1) = .true.
         end if
 
       case ('-wbotopo','-usewbo')  !> try to use a WBO file in topology analysis
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         if (ctmp(1:1) .ne. '-'.and.(nra >= i+1)) then
           env%wbofile = trim(ctmp)
+          processedarg(i+1) = .true.
         else
           env%wbofile = 'wbo'
         end if
         env%wbotopo = .true.
 
       case ('-testtopo')
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         inquire (file=ctmp,exist=ex)
         if (i+2 .le. nra) then
-          dtmp = trim(arg(i+2))
+          dtmp = arg2
           if (dtmp(1:1) == '-') then
             dtmp = 'default'
+          else
+            processedarg(i+2) = .true.
           end if
         end if
         if (ex) then
+          processedarg(i+1) = .true.
           call testtopo(ctmp,env,dtmp)
         end if
 
       case ('-resortensemble')
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         inquire (file=ctmp,exist=ex)
         if (ex) then
+          processedarg(i+1) = .true.
           call resort_ensemble(ctmp)
         end if
         stop
 
       case ('-thermo','-thermotool')
+        processedarg(i) = .true.
         env%properties = p_thermo
         ctmp = trim(arg(1))  ! first argument to read the structure
         if (ctmp(1:1) .ne. '-') then
           env%inputcoords = trim(ctmp)
           env%thermo%coords = trim(ctmp)
         end if
-        ctmp = trim(arg(i+1)) ! second argument to read the vibspectrum
+        ctmp = arg1 ! second argument to read the vibspectrum
         if (ctmp(1:1) .ne. '-') then
+          processedarg(i+1) = .true.
           env%thermo%vibfile = trim(ctmp)
         end if
 
       case ('-rmsd','-rmsdheavy','-hrmsd')
-        ctmp = trim(arg(i+1))
-        dtmp = trim(arg(i+2))
+        processedarg(i) = .true.
         if ((argument == '-rmsdheavy').or.(argument == '-hrmsd')) then
-          call quick_rmsd_tool(ctmp,dtmp,.true.)
+          env%sortmode = 'hrmsd'
+        else
+          env%sortmode = 'rmsd'
+        end if
+        ctmp = arg1
+        dtmp = arg2
+        env%preopt = .false.
+        env%crestver = crest_sorting
+        inquire (file=ctmp,exist=ex)
+        if (ex) then
+          env%inputcoords = ctmp
+          env%ensemblename = ctmp
+          processedarg(i+1) = .true.
+        end if
+        inquire (file=dtmp,exist=ex)
+        if (ex) then
+          env%ensemblename2 = dtmp
+          processedarg(i+2) = .true.
+        end if
+
+      case ('-irmsd','-irmsd_noinv')
+        processedarg(i) = .true.
+        ctmp = arg1
+        dtmp = arg2
+        env%preopt = .false.
+        env%crestver = crest_sorting
+        env%sortmode = 'irmsd'
+        inquire (file=ctmp,exist=ex)
+        if (ex) then
+          env%inputcoords = ctmp
+          env%ensemblename = ctmp
+          processedarg(i+1) = .true.
+        end if
+        inquire (file=dtmp,exist=ex)
+        if (ex) then
+          env%ensemblename2 = dtmp
+          processedarg(i+2) = .true.
+        end if
+        if (index(argument,'_noinv') .ne. 0) then
+          env%iinversion = 2
+        end if
+
+      case ('-hungarian','-hungarianheavy','-hhungarian','-lsap','-hlsap','-lsapheavy')
+        processedarg(i:i+2) = .true.
+        ctmp = arg1
+        dtmp = arg2
+        if ((argument == '-hungarianheavy').or.(argument == '-hhungarian').or. &
+           &(argument == '-lsapheavy').or.(argument == '-hlsap')) then
+          call quick_hungarian_match(ctmp,dtmp,.true.)
         else
-          call quick_rmsd_tool(ctmp,dtmp,.false.)
+          call quick_hungarian_match(ctmp,dtmp,.false.)
         end if
         stop
 
       case ('-symmetries')
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         inquire (file=ctmp,exist=ex)
         if (ex) then
+          processedarg(i+1) = .true.
           call ensemble_analsym(trim(ctmp),.true.)
         end if
-        stop
+        call exit(0)
 
       case ('-exlig','-exligand','-exchligand')
+        processedarg(i) = .true.
         env%properties = p_ligand
         env%protb%infile = trim(arg(1))
-        ctmp = trim(arg(i+1))
+        ctmp = arg1
+        processedarg(i+1) = .true.
         env%protb%newligand = trim(ctmp)
         read (arg(i+2),*,iostat=io) j
         if (io == 0) then
           env%protb%centeratom = j
+          processedarg(i+2) = .true.
         end if
         read (arg(i+3),*,iostat=io) j
         if (io == 0) then
           env%protb%ligand = j
+          processedarg(i+3) = .true.
         end if
         exit
 
       case ("-acidbase","-ab",'-abprep','-pkaprep','-gdissprep')  !-- acid base correction
+        processedarg(i) = .true.
         !> crest --ab <acid.xyz> <base.xyz> --chrg <acidchrg>
         env%properties = p_acidbase
         if (index(arg(i),'prep') .ne. 0) then
           call pka_argparse2(env,arg(i+1),arg(i+2),env%protb%pka_mode)
         else
-          ctmp = trim(arg(i+1))
+          ctmp = arg1
           inquire (file=ctmp,exist=ex)
           if (ex) then
+            processedarg(i+1) = .true.
             env%protb%pka_acidensemble = trim(ctmp)
-            write (*,'(1x,a,a)') 'File used for the acid: ',trim(ctmp)
+            write (stdout,'(1x,a,a)') 'File used for the acid: ',trim(ctmp)
           end if
-          ctmp = trim(arg(i+2))
+          ctmp = arg2
           inquire (file=ctmp,exist=ex)
           if (ex) then
+            processedarg(i+2) = .true.
             env%protb%pka_baseensemble = trim(ctmp)
-            write (*,'(1x,a,a)') 'File used for the base: ',trim(ctmp)
+            write (stdout,'(1x,a,a)') 'File used for the base: ',trim(ctmp)
           end if
         end if
         env%solv = '--alpb h2o'
         env%gfnver = '--gfn2'
 
       case ('-redoextrapol')
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
+        processedarg(i+1) = .true.
         read (arg(i+2),*,iostat=io) j
         if (io == 0) then
+          processedarg(i+2) = .true.
           call redo_extrapol(ctmp,j)
         else
           call redo_extrapol(ctmp,0)
@@ -698,40 +854,91 @@ subroutine parseflags(env,arg,nra)
         stop
 
       case ('-sp') !> singlepoint calculation (uses new calculator routines)
+        processedarg(i) = .true.
         env%crestver = crest_sp
         env%preopt = .false.
         env%legacy = .false.
+        write (stdout,'(2x,a,t15,a)') argument//':','Singlepoint energy calculation runtype'
         exit
 
       case ('-opt','-optimize','-ancopt','-ohess') !> ANCOPT structure optimization (uses new calculator routines)
+        processedarg(i) = .true.
         env%preopt = .false.
         env%crestver = crest_optimize
         env%legacy = .false.
-        if (argument .eq. '-ohess') env%crest_ohess = .true.
+        if (argument .eq. '-ohess') then
+          env%crest_ohess = .true.
+          write (stdout,'(2x,a,t15,a)') argument//':','Geometry optimization + frequency calculation runtype'
+        else
+          write (stdout,'(2x,a,t15,a)') argument//':','Geometry optimization runtype'
+        end if
+        !if (i+1 .le. nra) then
+        env%optlev = optlevnum(arg(i+1),iostat=io)
+        if (io == 0) processedarg(i+1) = .true.
+        !end if
+
         exit
 
       case ('-hess','-numhess') !> Numerical hessian
+        processedarg(i) = .true.
         env%preopt = .false.
         env%crestver = crest_numhessian
         env%legacy = .false.
+        write (stdout,'(2x,a,t15,a)') argument//':','Frequency calculation runtype'
         exit
 
       case ('-trialopt')  !> test optimization with topocheck
+        processedarg(i) = .true.
         env%preopt = .false.
         env%crestver = crest_trialopt
+        write (stdout,'(2x,a,t15,a)') argument//':','Trial geometry optimization'
         exit
 
       case ('-dynamics','-dyn') !> molecular dynamics (uses new calculator routines)
+        processedarg(i) = .true.
         env%preopt = .false.
         env%crestver = crest_moldyn
         env%legacy = .false.
+        write (stdout,'(2x,a,t15,a)') argument//':','Molecular dynamics simulation'
+        exit
+
+      case ('-sort','-cregen')
+        processedarg(i) = .true.
+        env%preopt = .false.
+        env%crestver = crest_sorting
+        env%autozsort = .false.
+        if (argument == '-cregen') then
+          env%sortmode = 'cregen'
+          env%confgo = .true.
+        end if
+        ctmp = arg1
+        inquire (file=ctmp,exist=ex)
+        if (ex) then
+          processedarg(i+1) = .true.
+          env%inputcoords = ctmp
+          env%ensemblename = ctmp
+        end if
+        if (argument == '-sort'.and.nra >= i+2) then
+          ctmp = arg2
+          if (ctmp(1:1) .ne. '-') then
+            processedarg(i+2) = .true.
+            env%sortmode = trim(ctmp)
+          end if
+        end if
+
+      case ('-bh','-GMIN')
+        processedarg(i) = .true.
+        env%crestver = crest_bh
+        write (stdout,'(2x,a,t15,a)') argument//':','Basin-hopping global optimization'
         exit
 
       case ('-SANDBOX')
-        !>--- IMPLEMENT HERE WHATEVER YOU LIKE, FOR TESTING
+        processedarg(i) = .true.
+        !>--- readl vs readl_old test suite
         !>-----
         stop
       case ('-PLAYGROUND','-TEST')
+        processedarg(i) = .true.
         env%preopt = .false.
         env%crestver = crest_test
         exit
@@ -780,12 +987,12 @@ subroutine parseflags(env,arg,nra)
     call inputcoords(env,env%inputcoords)
   else
     call inputcoords(env,trim(arg(1)))
+    processedarg(1) = .true.
+  end if
+!> For sorting runtypes, fall back to the input file if no ensemble was set explicitly
+  if (env%crestver == crest_sorting.and.len_trim(env%ensemblename) == 0) then
+    env%ensemblename = env%inputcoords
   end if
-!========================================================================================!
-!> after this point there should always be a "coord" file present
-!========================================================================================!
-  allocate (env%includeRMSD(env%nat))
-  env%includeRMSD = 1
 
 !========================================================================================!
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
@@ -793,18 +1000,28 @@ subroutine parseflags(env,arg,nra)
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
 !========================================================================================!
   do i = 1,nra
+    if (processedarg(i)) cycle
     argument = trim(arg(i))
+    arg1 = ''
+    if (i+1 .le. nra) arg1 = trim(arg(i+1))
+    arg2 = ''
+    if (i+2 .le. nra) arg2 = trim(arg(i+2))
+    arg3 = ''
+    if (i+3 .le. nra) arg3 = trim(arg(i+3))
     if (argument(1:2) == '--') then
       argument = argument(2:)
     end if
     if (argument .ne. '') then
+
 !========================================================================================!
 !-------- switch between legacy (systemcall) and new code (API) implementations
 !========================================================================================!
       select case (argument)
       case ('-legacy')      !> switch to old xtb-call version where possible
+        processedarg(i) = .true.
         env%legacy = .true.
       case ('-newversion')  !> switch to newer implementations (CREST >3.0)
+        processedarg(i) = .true.
         env%legacy = .false.
       end select
 !========================================================================================!
@@ -812,61 +1029,70 @@ subroutine parseflags(env,arg,nra)
 !========================================================================================!
       if (any((/crest_imtd,crest_imtd2,11/) == env%crestver)) then
         select case (argument) !> V2
-        case ('-mdtemp')                          !> set MTD temperature (V2 version)
-          call readl(arg(i+1),xx,j)
-          env%mdtemp = xx(1)
-          env%user_temp = .true.
+
         case ('-quick')                           !> performing quick conformational search
+          processedarg(i) = .true.
           env%quick = .true.
           env%runver = 2
           env%ewin = 5.0d0
           if (env%optlev > 1.0d0) env%optlev = 1.0d0    !> optlev tight for quick run
-        case ('-shake')                           !> set shake
-          call readl(arg(i+1),xx,j)
-          env%shake = nint(xx(1))
-        case ('-tstep')                           !> set MD timestep in fs
-          call readl(arg(i+1),xx,j)
-          env%mdstep = xx(1)
-          env%user_mdstep = .true.
-        case ('-vbdump')                          !> Vbias dump in ps
-          call readl(arg(i+1),xx,j)
-          xx(2) = xx(1)*1000
-          env%mddump = nint(xx(2))
+
         case ('-mdskip')                          !> set skipping structures in -mdopt
-          call readl(arg(i+1),xx,j)
-          env%mdskip = nint(xx(1))
-        case ('-mddump')                          !> set dumpstep for writing structures from MD
-          call readl(arg(i+1),xx,j)
-          env%mddumpxyz = nint(xx(1))
+          processedarg(i) = .true.
+          call readl(arg1,xx,j)
+          if (j > 0) then
+            env%mdskip = nint(xx(1))
+            processedarg(i+1) = .true.
+          else
+            call parseflags_missing(argument)
+          end if
+
         case ('-nomtd')                           !> Don't do the MTD in V2
+          processedarg(i) = .true.
           env%performMTD = .false.
+
         case ('-restartopt')                      !> go to step 2 of multilevel optimization immideatly
+          processedarg(i) = .true.
           env%restartopt = .true.
           env%autozsort = .false.
+
         case ('-norotmd')                         !> don't do the regular mds after step 2 in multilevel optimization of V2
+          processedarg(i) = .true.
           env%rotamermds = .false.
+
         case ('-rotmd')
+          processedarg(i) = .true.
           env%rotamermds = .true.
-        case ('-tnmd')                            !> temperature for additional normal MDs
-          call readl(arg(i+1),xx,j)
-          env%nmdtemp = xx(1)
+
         case ('-gcmopt')                          !> GC multilevel optimization activate in V2
+          processedarg(i) = .true.
           env%gcmultiopt = .true.
+
         case ('-gcsopt')                          !> GC single level optimization in V2
+          processedarg(i) = .true.
           env%gcmultiopt = .false.
+
         case ('-nogcmopt')                        !> GC single level optimization in V2
+          processedarg(i) = .true.
           env%gcmultiopt = .false.
+
         case ('-qmdff')                           !> use QMDFF for the MDs in V2?
+          processedarg(i) = .true.
           env%useqmdff = .true.
+          call parseflags_deprecated(argument)
+
         case ('-nci')                             !> NCI special mode
-          write (*,'(2x,a,1x,a)') trim(arg(i)),' : Special NCI mode for non-covalently bound complexes or clusters.'
+          processedarg(i) = .true.
+          write (stdout,'(2x,a,1x,a)') trim(arg(i)),' : Special NCI mode for non-covalently bound complexes or clusters.'
           env%NCI = .true.
           env%runver = 4
           env%autozsort = .false.
           env%performCross = .false.
           env%rotamermds = .false.
+
         case ('-squick','-superquick')            !> extremely crude quick mode
-          write (*,'(2x,a,1x,a)') trim(arg(i)),' : very crude quick-mode (no NORMMD, no GC, crude opt.)'
+          processedarg(i) = .true.
+          write (stdout,'(2x,a,1x,a)') trim(arg(i)),' : very crude quick-mode (no NORMMD, no GC, crude opt.)'
           env%rotamermds = .false.      !> no NORMMD
           env%performCross = .false.    !> no GC
           env%quick = .true.            !> MTD settings from the quick-mode
@@ -876,7 +1102,8 @@ subroutine parseflags(env,arg,nra)
           env%ewin = 5.0d0              !> smaller energy window
 
         case ('-mquick','-megaquick')   !> extremely crude quick mode pt.2
-          write (*,'(2x,a,1x,a)') trim(arg(i)),' : very crude quick-mode (no NORMMD, no GC, crude opt.)'
+          processedarg(i) = .true.
+          write (stdout,'(2x,a,1x,a)') trim(arg(i)),' : very crude quick-mode (no NORMMD, no GC, crude opt.)'
           env%rotamermds = .false.      !> no NORMMD
           env%performCross = .false.    !> no GC
           env%quick = .true.            !> MTD settings from the quick-mode
@@ -887,14 +1114,18 @@ subroutine parseflags(env,arg,nra)
           env%ewin = 2.5d0              !> smaller energy window
 
         case ('-extensive')   !> counterpart to quick mode
+          processedarg(i) = .true.
           env%slow = .true.
           env%quick = .false.
           env%superquick = .false.
           env%optlev = 0.0d0
           env%ewin = 8.0d0
           env%runver = 8
+
         case ('-static','-staticmtd')
+          processedarg(i) = .true.
           env%staticmtd = .true.
+
         case default
           continue
         end select !> V2
@@ -902,17 +1133,26 @@ subroutine parseflags(env,arg,nra)
         if (env%iterativeV2) then
           select case (argument) !> V2i
           case ('-mrest')                  !> set max number of restarts
-            call readl(arg(i+1),xx,j)
-            env%Maxrestart = nint(xx(1))
+            processedarg(i) = .true.
+            call readl(arg1,xx,j)
+            if (j > 0) then
+              env%Maxrestart = nint(xx(1))
+              processedarg(i+1) = .true.
+            else
+              call parseflags_missing(argument)
+            end if
+
           case ('-iru')                    !> re-use previously found conformers as bias in iterative approach
+            processedarg(i) = .true.
             env%iru = .true.
-          case ('-keepdir','-keeptmp')     !> Do not delete METADYN and NORMMD directories
-            env%keepModef = .true.
+
           case ('-singlerun')              !> QCG special mode
-            write (*,'(2x,a,1x,a)') trim(arg(i)),' : run mode with only a single MTD and no iterations (for testing)'
+            processedarg(i) = .true.
+            write (stdout,'(2x,a,1x,a)') trim(arg(i)),' : run mode with only a single MTD and no iterations (for testing)'
             env%runver = 45
             env%Maxrestart = 1
             env%rotamermds = .false.
+
           case default
             continue
           end select !> V2i
@@ -925,10 +1165,17 @@ subroutine parseflags(env,arg,nra)
       if (env%crestver == crest_mdopt.or.env%crestver == crest_screen) then
         select case (argument) !> SCREEN
         case ('-purge')        !> Purge special application
+          processedarg(i) = .true.
           env%optpurge = .true.
+
         case ('-ethrpurge','-ethrp')
+          processedarg(i) = .true.
           read (arg(i+1),*,iostat=io) rdum
-          if (io == 0) env%ethrpurge = rdum
+          if (io == 0) then
+            env%ethrpurge = rdum
+            processedarg(i+1) = .true.
+          end if
+
         case default
           continue
         end select !> SCREEN
@@ -939,23 +1186,28 @@ subroutine parseflags(env,arg,nra)
       if (env%crestver == crest_nano) then
         select case (argument) !> RCTR
         case ('-genpot')
+          processedarg(i) = .true.
           if (i+1 .le. nra) then
-            atmp = trim(arg(i+1))
+            atmp = arg1
             if (atmp(1:1) .ne. '-') then
-              call readl(arg(i+1),xx,j)
+              call readl(arg1,xx,j)
               env%rdens = xx(1)
+              processedarg(i+1) = .true.
             end if
           end if
           env%properties = p_reactorset
           env%preactorpot = .true.
+
         case ('-genmtd')
+          processedarg(i) = .true.
           env%properties = p_reactorset
           env%mdtime = 20.0d0
           if (i+1 .le. nra) then
-            atmp = trim(arg(i+1))
+            atmp = arg1
             if (atmp(1:1) .ne. '-') then
-              call readl(arg(i+1),xx,j)
+              call readl(arg1,xx,j)
               env%mdtime = xx(1)
+              processedarg(i+1) = .true.
             end if
           end if
           env%nmetadyn = 1
@@ -968,10 +1220,15 @@ subroutine parseflags(env,arg,nra)
           env%metadexp(1) = 1.00_wp
           env%metadfac(1) = 0.04_wp
           env%preactormtd = .true.
+
         case ('-fragopt')
+          processedarg(i) = .true.
           env%restartopt = .true.
+
         case ('-iso')
+          processedarg(i) = .true.
           env%riso = .true.
+
         case default
           continue
         end select !> RCTR
@@ -981,48 +1238,31 @@ subroutine parseflags(env,arg,nra)
 !========================================================================================!
       if (env%QCG) then
         select case (argument) !> QCG
-        case ('-keepdir','-keeptmp')
+        case ('-keeptmp')
+          processedarg(i) = .true.
           env%keepModef = .true.
-        case ('-tstep')                           !> set MD timestep in fs
-          call readl(arg(i+1),xx,j)
-          env%mdstep = xx(1)
-          env%user_mdstep = .true.
-        case ('-vbdump')                          !> Vbias dump in ps
-          call readl(arg(i+1),xx,j)
-          xx(2) = xx(1)*1000
-          env%mddump = nint(xx(2))
-        case ('-mdskip')                          !> set skipping structures in -mdopt
-          call readl(arg(i+1),xx,j)
-          env%mdskip = nint(xx(1))
-        case ('-mddump')                          !> set dumpstep for writing structures out of the md
-          env%user_dumxyz = .true.
-          call readl(arg(i+1),xx,j)
-          env%mddumpxyz = nint(xx(1))
+
         case ('-nomtd')                           !> Don't do the MTD in V2
+          processedarg(i) = .true.
           env%performMTD = .false.
-        case ('-wscal')                           !> scale size of wall potential
-          call readl(arg(i+1),xx,j)
-          env%potscal = xx(1)
-          env%user_wscal = .true.
+
         case ('-fixsolute')                       !> Fix the solute after CMA trafo
+          processedarg(i) = .true.
           env%constrain_solu = .true.
+
         case ('-nofix')                           !> No fixing of the solute after CMA trafo
+          processedarg(i) = .true.
           env%noconst = .true.
+
         case ('-restartopt')                      !> go to step 2 of multilevel optimization immideatly
+          processedarg(i) = .true.
           env%restartopt = .true.
           env%autozsort = .false.
+
         case ('-norotmd')                         !> don't do the regular mds after step 2 in multilevel optimization of V2
+          processedarg(i) = .true.
           env%rotamermds = .false.
-        case ('-mdtemp')                          !> set MTD temperature (V2 version)
-          call readl(arg(i+1),xx,j)
-          env%mdtemp = xx(1)
-          env%user_temp = .true.
-        case ('-tnmd')                            !> temperature for additional normal MDs
-          call readl(arg(i+1),xx,j)
-          env%nmdtemp = xx(1)
-        case ('-shake')                           !> set shake
-          call readl(arg(i+1),xx,j)
-          env%shake = nint(xx(1))
+
         end select !> QCG
       end if
 
@@ -1032,38 +1272,86 @@ subroutine parseflags(env,arg,nra)
       if (env%crestver == crest_msreac) then
         select case (argument) !> msreact
         case ('-msei')
+          processedarg(i) = .true.
           env%msei = .true.
+
         case ('-mscid')
+          processedarg(i) = .true.
           env%mscid = .true.
           env%msei = .false.
+
         case ('-msnoiso') !> filter out non fragmentated structures in msreact
+          processedarg(i) = .true.
           env%msnoiso = .true.
+
         case ('-msiso') !> filter out fragmentated structures in msreact
+          processedarg(i) = .true.
           env%msiso = .true.
+
         case ('-msnbonds') ! give number of bonds up to which bias potential is added between atoms default 3
-          call readl(arg(i+1),xx,j)
-          env%msnbonds = xx(1)
+          processedarg(i) = .true.
+          call readl(arg1,xx,j)
+          if (j > 0) then
+            env%msnbonds = xx(1)
+            processedarg(i+1) = .true.
+          else
+            call parseflags_missing(argument)
+          end if
+
         case ('-msnshifts') ! give number of times atoms are randomly shifted before optimization
-          call readl(arg(i+1),xx,j)
-          env%msnshifts = xx(1)
+          processedarg(i) = .true.
+          call readl(arg1,xx,j)
+          if (j > 0) then
+            env%msnshifts = xx(1)
+            processedarg(i+1) = .true.
+          else
+            call parseflags_missing(argument)
+          end if
+
         case ('-msnshifts2') ! give number of times atoms are randomly shifted before applying the constrained optimization default 0
-          call readl(arg(i+1),xx,j)
-          env%msnshifts2 = xx(1)
+          processedarg(i) = .true.
+          call readl(arg1,xx,j)
+          if (j > 0) then
+            env%msnshifts2 = xx(1)
+            processedarg(i+1) = .true.
+          else
+            call parseflags_missing(argument)
+          end if
+
         case ('-msnfrag') ! give number of structures that should be generated
-          call readl(arg(i+1),xx,j)
-          env%msnfrag = xx(1)
+          processedarg(i) = .true.
+          call readl(arg1,xx,j)
+          if (j > 0) then
+            env%msnfrag = xx(1)
+            processedarg(i+1) = .true.
+          else
+            call parseflags_missing(argument)
+          end if
+
         case ('-msmolbar') !> filter out structures with same molbar code in msreact
+          processedarg(i) = .true.
           env%msmolbar = .true.
+
         case ('-msinchi') !> filter out structures with same inchi code in msreact
+          processedarg(i) = .true.
           env%msinchi = .true.
+
         case ('-msnoattrh') !> add attractive potential for H-atoms
+          processedarg(i) = .true.
           env%msattrh = .false.
+
         case ('-mslargeprint') !> additional printouts and keep MSDIR
+          processedarg(i) = .true.
           env%mslargeprint = .true.
-        case ('-msinput') ! give number of times atoms are randomly shifted before applying the constrained optimization default 0
-          ctmp = trim(arg(i+1))
+
+        case ('-msinput') ! msreact input file
+          processedarg(i) = .true.
+          ctmp = arg1
           if (ctmp(1:1) .ne. '-') then
             env%msinput = trim(ctmp)
+            processedarg(i+1) = .true.
+          else
+
           end if
         end select !> msreact
       end if
@@ -1072,26 +1360,45 @@ subroutine parseflags(env,arg,nra)
 !========================================================================================!
       select case (argument) !> ARGPARSER1
       case ('-dry')             !> "dry" run to print settings
+        processedarg(i) = .true.
         env%dryrun = .true.
+
       case ('-nozs')
+        processedarg(i) = .true.
         env%autozsort = .false.   !> turn off automatic zsort (default)
+
       case ('-zs')
+        processedarg(i) = .true.
         env%autozsort = .true.    !> turn on automatic zsort
+
       case ('-nocross')
+        processedarg(i) = .true.
         env%performCross = .false.    !> skip the genetic crossing
-        write (*,'(2x,a,1x,a)') trim(arg(i)),' : skipping GC part.'
+        write (stdout,'(2x,a,1x,a)') trim(arg(i)),' : skipping GC part.'
+
       case ('-cross')
+        processedarg(i) = .true.
         env%performCross = .true.     !> do the genetic crossing
         env%autozsort = .true.
+
       case ('-keepdir','-keeptmp')     !> Do not delete temporary directories at the end
+        processedarg(i) = .true.
         env%keepModef = .true.
+
       case ('-opt','-optlev')             !> settings for optimization level of GFN-xTB
-        env%optlev = optlevnum(arg(i+1))
-        write (*,'(2x,a,1x,a)') trim(arg(i)),optlevflag(env%optlev)
+        processedarg(i) = .true.
+        if (i+1 .le. nra) then
+          env%optlev = optlevnum(arg(i+1),iostat=io)
+          if (io == 0) processedarg(i+1) = .true.
+        end if
+        write (stdout,'(2x,a,1x,a)') trim(arg(i)),optlevflag(env%optlev)
+
       case ('-gfn','-gfn1','-gfn2','-gfn0','-gff','-gfnff')
+        processedarg(i) = .true.
         ctmp = argument
         if (argument == '-gfn') then
-          dtmp = trim(arg(i+1))
+          processedarg(i+1) = .true.
+          dtmp = arg1
           ctmp = ctmp//dtmp
         end if
         if (env%properties == p_isomerize) then
@@ -1100,16 +1407,16 @@ subroutine parseflags(env,arg,nra)
         select case (ctmp) !> GFN
         case ('-gfn1')
           env%gfnver = '--gfn1'
-          write (*,'(2x,a,'' : Use of GFN1-xTB requested.'')') env%gfnver
+          write (stdout,'(2x,a,'' : Use of GFN1-xTB requested.'')') env%gfnver
         case ('-gfn2')
           env%gfnver = '--gfn2'
-          write (*,'(2x,a,'' : Use of GFN2-xTB requested.'')') env%gfnver
+          write (stdout,'(2x,a,'' : Use of GFN2-xTB requested.'')') env%gfnver
         case ('-gfn0')
           env%gfnver = '--gfn0'
-          write (*,'(2x,a,'' : Use of GFN0-xTB requested.'')') env%gfnver
+          write (stdout,'(2x,a,'' : Use of GFN0-xTB requested.'')') env%gfnver
         case ('-gff','-gfnff')
           env%gfnver = '--gff'
-          write (*,'(2x,a,'' : Use of GFN-FF requested.'')') '--gfnff'
+          write (stdout,'(2x,a,'' : Use of GFN-FF requested.'')') '--gfnff'
           env%mdstep = 1.5d0
           env%hmass = 5.0d0
           ctype = 5 !> bond constraint activated
@@ -1125,95 +1432,201 @@ subroutine parseflags(env,arg,nra)
         end select !> GFN
 
       case ('-gxtb')
-        call gxtb_dev_warning()
+        processedarg(i) = .true.
+        env%gfnver = '--gxtb'
+        write (stdout,'(2x,a,'' : Use of g-xTB requested.'')') env%gfnver
+        call gxtb_syscall_warning()
+
       case ('-gxtb_dev')
-        env%gfnver = 'gxtb_dev'
+        processedarg(i) = .true.
+        env%gfnver = '--gxtb'
+        write (stdout,'(2x,a)') 'Note: --gxtb_dev is deprecated, redirecting to --gxtb.'
 
-      case ('-gfn2@gfn0','-gfn2@gfn1','-gfn2@gff','-gfn2@ff','-gfn2@gfnff')
-        if (.not.env%legacy) then !TODO
-          write (*,'("> ",a,1x,a)') argument,'option not yet available with new calculator'
-          error stop
-        end if
-        select case (argument) !> GFN2ON
-        case ('-gfn2@gfn0')
-          env%gfnver = '--gfn0'
-        case ('-gfn2@gfn1')
-          env%gfnver = '--gfn1'
-        case ('-gfn2@gff','-gfn2@ff','-gfn2@gfnff')
-          env%gfnver = '--gff'
-          env%mdstep = 2.0d0
+      case ('-mlip') !> quick setup of an fmlip-relay ML potential: --mlip <uma|maceoff>
+        processedarg(i) = .true.
+        env%legacy = .false. !> new calculators only!
+        select case (trim(arg1))
+        case ('uma')
+          env%gfnver = 'uma'
+          processedarg(i+1) = .true.
+          write (stdout,'(2x,a)') '--mlip uma : FairChem UMA (omol task) via fmlip-relay requested.'
+        case ('maceoff','mace-off','mace_off')
+          env%gfnver = 'maceoff'
+          processedarg(i+1) = .true.
+          write (stdout,'(2x,a)') '--mlip maceoff : MACE-OFF23 (medium) via fmlip-relay requested.'
         case default
-          env%gfnver = '--gfn2'
-        end select !> GFN2ON
-        env%gfnver2 = '--gfn2'
-        call env%addjob(51)
-        call env%checkhy()
-        env%reweight = .false.
-      case ('-gfn2//gfnff')
-        if (.not.env%legacy) then !TODO
-          write (*,'("> ",a,1x,a)') argument,'option not yet available with new calculator'
-          error stop
-        end if
-        env%gfnver = '--gff'
-        env%mdstep = 2.0d0
-        env%gfnver2 = '--gfn2'
-        env%reweight = .true.
-        env%mdstep = 2.0d0
-        env%hmass = 4.0d0
-        ctype = 1 !> bond constraint
-        bondconst = .true.
-        env%cts%cbonds_md = .true.
-        env%checkiso = .true.
-        if (index(arg(i+1),'opt') .ne. 0) then
-          env%altopt = .true.
-          write (*,'(2x,a,a)') argument,' : GFN-FF MDs + GFN2 opt.'
-        else
-          write (*,'(2x,a,a)') argument,' : energy reweighting'
-        end if
+          write (stdout,'(/,2x,a)') '┌─[ --mlip: missing or unknown backend ]'
+          write (stdout,'(2x,a)')   '│ The --mlip flag selects an fmlip-relay ML potential'
+          write (stdout,'(2x,a)')   '│ and expects one backend keyword:'
+          write (stdout,'(2x,a)')   '│   uma      FairChem UMA foundation model (omol task)'
+          write (stdout,'(2x,a)')   '│   maceoff  MACE-OFF23 organic force field (medium)'
+          write (stdout,'(2x,a)')   '│ For finer control (model size, task, device, custom'
+          write (stdout,'(2x,a)')   '│ checkpoints) use the TOML [[calculation.level]] block.'
+          write (stdout,'(2x,a,/)') '└────────────────────────────────────────────────'
+          call creststop(status_config)
+        end select
+
+      case ('-orca') !> set up a single ORCA driver level: --orca <template> <exe>
+        processedarg(i) = .true.
+        env%legacy = .false. !> new calculators only!
+        ! ── both the template and the executable are mandatory ──────────
+        if (arg1 == '' .or. arg1(1:1) == '-' .or. &
+        &   arg2 == '' .or. arg2(1:1) == '-') then
+          write (stdout,'(/,2x,a)') '┌─[ --orca: missing argument(s) ]'
+          write (stdout,'(2x,a)')   '│ The --orca flag sets up an ORCA driver and expects'
+          write (stdout,'(2x,a)')   '│ exactly two arguments, in this order:'
+          write (stdout,'(2x,a)')   '│   1) an ORCA input template'
+          write (stdout,'(2x,a)')   '│   2) the path to the ORCA executable'
+          write (stdout,'(2x,a)')   '│ The template must define ORCA EnGrad jobs ONLY'
+          write (stdout,'(2x,a)')   '│ (no opt/freq/md) - CREST drives the SP/opt loop.'
+          write (stdout,'(2x,a)')   '│ Example:'
+          write (stdout,'(2x,a)')   '│   crest struc.xyz --orca ORCA.in /path/to/orca'
+          write (stdout,'(2x,a,/)') '└────────────────────────────────────────────────'
+          call creststop(status_config)
+        end if
+        env%orca_template = trim(arg1)
+        env%orca_cmd = trim(arg2)
+        processedarg(i+1) = .true.
+        processedarg(i+2) = .true.
+        env%gfnver = '--orca'
+        write (stdout,'(2x,a)') '--orca : Use of ORCA driver requested.'
+        write (stdout,'(4x,a,1x,a)') 'template  :',trim(env%orca_template)
+        write (stdout,'(4x,a,1x,a)') 'executable:',trim(env%orca_cmd)
 
       case ('-refine','-rsp','-ropt') !> add one refinement step (via cmd only one is possible)
+        processedarg(i) = .true.
         env%legacy = .false. !> new calculators only!
-        if (nra >= i+1) then
-          env%gfnver2 = trim(arg(i+1))
-          write (*,'(2x,a,1x,a,a)') argument,trim(env%gfnver2), &
+        if (i+1 .le. nra) then
+          env%gfnver2 = arg1
+          write (stdout,'(2x,a,1x,a,a)') argument,trim(env%gfnver2), &
           & ' : adding refinement step (singlepoint on optimized structures)'
+          processedarg(i+1) = .true.
+        end if
+
+      case ('-rerank') !> post-search SP reranking at a higher level (pqueue job 52)
+        processedarg(i) = .true.
+        env%legacy = .false.
+        if (i+1 .le. nra) then
+          env%rerank_lvl = lowercase(trim(arg1))
+          processedarg(i+1) = .true.
+          call env%addjob(p_prop_multilevel+2)
+          write (stdout,'(2x,a,1x,a,a)') argument,trim(env%rerank_lvl), &
+            & ' : post-search SP re-ranking of conformer ensemble'
+        end if
+
+      case ('-reopt') !> post-search geometry re-optimization (standalone, pqueue job 53)
+        processedarg(i) = .true.
+        env%legacy = .false.
+        if (i+1 .le. nra) then
+          env%reopt_lvl = lowercase(trim(arg1))
+          processedarg(i+1) = .true.
+          call env%addjob(p_prop_multilevel+3)
+          write (stdout,'(2x,a,1x,a,a)') argument,trim(env%reopt_lvl), &
+            & ' : post-search re-optimization of conformer ensemble'
+        end if
+
+      case ('-finalhess')
+        processedarg(i) = .true.
+        env%legacy = .false.
+        call env%addjob(p_prop_finalhess)
+        write (stdout,'(2x,a,a)') argument, &
+          & ' : post-search Hessian + free-energy re-ranking of conformer ensemble'
+
+      case default !> catch composite method arguments: A@B, A//B, A/sp/B, A/opt/B
+        if (argument(1:1) == '-') then
+          call parse_hybrid_argument(argument(2:),hybrid_quality,hybrid_workhorse, &
+            &                        hybrid_mode,io)
+          if (io == 0) then
+            processedarg(i) = .true.
+            env%legacy = .false.
+            call setup_hybrid_calc(env,trim(hybrid_workhorse), &
+              &                    trim(hybrid_quality),trim(hybrid_mode))
+          end if
         end if
 
       case ('-charges') !> read charges from file for GFN-FF calcs.
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         if ((len_trim(ctmp) < 1).or.(ctmp(1:1) == '-')) then
           ctmp = 'charges'
+        else
+          processedarg(i+1) = .true.
         end if
         inquire (file=ctmp,exist=ex)
         if (ex) then
           env%chargesfilename = ctmp
           env%chargesfile = .true.
-          write (*,'(2x,a,a,a)') '-charges: file <',trim(ctmp),'> used for atomic charges'
+          write (stdout,'(2x,a,a,a)') '-charges: file <',trim(ctmp),'> used for atomic charges'
           call env%ref%rdcharges(env%chargesfilename,idum)
           if (idum .ne. env%chrg) then
-            write (*,'(12x,a,i0)') 'with total summed up molecular charge: ',idum
+            write (stdout,'(12x,a,i0)') 'with total summed up molecular charge: ',idum
             env%chrg = idum
             env%ref%ichrg = idum
           end if
         end if
+
+      case ('-efield')  !> electric field in V/Ang, only compatibe with tblite
+        processedarg(i) = .true.
+        if (.not.allocated(env%ref%efield)) allocate (env%ref%efield(3),source=0.0_wp)
+        if (i+3 .le. nra) then
+          ctmp = arg1
+          read (ctmp,*,iostat=io) env%ref%efield(1)
+          if (io == 0) processedarg(i+1) = .true.
+          ctmp = arg2
+          read (ctmp,*,iostat=io) env%ref%efield(2)
+          if (io == 0) processedarg(i+2) = .true.
+          ctmp = arg3
+          read (ctmp,*,iostat=io) env%ref%efield(3)
+          if (io == 0) processedarg(i+3) = .true.
+          write (stdout,'("  --efield: ",3(1x,es10.3)," V/Å")') env%ref%efield(1:3)
+        else
+          call parseflags_missing(argument)
+        end if
+
+      case ('-ceh_guess')
+        processedarg(i) = .true.
+        env%ceh_guess = .true.
+
+      case ('-spin-polarized','-spinpol')
+        processedarg(i) = .true.
+        env%spin_polarized = .true.
+
       case ('-dscal','-dispscal','-dscal_global','-dispscal_global')
+        processedarg(i) = .true.
         env%cts%dispscal_md = .true.
         if (index(argument,'_global') .ne. 0) then
           env%cts%dispscal_global = .true.
         end if
         if (nra .ge. i+1) then
-          ctmp = trim(arg(i+1))
+          ctmp = arg1
           read (ctmp,*,iostat=io) rdum
-          if (io .eq. 0) env%cts%dscal = rdum
+          if (io .eq. 0) then
+            env%cts%dscal = rdum
+            processedarg(i+1) = .true.
+          end if
         end if
+        if (.not.env%legacy) call parseflags_deprecated(argument)
+
       case ('-mtd_kscal','-mtdkscal')
-        call readl(arg(i+1),xx,j)
-        env%mtd_kscal = xx(1)
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          env%mtd_kscal = xx(1)
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-norestart')
+        processedarg(i) = .true.
         env%allowrestart = .false.
+
       case ('-readbias')
+        processedarg(i) = .true.
         env%readbias = .true.
+
       case ('-useonly')
+        processedarg(i) = .true.
         env%properties = p_useonly
         env%autozsort = .false.
         env%dummypercent = 1.0_wp
@@ -1221,46 +1634,82 @@ subroutine parseflags(env,arg,nra)
           atmp = adjustl(arg(i+1))
           if (atmp(1:1) .ne. '-') then
             read (atmp,*) env%dummypercent
+            processedarg(i+1) = .true.
           end if
         end if
 
       case ('-gbsa','-g','-alpb')   !> use GBSA or ALPB implicit solvation
+        processedarg(i) = .true.
         env%gbsa = .true.
         atmp = adjustl(arg(i+1))
         if (atmp(1:1) .ne. '-'.and.atmp(1:1) .ne. ' ') then
           env%solvent = arg(i+1)
+          processedarg(i+1) = .true.
           if (trim(argument) == '-alpb') then
             env%solv = '--alpb '//trim(env%solvent)
           else
             env%solv = '--gbsa '//trim(env%solvent)
           end if
+        else
+          call parseflags_missing(argument)
         end if
-        write (*,'(2x,a,a)') trim(env%solv),' : implicit solvation'
+        write (stdout,'(2x,a,a)') trim(env%solv),' : implicit solvation'
 
       case ('-chrg')                  !> create a .CHRG file
-        call readl(arg(i+1),xx,j)
-        open (newunit=ich,file='.CHRG')
-        env%chrg = nint(xx(1))
-        env%ref%ichrg = env%chrg
-        write (ich,'(i0)') nint(xx(1))
-        close (ich)
-        write (*,'(2x,a,1x,a)') trim(arg(i)),trim(arg(i+1))
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          open (newunit=ich,file='.CHRG')
+          env%chrg = nint(xx(1))
+          env%ref%ichrg = env%chrg
+          write (ich,'(i0)') nint(xx(1))
+          close (ich)
+          write (stdout,'(2x,a,1x,a)') trim(arg(i)),arg1
+        else
+          call parseflags_missing(argument)
+        end if
 
       case ('-uhf')                    !> create a .UHF file
-        call readl(arg(i+1),xx,j)
-        open (newunit=ich,file='.UHF')
-        env%uhf = nint(xx(1))
-        env%ref%uhf = env%uhf
-        write (ich,'(i0)') nint(xx(1))
-        close (ich)
-        write (*,'(2x,a,1x,a)') trim(arg(i)),trim(arg(i+1))
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          open (newunit=ich,file='.uhf')
+          env%uhf = nint(xx(1))
+          env%ref%uhf = env%uhf
+          write (ich,'(i0)') nint(xx(1))
+          close (ich)
+          write (stdout,'(2x,a,1x,a)') trim(arg(i)),arg1
+        else
+          call parseflags_missing(argument)
+        end if
+
+      case ('-mult','-multiplicity')   !> spin multiplicity (2S+1); stored as uhf = mult-1
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%uhf = nint(xx(1))-1
+          env%ref%uhf = env%uhf
+          open (newunit=ich,file='.uhf')
+          write (ich,'(i0)') env%uhf
+          close (ich)
+          write (stdout,'(2x,a,1x,a)') trim(arg(i)),arg1
+        else
+          call parseflags_missing(argument)
+        end if
 
       case ('-grad')
+        processedarg(i) = .true.
         env%gradsp = .true.
+
       case ('-nograd')
+        processedarg(i) = .true.
         env%gradsp = .false.
 
       case ('-len','-mdlen','-mdtime') !> set md length in ps
+        processedarg(i) = .true.
         atmp = arg(i+1)
         call to_lower(atmp)
         j = index(atmp,'x')
@@ -1269,48 +1718,183 @@ subroutine parseflags(env,arg,nra)
           btmp = atmp(j+1:)
           env%scallen = .true.
           call readl(btmp,xx,j)
-          env%mdlenfac = xx(1)
+          if (j > 0) then
+            env%mdlenfac = xx(1)
+            processedarg(i+1) = .true.
+          else
+            call parseflags_missing(argument)
+          end if
         else                           !> direct setting of the md length
-          call readl(arg(i+1),xx,j)
-          env%mdtime = xx(1)
-          write (*,'(2x,a,1x,a,1x,a)') trim(arg(i)),trim(arg(i+1)), &
-          &    '(MD length in ps)'
+          call readl(arg1,xx,j)
+          if (j > 0) then
+            processedarg(i+1) = .true.
+            env%mdtime = xx(1)
+            write (stdout,'(2x,a,1x,a,1x,a)') trim(arg(i)),arg1, &
+            &    '(MD length in ps)'
+          else
+            call parseflags_missing(argument)
+          end if
+        end if
+
+      case ('-shake')                           !> set shake
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          env%shake = nint(xx(1))
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
+      case ('-tstep')                           !> set MD timestep in fs
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          env%mdstep = xx(1)
+          env%user_mdstep = .true.
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
+      case ('-vbdump')                          !> Vbias dump in ps
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          xx(2) = xx(1)*1000
+          env%mddump = nint(xx(2))
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
+      case ('-tnmd')                            !> temperature for additional normal MDs
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          env%nmdtemp = xx(1)
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
+      case ('-mdskip')                          !> set skipping structures in -mdopt
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          env%mdskip = nint(xx(1))
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
+      case ('-mddump')                          !> set dumpstep for writing structures from MD
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          env%user_dumxyz = .true.
+          env%mddumpxyz = nint(xx(1))
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
+      case ('-mdscal','-lenscal')       !> scale md length
+        processedarg(i) = .true.
+        env%scallen = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          env%mdlenfac = xx(1)
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
         end if
-      case ('-mdscal','-lenscal')       !> scale md length
-        env%scallen = .true.
-        call readl(arg(i+1),xx,j)
-        env%mdlenfac = xx(1)
+
+      case ('-mdtemp')                          !> set MTD temperature (V2 version)
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          env%mdtemp = xx(1)
+          env%user_temp = .true.
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-nmtd') !> set number of MTDs
+        processedarg(i) = .true.
         env%runver = 787878
-        call readl(arg(i+1),xx,j)
-        env%nmetadyn = nint(xx(1))
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%nmetadyn = nint(xx(1))
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-gcmax','-setgcmax')       !> set maximum number of structures for GC
+        processedarg(i) = .true.
         env%setgcmax = .true.
-        call readl(arg(i+1),xx,j)
-        env%gcmax = xx(1)
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          env%gcmax = xx(1)
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-xnam')                    !> select a name for the xTB executeable
-        env%ProgName = trim(arg(i+1))
-        write (*,'(2x,''-xnam :'')',advance='no')
-        write (*,'(1x,''xtb executable was set to: "'',a,''"'')') trim(env%ProgName)
+        processedarg(i) = .true.
+        env%ProgName = arg1
+        write (stdout,'(2x,''-xnam :'')',advance='no')
+        write (stdout,'(1x,''xtb executable was set to: "'',a,''"'')') trim(env%ProgName)
+        processedarg(i+1) = .true.
+
       case ('-niceprint')               !> progres bar printout
+        processedarg(i) = .true.
         env%niceprint = .true.
+
       case ('-origin')                  !> track the origin (i.e. the generation step) of each conformer
+        processedarg(i) = .true.
         env%trackorigin = .true.
-        write (*,'(2x,a,1x,a)') trim(arg(i)),': tracking conformer origins.'
+        write (stdout,'(2x,a,1x,a)') trim(arg(i)),': tracking conformer origins.'
+
       case ('-constrain')               !> provide a list of atoms to write a .xcontrol.sample
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         call quick_constrain_file('coord',env%nat,env%ref%at,ctmp)
+        processedarg(i+1) = .true.
+
+      case ('-freeze')               !> freeze atoms during optimization/MD
+        processedarg(i) = .true.
+        if (i+1 .le. nra) then
+          ctmp = arg1
+          call get_atlist(env%ref%nat,atlist,ctmp,env%ref%at)
+          env%calc%nfreeze = count(atlist)
+          call move_alloc(atlist,env%calc%freezelist)
+          processedarg(i+1) = .true.
+          write (stdout,'(2x,a,1x,i0,1x,a)') '-freeze :',env%calc%nfreeze,'atoms frozen'
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-nocbonds')
+        processedarg(i) = .true.
         bondconst = .false.
         env%cts%cbonds_global = .false.
         env%cts%cbonds_md = .false.
         inquire (file='bondlengths',exist=ex)
         if (ex) call remove('bondlengths')
+
       case ('-cbonds','-cbonds_md','-cbonds_ez')  !> constrain all bonds
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         if (ctmp(1:1) .ne. '-') then
           read (ctmp,*,iostat=io) rdum
-          if (io .eq. 0) env%forceconst = rdum
+          if (io .eq. 0) then
+            env%forceconst = rdum
+            processedarg(i+1) = .true.
+          end if
         end if
         ctype = 1
         bondconst = .true.
@@ -1322,11 +1906,16 @@ subroutine parseflags(env,arg,nra)
         if (index(argument,'_ez') .ne. 0) then !> if the only E/Z shall be constrained
           ctype = 5
         end if
+
       case ('-cmetal','-cmetal_md')            !> constrain transition metal coordination sites
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         if (ctmp(1:1) .ne. '-') then
           read (ctmp,*,iostat=io) rdum
-          if (io .eq. 0) env%forceconst = rdum
+          if (io .eq. 0) then
+            env%forceconst = rdum
+            processedarg(i+1) = .true.
+          end if
         end if
         ctype = 2
         bondconst = .true.
@@ -1335,11 +1924,16 @@ subroutine parseflags(env,arg,nra)
           env%cts%cbonds_md = .true.
           env%cts%cbonds_global = .false.
         end if
+
       case ('-cheavy','-fixheavy','-cheavy_md')  !> constrain all heavy atom bonds
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         if (ctmp(1:1) .ne. '-') then
           read (ctmp,*,iostat=io) rdum
-          if (io .eq. 0) env%forceconst = rdum
+          if (io .eq. 0) then
+            env%forceconst = rdum
+            processedarg(i+1) = .true.
+          end if
         end if
         ctype = 3
         bondconst = .true.
@@ -1348,11 +1942,16 @@ subroutine parseflags(env,arg,nra)
           env%cts%cbonds_md = .true.
           env%cts%cbonds_global = .false.
         end if
+
       case ('-clight','-fixhyd','-clight_md')  !> constraint all X-H bonds
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         if (ctmp(1:1) .ne. '-') then
           read (ctmp,*,iostat=io) rdum
-          if (io .eq. 0) env%forceconst = rdum
+          if (io .eq. 0) then
+            env%forceconst = rdum
+            processedarg(i+1) = .true.
+          end if
         end if
         ctype = 4
         bondconst = .true.
@@ -1361,268 +1960,478 @@ subroutine parseflags(env,arg,nra)
           env%cts%cbonds_md = .true.
           env%cts%cbonds_global = .false.
         end if
+
       case ('-cfile','-cinp','-C','-c')     !> specify the constrain file
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         if (ctmp(1:1) .ne. '-') then
           env%constraints = trim(ctmp)
-          write (*,'(2x,a,1x,a)') argument//' :',trim(ctmp)
+          processedarg(i+1) = .true.
+          write (stdout,'(2x,a,1x,a)') argument//' :',trim(ctmp)
         end if
+
       case ('-fc','-forceconstant')
-        ctmp = trim(arg(i+1))
-        if (i+1 >= nra) then
-          call readl(arg(i+1),xx,j)
-          env%forceconst = xx(1)
+        processedarg(i) = .true.
+        ctmp = arg1
+        if (i+1 .le. nra) then
+          call readl(arg1,xx,j)
+          if (j > 0) then
+            env%forceconst = xx(1)
+            processedarg(i+1) = .true.
+          else
+            call parseflags_missing(argument)
+          end if
         end if
-        write (*,'(2x,a,f6.4,a)') '-fc ',env%forceconst,': selected force constant in Eh'
+        write (stdout,'(2x,a,f6.4,a)') '-fc ',env%forceconst,': selected force constant in Eh'
+
       case ('-nomlo','-no-multilevel')   !> turn off multilevel optimization
+        processedarg(i) = .true.
         env%multilevelopt = .false.
+
       case ('-normmd')  !> set number of normMDs
+        processedarg(i) = .true.
         env%rotamermds = .true.
         if (i+1 .le. nra) then
-          call readl(arg(i+1),xx,j)
-          env%nrotammds = nint(xx(1))  !> how many lowest conformers?
+          call readl(arg1,xx,j)
+          if (j > 0) then
+            env%nrotammds = nint(xx(1))  !> how many lowest conformers?
+            processedarg(i+1) = .true.
+          else
+            call parseflags_missing(argument)
+          end if
         end if
         if (i+2 .le. nra) then
-          call readl(arg(i+2),xx,j)
-          env%temps = nint(xx(1))      !> how many different temperatures
+          call readl(arg2,xx,j)
+          if (j > 0) then
+            env%temps = nint(xx(1))      !> how many different temperatures
+            processedarg(i+2) = .true.
+          end if
         end if
+
       case ('-rmsdpot','-gesc')
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         inquire (file=ctmp,exist=ex)
         if (ex) then
           env%cts%usermsdpot = .true.
           call getcwd(atmp)
           env%cts%rmsdpotfile = trim(atmp)//'/'//ctmp
-          write (*,'(2x,a,a,a,a)') argument,': using <',ctmp,'> as bias'
+          write (stdout,'(2x,a,a,a,a)') argument,': using <',ctmp,'> as bias'
+          processedarg(i+1) = .true.
         else
-          write (*,'(a,a)') argument,': Warning! File could not be found!'
+          write (stdout,'(a,a)') argument,': Warning! File could not be found!'
         end if
+        call parseflags_deprecated(argument)
+
       case ('-mergebias','-mergebias+','-gesc+')
+        processedarg(i) = .true.
         env%properties = -9224
         if (index(argument,'+') > 0) env%properties = p_gesc2
-        ctmp = trim(arg(i+1))
+        ctmp = arg1
         inquire (file=ctmp,exist=ex)
         if (ex) then
           env%biasfile = ctmp
+          processedarg(i+1) = .true.
         end if
         env%autozsort = .false.
+        call parseflags_deprecated(argument)
+
       case ('-gescopt')
-        env%gescoptlev = optlevnum(arg(i+1))
+        processedarg(i) = .true.
+        env%gescoptlev = optlevnum(arg(i+1),iostat=io)
+        if (io == 0) processedarg(i+1) = .true.
+
       case ('-gescheavy','-heavygesc','-gesc_heavy')
+        processedarg(i) = .true.
         env%cts%gesc_heavy = .true.
+
       case ('-rthr2') !> bias rmsd threshold
+        processedarg(i) = .true.
         read (arg(i+1),*,iostat=io) rdum
-        if (io == 0) env%rthr2 = rdum
+        if (io == 0) then
+          env%rthr2 = rdum
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+        call parseflags_deprecated(argument)
+
       case ('-kshift')
+        processedarg(i) = .true.
         read (arg(i+1),*,iostat=io) rdum
-        if (io == 0) env%kshift = rdum
+        if (io == 0) then
+          env%kshift = rdum
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
         env%kshiftnum = 1
+        call parseflags_deprecated(argument)
+
       case ('-hflip')
+        processedarg(i) = .true.
         env%doOHflip = .true.
+
       case ('-noflip')
+        processedarg(i) = .true.
         env%doOHflip = .false.
+
       case ('-maxflip')
+        processedarg(i) = .true.
         read (arg(i+1),*,iostat=io) rdum
         if (io == 0.and.(index(arg(i+1),'-') .eq. 0)) then
           env%maxflip = nint(rdum)
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
         end if
+
       case ('-osdf')
+        processedarg(i) = .true.
         env%outputsdf = .true.
-        write (*,'(2x,a," :",1x,a)') trim(arg(i)), &
+        write (stdout,'(2x,a," :",1x,a)') trim(arg(i)), &
         & "output ensemble requested in sdf format"
 
       case ('-wscal')                           !> scale size of wall potential
-        call readl(arg(i+1),xx,j)
-        env%potscal = xx(1)
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          env%potscal = xx(1)
+          env%user_wscal = .true.
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-wpad')                            !> scale size of wall potential
-        call readl(arg(i+1),xx,j)
-        env%potpad = xx(1)
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          env%potpad = xx(1)
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-watoms','-wat')
+        processedarg(i) = .true.
         ctmp = arg(i+1)
         if (ctmp(1:1) .ne. '-') then
           env%potatlist = trim(ctmp)
-          write (*,*) env%potatlist
+          write (stdout,*) env%potatlist
+          processedarg(i+1) = .true.
         end if
+
       case ('-wall')
+        processedarg(i) = .true.
         env%wallsetup = .true.
-        write (*,'(2x,a,1x,a)') '--wall:','requesting setup of wall potential'
+        write (stdout,'(2x,a,1x,a)') '--wall:','requesting setup of wall potential'
+
       case ('-wallxl','-wall-xl')
+        processedarg(i) = .true.
         env%wallsetup = .true.
         env%potscal = 1.5_wp
-        write (*,'(2x,a,1x,a)') '--wall-xl:','requesting setup of wall potential (x1.5 size)'
+        write (stdout,'(2x,a,1x,a)') '--wall-xl:','requesting setup of wall potential (x1.5 size)'
+
       case ('-wallxxl','-wall-xxl')
+        processedarg(i) = .true.
         env%wallsetup = .true.
         env%potscal = 2.0_wp
-        write (*,'(2x,a,1x,a)') '--wall-xxl:','requesting setup of wall potential (x2.0 size)'
+        write (stdout,'(2x,a,1x,a)') '--wall-xxl:','requesting setup of wall potential (x2.0 size)'
+
+      case ('-alkylize')
+        processedarg(i) = .true.
+        write (stdout,'(2x,a,1x)',advance='no') '--alkylize'
+        env%alkylize = .true.
+        if (nra >= i+1) then
+          ctmp = arg1
+          select case (ctmp)
+          case ('full','sample')
+            env%alkylizeskip = .false.
+            write (stdout,'(a,1x)',advance='no') ctmp
+            processedarg(i+1) = .true.
+          case ('simple')
+            write (stdout,'(a,1x)',advance='no') ctmp
+            processedarg(i+1) = .true.
+          end select
+        end if
+        write (stdout,'(a)') ': automatic alkyl group dispatch'
+
 !========================================================================================!
 !------ flags for parallelization / disk space
 !========================================================================================!
       case ('-T','-P','-parallel')  !> set total number of OMP threads, this replaces -P and -O entirely
-        call readl(arg(i+1),xx,j)
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+        else
+          call parseflags_missing(argument)
+        end if
         if (index(arg(i+1),'-') .ne. 0) xx = 0d0
         env%Threads = nint(xx(1))
         env%autothreads = .true.
         env%threadssetmanual = .true.
-        write (*,'(2x,a,1x,i0,1x,a)') trim(arg(i)),nint(xx(1)), &
+        write (stdout,'(2x,a,1x,i0,1x,a)') trim(arg(i)),nint(xx(1)), &
         &     '(CPUs/Threads selected)'
+
       case ('-inplace')     !> activate "in-place" mode for optimizations (ON by default)
+        processedarg(i) = .true.
         env%inplaceMode = .true.
-!========================================================================================!
-!------- CREGEN related flags
-!========================================================================================!
-      case ('-cregen','-oldcregen')  !> CREGEN standalone use
-        env%confgo = .true.
-        env%properties = p_cregen
-        env%autozsort = .false.
-        atmp = ''
-        env%ensemblename = 'none selected'
-        if (nra .ge. (i+1)) atmp = adjustl(arg(i+1))
-        if ((atmp(1:1) /= '-').and.(len_trim(atmp) .ge. 1)) then
-          env%ensemblename = trim(atmp)
-        end if
-        if (index(env%ensemblename,'none selected') .ne. 0) then
-          write (*,'(2x,a,1x,a)') trim(arg(i)),': CREGEN standalone usage.'
-        else
-          write (*,'(2x,a,1x,a,a,a)') trim(arg(i)),': CREGEN standalone usage. Sorting file <', &
-          & trim(env%ensemblename),'>'
-        end if
-        if (trim(arg(i)) .eq. '-oldcregen') then
-          write (*,'(3x,a)') 'Using the old version of the CREGEN subroutine.'
-          env%newcregen = .false.
-        end if
-      case ('-oldcr')
-        write (*,'(3x,a)') 'Using the old version of the CREGEN subroutine.'
-        env%newcregen = .false.
-        env%ethr = 0.1d0 !> ETHR old value
       case ('-enso')             !> compare two given ensembles
+        processedarg(i) = .true.
         env%ENSO = .true.
+
       case ('-compare')          !> compare two given ensembles
+        processedarg(i) = .true.
         env%compareens = .true.
-      case ('-maxcomp')          !> maximum number of lowest conformers to compare with "-compare"
-        call readl(arg(i+1),xx,j)
-        env%maxcompare = nint(xx(1))
+
+      case ('-maxcomp')          !> maximum number of lowest structures to compare with "-compare"
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%maxcompare = nint(xx(1))
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-ewin')             !> set energy threshold in kcal/mol
-        call readl(arg(i+1),xx,j)
-        env%ewin = abs(xx(1))
-        if (any((/p_protonate,p_deprotonate,p_tautomerize/) == env%properties)) then
-          env%protb%ewin = abs(xx(1))
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%ewin = abs(xx(1))
+          if (any((/p_protonate,p_deprotonate,p_tautomerize/) == env%properties)) then
+            env%protb%ewin = abs(xx(1))
+          end if
+          write (stdout,'(2x,a,1x,a)') trim(arg(i)),arg1
+        else
+          call parseflags_missing(argument)
         end if
-        write (*,'(2x,a,1x,a)') trim(arg(i)),trim(arg(i+1))
+
       case ('-rthr')             !> set RMSD thr
-        call readl(arg(i+1),xx,j)
-        env%rthr = xx(1)
-        write (*,'(2x,a,1x,a)') trim(arg(i)),trim(arg(i+1))
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%rthr = xx(1)
+          write (stdout,'(2x,a,1x,a)') trim(arg(i)),arg1
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-ethr')             !> set E thr
-        call readl(arg(i+1),xx,j)
-        env%ethr = xx(1)
-        write (*,'(2x,a,1x,a)') trim(arg(i)),trim(arg(i+1))
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%ethr = xx(1)
+          write (stdout,'(2x,a,1x,a)') trim(arg(i)),arg1
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-bthr')             !> set rot const thr
-        call readl(arg(i+1),xx,j)
-        env%thresholds(4) = xx(1)  !> legacy
-        env%bthr2 = xx(1)
-        write (*,'(2x,a,1x,a)') trim(arg(i)),trim(arg(i+1))
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%thresholds(4) = xx(1)  !> legacy
+          env%bthr2 = xx(1)
+          write (stdout,'(2x,a,1x,a)') trim(arg(i)),arg1
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-allrot')           !> use all rotational constants for comparison, instead of mean
+        processedarg(i) = .true.
         env%allrot = .true.
+
       case ('-athr')             !> set int. rotation. equal atoms for NMR thr
-        call readl(arg(i+1),xx,j)
-        env%athr = xx(1)
-        write (*,'(2x,a,1x,a)') trim(arg(i)),trim(arg(i+1))
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%athr = xx(1)
+          write (stdout,'(2x,a,1x,a)') trim(arg(i)),arg1
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-pthr')             !> set population thr
-        call readl(arg(i+1),xx,j)
-        rdum = min(1.0_wp,xx(1)) !--> pthr <= 1
-        rdum = max(0.0_wp,rdum)  !--> pthr >= 0
-        env%pthr = rdum
-        write (*,'(2x,a,1x,f6.4)') trim(arg(i)),rdum !trim(arg(i+1))
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          rdum = min(1.0_wp,xx(1)) !--> pthr <= 1
+          rdum = max(0.0_wp,rdum)  !--> pthr >= 0
+          env%pthr = rdum
+          write (stdout,'(2x,a,1x,f6.4)') trim(arg(i)),rdum !arg1
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-eqv')
+        processedarg(i) = .true.
         env%doNMR = .true. !> option for the very last confg call
+
       case ('-zsort')
+        processedarg(i) = .true.
         env%onlyZsort = .true.                                 !perform only the zsort subroutine
         env%autozsort = .true.                                 ! CB: needs to be set to run zsort
-        write (*,'(2x,a,1x,a)') trim(arg(i)),' : only using the ZSORT subroutine.'
+        write (stdout,'(2x,a,1x,a)') trim(arg(i)),' : only using the ZSORT subroutine.'
+
       case ('-metac')                                        !automatic complete of mag. and chem. methyl equivalencies
+        processedarg(i) = .true.
         env%methautocorr = .true.
+
       case ('-esort')          !> cregen legacy option
+        processedarg(i) = .true.
         env%esort = .true.
+
       case ('-debug')
+        processedarg(i) = .true.
         env%cgf(1) = .true.    !> debug option for confg
+
       case ('-nowr')
+        processedarg(i) = .true.
         env%cgf(2) = .false.   !> newfile option for confg
+
       case ('-eqan')
+        processedarg(i) = .true.
         env%cgf(3) = .true.    !> equivalence analysis on (for NMR)
+
       case ('-noeqan')
+        processedarg(i) = .true.
         env%cgf(3) = .false.   !> equivalence analysis off (for nmr)
+
       case ('-rot')
+        processedarg(i) = .true.
         env%cgf(5) = .false.   !> just rotamer check
+
       case ('-nmr')            !> NMR mode for confscript
+        processedarg(i) = .true.
         env%doNMR = .true.
         env%optlev = 2.0d0
+
       case ('-fullcre')
+        processedarg(i) = .true.
         env%doNMR = .true.
         env%fullcre = .true.
+
       case ('-heavy')
+        processedarg(i) = .true.
         env%cgf(4) = .true.   !> perform just the heavy atom RMSD
         env%heavyrmsd = .true.
+
       case ('-temp')
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         if (index(ctmp,'-') .eq. 0) then
-          call readl(arg(i+1),xx,j)
+          call readl(arg1,xx,j)
           env%tboltz = xx(1)
+          processedarg(i+1) = .true.
         end if
+
       case ('-prsc')                !> write scoord files
+        processedarg(i) = .true.
         env%printscoords = .true.
+
       case ('-noprsc')              !> don't write scoord files
+        processedarg(i) = .true.
         env%printscoords = .false.
+
       case ('-subrmsd')             !> use only the RMSD for atoms that are included in the MTD
+        processedarg(i) = .true.
         env%subRMSD = .true.
+
       case ('-noopt')               !> skip the pre-optimization with GFNn-xTB before the confsearch
+        processedarg(i) = .true.
         env%preopt = .false.
+
       case ('-topo','-topocheck')
+        processedarg(i) = .true.
         env%checktopo = .true.
-      case ('-notopo','-notopocheck')
+
+      case ('-notopo','-notopocheck','-noreftopo')
+        processedarg(i) = .true.
         env%checktopo = .false.
-        ctmp = trim(arg(i+1))
+        ctmp = arg1
         if (ctmp(1:1) .ne. '-') then
+          processedarg(i+1) = .true.
           call parse_topo_excl(env,ctmp)
           if (allocated(env%excludeTOPO)) then
             env%checktopo = .true.
           end if
         end if
-      case ('-noreftopo')
         env%reftopo = .false.
+
       case ('-ezcheck','-checkez')
+        processedarg(i) = .true.
         env%checkiso = .true.
+
       case ('-noezcheck','-nocheckez')
+        processedarg(i) = .true.
         env%checkiso = .false.
+
+      case ('-inversion')
+        processedarg(i) = .true.
+        ctmp = lowercase(arg1)
+        select case (ctmp)
+        case ('auto')
+          env%iinversion = 0
+        case ('on')
+          env%iinversion = 1
+        case ('off')
+          env%iinversion = 2
+        case default
+          write (stdout,'(a,a,a,a)') 'invalid argument for ',argument,': ',trim(ctmp)
+          stop
+        end select
+        processedarg(i+1) = .true.
 !========================================================================================!
 !-------- PROPERTY CALCULATION related flags
 !========================================================================================!
       case ('-protonate')             !> protonation tool
+        processedarg(i) = .true.
         env%properties = p_protonate
         env%autozsort = .false.
         env%protb%threshsort = .true.
-        ctmp = trim(arg(i+1))
+        ctmp = arg1
         if (ctmp(1:1) .ne. '-') then
+          processedarg(i+1) = .true.
           read (ctmp,*,iostat=io) idum
           if (io .eq. 0) env%protb%amount = idum
         end if
+
       case ('-swel')                  !> switch out H+ to something else in protonation script
+        processedarg(i) = .true.
         if (env%properties .eq. -3) then
           call swparse(arg(i+1),env%protb)
+          processedarg(i+1) = .true.
         end if
+
       case ('-deprotonate')           !> deprotonation tool
+        processedarg(i) = .true.
         env%properties = p_deprotonate
         env%autozsort = .false.
         env%protb%threshsort = .true.
-        ctmp = trim(arg(i+1))
+        ctmp = arg1
         if (ctmp(1:1) .ne. '-') then
+          processedarg(i+1) = .true.
           read (ctmp,*,iostat=io) idum
           if (io .eq. 0) env%protb%amount = idum
         end if
+
       case ('-tautomerize')           !> tautomerization tool
+        processedarg(i) = .true.
         env%properties = p_tautomerize
         env%autozsort = .false.
         env%protb%threshsort = .true.
+
       case ('-tautomerize2','-exttautomerize')
+        processedarg(i) = .true.
         if (env%properties == p_propcalc) then
           env%properties = p_tautomerize2
         else
@@ -1635,48 +2444,77 @@ subroutine parseflags(env,arg,nra)
         env%performCross = .false.  !> skip the genetic crossing
         env%trackorigin = .false.
         env%Maxrestart = 1
+
       case ('-relax')
+        processedarg(i) = .true.
         env%runver = 33
         env%relax = .true.
         env%performCross = .false.  !> skip the genetic crossing
         env%trackorigin = .false.
         env%Maxrestart = 1
+
       case ('-trev','-tdp')
+        processedarg(i) = .true.
         env%protb%deprotprot = .true. !> switch to deprotonation-first mode in tautomerization
+
       case ('-iter')                !> number of Protonation/Deprotonation cycles in Tautomerization
-        call readl(arg(i+1),xx,j)
-        env%protb%iter = nint(xx(1))
+        processedarg(i) = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%protb%iter = nint(xx(1))
+        end if
+
       case ('-texcl','-blacklist')
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
+        processedarg(i+1) = .true.
+
       case ('-strict')
+        processedarg(i) = .true.
         env%protb%strictPDT = .true.
+
       case ('-verystrict','-vstrict')
+        processedarg(i) = .true.
         env%protb%strictPDT = .false.
         env%protb%fixPDT = .true.
+
       case ('-fstrict')
+        processedarg(i) = .true.
         env%protb%strictPDT = .true.
         env%protb%fixPDT = .true.
+
       case ('-corr','-abcorr')
+        processedarg(i) = .true.
         env%protb%strictPDT = .true.
         env%protb%fixPDT = .true.
         env%protb%ABcorrection = .true.
+
       case ('-pkaensemble')
+        processedarg(i) = .true.
         env%preopt = .false.
         env%presp = .false.
         call pka_argparse2(env,arg(i+1),arg(i+2),env%protb%pka_mode)
+        processedarg(i+1) = .true.
+        processedarg(i+2) = .true.
+
       case ('-pkaparam')
+        processedarg(i) = .true.
         env%protb%rdcfer = .true.
         if (i+1 .le. nra) then
-          ctmp = trim(arg(i+1))
+          ctmp = arg1
           if (ctmp(1:1) .ne. '-') then
+            processedarg(i+1) = .true.
             env%protb%cferfile = ctmp
           end if
         end if
+
 !========================================================================================!
 !--------- ENTROPY related settings
 !========================================================================================!
       case ('-entropy','-entropic')  !> new, specialized calculation of molecular entropies
-        write (*,'(2x,a,'' : enhanced ensemble entropy calculation'')') trim(arg(i))
+        processedarg(i) = .true.
+        write (stdout,'(2x,a,'' : enhanced ensemble entropy calculation'')') argument
         if (env%properties == p_propcalc) then
           !>--- for standalone use
           env%properties = p_CREentropy
@@ -1700,213 +2538,331 @@ subroutine parseflags(env,arg,nra)
         env%runver = 111             !> version  for selection of MTD bias settings
         env%doNMR = .true.           !> we need equivalencies
         if (i+1 .le. nra) then
-          ctmp = trim(arg(i+1))    !> second argument can be the temperature
+          ctmp = arg1    !> second argument can be the temperature
           if (index(ctmp,'-') .eq. 0) then
-            call readl(arg(i+1),xx,j)
+            processedarg(i+1) = .true.
+            call readl(arg1,xx,j)
             env%tboltz = xx(1)
           end if
         end if
         call env%addjob(env%properties)
 
       case ('-scthr','-entropy_cthr')
+        processedarg(i) = .true.
         read (arg(i+1),*,iostat=io) rdum
-        if (io == 0) env%emtd%confthr = rdum
+        if (io == 0) then
+          processedarg(i+1) = .true.
+          env%emtd%confthr = rdum
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-ssthr','-entropy_sthr')
+        processedarg(i) = .true.
         read (arg(i+1),*,iostat=io) rdum
-        if (io == 0) env%emtd%sconvthr = rdum
+        if (io == 0) then
+          processedarg(i+1) = .true.
+          env%emtd%sconvthr = rdum
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-rrhoav')             !> see above in the first specification of -rrhoav
+        processedarg(i) = .true.
         env%properties = p_rrhoaverage
         call read_bhess_ref(env,'coord')
+
       case ('-avbhess')
+        processedarg(i) = .true.
         env%thermo%avbhess = .true. !> use bhess in rrhoav for all structures (expensive)
+
       case ('-avchess')
+        processedarg(i) = .true.
         env%thermo%constrhess = .true.   !> apply constraints during rrhoav routine
+
       case ('-printpop')
+        processedarg(i) = .true.
         env%thermo%printpop = .true. !> print a file with free energy pop. at different T
+
       case ('-noref')              !> dont use a bhess reference
+        processedarg(i) = .true.
         env%emtd%bhess = .false.
+
       case ('-ref')
+        processedarg(i) = .true.
         env%emtd%bhess = .true.
-        inquire (file=trim(arg(i+1)),exist=ex)
+        inquire (file=arg1,exist=ex)
         if (ex) then
-          call read_bhess_ref(env,trim(arg(i+1)))
+          processedarg(i+1) = .true.
+          call read_bhess_ref(env,arg1)
         end if
+
       case ('-pcap')
+        processedarg(i) = .true.
         read (arg(i+1),*,iostat=io) j
         if (io == 0.and.(index(arg(i+1),'-') .eq. 0)) then
+          processedarg(i+1) = .true.
           env%thermo%pcap = j
         end if
+
       case ('-ptot')
+        processedarg(i) = .true.
         read (arg(i+1),*,iostat=io) rdum
         if (io == 0.and.(index(arg(i+1),'-') .eq. 0)) then
+          processedarg(i+1) = .true.
           if (rdum > 1.0d0) rdum = 1.0d0
           env%thermo%ptot = rdum
         end if
+
       case ('-ithr')
+        processedarg(i) = .true.
         read (arg(i+1),*,iostat=io) rdum
         if (io == 0) then
+          processedarg(i+1) = .true.
           if (rdum > 0.0d0) rdum = 0.0
           env%thermo%ithr = rdum
         end if
+
       case ('-rotorcut','-sthr')
+        processedarg(i) = .true.
         read (arg(i+1),*,iostat=io) rdum
         if (io == 0.and.(index(arg(i+1),'-') .eq. 0)) then
+          processedarg(i+1) = .true.
           if (rdum < 0.0d0) rdum = 0.0d0
           env%thermo%sthr = rdum
         end if
+
       case ('-fscal')
+        processedarg(i) = .true.
         read (arg(i+1),*,iostat=io) rdum
         if (io == 0.and.(index(arg(i+1),'-') .eq. 0)) then
+          processedarg(i+1) = .true.
           env%thermo%fscal = rdum
         end if
+
       case ('-trange')    !> provide a range of temperatures (min max step) for entropy evaluation
+        processedarg(i) = .true.
         read (arg(i+1),*,iostat=io) rdum
         if (io == 0.and.(index(arg(i+1),'-') .eq. 0)) then
+          processedarg(i+1) = .true.
           env%thermo%trange(1) = rdum  !> T start
         end if
         read (arg(i+2),*,iostat=io) rdum
         if (io == 0.and.(index(arg(i+2),'-') .eq. 0)) then
+          processedarg(i+2) = .true.
           env%thermo%trange(2) = rdum  !> T stop (approx.)
         end if
         read (arg(i+3),*,iostat=io) rdum
         if (io == 0.and.(index(arg(i+3),'-') .eq. 0)) then
+          processedarg(i+3) = .true.
           env%thermo%trange(3) = rdum  !> T step
         end if
+
       case ('-tread')   !> read a file with temperatures (one per line) for entropy evaluation
-        ctmp = trim(arg(i+1))
+        processedarg(i) = .true.
+        ctmp = arg1
         inquire (file=ctmp,exist=ex)
         if (ex) then
+          processedarg(i+1) = .true.
           call env%thermo%read_temps(ctmp)
         end if
 !=========================================================================================!
 !-------- QCG-Related flags
 !=========================================================================================!
       case ('-nopreopt')
+        processedarg(i) = .true.
         env%nopreopt = .true.
         env%qcg_flag = .true.
+
       case ('-xtbiff')
+        processedarg(i) = .true.
         env%use_xtbiff = .true.
+
       case ('-grow')
+        processedarg(i) = .true.
         env%qcg_runtype = 0
         env%qcg_flag = .true.
+
       case ('-ensemble')
+        processedarg(i) = .true.
         env%qcg_runtype = 1
         env%qcg_flag = .true.
+
       case ('-esolv')
+        processedarg(i) = .true.
         env%qcg_runtype = 2
         env%qcg_flag = .true.
+
       case ('-gsolv')
+        processedarg(i) = .true.
         env%qcg_runtype = 3
         env%qcg_flag = .true.
+
       case ('-nsolv')
+        processedarg(i) = .true.
         env%qcg_flag = .true.
-        call readl(arg(i+1),xx,j)
-        env%nsolv = NINT(xx(1))
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%nsolv = NINT(xx(1))
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-maxsolv')
+        processedarg(i) = .true.
         env%qcg_flag = .true.
-        call readl(arg(i+1),xx,j)
-        env%max_solv = NINT(xx(1))
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%max_solv = NINT(xx(1))
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-normdock')
+        processedarg(i) = .true.
         env%docking_qcg_flag = ''
+
       case ('-fin_opt_gfn2')
+        processedarg(i) = .true.
         env%final_gfn2_opt = .true.
+
       case ('-no_fin_opt_gfn2')
+        processedarg(i) = .true.
         env%final_gfn2_opt = .false.
+
       case ('-directed') !> specify the directed list
+        processedarg(i) = .true.
         env%qcg_flag = .true.
-        ctmp = trim(arg(i+1))
+        ctmp = arg1
         if (ctmp(1:1) .ne. '-') then
+          processedarg(i+1) = .true.
           env%directed_file = trim(ctmp)
-          write (*,'(2x,a,1x,a)') trim(argument)//' :',trim(ctmp)
+          write (stdout,'(2x,a,1x,a)') trim(argument)//' :',trim(ctmp)
         end if
+
       case ('-nclus')
+        processedarg(i) = .true.
         env%qcg_flag = .true.
-        call readl(arg(i+1),xx,j)
-        env%nqcgclust = NINT(xx(1))
-        env%user_nclust = .true.
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%nqcgclust = NINT(xx(1))
+          env%user_nclust = .true.
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-freqscal')
+        processedarg(i) = .true.
         env%qcg_flag = .true.
-        call readl(arg(i+1),xx,j)
-        env%freq_scal = (xx(1))
+        call readl(arg1,xx,j)
+        if (j > 0) then
+          processedarg(i+1) = .true.
+          env%freq_scal = (xx(1))
+        else
+          call parseflags_missing(argument)
+        end if
+
       case ('-qcgmtd')
+        processedarg(i) = .true.
         env%ensemble_method = -1
         env%qcg_flag = .true.
+
       case ('-ncimtd')
+        processedarg(i) = .true.
         env%ensemble_method = 0
         env%qcg_flag = .true.
+
       case ('-md')
+        processedarg(i) = .true.
         env%ensemble_method = 1
         env%qcg_flag = .true.
         if (.not.env%user_enslvl) then
           env%ensemble_opt = '--gfn2'
         end if
+
       case ('-mtd')
+        processedarg(i) = .true.
         env%ensemble_method = 2
         env%qcg_flag = .true.
         if (.not.env%user_enslvl) then
           env%ensemble_opt = '--gfn2'
         end if
+
       case ('-samerand')
+        processedarg(i) = .true.
         env%sameRandomNumber = .true.
         env%qcg_flag = .true.
+
       case ('-nocff')
+        processedarg(i) = .true.
         env%cff = .false.
         env%qcg_flag = .true.
+
       case ('-enslvl')
+        processedarg(i) = .true.
         ctmp = arg(i+1)
+        processedarg(i+1) = .true.
         env%user_enslvl = .true.
         env%qcg_flag = .true.
-        if (arg(i+1) == 'gfn') then
-          dtmp = trim(arg(i+2))
+        if (arg(i+1) == '-gfn') then
+          processedarg(i+2) = .true.
+          dtmp = arg2
           ctmp = trim(ctmp)//dtmp
         end if
         select case (ctmp)
         case ('gfn1')
           env%ensemble_opt = '--gfn1'
-          write (*,'(2x, a)') 'Use of GFN1-xTB for ensemble search requested.'
+          write (stdout,'(2x, a)') 'Use of GFN1-xTB for ensemble search requested.'
         case ('gfn2')
           env%ensemble_opt = '--gfn2'
-          write (*,'(2x, a)') 'Use of GFN2-xTB for ensemble search requested.'
+          write (stdout,'(2x, a)') 'Use of GFN2-xTB for ensemble search requested.'
         case ('gfn0')
           env%ensemble_opt = '--gfn0'
-          write (*,'(2x, a)') 'Use of GFN0-xTB for ensemble search requested.'
+          write (stdout,'(2x, a)') 'Use of GFN0-xTB for ensemble search requested.'
         case ('gff','gfnff')
           env%ensemble_opt = '--gff'
-          write (*,'(2x, a)') 'Use of GFN-FF for ensemble search requested.'
+          write (stdout,'(2x, a)') 'Use of GFN-FF for ensemble search requested.'
         end select
 
       case ('-freqlvl')
+        processedarg(i) = .true.
         ctmp = arg(i+1)
+        processedarg(i+1) = .true.
         env%qcg_flag = .true.
-        if (arg(i+1) == 'gfn') then
-          dtmp = trim(arg(i+2))
+        if (arg(i+1) == '-gfn') then
+          processedarg(i+2) = .true.
+          dtmp = arg2
           ctmp = trim(ctmp)//dtmp
         end if
         select case (ctmp)
         case ('gfn1')
           env%freqver = '--gfn1'
-          write (*,'(2x, a)') 'Use of GFN1-xTB for frequency computation requested.'
+          write (stdout,'(2x, a)') 'Use of GFN1-xTB for frequency computation requested.'
         case ('gfn2')
           env%freqver = '--gfn2'
-          write (*,'(2x, a)') 'Use of GFN2-xTB for frequency computation requested.'
+          write (stdout,'(2x, a)') 'Use of GFN2-xTB for frequency computation requested.'
         case ('gfn0')
           env%freqver = '--gfn0'
-          write (*,'(2x, a)') 'Use of GFN0-xTB for frequency computation requested.'
+          write (stdout,'(2x, a)') 'Use of GFN0-xTB for frequency computation requested.'
         case ('gff','gfnff')
           env%freqver = '--gff'
-          write (*,'(2x, a)') 'Use of GFN-FF for frequency computation requested.'
+          write (stdout,'(2x, a)') 'Use of GFN-FF for frequency computation requested.'
         end select
 !========================================================================================!
 !-------- PRINCIPAL COMPONENT analysis and CLUSTERING flags
 !========================================================================================!
       case ('-cluster')
-        write (*,'(2x,a,'' : ensemble clustering'')') trim(arg(i))
+        processedarg(i) = .true.
+        write (stdout,'(2x,a,'' : ensemble clustering'')') trim(arg(i))
         if (env%properties == p_propcalc) then
           !>--- for standalone use
           env%properties = p_cluster
-        elseif (env%confgo.and.env%properties == p_cregen) then
-          !>--- as extension for CREGEN
-          env%cluster = .true.
+        elseif (env%crestver == crest_sorting) then
+          !>--- standalone clustering via --sort --cluster
+          env%sortmode = 'cluster'
         else if (any((/crest_imtd,crest_imtd2/) == env%crestver)) then
           !>--- works as an extensiton to the conformational search
           env%properties = abs(p_cluster)
@@ -1918,59 +2874,72 @@ subroutine parseflags(env,arg,nra)
         if (i+1 .le. nra) then !second argument a distinct number of clusters
           read (arg(i+1),*,iostat=io) j
           if (io == 0.and.(index(arg(i+1),'-') .eq. 0)) then
+            processedarg(i+1) = .true.
             env%nclust = j
           else
             env%nclust = 0
             if ((index(arg(i+1),'-') .eq. 0)) then
-              ctmp = trim(arg(i+1))
+              processedarg(i+1) = .true.
+              ctmp = arg1
               select case (ctmp)
               case ('loose')
                 env%clustlev = -1
-                write (*,'(2x,a,'' loose : using loose clustering setting'')') trim(arg(i))
+                write (stdout,'(2x,a,'' loose : using loose clustering setting'')') trim(arg(i))
               case ('normal')
                 env%clustlev = 0
-                write (*,'(2x,a,'' normal : using normal clustering setting'')') trim(arg(i))
+                write (stdout,'(2x,a,'' normal : using normal clustering setting'')') trim(arg(i))
               case ('tight')
                 env%clustlev = 1
-                write (*,'(2x,a,'' tight : using tight clustering setting'')') trim(arg(i))
+                write (stdout,'(2x,a,'' tight : using tight clustering setting'')') trim(arg(i))
               case ('vtight','verytight')
                 env%clustlev = 2
-                write (*,'(2x,a,'' vtight : using very tight clustering setting'')') trim(arg(i))
+                write (stdout,'(2x,a,'' vtight : using very tight clustering setting'')') trim(arg(i))
               case ('incremental','incr')
                 env%clustlev = 10
-                write (*,'(2x,a,'' incremental : using incremental clustering settings'')') trim(arg(i))
+                write (stdout,'(2x,a,'' incremental : using incremental clustering settings'')') trim(arg(i))
               case ('tightincremental','tightincr')
                 env%clustlev = 11
-                write (*,'(2x,a,'' tightincremental : using incremental clustering settings'')') &
+                write (stdout,'(2x,a,'' tightincremental : using incremental clustering settings'')') &
                 &    trim(arg(i))
               case ('vtightincremental','vtightincr')
                 env%clustlev = 12
-                write (*,'(2x,a,'' vtightincremental : using incremental clustering settings'')') &
+                write (stdout,'(2x,a,'' vtightincremental : using incremental clustering settings'')') &
                  & trim(arg(i))
               end select
             end if
           end if
         end if
+
       case ('-pccap')
+        processedarg(i) = .true.
         if (i+1 .le. nra) then !> second argument is the max. number of PCs
           read (arg(i+1),*,iostat=io) j
           if (io == 0.and.(index(arg(i+1),'-') .eq. 0)) then
+            processedarg(i+1) = .true.
             env%pccap = j
           end if
         end if
+
       case ('-nopcmin')
+        processedarg(i) = .true.
         env%pcmin = 0.0d0
+
       case ('-pctype','-pctyp')
+        processedarg(i) = .true.
         if (i+1 .le. nra) then
-          ctmp = trim(arg(i+1))
+          ctmp = arg1
           if (ctmp(1:1) .ne. '-') then
+            processedarg(i+1) = .true.
             env%pcmeasure = ctmp
           end if
         end if
+
       case ('-pcaex','-pcaexclude')
+        processedarg(i) = .true.
         if (i+1 .le. nra) then
-          ctmp = trim(arg(i+1))
+          ctmp = arg1
           if (ctmp(1:1) .ne. '-') then
+            processedarg(i+1) = .true.
             env%atlist = ctmp
             env%pcaexclude = .true.
           end if
@@ -1979,43 +2948,28 @@ subroutine parseflags(env,arg,nra)
 !---------- PROPERTY MODE
 !========================================================================================!
       case ('-prop')
+        processedarg(i) = .true.
 !>----------------------------------------------------------------
 !> NOTE: These flags are outdated and using them is discouraged!
 !>----------------------------------------------------------------
         if ((env%properties == p_none.or.    &
         &  env%properties == p_propcalc)) then         !property selection
-          ctmp = trim(arg(i+1))
+          ctmp = arg1
+          processedarg(i+1) = .true.
           PROPARG:select case(ctmp)
           case ('hess')                  !hessian calculation to free energies for all conformers
-          env%properties2 = 1
+          env%properties2 = p_prop_hess
           case ('ohess')                 !optimization+hessian calculation
-          env%properties2 = 10
+          env%properties2 = p_prop_ohess
           case ('autoir','autoIR')       !automated IR averaging for populated (-pthr) conformers
-          env%properties2 = 2
-          case ('b973c')                 !B97-3c optimization (xtb driver for ancopt)
-          env%properties2 = 3
-          case ('b973cIR')               !B97-3c optimization + IR spectra average
-          env%properties2 = 4
-          case ('dft')                   !DFT (custom) job, read from dftrc
-          env%properties2 = 100
-          case ('dftOPT')                !DFT (custom) optimization (xtb driver for ancopt)
-          env%properties2 = 5
-          case ('dftIR')                 !DFT (custom) optimization + IR spectra average
-          env%properties2 = 6
-          case ('dftSP')                 !DFT (custom) singlepoint
-          env%properties2 = 7
-          env%harcutpthr = 0.75
-          case ('dftFREQ')               !DFT (custom) optimization + frequencies
-          env%properties2 = 8
+          env%properties2 = p_prop_autoir
           case ('reopt')                 !reoptimize only conformers at vtight level
-          env%properties2 = 20
-          case ('TEST')                  !testSTUFF
-          env%properties2 = -9999
+          env%properties2 = p_prop_reopt
           case ('singlepoint','sp')      !singlepoint calculation and ensemble sorting
-          env%properties2 = 999
+          env%properties2 = p_prop_rerank
           env%pclean = .true.
-          case ('dipole')      !singlepoint calculation and dipole grepping
-          env%properties2 = 998
+          case ('dipole')                !singlepoint calculation and dipole grepping
+          env%properties2 = p_prop_dipole
           env%pclean = .true.
           case default
           env%properties2 = 0
@@ -2024,29 +2978,41 @@ subroutine parseflags(env,arg,nra)
             call env%addjob(env%properties2)
           end if
         end if
+        call parseflags_deprecated(argument)
+
       case ('-dftrc')                            !provide dft-rc file (including path)
+        processedarg(i) = .true.
         atmp = ''
         if (nra .ge. (i+1)) atmp = adjustl(arg(i+1))
         if ((atmp(1:1) /= '-').and.(len_trim(atmp) .ge. 1)) then
+          processedarg(i+1) = .true.
           env%dftrcfile = trim(atmp)
         end if
+        call parseflags_deprecated(argument)
+
       case ('-hardcut')                          !cut DFT populations hard
+        processedarg(i) = .true.
         env%hardcutDFT = .true.
+        call parseflags_deprecated(argument)
+
       case ('-pclean')                           !cleanup option for property mode, i.e., remove PROP/
+        processedarg(i) = .true.
         env%pclean = .true.
 !========================================================================================!
       case ('-scratch')
+        processedarg(i) = .true.
         !use a scratch directory to perform the calculation in
         env%scratch = .true.
         atmp = ''
         if (nra .ge. (i+1)) atmp = adjustl(arg(i+1))
         if ((atmp(1:1) /= '-').and.(len_trim(atmp) .ge. 1)) then
+          processedarg(i+1) = .true.
           env%scratchdir = trim(atmp)
         end if
+
       case ('-keepscratch')
+        processedarg(i) = .true.
         env%keepScratch = .true.
-      case default
-        continue
       end select !> ARGPARSER1
 !========================================================================================!
     end if
@@ -2058,6 +3024,8 @@ subroutine parseflags(env,arg,nra)
 !========================================================================================!
   deallocate (strings,floats,xx)
 
+  call parseflags_cli_summary(nra,arg,processedarg)
+
 !>----- additional checks and settings
   if (env%crestver .eq. crest_solv) bondconst = .false.
 
@@ -2069,16 +3037,19 @@ subroutine parseflags(env,arg,nra)
     error stop 'Z sorting of the input is unavailable for -qcg runtyp.'
   end if
 
+!>--- avoid 0 potscal
+  if (env%potscal < 1.0d-5) env%potscal = 1.0_wp
+
 !>--- automatic wall potential for the LEGACY version
-  if (env%NCI.or.env%wallsetup.and.env%legacy) then
+  if ((env%NCI.or.env%wallsetup).and.env%legacy) then
     call wallpot(env)
     if (env%wallsetup) then
-      write (*,'(2x,a)') 'Automatically generated ellipsoide potential:'
+      write (stdout,'(2x,a)') 'Automatically generated ellipsoide potential:'
     else
-      write (*,'(2x,a)') 'Automatically generated ellipsoide potential for NCI mode:'
+      write (stdout,'(2x,a)') 'Automatically generated ellipsoide potential for NCI mode:'
     end if
     call write_cts_NCI_pr(stdout,env%cts)
-    write (*,*)
+    write (stdout,*)
   end if
 
 !>--- automatic bond constraint setup
@@ -2211,28 +3182,75 @@ subroutine parseflags(env,arg,nra)
     flush (stdout)
     call env2calc_setup(env)
     write (stdout,*) 'done.'
-    call env%calc%info(stdout)
-  end if
-!>--- pass on opt-level to new calculator
-  if (.not.env%legacy) then
-    env%calc%optlev = nint(env%optlev)
   end if
 
-!>--- ONIOM setup from toml file
-  if (allocated(env%ONIOM_toml)) then
-    allocate (env%calc%ONIOM)
-    call ONIOM_read_toml(env%ONIOM_toml,env%nat,env%ref%at,env%ref%xyz,env%calc%ONIOM)
-    call env%calc%ONIOMexpand()
+!>--- pass on other settings (from cli) to new calculator
+  if (.not.env%legacy) then
+    call env2calc_modify(env)
   end if
 
 !>--- important printouts
   if (.not.env%legacy) then
+
+    if (env%crestver .ne. crest_sorting) then
+      call env%calc%info(stdout)
+    end if
+
     call print_frozen(env)
   end if
 
   return
 end subroutine parseflags
 
+subroutine parseflags_missing(arg)
+  use crest_parameters
+  implicit none
+  character(len=*),intent(in) :: arg
+  write (stdout,'(a)') trim(arg)//' requires a valid argument'
+end subroutine parseflags_missing
+
+subroutine parseflags_deprecated(arg)
+  !**********************************************
+  !* Print a deprecation error and stop.
+  !**********************************************
+  use crest_parameters
+  use crest_data
+  implicit none
+  character(len=*),intent(in) :: arg
+  write (stdout,'(/,a)') repeat('!',60)
+  write (stdout,'(a)') '  DEPRECATED FLAG: '//trim(arg)
+  write (stdout,'(a)') '  This flag has been removed. Please update your input.'
+  write (stdout,'(a,/)') repeat('!',60)
+  call creststop(status_safety)
+end subroutine parseflags_deprecated
+
+subroutine parseflags_cli_summary(nra,args,processedarg)
+  use crest_parameters
+  use crest_data
+  implicit none
+  integer,intent(in) :: nra
+  character(len=*),intent(in) :: args(nra)
+  logical,intent(in) :: processedarg(nra)
+  integer :: ii,nprocessed
+  nprocessed = count(processedarg,1)
+  if (nprocessed == nra) then
+    write (stdout,'(/,a)') '> All CLI arguments successfully processed.'
+  else
+    write (stdout,'(70("-"))')
+    write (stdout,'(a,/)') '** WARNING ** Some CLI arguments were not correctly processed:'
+    do ii = 1,nra
+      if (processedarg(ii)) cycle
+      write (stdout,'(1x,a,i4,a,t20,a)') 'Argument',ii,': ',trim(args(ii))
+    end do
+
+    write (stdout,'(/,a)') 'Please check your command line input for sanity.'
+    write (stdout,'(70("-"))')
+    write (stdout,*)
+    call creststop(status_safety)
+  end if
+
+end subroutine parseflags_cli_summary
+
 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc!
 !=========================================================================================!
 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC!
@@ -2281,7 +3299,7 @@ subroutine parseRC2(env,bondconst)
   end if
 
   if (ex1) then
-    write (*,'(/,1x,a,a,a)') '<',trim(env%constraints),'> file present.'
+    write (stdout,'(/,1x,a,a,a)') '<',trim(env%constraints),'> file present.'
     env%cts%used = .true.
   else
     env%cts%used = .false.
@@ -2291,13 +3309,13 @@ subroutine parseRC2(env,bondconst)
 !>--- read the data
   call read_constrainbuffer(env%constraints,env%cts)
   call sort_constraints(env%cts)
-  write (*,*) 'content of the constraining file (sorted):'
+  write (stdout,*) 'content of the constraining file (sorted):'
   if (env%cts%ndim .gt. 20) then
-    write (*,'(1x,a)') '<skipped due to length of constraining file>'
+    write (stdout,'(1x,a)') '<skipped due to length of constraining file>'
   else
     do i = 1,env%cts%ndim
       if (trim(env%cts%sett(i)) .ne. '') then
-        write (*,'(''>'',1x,a)') trim(env%cts%sett(i))
+        write (stdout,'(''>'',1x,a)') trim(env%cts%sett(i))
       end if
     end do
   end if
@@ -2322,8 +3340,8 @@ subroutine parseRC2(env,bondconst)
       dg = atmp
       call split_set_args(dg,argument)
       call parse_atlist_new(trim(argument),env%rednat,env%nat,env%ref%at,atlist)
-      write (*,'(2x,a)') trim(adjustl(btmp))
-      write (*,'(5x,a,i0)') '# of atoms considered for RMSDs:',env%rednat
+      write (stdout,'(2x,a)') trim(adjustl(btmp))
+      write (stdout,'(5x,a,i0)') '# of atoms considered for RMSDs:',env%rednat
       env%includeRMSD = atlist !includeRMSD contains only the atoms that are included in RMSD
     end if
     if (index(atmp,'atomlist-') .ne. 0) then
@@ -2333,8 +3351,8 @@ subroutine parseRC2(env,bondconst)
       call split_set_args(dg,argument)
       call parse_atlist_new(trim(argument),j,env%nat,env%ref%at,atlist)
       env%rednat = env%nat-j
-      write (*,'(2x,a)') trim(adjustl(btmp))
-      write (*,'(3x,a,i0)') '# of atoms considered for RMSDs:',env%rednat
+      write (stdout,'(2x,a)') trim(adjustl(btmp))
+      write (stdout,'(3x,a,i0)') '# of atoms considered for RMSDs:',env%rednat
       env%includeRMSD = atlist !includeRMSD contains the atoms that are NOT included in RMSD
       do k = 1,env%nat
         if (env%includeRMSD(k) .lt. 1) then   !therefore the values have to be "inverted"
@@ -2354,15 +3372,15 @@ subroutine parseRC2(env,bondconst)
           dg = btmp
           call split_set_args(dg,argument)
           call parse_atlist_new(trim(argument),env%rednat,env%nat,env%ref%at,atlist)
-          write (*,'(2x,a)') trim(adjustl(btmp))
-          write (*,'(5x,a,i0)') '# of atoms considered for RMSDs:',env%rednat
+          write (stdout,'(2x,a)') trim(adjustl(btmp))
+          write (stdout,'(5x,a,i0)') '# of atoms considered for RMSDs:',env%rednat
           env%includeRMSD = atlist !includeRMSD contains only the atoms that are included in RMSD
         end if
       end do
     end if
     if (index(btmp,'reference=') .ne. 0) then
       call rdarg(btmp,'reference=',env%fixfile)
-      write (*,'(1x,a,1x,a)') 'fix file:',trim(env%fixfile)
+      write (stdout,'(1x,a,1x,a)') 'fix file:',trim(env%fixfile)
     end if
     if ((index(atmp,'$wall') .ne. 0)) then
       if (env%NCI) then
@@ -2378,9 +3396,9 @@ subroutine parseRC2(env,bondconst)
           k = k+1
         end do
 
-        write (*,'(/,2x,a)') 'Automatically generated ellipsoide potential overwritten by:'
+        write (stdout,'(/,2x,a)') 'Automatically generated ellipsoide potential overwritten by:'
         call write_cts_NCI(6,env%cts)
-        write (*,*)
+        write (stdout,*)
 
       end if
     end if
@@ -2421,7 +3439,8 @@ subroutine inputcoords(env,arg)
   character(len=:),allocatable :: arg2
   type(coord) :: mol
   type(zmolecule) :: zmol
-  integer :: i
+  integer :: i,idiff
+  integer,allocatable :: tmpinclude(:)
 
 !>--- Redirect for QCG input reading
   if (env%QCG) then
@@ -2467,7 +3486,8 @@ subroutine inputcoords(env,arg)
   if (.not.allocated(env%inputcoords)) env%inputcoords = 'coord'
   call mol%open('coord')
 !>-- shift to CMA and/or align according to rot.const. We have to be careful about this.
-  if (any((/crest_sp,crest_optimize,crest_numhessian,crest_trialopt/) == env%crestver)) then
+  if (any((/crest_sp,crest_optimize,crest_numhessian,crest_trialopt, &
+  &         crest_ensemblesp,crest_ensemblehess/) == env%crestver)) then
     !> some runtypes should only do a CMA translation, but no rotation
     call CMAtrf(mol%nat,mol%nat,mol%at,mol%xyz)
   else if (env%crestver == crest_solv) then
@@ -2506,8 +3526,29 @@ subroutine inputcoords(env,arg)
   env%protb%nfrag = zmol%nfrag
   call zmol%deallocate()
 
+!>--- Repair logic of includeRMSD array (especially for something like QCG)
+  if (.not.allocated(env%includeRMSD)) then
+    allocate (env%includeRMSD(env%ref%nat))
+    env%includeRMSD(:) = 1
+  else
+    !> assuming if the current includeRMSD is smaller than the
+    !> current system we have *appended* some atoms
+    idiff = size(env%includeRMSD,1)
+    if (idiff < env%ref%nat) then
+      allocate (tmpinclude(env%ref%nat),source=1)
+      do i = 1,idiff
+        tmpinclude(i) = env%includeRMSD(i)
+      end do
+      !deallocate(env%includeRMSD)
+      call move_alloc(tmpinclude,env%includeRMSD)
+    end if
+  end if
+
   return
 end subroutine inputcoords
 
 !========================================================================================!
 !========================================================================================!
+
+!========================================================================================!
+!========================================================================================!
diff --git a/src/cregen.f90 b/src/cregen.f90
deleted file mode 100644
index 31b86ca9..00000000
--- a/src/cregen.f90
+++ /dev/null
@@ -1,2650 +0,0 @@
-!===============================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2018-2024 Philipp Pracht
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!===============================================================================!
-
-!=========================================================================================!
-!=========================================================================================!
-!> CREGEN is the universal ensemble sorting routine of CREST.
-!> This is a rewrite of the original routines since the old ones
-!> got a bit messy over time.
-!> the quickset variable can be used for some special runtypes:
-!>   quickset:  2   - do symmetry analysis
-!>              3   - switch off equivalency analysis
-!>              6,7 - energy sorting only with (7) or without (6) ewin energy cut-off
-!>              9   - no sorting, only check groups
-!>             12   - no topology check, turn ewin to infty
-!>             13   - no topology check, ewin and rmsd checking (msreact settings)
-!=========================================================================================!
-!=========================================================================================!
-
-module cregen_interface
-!*******************************************************
-!* module to load an interface to the newcregen routine
-!* mandatory to handle the optional input arguments
-!*******************************************************
-  implicit none
-  interface
-    subroutine newcregen(env,quickset,infile)
-      use crest_parameters
-      use crest_data
-      use crest_restartlog
-      use strucrd
-      implicit none
-      type(systemdata),intent(inout) :: env
-      integer,intent(in),optional :: quickset
-      character(len=*),intent(in),optional :: infile
-    end subroutine newcregen
-  end interface
-end module cregen_interface
-
-subroutine newcregen(env,quickset,infile)
-!****************************
-!* The main CREGEN routine
-!****************************
-  use crest_parameters
-  use crest_data
-  use crest_restartlog
-  use strucrd
-  implicit none
-  !> INPUT
-  type(systemdata),intent(inout) :: env   !> MAIN STORAGE OS SYSTEM DATA
-  integer,intent(in),optional :: quickset !> quick access to predefined CREGEN modes
-  character(len=*),intent(in),optional :: infile
-  !> LOCAL
-  integer :: simpleset
-  character(len=258) :: fname  !> input file
-  character(len=258) :: oname  !> sorted output file
-  character(len=258) :: cname  !> unique structure file
-!>--- ensemble arguments
-  integer :: nat                      !> number of atoms
-  integer :: nall                     !> number of structures
-  integer,allocatable  :: at(:)       !> atom numbers
-  real(wp),allocatable :: xyz(:,:,:)  !> Cartesian coordinates
-  character(len=128),allocatable :: comments(:)
-  character(len=128),allocatable :: comref(:)
-  real(wp),allocatable :: er(:)       !> energies
-  type(coord),allocatable :: structures(:)  !> a list of structures using the coord type
-  type(coord),allocatable :: references(:)  !> the reference structure list
-!>--- dummy ensemble arguments
-  integer :: nallref
-  integer :: nallnew
-  real(wp),allocatable :: xyzref(:,:,:)
-!>--- sorting arguments
-  integer,allocatable :: gref(:),group(:)
-  integer :: ng
-  integer,allocatable :: degen(:,:)
-
-!>--- float data
-  real(wp) :: ewin,rthr,bthr,pthr,ethr,athr
-  real(wp) :: T,couthr
-
-!>--- boolean data
-  logical :: checkbroken
-  logical :: topocheck
-  logical :: checkez
-  logical :: sortE
-  logical :: sortRMSD
-  logical :: sortRMSD2
-  logical :: newfile
-  logical :: repairord
-  logical :: conffile
-  logical :: bonusfiles
-  logical :: anal
-  logical :: saveelow
-  logical :: userinput
-
-!>--- printout directions
-  integer :: prch  !> the main printout channel
-  logical :: pr1,pr2,pr3,pr4
-
-!>--- restart skip & tracking
-  if (trackrestart(env)) return
-
-!====================================================================!
-!>  S E T T I N G S
-!====================================================================!
-  if (present(quickset)) then
-    simpleset = quickset
-  else
-    simpleset = 0
-  end if
-
-!>-- determine filenames and output channel
-  if (present(infile)) then
-    fname = trim(infile)
-    userinput = .true.
-  else
-    fname = trim(env%ensemblename)
-    userinput = .false.
-  end if
-  call cregen_files(env,fname,oname,cname,simpleset,userinput,prch)
-
-!>-- determine which printouts are required
-  call cregen_prout(env,simpleset,pr1,pr2,pr3,pr4)
-
-!>-- determine which subroutines are required
-  call cregen_director(env,simpleset,checkbroken,sortE,sortRMSD,sortRMSD2, &
-  &  repairord,newfile,conffile,bonusfiles,anal,topocheck,checkez,saveelow)
-
-!>--- DATA SECTION
-  call cregen_filldata1(env,ewin,rthr,ethr,bthr,athr,pthr,T,couthr)
-  call cregen_filldata2(simpleset,ewin)
-
-!>--- setting the threads for OMP parallel usage
-  call cregen_setthreads(prch,env,.false.)
-
-!=====================================================================!
-!>  E N S E M B L E   P R O C E S S I N G
-!=====================================================================!
-
-!>--- read in the ensemble parameters
-  call rdensembleparam(fname,nat,nallref)
-
-!>--- print a summary about the ensemble and thresholds
-  if (pr1) call cregen_pr1(prch,env,nat,nallref,rthr,bthr,pthr,ewin)
-
-!>--- allocate space and read in the ensemble
-  allocate (at(nat),comments(nallref),xyz(3,nat,nallref))
-  call rdensemble(fname,nat,nallref,at,xyz,comments)
-  !call rdensemble(fname,nallref,structures)
-  !allocate(references, source=structures)
- 
-!>--- track ensemble for restart
-  call trackensemble(fname,nat,nallref,at,xyz,comments)
-
-!>--- check if the ensemble contains broken structures? i.e., fusion or dissociation
-  if (checkbroken) then
-    call discardbroken(prch,env,topocheck,nat,nallref,at,xyz,comments,nall)
-!>--- if structures were discarded, resize xyz
-    if (nall .lt. nallref) then
-      xyzref = xyz(:,:,1:nall)
-      call move_alloc(xyzref,xyz)
-      comref = comments(1:nall)
-      call move_alloc(comref,comments)
-    end if
-  else
-    nall = nallref
-  end if
-
-!>--- compare neighbourlists to sort out chemically transformed structures
-  if (topocheck) then
-    call cregen_topocheck(prch,env,checkez,nat,nall,at,xyz,comments,nallnew)
-!>--- if structures were discarded, resize xyz
-    if (nallnew .lt. nall) then
-!>-- special fallback if all are discared
-      if (nallnew == 0) then
-        call rdcoord('coord',nat,at,xyz(:,:,1))
-        xyz = xyz*bohr
-        write (comments(1),'(f18.8)') env%elowest
-        nallnew = 1
-      end if
-      nall = nallnew
-      xyzref = xyz(:,:,1:nall)
-      call move_alloc(xyzref,xyz)
-      comref = comments(1:nall)
-      call move_alloc(comref,comments)
-    end if
-  end if
-  if (topocheck.or.checkbroken) then
-    write (prch,'('' number of reliable points      :'',i6)') nall
-  end if
-
-!>--- sort the ensemble by its energies and make a cut (EWIN)
-  if (sortE) then
-    call cregen_esort(prch,nat,nall,xyz,comments,nallnew,ewin)
-    !>--- if structures were discarded, resize xyz
-    if (nallnew .lt. nall) then
-      nall = nallnew
-      xyzref = xyz(:,:,1:nall)
-      call move_alloc(xyzref,xyz)
-      comref = comments(1:nall)
-      call move_alloc(comref,comments)
-    end if
-  end if
-
-!>--- do the rotational constants and RMSD check
-  if (sortRMSD) then
-    allocate (group(0:nall))
-    call cregen_CRE(prch,env,nat,nall,at,xyz,comments,nallnew,group,.false.)
-!>--- if structures were discarded, resize xyz
-    if (nallnew .lt. nall) then
-      nall = nallnew
-      xyzref = xyz(:,:,1:nall)
-      call move_alloc(xyzref,xyz)
-      comref = comments(1:nall)
-      call move_alloc(comref,comments)
-      allocate (gref(0:nallnew))
-      gref(0:nallnew) = group(0:nallnew)
-      call move_alloc(gref,group)
-      nall = nallnew
-    end if
-!>--- repair the order
-    if (repairord) then
-      call cregen_repairorder(nat,nall,xyz,comments,group)
-    end if
-!>--- get group info to degen
-    ng = group(0)
-    allocate (degen(3,ng))
-    call cregen_groupinfo(nall,ng,group,degen)
-  end if
-  if (sortRMSD2) then
-    allocate (group(0:nall))
-    call cregen_CRE(prch,env,nat,nall,at,xyz,comments,nallnew,group,.true.)
-  end if
-
-!=====================================================================!
-!>  E N S E M B L E   O U T P U T
-!=====================================================================!
-
-!>--- align all structures to the first structure using the RMSD
-  call cregen_rmsdalign(nat,nall,at,xyz)
-
-!>--- write new file with ALL remaining structures
-  if (newfile) then
-    call cregen_file_wr(env,oname,nat,nall,at,xyz,comments)
-!>--- track ensemble for restart
-    call trackensemble(oname,nat,nall,at,xyz,comments)
-  end if
-!>--- write a file containing only conformers (no rotamers)
-  if (conffile) then
-    call cregen_conffile(env,cname,nat,nall,at,xyz,comments,ng,degen)
-  end if
-  if (saveelow) then
-    env%elowest = grepenergy(comments(1))
-!>-- and update reference geometry (in Bohr)
-    env%ref%xyz = xyz(:,:,1)/bohr
-  end if
-
-!>--- additional files for entropy mode
-  if (bonusfiles) then
-    call cregen_bonusfiles(ng,degen)
-  end if
-
-!>--- several printouts
-  if (pr2) then
-    allocate (er(nall))
-    call cregen_pr2(prch,env,nall,comments,ng,degen,er)
-    call cregen_econf_list(prch,nall,er,ng,degen)
-    deallocate (er)
-  end if
-  if (pr3) then !> alternative to pr2
-    call cregen_pr3(prch,oname,nall,comments)
-  end if
-  if (pr4) then !> group dara printout
-    call cregen_pr4(prch,fname,nall,group)
-  end if
-
-!>--- analyze nuclear equivalencies, e.g. for NMR and Entropy
-  if (anal) then
-    call cregen_EQUAL(prch,nat,nall,at,xyz,group,athr,.not.env%entropic)
-  end if
-
-!>--- deallocate data
-  if (prch .ne. stdout) then
-    close (prch)
-  end if
-  if (allocated(er)) deallocate (er)
-  if (allocated(degen)) deallocate (degen)
-  if (allocated(group)) deallocate (group)
-  deallocate (xyz,comments,at)
-  return
-end subroutine newcregen
-
-!=========================================================================================!
-!=========================================================================================!
-!>  CREGEN DATA SECTION
-!=========================================================================================!
-!=========================================================================================!
-
-subroutine cregen_files(env,fname,oname,cname,simpleset,userinput,iounit)
-!*************************************************************
-!* subroutine cregen_files
-!* handle all settings regarding input and output file names
-!* including where to print the cregen output
-!*************************************************************
-  use crest_parameters
-  use crest_data
-  use iomod
-  use utilities
-  implicit none
-  type(systemdata) :: env    !> MAIN STORAGE OS SYSTEM DATA
-  character(len=*) :: fname  !> name of the ensemble to be read
-  character(len=*) :: oname  !> output ensemble name (including rotamers)
-  character(len=*) :: cname  !> output ensemble name (only conformers)
-  integer,intent(in) :: simpleset
-  logical,intent(in) :: userinput !> was an input file given via the optional subroutine arg?
-  integer,intent(out) :: iounit
-  character(len=:),allocatable :: outfile
-  logical :: ex
-  !>--------------------------------------------------------------------
-  outfile = 'cregen.out.tmp'
-  if (env%cgf(6)) outfile = 'tmp'
-
-  !>-- the entire cregen output can be printed printed to a seperate file
-  !>   or to the terminal
-  call remove(outfile)
-  if (simpleset > 0) then
-    select case (simpleset)
-    case (6,7,9,12)
-      iounit = stdout
-    case default
-      open (newunit=iounit,file=outfile)
-    end select
-  else if (env%confgo.and..not. (env%properties .eq. -2).and..not.env%relax) then
-    iounit = stdout
-  else
-    open (newunit=iounit,file=outfile)
-  end if
-
-  if ((env%confgo.and.(index(trim(fname),'none selected') .eq. 0)) &
-  &    .OR.userinput) then
-    if (.not.userinput) then
-      fname = trim(env%ensemblename)
-    end if
-    oname = trim(fname)//'.sorted'
-    cname = 'crest_ensemble.xyz'
-    if (env%fullcre) then
-      env%ensemblename = trim(oname)
-    end if
-  else !> internal mode for conformational search
-    call checkname_xyz(crefile,fname,oname)
-    cname = conformerfile
-  end if
-  if (simpleset == 12) then !> MECP files
-    fname = "crest_mecp_search.xyz"
-    oname = "crest_mecp_search.xyz.sorted"
-    cname = "crest_ensemble.xyz"
-  end if
-  if (simpleset == 13) then !> MSREACT files
-    fname = "crest_unique_products.xyz"
-    oname = "crest_unique_products.sorted"
-    cname = "crest_msreact_products.xyz"
-  end if
-  if (simpleset == 15) then !> crossing files
-    call checkname_xyz('confcross',fname,oname)
-    cname = trim(fname)//'.unique'
-  end if
-
-  write (iounit,*) 'input  file name : ',trim(fname)
-  select case (simpleset)
-  case (9)
-    continue
-  case default
-    write (iounit,*) 'output file name : ',trim(oname)
-  end select
-
-  inquire (file=fname,exist=ex)
-  if (.not.ex) then
-    write (0,*) 'Warning, file ',trim(fname),' does not exist!'
-    error stop
-  end if
-
-  return
-end subroutine cregen_files
-
-!=========================================================================================!
-
-subroutine cregen_prout(env,simpleset,pr1,pr2,pr3,pr4)
-!***********************************************************
-!* subroutine cregen_prout
-!* handle all settings regarding which printouts are active
-!* (currently only those for default cregen runs)
-!***********************************************************
-  use crest_parameters
-  use crest_data
-  use iomod
-  implicit none
-  type(systemdata) :: env !> MAIN STORAGE OS SYSTEM DATA
-  integer,intent(in) :: simpleset
-  logical,intent(out) :: pr1,pr2,pr3,pr4
-
-  pr1 = .true.  !> threshold summary
-  pr2 = .true.  !> detailed energy/group list
-  pr3 = .false. !> plain energy list
-  pr4 = .false. !> group list printout
-
-  if (any(simpleset == (/6,7/)).or.env%esort) then
-    pr1 = .false.
-    pr2 = .false.
-    if (env%crestver .ne. crest_solv) pr3 = .true.
-  end if
-
-  if (simpleset == 9) then
-    pr1 = .true.
-    pr2 = .false.
-    pr3 = .false.
-    pr4 = .true.
-  end if
-
-  if (simpleset == 13) then
-    pr1 = .false.
-    pr2 = .false.
-    pr3 = .false.
-    pr4 = .false.
-  end if
-
-  return
-end subroutine cregen_prout
-
-!=========================================================================================!
-
-subroutine cregen_director(env,simpleset,checkbroken,sortE,sortRMSD,sortRMSD2, &
-        &  repairord,newfile,conffile,bonusfiles,anal,topocheck,checkez,saveelow)
-!**************************************************************
-!* subroutine cregen_director !IMPORTANT!
-!* handle which comparisons are required and which files shall
-!* be written
-!**************************************************************
-  use crest_parameters
-  use crest_data
-  use iomod
-  implicit none
-  type(systemdata) :: env    ! MAIN STORAGE OS SYSTEM DATA
-  integer,intent(in) :: simpleset
-  logical,intent(out) :: checkbroken
-  logical,intent(out) :: sortE,sortRMSD,sortRMSD2
-  logical,intent(out) :: repairord
-  logical,intent(out) :: newfile,conffile
-  logical,intent(out) :: bonusfiles
-  logical,intent(out) :: anal
-  logical,intent(out) :: topocheck
-  logical,intent(out) :: checkez
-  logical,intent(out) :: saveelow 
-
-  checkbroken = .true. !> fragmentized structures are sorted out
-  sortE = .true.       !> sort based on energy
-  sortRMSD = .true.    !> sort based on RMSD
-  sortRMSD2 = .false.  !> check groups for whole ensemble
-  repairord = .true.   !> double-check the sorted Ensemble
-
-  newfile = .true.  !> sorted input file
-
-  conffile = .true. !> sorted unique structure file
-
-  saveelow = .true. !> save (overwrite) lowest structure to env%ref
-
-  topocheck = env%checktopo !> topology is compared to reference structure
-  checkez = env%checkiso    !> check for C=C cis/trans isomerizations
-  if (env%relax) then
-    topocheck = .false.
-  end if
-
-  bonusfiles = .false.
-  if (env%entropic.or.env%doNMR) then
-    bonusfiles = .true.
-  end if
-
-  anal = .false.
-  if (env%doNMR.or.env%cgf(3).or.simpleset == 2) then
-    anal = .true.
-  end if
-  if (simpleset == 3) then
-    anal = .false.
-  end if
-
-  if (any(simpleset == (/6,7/)).or.env%esort) then  !energy sorting only
-    checkbroken = .false.
-    sortE = .true.
-    sortRMSD = .false.
-    repairord = .false.
-    newfile = .true.
-    if ((env%crestver .eq. crest_solv).and.(.not.env%QCG)) then
-      conffile = .true. !Conffile is needed for confscript in QCG
-    else
-      conffile = .false.
-    end if
-    topocheck = .false.
-    checkez = .false.
-    bonusfiles = .false.
-    anal = .false.
-    saveelow = .false.
-  end if
-
-  if (simpleset == 9) then  !optpurge mode
-    checkbroken = .false.
-    sortE = .false.
-    sortRMSD = .false.
-    sortRMSD2 = .true.
-    repairord = .false.
-    newfile = .false.
-    conffile = .false.
-    topocheck = .false.
-    checkez = .false.
-    bonusfiles = .false.
-    anal = .false.
-  end if
-
-  !> MECP search final sorting
-  if (simpleset == 12) then
-    topocheck = .false.
-    checkez = .false.
-    bonusfiles = .false.
-    anal = .false.
-  end if
-
-  if (simpleset == 13) then  !msreact mode
-    checkbroken = .false.
-    sorte = .true.
-    sortRMSD = .true.
-    sortRMSD2 = .false.
-    repairord = .false.
-    newfile = .true.
-    conffile = .true.
-    topocheck = .false.
-    checkez = .false.
-    bonusfiles = .false.
-    anal = .false.
-
-  end if
-
-  return
-end subroutine cregen_director
-
-!=========================================================================================!
-
-subroutine cregen_filldata1(env,ewin,rthr,ethr,bthr,athr,pthr,T,couthr)
-!*******************************************************
-!* subroutine cregen_filldata1
-!* get important threshold from "opt" and "sys" objects
-!*******************************************************
-  use crest_parameters
-  use crest_data
-  implicit none
-  type(systemdata) :: env  !> MAIN STORAGE OS SYSTEM DATA
-  real(wp),intent(out) :: ewin,rthr,ethr,bthr,athr,pthr,T,couthr
-  !>--------------------------------------------------------------------
-  ewin = env%ewin      !> ensemble energy window in kcal/mol
-  rthr = env%rthr      !> RMSD thr in Ang
-  ethr = env%ethr      !> E threshold in kcal
-  bthr = env%bthr2     !> rot const thr (lower bound)
-  athr = env%athr      !> to det. int. rotation. equal atoms for NMR, CRITICAL!
-  pthr = env%pthr      !> population thr
-  T = env%tboltz       !> Temperature
-  couthr = env%couthr  !> coulomb sorting threshold
-  return
-end subroutine cregen_filldata1
-subroutine cregen_filldata2(simpleset,ewin)
-  use crest_parameters
-  use crest_data
-  implicit none
-  integer,intent(in) :: simpleset
-  real(wp),intent(out) :: ewin
-  if (any(simpleset == (/6,12/))) then
-    ewin = huge(ewin)
-  end if
-  return
-end subroutine cregen_filldata2
-
-!=========================================================================================!
-
-subroutine cregen_groupinfo(nall,ng,group,degen)
-!*************************************************************
-!* subroutine cregen_groupinfo
-!* get info about each conformer group and save it to "degen"
-!*************************************************************
-  use crest_parameters
-  implicit none
-  integer :: nall,ng
-  integer :: group(0:nall)
-  integer :: degen(3,ng)
-  integer :: i,j,k
-  integer :: a,b
-  do i = 1,ng
-    a = 0; b = 0; k = 0
-    do j = 1,nall
-      if (group(j) .eq. i) then
-        k = k+1
-        if (a == 0) a = j
-        b = j
-      end if
-    end do
-    degen(1,i) = k !>-- number of members in group i
-    degen(2,i) = a !>-- first member of group i
-    degen(3,i) = b !>-- last member of group i
-  end do
-  return
-end subroutine cregen_groupinfo
-
-!=========================================================================================!
-!=========================================================================================!
-!>  CREGEN SUBROUTINES
-!=========================================================================================!
-!=========================================================================================!
-
-subroutine discardbroken(ch,env,topocheck,nat,nall,at,xyz,comments,newnall)
-!**************************************************
-!* subroutine discardbroken
-!* analyze an ensemble and track broken structures
-!* to be discarded.
-!**************************************************
-  use crest_parameters
-  use crest_data
-  use strucrd
-  use miscdata,only:rcov
-  implicit none
-  !> INPUT
-  type(systemdata) :: env    ! MAIN STORAGE OS SYSTEM DATA
-  integer,intent(in) :: ch ! printout channel
-  integer,intent(in) :: nat,nall
-  integer,intent(in) :: at(nat)
-  logical,intent(in) :: topocheck
-  !> OUTPUT
-  real(wp),intent(inout) :: xyz(3,nat,nall)
-  character(len=*),intent(inout) :: comments(nall)
-  integer,intent(out) :: newnall
-  !> LOCAL
-  integer :: llan
-  integer,allocatable :: order(:),orderref(:)
-  integer :: nat0
-  real(wp),allocatable :: cref(:,:),c0(:,:),c1(:,:)
-  integer,allocatable  :: at0(:),atdum(:)
-  real(wp),allocatable :: cn(:),bond(:,:)
-  integer :: frag,frag0
-  real(wp) :: erj
-  integer :: j
-  logical :: substruc
-  logical :: distok,distcheck
-  real(wp) :: cnorm
-  logical :: dissoc
-
-  !>--- if we don't wish to include all atoms:
-  substruc = (nat .ne. env%rednat.and.env%subRMSD)
-
-  !>--- read the reference structure
-  allocate (cref(3,nat),atdum(nat))
-  call rdcoord('coord',nat,atdum,cref)
-  !>--- check fragements
-  allocate (bond(nat,nat),cn(nat),source=0.0_wp)
-  call mreclm(frag0,nat,at,cref,atdum,bond,rcov,cn)
-  deallocate (bond,cn)
-
-  write (ch,'('' # fragment in coord            :'',i6)') frag0
-  deallocate (atdum)
-  if (substruc) then
-    nat0 = env%rednat
-    allocate (c0(3,nat0),at0(nat0),c1(3,nat0),atdum(nat0))
-    call maskedxyz(nat,nat0,cref,c0,at,at0,env%includeRMSD)
-  else
-    allocate (c0(3,nat),at0(nat),c1(3,nat),atdum(nat))
-    c0 = cref
-    at0 = at
-    nat0 = nat
-  end if
-  !>--- fragments for actual reference
-  allocate (bond(nat0,nat0),cn(nat0))
-  call mreclm(frag0,nat0,at0,c0,atdum,bond,rcov,cn)
-
-  allocate (order(nall),orderref(nall))
-  !>--- loop over the structures
-  newnall = 0
-  llan = nall
-  do j = 1,nall
-    erj = grepenergy(comments(j)) !> get energy of structure j
-    if (.not.substruc) then
-      c1(:,:) = xyz(:,:,j)/bohr
-    else
-      call maskedxyz(nat,nat0,xyz(:,:,j),c1,at,at0,env%includeRMSD)
-      c1 = c1/bohr
-    end if
-    distok = distcheck(nat0,c1) !> distance check
-    cnorm = sum(abs(c1))        !> clash check
-
-    !>--- further checks: dissociation?
-    dissoc = .false.
-    if (abs(erj) .gt. 1.0d-6.and.cnorm .gt. 1.0d-6 &
-    &   .and.distok.and.topocheck) then
-      dissoc = .false.
-      call mreclm(frag,nat0,at0,c1,atdum,bond,rcov,cn)
-      if (frag .gt. frag0) then
-        dissoc = .true.
-      end if
-    end if
-
-    if (dissoc.or.(cnorm .lt. 1.0d-6).or.(.not.distok)) then
-      !>--- move broken structures to the end of the matrix
-      orderref(j) = llan
-      llan = llan-1
-      !write(ch,*) 'removing structure',j
-    else
-      newnall = newnall+1
-      orderref(j) = newnall
-    end if
-  end do
-
-  !>--- sort the xyz array (only if structures have been discarded)
-  if (newnall .lt. nall) then
-    order = orderref
-    call xyzqsort(nat,nall,xyz,c0,order,1,nall)
-    order = orderref
-    call stringqsort(nall,comments,1,nall,order)
-
-    llan = nall-newnall
-    write (ch,'('' number of removed clashes      :'',i6)') llan
-  end if
-  !>--- otherwise the ensemble is ok
-
-  if (allocated(orderref)) deallocate (orderref)
-  if (allocated(order)) deallocate (order)
-  if (allocated(cn)) deallocate (cn)
-  if (allocated(bond)) deallocate (bond)
-  if (allocated(atdum)) deallocate (atdum)
-  if (allocated(c1)) deallocate (c1)
-  if (allocated(at0)) deallocate (at0)
-  if (allocated(c0)) deallocate (c0)
-  if (allocated(cref)) deallocate (cref)
-  return
-end subroutine discardbroken
-
-!=========================================================================================!
-
-subroutine cregen_topocheck(ch,env,checkez,nat,nall,at,xyz,comments,newnall)
-!*************************************************************
-!* subroutine cregen_topocheck
-!* analyze an ensemble and compare topology (neighbourlist)
-!* to the reference structure
-!*************************************************************
-  use crest_parameters
-  use crest_data
-  use strucrd
-  use miscdata,only:rcov
-  use utilities
-  use crest_cn_module
-  implicit none
-  type(systemdata) :: env    ! MAIN STORAGE OS SYSTEM DATA
-  integer,intent(in) :: ch ! printout channel
-  logical,intent(in) :: checkez
-  integer,intent(in) :: nat,nall
-  integer,intent(in) :: at(nat)
-  real(wp),intent(inout) :: xyz(3,nat,nall)
-  character(len=*),intent(inout) :: comments(nall)
-  integer,intent(out) :: newnall
-  integer :: llan
-  integer,allocatable :: order(:),orderref(:)
-  real(wp),allocatable :: cref(:,:),c1(:,:)
-  integer,allocatable  :: atdum(:)
-  real(wp),allocatable :: cn(:),bond(:,:)
-  integer,allocatable :: toporef(:)
-  integer,allocatable :: topo(:)
-  logical,allocatable :: neighmat(:,:)
-  integer :: nbonds
-  integer :: j,l
-  integer :: ntopo,ncc,ccfail
-  logical :: discard
-  integer,allocatable :: ezat(:,:)
-  real(wp),allocatable :: ezdihedref(:)
-  real(wp),allocatable :: ezdihed(:)
-  real(wp) :: winkeldiff
-
-  !>--- read the reference structure
-  allocate (cref(3,nat),atdum(nat))
-  call rdcoord('coord',nat,atdum,cref)
-
-  !>--- get the reference topology matrix (bonds)
-  ntopo = nat*(nat+1)/2
-  allocate (toporef(ntopo),topo(ntopo))
-  allocate (neighmat(nat,nat),source=.false.)
-  allocate (bond(nat,nat),cn(nat),source=0.0_wp)
-  cn = 0.0d0
-  bond = 0.0d0
-  call calc_ncoord(nat,atdum,cref,rcov,cn,400.0_wp,bond)
-
-  if (allocated(env%excludeTOPO)) then
-    call bondtotopo_excl(nat,at,bond,cn,ntopo,toporef,neighmat,env%excludeTOPO)
-  else
-    call bondtotopo(nat,at,bond,cn,ntopo,toporef,neighmat)
-  end if
-
-  nbonds = sum(toporef)
-  write (ch,'('' # bonds in reference structure :'',i6)') nbonds
-  !>--- if required, check for C=C bonds (based only on structure!)
-  if (checkez) then
-    cref = cref*bohr
-    call nezcc(nat,atdum,cref,cn,ntopo,toporef,ncc)
-    if (ncc > 0) then
-      write (ch,'(''   => # of C=C bonds :'',i6)') ncc
-      allocate (ezat(4,ncc))
-      allocate (ezdihedref(ncc),ezdihed(ncc),source=0.0d0)
-      call ezccat(nat,atdum,cref,cn,ntopo,toporef,ncc,ezat)
-      call ezccdihed(nat,cref,ncc,ezat,ezdihedref)
-      !do i=1,ncc
-      !  write(*,'(1x,a,4i4,a,f6.2)') 'C=C bond atoms:',ezat(1:4,i)," angle: ",ezdihedref(i)
-      !enddo
-    end if
-  end if
-
-  allocate (order(nall),orderref(nall))
-  allocate (c1(3,nat))
-  !>--- loop over the structures
-  ccfail = 0
-  newnall = 0
-  llan = nall
-  do j = 1,nall
-    c1(1:3,1:nat) = xyz(1:3,1:nat,j)/bohr
-    !>--- generate topo and compare
-    discard = .false.
-    cn = 0.0d0
-    bond = 0.0d0
-    call calc_ncoord(nat,at,c1,rcov,cn,400.0_wp,bond)
-    if (allocated(env%excludeTOPO)) then
-      call bondtotopo_excl(nat,at,bond,cn,ntopo,topo,neighmat,env%excludeTOPO)
-    else
-      call bondtotopo(nat,at,bond,cn,ntopo,topo,neighmat)
-    end if
-    do l = 1,ntopo
-      if (toporef(l) .ne. topo(l)) then
-        discard = .true.   !> if there is any mismatch in neighbor lists
-        exit
-      end if
-    end do
-    !>--- get E/Z info of C=C, discard isomers
-    if (checkez.and..not.discard.and.ncc > 0) then
-      c1 = c1*bohr
-      call ezccdihed(nat,c1,ncc,ezat,ezdihed)
-      do l = 1,ncc
-        winkeldiff = ezdihedref(l)-ezdihed(l)
-        winkeldiff = abs(winkeldiff)
-        if (winkeldiff > 90.0_wp) then
-          discard = .true.
-          ccfail = ccfail+1
-          exit
-        end if
-      end do
-    end if
-
-    if (discard) then
-      !>-- move broken structures to the end of the matrix
-      orderref(j) = llan
-      llan = llan-1
-    else
-      newnall = newnall+1
-      orderref(j) = newnall
-    end if
-  end do
-
-  !>--- sort the xyz array (only if structures have been discarded)
-  if (newnall .lt. nall) then
-    order = orderref
-    call xyzqsort(nat,nall,xyz,c1,order,1,nall)
-    order = orderref
-    call stringqsort(nall,comments,1,nall,order)
-
-    llan = nall-newnall
-    write (ch,'('' number of topology mismatches  :'',i6)') llan
-    !>--- report the removals during a run
-    if (ch .ne. stdout) then
-      write (stdout,'("CREGEN> number of topology-based structure removals: ",i0)') llan
-    end if
-    if (checkez.and.ccfail > 0) then
-      write (ch,'(''  => discared due to E/Z isom.  :'',i6)') ccfail
-    end if
-  end if
-  !>--- otherwise the ensemble is ok
-
-  deallocate (c1)
-  deallocate (orderref,order)
-  if (allocated(ezdihedref)) deallocate (ezdihedref)
-  if (allocated(ezdihed)) deallocate (ezdihed)
-  if (allocated(ezat)) deallocate (ezat)
-  deallocate (cn,bond)
-  deallocate (neighmat)
-  deallocate (topo,toporef)
-  deallocate (atdum)
-  deallocate (cref)
-  return
-
-contains
-  subroutine nezcc(nat,at,xyz,cn,ntopo,topo,ncc)
-    !***************************************************
-    !* Check how many (potential) C=C bonds are present
-    !***************************************************
-    use crest_parameters
-    integer,intent(in)  :: nat
-    integer,intent(in)  :: at(nat)
-    real(wp),intent(in) :: xyz(3,nat)
-    real(wp),intent(in) :: cn(nat)
-    integer,intent(in)  :: ntopo
-    integer,intent(in)  :: topo(ntopo)
-    integer,intent(out) :: ncc
-    real(wp) :: dist
-    integer :: l
-    integer :: ci,cj
-    real(wp),parameter :: distcc = 1.384_wp
-    ncc = 0
-    do ci = 1,nat
-      do cj = 1,ci-1
-        if (ci == cj) cycle
-        l = lin(ci,cj)
-        if (topo(l) == 0) cycle
-        if (at(ci) == 6.and.at(cj) == 6.and. &
-        &  nint(cn(ci)) == 3.and.nint(cn(cj)) == 3) then
-          dist = (xyz(1,ci)-xyz(1,cj))**2+ &
-          &    (xyz(2,ci)-xyz(2,cj))**2+ &
-          &    (xyz(3,ci)-xyz(3,cj))**2
-          dist = sqrt(dist)
-          if (dist < distcc) then
-            ncc = ncc+1
-          end if
-        end if
-      end do
-    end do
-    return
-  end subroutine nezcc
-  subroutine ezccat(nat,at,xyz,cn,ntopo,topo,ncc,ezat)
-    !********************************************************
-    !* Check which atoms can be used for C=C dihedral angles
-    !********************************************************
-    use crest_parameters
-    integer,intent(in)  :: nat
-    integer,intent(in)  :: at(nat)
-    real(wp),intent(in) :: xyz(3,nat)
-    real(wp),intent(in) :: cn(nat)
-    integer,intent(in)  :: ntopo
-    integer,intent(in)  :: topo(ntopo)
-    integer,intent(in)  :: ncc
-    integer,intent(out) :: ezat(4,ncc)
-    real(wp) :: dist
-    integer :: i,j,k,l
-    integer :: ci,cj
-    real(wp),parameter :: distcc = 1.384_wp
-    if (ncc < 1) return
-    k = 0
-    do ci = 1,nat
-      do cj = 1,ci-1
-        if (ci == cj) cycle
-        l = lin(ci,cj)
-        if (topo(l) == 0) cycle
-        if (at(ci) == 6.and.at(cj) == 6.and. &
-        &  nint(cn(ci)) == 3.and.nint(cn(cj)) == 3) then
-          dist = (xyz(1,ci)-xyz(1,cj))**2+ &
-          &    (xyz(2,ci)-xyz(2,cj))**2+ &
-          &    (xyz(3,ci)-xyz(3,cj))**2
-          dist = sqrt(dist)
-          if (dist < distcc) then
-            k = k+1
-            ezat(2,k) = ci
-            ezat(3,k) = cj
-            !>-- get a neighbour for ci
-            do i = 1,nat
-              if (i == cj.or.i == ci) cycle
-              l = lin(ci,i)
-              if (topo(l) == 1) then
-                ezat(1,k) = i
-                exit
-              end if
-            end do
-            !>-- get a neighbour for cj
-            do j = 1,nat
-              if (j == cj.or.j == ci) cycle
-              l = lin(cj,j)
-              if (topo(l) == 1) then
-                ezat(4,k) = j
-                exit
-              end if
-            end do
-          end if
-        end if
-      end do
-    end do
-    return
-  end subroutine ezccat
-  subroutine ezccdihed(nat,xyz,ncc,ezat,ezdihed)
-    !********************************************************
-    !* Check which atoms can be used for C=C dihedral angles
-    !********************************************************
-    use crest_parameters
-    integer,intent(in)  :: nat
-    real(wp),intent(in) :: xyz(3,nat)
-    integer,intent(in)  :: ncc
-    integer,intent(in) :: ezat(4,ncc)
-    real(wp),intent(out) :: ezdihed(ncc)
-    integer :: i,k
-    integer :: a,b,c,d
-    real(wp) :: winkel
-    if (ncc < 1) return
-    k = 0
-    do i = 1,ncc
-      a = ezat(1,i)
-      b = ezat(2,i)
-      c = ezat(3,i)
-      d = ezat(4,i)
-      call DIHED(xyz,a,b,c,d,winkel) !>-- from intmodes.f
-      winkel = abs(winkel*(180.0_wp/pi))
-      if (winkel > 180.0_wp) then
-        winkel = 360.0_wp-winkel
-      end if
-      ezdihed(i) = winkel
-    end do
-    return
-  end subroutine ezccdihed
-end subroutine cregen_topocheck
-
-!=========================================================================================!
-
-subroutine cregen_esort(ch,nat,nall,xyz,comments,nallout,ewin)
-!**************************************************************
-!* subroutine cregen_esort
-!* sort the ensemble by energy and determine the new
-!* ensemble size within the energy threshold.
-!* On Input: ch - printout channel
-!*           nat - number of atoms
-!*           nall - number of structure in ensemble
-!*           xyz  - Cartesian coordinates
-!*           comments - commentary lines containing the energy
-!*           ewin - energy window in kcal/mol
-!* On Output: nallout - number of strucutres after cutoff
-!**************************************************************
-  use crest_parameters
-  use strucrd
-  implicit none
-  integer,intent(in) :: ch
-  integer,intent(in) :: nat
-  integer,intent(in) :: nall
-  real(wp),intent(inout) :: xyz(3,nat,nall)
-  character(len=*) :: comments(nall)
-  integer :: nallout
-  real(wp),intent(in) :: ewin
-
-  real(wp),allocatable :: energies(:)
-  integer,allocatable :: orderref(:)
-  integer,allocatable :: order(:)
-  real(wp),allocatable :: c0(:,:)
-  integer :: i
-  real(wp) :: de,emax
-
-  allocate (energies(nall))
-  allocate (orderref(nall),order(nall))
-  do i = 1,nall
-    energies(i) = grepenergy(comments(i))
-    orderref(i) = i
-    order(i) = i
-  end do
-  !>-- sort the energies and obtain the order
-  call qsort(energies,1,nall,orderref)
-  !>-- after the sorting orderref contains information:
-  !>   before the sorting element "i" WAS at position "orderref(i)"
-  !>   but to use it as a mask, we need to invert it,
-  !>   so that it is: element "i" IS NOW at position "orderref(i)"
-  call maskinvert(nall,orderref)
-
-  !>-- sort structures and comments based on the order
-  order = orderref
-  allocate (c0(3,nat))
-  call xyzqsort(nat,nall,xyz,c0,order,1,nall)
-  deallocate (c0)
-  order = orderref
-
-  call stringqsort(nall,comments,1,nall,order)
-
-  !>-- determine cut-off of energies
-  if (ewin < 9999.9_wp) then
-    write (ch,'('' sorting energy window (EWIN)   :'',1x,f9.4,a)') ewin,' / kcal*mol⁻¹'
-  else
-    write (ch,'('' sorting energy window (EWIN)   :'',3x,a,a)') '+∞',' / kcal*mol⁻¹'
-  end if
-  emax = maxval(energies(:),1)
-  de = (emax-energies(1))*autokcal
-  if (de .gt. ewin) then
-    nallout = 1 !> lowest is always taken
-    do i = 2,nall
-      de = (energies(i)-energies(1))*autokcal
-      if (de .lt. ewin) then
-        nallout = nallout+1
-      else
-        exit
-      end if
-    end do
-    write (ch,'('' number of removed by energy    :'',3x,i0)') (nall-nallout)
-    write (ch,'('' number of remaining points     :'',3x,i0)') nallout
-  else
-    nallout = nall
-  end if
-  write (ch,*) 'reference state Etot           :',energies(1)
-
-  deallocate (order,orderref)
-  deallocate (energies)
-  return
-end subroutine cregen_esort
-
-!=========================================================================================!
-
-subroutine cregen_CRE(ch,env,nat,nall,at,xyz,comments,nallout,group,nosort)
-!*************************************************************
-!* subroutine cregen_CRE
-!* sort the ensemble based on rotational constants,RMSD and
-!* energy to determine rotamers and duplicates.
-!* On Input: ch - printout channel
-!*           nat - number of atoms
-!*           nall - number of structure in ensemble
-!*           at   - atom types
-!*           xyz  - Cartesian coordinates
-!*           comments - commentary lines containing the energy
-!*           nosort - don't actually sort
-!* On Output: nallout - new total number of structures
-!*            group   - to which group every structure belongs
-!**************************************************************
-  use crest_parameters,id => dp
-  use crest_data
-  use strucrd
-  use ls_rmsd
-  use axis_module
-  use utilities
-  implicit none
-  type(systemdata) :: env
-  integer,intent(in) :: ch
-  integer,intent(in) :: nat
-  integer,intent(in) :: nall
-  integer,intent(in) :: at(nat)
-  real(wp),intent(inout) :: xyz(3,nat,nall)
-  integer,intent(inout) :: group(0:nall)
-  logical,intent(in) :: nosort
-  character(len=*) :: comments(nall)
-  integer :: nallout
-  logical :: enantio = .true.   !check for enantiomers?
-
-  !>--- float data
-  real(wp) :: ewin,rthr,bthr,pthr,ethr,athr,T
-  !>--- energy data
-  real(wp),allocatable :: er(:)
-  integer,allocatable :: orderref(:),order(:)
-  real(wp) :: de
-  !>--- dummy structure data
-  integer,allocatable :: includeRMSD(:)
-  real(wp),allocatable :: c0(:,:),c1(:,:),cdum(:,:)
-  real(wp),allocatable :: c0h(:,:),c1h(:,:)
-  integer,allocatable  :: maskheavy(:)
-  integer,allocatable :: at0(:)
-  logical :: substruc
-  integer :: nat0
-  real(wp),allocatable :: rot(:,:)
-  real(wp) :: rotdum(3),bdum
-  !>--- RMSD data
-  real(sp),allocatable :: rmat(:) !SINGLE PRECISION
-  real(wp) :: rdum,dr,rdum2
-  real(wp),allocatable :: gdum(:,:),Udum(:,:),xdum(:),ydum(:) !dummy tensors
-  integer(id) :: klong
-  integer(id),allocatable :: rmap1(:)
-  integer,allocatable :: rmap2(:)
-  logical :: l1,l2,l3
-  !>--- CRE comparison data
-  integer,allocatable :: double(:)
-  logical :: equalrotaniso !> this is a function
-  logical,allocatable :: mask(:)
-  real(wp) :: couthr
-  real(wp),allocatable :: enuc(:)
-  real(wp),allocatable :: ecoul(:)
-  real(wp) :: r
-  integer :: i,j,k,l,natnoh
-  logical :: heavy
-
-!>--- set parameters
-  call cregen_filldata1(env,ewin,rthr,ethr,bthr,athr,pthr,T,couthr)
-  if (env%entropic) enantio = .false.
-  heavy = env%heavyrmsd
-  substruc = (nat .ne. env%rednat.and.env%subRMSD)
-  if (substruc) then
-    nat0 = env%rednat
-    includeRMSD = env%includeRMSD
-  end if
-  allocate (rot(3,nall))
-
-!>--- get energies from the comment line
-  allocate (er(nall))
-  allocate (orderref(nall),order(nall))
-  do i = 1,nall
-    er(i) = grepenergy(comments(i))
-    orderref(i) = i
-  end do
-
-!>--- get dummy structure memory space
-  if (substruc) then
-    allocate (c0(3,nat0),c1(3,nat0),at0(nat0))
-  else
-    allocate (c0(3,nat),c1(3,nat),at0(nat))
-    at0 = at
-    nat0 = nat
-  end if
-
-!>--- transform the coordinates to CMA and get rot.constants
-  do i = 1,nall
-    call axis(nat,at,xyz(:,:,i)) !>-- all coordinates to CMA
-    if (substruc) then
-      call maskedxyz(nat,nat0,xyz(:,:,i),c1,at,at0,includeRMSD)
-    else
-      c1(:,:) = xyz(:,:,i)
-    end if
-    call axis(nat0,at0,c1,rot(1:3,i),bdum)  !>-- B0 in MHz
-  end do
-
-!>--- RMSD part
-  allocate (double(nall),source=0)
-  !========================================================!
-  !>-- crucial point: rmat is huge. VERY huge, potentially.
-  !>-- for large ensembles the size of rmat can be strongly reduced
-  !>   but this requires additional tracking and counting.
-  !>   It will pay off, however.
-  allocate (rmap1(nall),rmap2(nall))
-  klong = 0
-  do i = 1,nall
-    rmap1(i) = klong
-    l1 = .true.
-    do j = 1,i-1
-      !> ekcal(j) should always be smaller than ekcal(i) because i>j
-      de = (er(i)-er(j))*autokcal
-      if (de .lt. ethr) then !>-- we only need RMSDs for structures close in energy
-        klong = klong+1
-        if (l1) then
-          rmap2(i) = j
-          l1 = .false.
-        end if
-      end if
-    end do
-  end do
-
-  !>-- now klong is the size of rmat with only the minimum required RMSDs
-  !>   rmat itself can be single precision.
-  allocate (rmat(klong),source=0.0_sp)
-  allocate (gdum(3,3),Udum(3,3),xdum(3),ydum(3))
-  !>-- begin calculation of RMSDs
-  klong = 0
-  write (stdout,'(a)',advance='no') 'CREGEN> running RMSDs ...'
-  flush (stdout)
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
-  if (.not.substruc) then !regular case, all atoms included in RMSD
-    if (.not.heavy) then    !really, the regular case
-      do i = 1,nall
-        c0(1:3,1:nat) = xyz(1:3,1:nat,i)
-!$OMP PARALLEL PRIVATE ( j,klong,c1,xdum,ydum,Udum,gdum,rdum,rdum2,de) &
-!$OMP SHARED ( i,c0,rmat,nat,xyz,rmap1,rmap2,er,ethr,enantio)
-!$OMP DO
-        do j = 1,i-1
-          de = (er(i)-er(j))*autokcal
-          if (de .lt. ethr) then
-            c1(1:3,1:nat) = xyz(1:3,1:nat,j)
-            call rmsd(nat,c0,c1,0,Udum,xdum,ydum,rdum,.false.,gdum) ! all atoms
-            if (enantio) then  !also check for enantiomer by inverting a coordinate
-              c1(1,:) = -c1(1,:)
-              call rmsd(nat,c0,c1,0,Udum,xdum,ydum,rdum2,.false.,gdum) ! all atoms
-            else
-              rdum2 = rdum
-            end if
-            klong = linr(rmap1(i),rmap2(i),j)
-            rmat(klong) = real(min(rdum,rdum2),sp)
-          end if
-        end do
-!$OMP END DO
-!$OMP END PARALLEL
-      end do
-    else  !> heavy atom case
-      natnoh = nat-counth(nat,at)
-      allocate (c0h(3,natnoh),c1h(3,natnoh),source=0.0_wp)
-      allocate (maskheavy(nat),source=0)
-      call heavymask(nat,at,maskheavy)
-      write (*,*) 'doing heavy atom rmsds with ',natnoh,' atoms'
-      do i = 1,nall
-        call maskedxyz2(nat,natnoh,xyz(:,:,i),c0h,maskheavy)
-!$OMP PARALLEL PRIVATE ( j,klong,c1h,xdum,ydum,Udum,gdum,rdum,rdum2,de) &
-!$OMP SHARED ( i,c0h,rmat,nat,xyz,rmap1,rmap2,er,ethr,enantio,maskheavy)
-!$OMP DO
-        do j = 1,i-1
-          de = (er(i)-er(j))*autokcal
-          if (de .lt. ethr) then
-            call maskedxyz2(nat,natnoh,xyz(:,:,j),c1h,maskheavy)
-            call rmsd(natnoh,c0h,c1h,0,Udum,xdum,ydum,rdum,.false.,gdum) ! all atoms
-            if (enantio) then  !also check for enantiomer by inverting a coordinate
-              c1h(1,:) = -c1h(1,:)
-              call rmsd(natnoh,c0h,c1h,0,Udum,xdum,ydum,rdum2,.false.,gdum) ! all atoms
-            else
-              rdum2 = rdum
-            end if
-            klong = linr(rmap1(i),rmap2(i),j)
-            rmat(klong) = real(min(rdum,rdum2),sp)
-          end if
-        end do
-!$OMP END DO
-!$OMP END PARALLEL
-      end do
-      deallocate (maskheavy,c1h,c0h)
-    end if
-    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
-  else !substruc == .true., RMSDs only on a part of the structure
-    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
-    do i = 1,nall
-      call maskedxyz2(nat,nat0,xyz(:,:,i),c0,includeRMSD)
-!$OMP PARALLEL PRIVATE ( j,klong,c1,xdum,ydum,Udum,gdum,rdum,rdum2,de) &
-!$OMP SHARED ( i,c0,rmat,nat,nat0,xyz,rmap1,rmap2,er,ethr,includeRMSD,enantio )
-!$OMP DO
-      do j = 1,i-1
-        de = (er(i)-er(j))*autokcal
-        if (de .lt. ethr) then
-          call maskedxyz2(nat,nat0,xyz(:,:,j),c1,includeRMSD)
-          call rmsd(nat0,c0,c1,0,Udum,xdum,ydum,rdum,.false.,gdum) ! all atoms
-          if (enantio) then  !also check for enantiomer by inverting a coordinate
-            c1(1,:) = -c1(1,:)
-            call rmsd(nat0,c0,c1,0,Udum,xdum,ydum,rdum2,.false.,gdum) ! all atoms
-          else
-            rdum2 = rdum
-          end if
-          klong = linr(rmap1(i),rmap2(i),j)
-          rmat(klong) = real(min(rdum,rdum2),sp)
-        end if
-      end do
-!$OMP END DO
-!$OMP END PARALLEL
-    end do
-  end if
-  write (stdout,'(1x,a)') 'done.'
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
-!>-- Now, with the RMSDs and rotational constants we can kick out duplicates
-  do i = 1,nall
-    do j = 1,i-1
-      !>-- only check for structures in energy range
-      de = (er(i)-er(j))*autokcal
-      if (de .lt. ethr) then
-        klong = linr(rmap1(i),rmap2(i),j)
-        dr = rmat(klong)
-      else
-        cycle
-      end if
-      !>-- very small RMSD --> same structure
-      if (dr .lt. rthr) then
-        double(i) = j !>-- "i" is the same structure as "j"
-        !>-- slightly larger RMSD, but same rot. constants --> same structure
-      elseif (dr .lt. 2.0_wp*rthr) then
-        l1 = equalrotaniso(i,j,nall,rot,0.5d0*bthr,env%bthrmax,env%bthrshift)
-        if (l1) then
-          double(i) = j  !>-- "i" is the same structure as "j"
-        end if
-      end if
-    end do
-    !>-- find the original reference. k is a dummy variable
-    call backtrack(double,i,k)
-  end do
-  deallocate (c0,c1,at0)
-  deallocate (ydum,xdum,Udum,gdum)
-  deallocate (rmat,rmap2,rmap1)
-
-  !>-- for ENSO write a file with duplicate info (if required)
-  call enso_duplicates(env,nall,double)
-
-!>-- count how many duplicates we have found
-  allocate (mask(nall))
-  mask(:) = double(:) .ne. 0
-  k = count(mask,1)
-  nallout = nall-k
-  deallocate (mask)
-  write (ch,*) 'number of doubles removed by rot/RMSD         :',k
-  if (.not.nosort) then
-    write (ch,*) 'total number unique points considered further :',nallout
-  else
-    nallout = nall
-  end if
-!>-- sort structures, energies, rot const. and comments
-  if (.not.nosort) then
-    j = 0
-    l = nall+1
-    do i = 1,nall
-      if (double(i) .eq. 0) then
-        j = j+1
-        orderref(i) = j
-      else
-        l = l-1
-        orderref(i) = l
-      end if
-    end do
-    order = orderref
-    allocate (cdum(3,nat))
-    call xyzqsort(nat,nall,xyz,cdum,order,1,nall)
-    deallocate (cdum)
-    order = orderref
-    call maskqsort(er,1,nall,order)
-    order = orderref
-    call stringqsort(nall,comments,1,nall,order)
-    order = orderref
-    call matqsort(3,nall,rot,rotdum,1,nall,order)
-  end if
-
-!>-- finally, determine conformer groups and their rotamers
-  allocate (c1(3,nat))
-  allocate (enuc(nallout))
-  do k = 1,nallout
-    c1(1:3,1:nat) = xyz(1:3,1:nat,k)
-    enuc(k) = 0.0_wp
-    do i = 1,nat-1
-      do j = i+1,nat
-        r = (c1(1,i)-c1(1,j))**2 &
-    &    +(c1(2,i)-c1(2,j))**2 &
-    &    +(c1(3,i)-c1(3,j))**2+1.d-12
-        enuc(k) = enuc(k)+at(i)*at(j)/r
-      end do
-    end do
-  end do
-!>-- check energy, rot. const. and nuclear permutation
-  double = 0 !>-- re-use "double"
-  SORTI: do i = 1,nallout
-    SORTJ: do j = 1,i-1
-      !>-- energy difference
-      de = (er(i)-er(j))*autokcal
-      l3 = double(j) .eq. 0
-      if (.not.l3) cycle
-      if (abs(de) .lt. ethr) then
-        !>-- rotational constant difference
-        l1 = equalrotaniso(i,j,nall,rot,bthr,env%bthrmax,env%bthrshift)
-        !>-- nuclear permutation
-        l2 = 2.0d0*abs(enuc(i)-enuc(j))/(enuc(i)+enuc(j)) .lt. 1.d-3
-        if (l1.and.l2.and.l3) then
-          double(i) = j   !>-- "i" is a rotamer of "j"
-          call backtrack(double,i,k)
-          cycle SORTI
-        end if
-      end if
-    end do SORTJ
-  end do SORTI
-!>-- assign conformer groups
-  k = 0
-  group = 0
-  do i = 1,nallout
-    if (double(i) .eq. 0) then
-      k = k+1
-      group(i) = k
-    else
-      j = double(i)
-      group(i) = group(j)
-    end if
-  end do
-  group(0) = k !>-- total number of groups
-  if (nosort) then
-    write (ch,'(1x,a,i10)') 'number of removed rotamers           :', (nallout-k)
-    nallout = k
-    write (ch,'(1x,a,i10)') 'total number unique points remaining :',nallout
-  end if
-
-  deallocate (enuc,c1,double)
-  deallocate (order,orderref)
-  if (allocated(ecoul)) deallocate (ecoul)
-  deallocate (er)
-  deallocate (rot)
-  return
-contains
-  function counth(nat,at) result(nh)
-    implicit none
-    integer :: nat
-    integer :: at(nat)
-    integer :: nh,i
-    nh = 0
-    do i = 1,nat
-      if (at(i) == 1) nh = nh+1
-    end do
-    return
-  end function counth
-  subroutine heavymask(nat,at,mask)
-    implicit none
-    integer :: nat
-    integer :: at(nat)
-    integer :: mask(nat)
-    integer :: i
-    mask = 0
-    do i = 1,nat
-      if (at(i) .ne. 1) mask(i) = 1
-    end do
-    return
-  end subroutine heavymask
-end subroutine cregen_CRE
-
-!=========================================================================================!
-
-subroutine cregen_EQUAL(ch,nat,nall,at,xyz,group,athr,rotfil)
-!****************************************************************
-!* subroutine cregen_EQUAL
-!* subroutine for the generation of nuclear equivalencies
-!* On Input: ch - printout channel
-!*           nat - number of atoms
-!*           nall - number of structure in ensemble
-!*           at   - atom types
-!*           xyz  - Cartesian coordinates
-!*           group - to which group does every strucutre belong
-!*           athr  - threshold for equivalency comparison
-!*           rotfil - wirte anmr_rotamer file?
-!* On Output: resorted xyz and comments
-!****************************************************************
-  use crest_parameters,id => dp
-  use crest_data
-  use strucrd
-  use miscdata,only:rcov
-  use crest_cn_module
-  use utilities
-  implicit none
-  integer,intent(in) :: ch
-  integer,intent(in) :: nat
-  integer,intent(in) :: nall
-  integer,intent(in) :: at(nat)
-  real(wp),intent(inout) :: xyz(3,nat,nall)
-  integer,intent(inout) :: group(0:nall)
-  real(wp),intent(in) :: athr
-  logical,intent(in) :: rotfil
-  real(wp),allocatable :: cdum(:,:)
-  integer :: ng,n
-  integer :: i,j,k,l
-  logical :: ex
-
-  !>--- arrays and variable for the analysis
-  integer :: gmax
-  integer,allocatable :: glist(:,:)
-  integer :: current
-  real(wp) :: dum
-  real(wp) :: shortest_distance
-  integer,allocatable  :: equiv(:,:,:)
-  integer,allocatable  :: pair(:),pre(:),nb(:,:)
-  logical,allocatable  :: vis(:)
-  real(wp),allocatable :: metric(:,:)
-  real(wp),allocatable :: dist(:,:,:)
-  integer,allocatable  :: relat(:,:)
-  real(wp),allocatable :: tmp2(:)
-  integer :: m,m1,m2,s1,s2,iat,j1,k2
-
-  !>-- further NMR-mode related data
-  integer,allocatable :: nmract(:)
-  integer,allocatable :: elist(:,:),flist(:,:)
-  integer,allocatable :: jnd(:)
-  real(wp),allocatable :: sd(:,:),jfake(:),cn(:)
-
-  character(len=:),allocatable :: atmp
-  integer :: ig,ir,irr,nr
-
-!>--- variable declarations
-  n = nat       !> other variable name for number of atoms
-  ng = group(0) !> number of different groups (conformers)
-  gmax = 0      !> max number of
-  do i = 1,ng
-    k = 0
-    do j = 1,nall
-      if (group(j) == i) k = k+1
-    end do
-    if (k .gt. gmax) gmax = k
-  end do
-  allocate (glist(0:gmax,ng),source=0)
-  do i = 1,ng
-    k = 0
-    do j = 1,nall
-      if (group(j) == i) then
-        k = k+1
-        glist(k,i) = j !> the k-th member of group i is structure j
-      end if
-    end do
-    glist(0,i) = k !> number of members in group i
-  end do
-
-!>---distance neighbor list
-  allocate (cdum(3,nat))
-
-!>--- set up the "pair" array --> how many bonds are between two nuclei?
-  allocate (pair(n*(n+1)/2),metric(n,n),vis(n),pre(n),nb(200,n))
-  cdum(1:3,1:n) = xyz(1:3,1:n,1)/bohr
-  call neighdist(n,at,cdum,nb,metric)
-  k = 0
-  pair = 0
-  do i = 1,n-1
-    do j = i+1,n
-!>---the shortest bond path
-      current = j
-      dum = shortest_distance(n,i,j,nb,metric,vis,pre)
-      k = 0
-      do while (pre(current) /= 0)
-        current = pre(current)
-        k = k+1
-      end do !> End loop: while precessor(current) /= 0
-      pair(lin(j,i)) = k  !> # of bonds between i and j
-    end do
-  end do
-  deallocate (nb,pre,vis,metric)
-
-  allocate (tmp2(n),relat(0:n,n))
-  allocate (equiv(0:n,n,0:nall),dist(n,n,nall))
-  equiv = 0
-!>-- (costly) symmetry analyis of all rotamers for NMR. this is complicated stuff also
-!>   and the end of the program where this is completed...
-  do i = 1,nall
-    call distance(n,xyz(:,:,i),dist(:,:,i)) !> distance matrix
-    do j = 1,n
-      do k = 1,n
-        tmp2(k) = dist(k,j,i)*dble(at(k))  !> the distance of j to all atoms * Z to distinguish
-      end do
-      call qqsort(tmp2,1,n)
-      dist(1:n,j,i) = tmp2(1:n)
-    end do
-  end do
-  write (ch,*) 'compare nuclear equivalencies ...'
-  do i = 1,ng
-    m = glist(0,i)
-    if (m .lt. 2) cycle  !> det equivalent atoms in each group
-    relat = 0
-    do m1 = 1,m
-!$OMP PARALLEL PRIVATE ( m2, s1, s2 ) SHARED ( relat )
-!$OMP DO
-      do m2 = 1,m1-1        !> compare all members
-        s1 = glist(m1,i)    !> struc 1
-        s2 = glist(m2,i)    !> struc 2
-        call compare(n,nall,s1,s2,dist,athr,relat) !> athr is distance vector equivalence threshold
-      end do
-!$OMP END DO
-!$OMP END PARALLEL
-    end do
-    equiv(0:n,1:n,i) = relat(0:n,1:n)
-  end do
-  deallocate (dist)
-!>-- symmetrize result i.e. if iat is in list of jat, jat must be in list of iat
-!>   done again at the end of this part
-  do i = 1,ng
-    do j1 = 1,n
-      m1 = equiv(0,j1,i)
-      do k = 1,m1
-        iat = equiv(k,j1,i)
-!>-- is atom j1 in the list of atom iat?
-        ex = .false.
-        m2 = equiv(0,iat,i)
-        do k2 = 1,m2
-          if (j1 .eq. equiv(k2,iat,i)) ex = .true.
-        end do
-        if (.not.ex) then
-          equiv(0,iat,i) = equiv(0,iat,i)+1
-          equiv(equiv(0,iat,i),iat,i) = j1
-        end if
-      end do
-    end do
-  end do
-
-!>-- inlcude equivalence info from the other conformers as well i.e.
-!>   assume that all conformers have the same chemical equivalencies
-!>   the result is put into equiv(:,:,0)
-  equiv(0:n,1:n,0) = equiv(0:n,1:n,1)
-  ILOOP: do i = 2,ng
-    JLOOP: do j = 1,n
-      m2 = equiv(0,j,0)      !> end of list of lowest
-      MLOOP: do m = 1,equiv(0,j,i)  !> list of higher
-        k = equiv(m,j,i)    !> in the one in the higher list
-        M1LOOP: do m1 = 1,m2
-          if (equiv(m1,j,0) .eq. k) then !> already there?
-            cycle MLOOP
-          end if
-        end do M1LOOP
-        equiv(0,j,0) = equiv(0,j,0)+1 !> append
-        equiv(equiv(0,j,0),j,0) = k
-      end do MLOOP
-    end do JLOOP
-  end do ILOOP
-
-!>--- NMR part and writeout
-!> get NMR-active nuclei
-  allocate (nmract(86))
-  call cregen_nmract(ch,nmract)
-
-  allocate (elist(n,n),flist(n,n))
-  ig = 0
-  atmp = 'anmr_nucinfo'
-  open (unit=3,file=atmp)
-  write (ch,'(''::::::::::: conformer group all :::::::::::'')')
-  write (3,*) n
-!cccccccccccccccccc
-!> chem eq. first
-!cccccccccccccccccc
-  elist = 0
-  do i = 1,n
-    m = equiv(0,i,ig)
-    do k = 1,m
-      l = equiv(k,i,ig)
-      elist(l,i) = 1
-    end do
-    elist(i,i) = 1
-  end do
-  do i = 1,n
-    do j = 1,equiv(0,i,ig)
-      k = equiv(j,i,ig)
-      elist(1:n,k) = elist(1:n,k)+elist(1:n,i)
-    end do
-  end do
-!>---  prepare write out
-  do i = 1,n
-    k = 1
-    equiv(1,i,ig) = i
-    elist(i,i) = 0
-    do j = 1,n
-      if (elist(j,i) .ne. 0) then
-        k = k+1
-        equiv(k,i,ig) = j
-      end if
-    end do
-    equiv(0,i,ig) = k
-  end do
-  write (ch,*) 'chemical equivalencies (mag.active nuclei):'
-
-  allocate (jnd(n))
-  jnd = 1
-  do j = 1,n
-    m = equiv(0,j,ig)
-    write (3,'(3x,i0,3x,i0)') j,m
-    do l = 1,m
-      if (l .ne. m) then
-        write (3,'(1x,i0)',advance='no') equiv(l,j,ig)  ! include the atom ie if there are no equiv.
-      else
-        write (3,'(1x,i0)',advance='yes') equiv(l,j,ig)
-      end if
-    end do
-    if (nmract(at(j)) .eq. 0) cycle
-    if (m .gt. 1.and.jnd(j) .eq. 1) then  ! just print
-      write (ch,'(''reference atom'',i4,'' # :'',i2)') equiv(1,j,ig),m
-      do k = 1,m
-        jnd(equiv(k,j,ig)) = 0
-      end do
-    end if
-  end do
-!cccccccccccccccccc
-!> mag eq.
-!cccccccccccccccccc
-!> make a check list of atoms for the mag. eq.
-  elist = 0
-  flist = 1
-  do i = 1,n
-    m = equiv(0,i,ig) !> the following lines fill the equiv list
-    do k = 1,m
-      l = equiv(k,i,ig)
-      elist(l,i) = 1
-    end do
-    elist(i,i) = 1
-  end do
-  flist = elist
-
-  do i = 1,n
-    m = equiv(0,i,ig)
-    do k = 1,m
-      l = equiv(k,i,ig)
-      if (l .eq. i) cycle
-      do j = 1,n
-        if (flist(j,i) .eq. 1.or.nmract(at(j)) .eq. 0) cycle !> don't check non-magnetic nuclei
-!c              write(*,*) l,j,pair(lin(i,j)),pair(lin(l,j)) !> and chem. equiv. ones (ie in the same
-        if (pair(lin(i,j)) .ne. pair(lin(l,j))) elist(l,i) = 0 !> group
-      end do
-    end do
-  end do
-!>---  symmetrize
-  do i = 1,n
-    k = 1
-    equiv(1,i,ig) = i
-    elist(i,i) = 0
-    do j = 1,n
-      if (elist(j,i) .ne. 0) then
-        k = k+1
-        equiv(k,i,ig) = j
-      end if
-    end do
-    equiv(0,i,ig) = k
-  end do
-  do i = 1,n
-    do j = 1,equiv(0,i,ig)
-      k = equiv(j,i,ig)
-      elist(1:n,k) = elist(1:n,k)+elist(1:n,i)
-    end do
-  end do
-!>---  prepare write out
-  do i = 1,n
-    k = 1
-    equiv(1,i,ig) = i
-    elist(i,i) = 0
-    do j = 1,n
-      if (elist(j,i) .ne. 0) then
-        k = k+1
-        equiv(k,i,ig) = j
-      end if
-    end do
-    if (k .gt. 2) then
-      equiv(0,i,ig) = k    !> CH3 etc
-    else
-      equiv(0,i,ig) = 1    !> this makes CH2-CH2 not mag. equiv.
-    end if
-  end do
-  jnd = 1
-  write (ch,*) 'magnetic equivalencies:'
-  do j = 1,n
-    m = equiv(0,j,ig)
-    write (3,*) j,m
-    write (3,'(20i5)') (equiv(l,j,ig),l=1,m)  !> include the atom ie if there are no equiv.
-    if (nmract(at(j)) .eq. 0) cycle
-    if (m .gt. 1.and.jnd(j) .eq. 1) then  !> just print
-      write (ch,'(''reference atom'',i4,'' # :'',i2)') equiv(1,j,ig),m
-      do k = 1,m
-        jnd(equiv(k,j,ig)) = 0
-      end do
-    end if
-  end do
-  close (3)
-
-!ccccccccccccccccccccc
-!c J averaging matrix
-!ccccccccccccccccccccc
-  if (rotfil) then
-    allocate (jfake(n*(n+1)/2),sd(n,n),cn(n))
-    atmp = 'anmr_rotamer'
-    open (unit=112,file=atmp,form='unformatted')
-    write (112) ng
-    jfake = 0
-    do ig = 1,ng       !> all conf groups
-      nr = glist(0,ig) !> how many rotamers?
-      write (112) nr
-      do ir = 1,nr
-        irr = glist(ir,ig)
-        call distance(n,xyz(:,:,irr),sd)   !> distance matrix
-        cdum(1:3,1:n) = xyz(1:3,1:n,irr)
-        call calculate_CN(n,at,cdum,cn)
-        do i = 1,n-1
-          do j = i+1,n
-            jfake(lin(j,i)) = cn(i)*cn(j)*sqrt(dble(at(i)*at(j))) &
-       &    /(dble(pair(lin(j,i)))*sd(j,i)**5) !> the approx. "J" is topologically equivalent to J
-            !> R^3 was wrong in one case because Hs were artificially paired
-            !> R^5 seems to be save
-          end do
-        end do
-        write (112) jfake(1:n*(n+1)/2)  !> read by anmr
-      end do
-    end do
-    close (112)
-    deallocate (cn)
-    deallocate (sd,jfake)
-  end if
-
-  if (allocated(jnd)) deallocate (jnd)
-  if (allocated(elist)) deallocate (elist)
-  if (allocated(flist)) deallocate (flist)
-  if (allocated(equiv)) deallocate (equiv)
-  if (allocated(dist)) deallocate (dist)
-  if (allocated(relat)) deallocate (relat)
-  if (allocated(tmp2)) deallocate (tmp2)
-  if (allocated(pair)) deallocate (pair)
-  if (allocated(glist)) deallocate (glist)
-
-  return
-end subroutine cregen_EQUAL
-
-!=========================================================================================!
-
-subroutine cregen_nmract(ch,nmract)
-!***************************************
-!* utility routine to fill nmract array
-!***************************************
-  use crest_parameters
-  use utilities
-  implicit none
-  integer :: nmract(86)
-  character(len=:),allocatable :: atmp
-  logical :: fail
-  integer :: io,i
-  real(wp) :: xx(10)
-  integer :: ch,ich2
-
-  nmract = 0 !reset
-  !>--- get NMR active nuclei
-  atmp = '.anmrrc'  ! <--- name of the .anmrrc written by ENSO
-  call getanmrrc(atmp,fail)
-  if (fail) then  !>--- there is no .anmrrc from ENSO
-    !write(ch,*)'NMR mode.'
-    nmract = 0       ! all nuclei inactive
-    nmract(1) = 1  ! H active
-    !nmract(6) = 1  ! C active
-    nmract(9) = 1  ! F active
-    nmract(15) = 1  ! P active
-  else          !>--- there IS a .anmrrc, and it is used.
-    write (ch,*) 'NMR mode. Reading <',trim(atmp),'> for atomic NMR data'
-    open (newunit=ich2,file=atmp)
-    read (ich2,'(a)') atmp
-    read (ich2,'(a)') atmp
-    if (index(atmp,'ENSO') .ne. 0) then
-      read (ich2,'(a)') atmp
-    end if
-    do
-      read (ich2,*,iostat=io) i,xx(1:2),nmract(i)
-      if (io < 0) exit
-    end do
-    close (ich2)
-  end if
-
-  return
-end subroutine cregen_nmract
-
-!=========================================================================================!
-
-subroutine cregen_repairorder(nat,nall,xyz,comments,group)
-!***************************************************************
-!* subroutine cregen_repairorder
-!* resort the ensemble to have groups grouped together
-!* (can be important for small energy diff. between conformers)
-!* On Input: ch - printout channel
-!*           nat - number of atoms
-!*           nall - number of structure in ensemble
-!*           xyz  - Cartesian coordinates
-!*           comments - commentary lines containing the energy
-!*           group - to which group does every strucutre belong
-!* On Output: resorted xyz and comments
-!***************************************************************
-  use crest_parameters,id => dp
-  use crest_data
-  use strucrd
-  use utilities
-  implicit none
-  integer,intent(in) :: nat
-  integer,intent(in) :: nall
-  real(wp),intent(inout) :: xyz(3,nat,nall)
-  integer,intent(inout) :: group(0:nall)
-  character(len=*) :: comments(nall)
-  real(wp),allocatable :: cdum(:,:)
-  integer,allocatable :: order(:),orderref(:)
-  character(len=128) :: btmp
-  real(wp) :: edum
-  logical :: ttag
-  integer,allocatable :: timetag(:)
-  integer :: ng,tmax
-  integer :: i,j,k,l
-
-  !>-- check if timetag info is present?
-  ttag = .false.
-
-  ng = group(0)
-  allocate (order(nall),orderref(nall))
-  !>-- determine new order
-  k = 0
-  if (ttag) then
-    do i = 1,ng
-      do l = 1,tmax  !>-- with timetag info
-        do j = 1,nall
-          if (group(j) .eq. i.and.timetag(j) .eq. l) then
-            k = k+1
-            orderref(k) = j
-            order(k) = i
-          end if
-        end do
-      end do
-    end do
-  else
-    do i = 1,ng
-      do j = 1,nall !>-- without timetag info
-        if (group(j) .eq. i) then
-          k = k+1
-          orderref(k) = j
-          order(k) = i
-        end if
-      end do
-    end do
-  end if
-
-  !>-- sort xyz and comments
-  group(1:nall) = order(1:nall)
-  order = orderref
-  allocate (cdum(3,nat))
-  call xyzqsort(nat,nall,xyz,cdum,order,1,nall)
-  deallocate (cdum)
-  order = orderref
-  call stringqsort(nall,comments,1,nall,order)
-  if (ttag) then
-    edum = grepenergy(comments(1))
-    write (btmp,*) edum,'!t1'
-    comments(1) = trim(btmp)
-  end if
-
-  deallocate (orderref,order)
-  if (allocated(timetag)) deallocate (timetag)
-  return
-end subroutine cregen_repairorder
-
-!=========================================================================================!
-
-recursive subroutine xyzqsort(nat,nall,xyz,c0,ord,first,last)
-!*************************************************************
-!* recursive subroutine xyzqsort
-!* A quicksort derivative for sorting an ensemble.
-!* On Input: nat  - number of atoms
-!*           nall - number of structures
-!*           xyz  - the ensemble ( xyz(3,nat,nall) )
-!*           c0   - a dummy coord field for sorting
-!*           ord  - order of the ensemble ( ord(nall) )
-!*           first - lower limit of sorting (nall dimension)
-!*           last  - upperl limit of sorting (nall dimension)
-!*************************************************************
-  use crest_parameters
-  implicit none
-  integer :: nat,nall
-  real(wp) :: xyz(3,nat,nall)
-  real(wp) :: c0(3,nat)
-  integer :: ord(nall)
-  integer :: first,last
-  integer :: x,t
-  integer :: i,j
-  x = ord((first+last)/2)
-  i = first
-  j = last
-  do
-    do while (ord(i) < x)
-      i = i+1
-    end do
-    do while (x < ord(j))
-      j = j-1
-    end do
-    if (i >= j) exit
-    t = ord(i); ord(i) = ord(j); ord(j) = t
-    c0(:,:) = xyz(:,:,i)
-    xyz(:,:,i) = xyz(:,:,j)
-    xyz(:,:,j) = c0(:,:)
-    i = i+1
-    j = j-1
-  end do
-  if (first < i-1) call xyzqsort(nat,nall,xyz,c0,ord,first,i-1)
-  if (j+1 < last) call xyzqsort(nat,nall,xyz,c0,ord,j+1,last)
-end subroutine xyzqsort
-
-!=========================================================================================!
-
-subroutine maskedxyz(n,nm,c,cm,at,atm,mask)
-!************************************************
-!* a small routine to get masked xyz coordinates
-!************************************************
-  use crest_parameters,only:wp
-  implicit none
-  integer,intent(in) :: n
-  integer,intent(in) :: nm
-  real(wp),intent(in) :: c(3,n)
-  real(wp),intent(out) :: cm(3,nm)
-  integer,intent(in) :: at(n)
-  integer,intent(out) :: atm(nm)
-  integer,intent(in) :: mask(n)
-  integer :: i,k
-  k = 1
-  do i = 1,n
-    if (mask(i) .gt. 0) then
-      cm(1:3,k) = c(1:3,i)
-      atm(k) = at(i)
-      k = k+1
-    end if
-  end do
-  return
-end subroutine maskedxyz
-subroutine maskedxyz2(n,nm,c,cm,mask)
-!************************************************
-!* a small routine to get masked xyz coordinates
-!* version without at array
-!************************************************
-  use crest_parameters,only:wp
-  implicit none
-  integer,intent(in) :: n
-  integer,intent(in) :: nm
-  real(wp),intent(in) :: c(3,n)
-  real(wp),intent(out) :: cm(3,nm)
-  integer,intent(in) :: mask(n)
-  integer :: i,k
-  k = 1
-  do i = 1,n
-    if (mask(i) .gt. 0) then
-      cm(1:3,k) = c(1:3,i)
-      k = k+1
-    end if
-  end do
-  return
-end subroutine maskedxyz2
-
-!=========================================================================================!
-
-subroutine cregen_file_wr(env,fname,nat,nall,at,xyz,comments)
-!*********************************
-!* write the output ensemble file
-!*********************************
-  use crest_parameters,only:wp
-  use crest_data
-  use strucrd
-  use utilities,only:boltz
-  implicit none
-  type(systemdata) :: env
-  character(len=*) :: fname
-  integer :: nat,nall
-  integer :: at(nat)
-  real(wp) :: xyz(3,nat,nall)
-  character(len=*) :: comments(nall)
-  character(len=128) :: newcomment
-
-  integer :: ich,i
-  real(wp),allocatable :: c0(:,:),xdum(:)
-  real(wp) :: eref,T
-  real(wp),allocatable :: er(:),erel(:),p(:)
-  character(len=40),allocatable :: origin(:)
-  real(wp),parameter :: autokcal = 627.509541_wp
-
-  allocate (er(nall),erel(nall),p(nall),origin(nall))
-  eref = grepenergy(comments(1))
-  do i = 1,nall
-    er(i) = grepenergy(comments(i))
-    erel(i) = (er(i)-eref)*autokcal
-    if (env%trackorigin) then
-      call getorigin(comments(i),origin(i))
-    end if
-  end do
-  T = env%tboltz
-  call boltz(nall,T,erel,p)
-
-  allocate (c0(3,nat),xdum(3))
-  open (newunit=ich,file=fname)
-  do i = 1,nall
-    c0(:,:) = xyz(:,:,i)
-    if (env%trackorigin) then
-      write (newcomment,*) er(i),p(i),'!'//trim(origin(i))
-    else
-      write (newcomment,*) er(i),p(i)
-    end if
-    call wrxyz(ich,nat,at,c0,newcomment)
-  end do
-  close (ich)
-  deallocate (xdum,c0)
-  deallocate (origin,p,erel,er)
-  return
-end subroutine cregen_file_wr
-
-!=========================================================================================!
-
-subroutine cregen_conffile(env,cname,nat,nall,at,xyz,comments,ng,degen)
-!*********************************
-!* write the output ensemble file
-!*********************************
-  use crest_parameters,only:wp,bohr
-  use crest_data
-  use strucrd
-  use iomod
-  use utilities
-  implicit none
-  type(systemdata) :: env
-  character(len=*) :: cname
-  integer :: nat,nall
-  integer :: at(nat)
-  real(wp) :: xyz(3,nat,nall)
-  character(len=*) :: comments(nall)
-  integer :: ng
-  integer :: degen(3,ng)
-  character(len=128) :: newcomment
-  integer :: ich,ich3,ichenso
-  integer :: i,k
-  real(wp),allocatable :: c0(:,:)
-  real(wp),allocatable :: er(:)
-  allocate (er(nall))
-  do i = 1,nall
-    er(i) = grepenergy(comments(i))
-  end do
-  allocate (c0(3,nat))
-  if (env%enso) then
-    open (newunit=ichenso,file='enso.tags')
-  end if
-  c0(:,:) = xyz(:,:,1)
-  write (newcomment,'(2x,f18.8)') er(1)
-  call wrxyz('crest_best.xyz',nat,at,xyz(:,:,1),newcomment)
-  open (newunit=ich,file=trim(cname))
-  do i = 1,ng
-    k = degen(2,i)
-    if (i .eq. 1.or.env%printscoords) then   !write a scoord.* for each conformer? scoord.1 is always written
-      call getname1(i,newcomment)
-      c0(:,:) = xyz(:,:,k)/bohr
-      call wrc0(newcomment,nat,at,c0)
-    end if
-    write (newcomment,'(2x,f18.8)') er(k)
-    call wrxyz(ich,nat,at,xyz(:,:,k),newcomment)
-    if (env%enso) write (ichenso,*) trim(comments(k))
-  end do
-  close (ich)
-  deallocate (c0)
-  deallocate (er)
-
-  if (env%enso) then
-    close (ichenso)
-  end if
-
-  call remove('cre_members')
-  open (newunit=ich3,file='cre_members')
-  write (ich3,'(3x,i0)') ng
-  do i = 1,ng
-    k = degen(1,i)
-    write (ich3,'(3x,i8,1x,i10,1x,i10)') &
-    &   k,degen(2,i),degen(3,i)
-  end do
-  close (ich3)
-
-  return
-end subroutine cregen_conffile
-
-!=========================================================================================!
-
-subroutine cregen_rmsdalign(nat,nall,at,xyz)
-!*****************************************************
-!* Algin all structures in xyz to the first structure
-!* in the ensemble based on the heavy-atom RMSD
-!*****************************************************
-  use crest_parameters,only:wp
-  use crest_data
-  use ls_rmsd
-  use iomod
-  implicit none
-  integer :: nat,nall
-  integer :: at(nat)
-  real(wp),intent(inout) :: xyz(3,nat,nall)
-  integer :: nath
-  integer :: i,j,k
-  real(wp),allocatable :: c0(:,:)
-  real(wp),allocatable :: c1(:,:)
-  real(wp),allocatable :: c2(:,:)
-  real(wp) ::  g(3,3),U(3,3),x_center(3),y_center(3),rmsdval
-
-  nath = 0
-  do j = 1,nat
-    if (at(j) > 2) nath = nath+1
-  end do
-  allocate (c0(3,nath),c1(3,nath),source=0.0d0)
-
-  allocate (c2(3,nat))
-  !>--- get the reference structure (the first one)
-  i = 0
-  do j = 1,nat
-    if (at(j) > 2) then
-      i = i+1
-      c0(1:3,i) = xyz(1:3,j,1)
-    end if
-  end do
-
-  do k = 2,nall
-    !>--- and the other strucutres into c1
-    i = 0
-    do j = 1,nat
-      if (at(j) > 2) then
-        i = i+1
-        c1(1:3,i) = xyz(1:3,j,k)
-      end if
-    end do
-    call rmsd(i,c1,c0,1,U,x_center,y_center,rmsdval,.false.,g)
-
-    c2 = matmul(U(1:3,1:3),xyz(1:3,1:nat,k))
-    xyz(1:3,1:nat,k) = c2
-  end do
-
-  deallocate (c2)
-  deallocate (c1,c0)
-  return
-end subroutine cregen_rmsdalign
-
-!=========================================================================================!
-
-subroutine cregen_bonusfiles(ng,degen)
-!*****************************************
-!* write the time tag and degeneracy file
-!*****************************************
-  use crest_parameters,only:wp,bohr
-  use crest_data
-  implicit none
-  integer :: ng
-  integer :: degen(3,ng)
-  integer :: i,ich
-
-  !>--- how many rotamers per conformer
-  open (newunit=ich,file='cre_degen')
-  write (ich,'(3x,i0)') ng
-  do i = 1,ng
-    write (ich,'(3x,i0,2x,i0)') i,degen(1,i)
-  end do
-  close (ich)
-
-  return
-end subroutine cregen_bonusfiles
-
-!=========================================================================================!
-!=========================================================================================!
-!>  CREGEN PRINTOUTS
-!=========================================================================================!
-!=========================================================================================!
-subroutine cregen_setthreads(ch,env,pr)
-  use crest_parameters
-  use crest_data
-  implicit none
-  type(systemdata) :: env
-  integer :: ch
-  logical :: pr
-  integer :: TID,OMP_GET_NUM_THREADS,OMP_GET_THREAD_NUM,nproc,T,Tn
-!>---- setting the threads for OMP parallel usage
-  if (env%autothreads) then
-    call new_ompautoset(env,'max',0,T,Tn)
-!$OMP PARALLEL PRIVATE(TID)
-    TID = OMP_GET_THREAD_NUM()
-    IF (TID .EQ. 0.and.pr) THEN
-      nproc = OMP_GET_NUM_THREADS()
-      write (ch,*) '============================='
-      write (ch,*) ' # threads =',nproc
-      write (ch,*) '============================='
-    END IF
-!$OMP END PARALLEL
-  end if
-  return
-end subroutine cregen_setthreads
-
-subroutine cregen_pr1(ch,env,nat,nall,rthr,bthr,pthr,ewin)
-  use crest_parameters
-  use crest_data
-  implicit none
-  integer :: ch
-  type(systemdata) :: env
-  integer :: nat
-  integer :: nall
-  real(wp) :: rthr,bthr,pthr,ewin
-  logical :: substruc
-  substruc = (nat .ne. env%rednat.and.env%subRMSD)
-  write (ch,'('' number of atoms                :'',3x,i0)') nat
-  if (substruc) then
-    write (ch,'('' atoms included in RMSD         :'',3x,i0)') env%rednat
-  end if
-  write (ch,'('' number of points on xyz files  :'',3x,i0)') nall
-  write (ch,'('' RMSD threshold                 :'',f9.4)') rthr
-  write (ch,'('' Bconst threshold               :'',f9.4)') bthr
-  write (ch,'('' population threshold           :'',f9.4)') pthr
-  return
-end subroutine cregen_pr1
-
-subroutine enso_duplicates(env,nall,double)
-  use crest_parameters
-  use crest_data
-  implicit none
-  type(systemdata) :: env
-  integer :: nall
-  integer :: double(nall)
-  integer :: i,j,ich
-
-  if (.not.env%ENSO.or..not.env%confgo) return
-
-  j = sum(double)
-  open (newunit=ich,file='cregen.enso')
-  if (j .gt. 0) then
-    do i = 1,nall
-      if (double(i) .gt. 0) then
-        write (ich,*) i,double(i)
-      end if
-    end do
-  else
-    write (ich,*) "ALL UNIQUE"
-  end if
-
-  return
-end subroutine enso_duplicates
-
-subroutine create_anmr_dummy(nat)
-  implicit none
-  integer :: nat
-  integer :: i,ich
-
-  open (newunit=ich,file='anmr_nucinfo')
-  write (ich,*) nat
-  do i = 1,nat
-    write (ich,'(3x,i0,3x,i0)') i,1
-    write (ich,'(3x,i0)') i
-  end do
-  do i = 1,nat
-    write (ich,*) i,1
-    write (ich,'(i5)') i
-  end do
-  close (ich)
-  return
-end subroutine create_anmr_dummy
-
-subroutine cregen_pr2(ch,env,nall,comments,ng,degen,er)
-  use crest_parameters
-  use crest_data
-  use strucrd
-  use iomod,only:touch
-  use utilities,only:boltz
-  implicit none
-  integer :: ch
-  type(systemdata) :: env
-  integer :: nall
-  character(len=*) :: comments(nall)
-  integer :: ng
-  integer :: degen(3,ng)
-  real(wp) :: er(nall)
-  integer :: ich,chref
-  integer :: i,j,k
-  real(wp),allocatable :: erel(:),egrp(:)
-  real(wp),allocatable :: p(:),pg(:)
-  real(wp) :: eref,T
-  character(len=40),allocatable :: origin(:)
-  integer :: a,b
-  logical :: ex
-  real(wp) :: A0,eav,g,s,ss,beta,elow
-
-  allocate (origin(nall),erel(nall),p(nall))
-  eref = grepenergy(comments(1))
-  env%elowest = eref
-  do i = 1,nall
-    er(i) = grepenergy(comments(i))
-    erel(i) = (er(i)-eref)*autokcal
-    if (env%trackorigin) then
-      call getorigin(comments(i),origin(i))
-    else
-      origin(i) = ''
-    end if
-  end do
-  T = env%tboltz
-  call boltz(nall,T,erel,p)
-  allocate (pg(ng),source=0.0_wp)
-  do i = 1,ng
-    a = degen(2,i)
-    b = degen(3,i)
-    do j = a,b
-      pg(i) = pg(i)+p(j)
-    end do
-  end do
-
-  !>-- really long energy list
-  write (ch,'(7x,a,8x,a,1x,a,2x,a,5x,a,3x,a,5x,a)') 'Erel/kcal','Etot', &
-  &    'weight/tot','conformer','set','degen','origin'
-  if (env%entropic.and.ng > 50000) then
-    write (ch,'(1x,a)') '<skipped due to lenght and written to seperate file>'
-    chref = ch
-    open (newunit=ch,file='crest.conformerlist')
-  end if
-  k = 0
-  do i = 1,ng
-    k = k+1
-    a = degen(2,i)
-    b = degen(3,i)
-    write (ch,'(i8,f8.3,1x,3f11.5,2i8,5x,a)') &
-  & k,erel(a),er(a),p(a),pg(i),i,degen(1,i),trim(origin(a))
-    if (.not.env%entropic) then
-      do j = a+1,b
-        k = k+1
-        write (ch,'(i8,f8.3,1x,2f11.5,32x,a)') &
-    &   k,erel(j),er(j),p(j),trim(origin(j))
-      end do
-    end if
-  end do
-  if (env%entropic.and.ng > 50000) then
-    close (ch)
-    ch = chref
-  end if
-
-  !>-- file for the '-compare' mode
-  if (env%compareens) then
-    open (newunit=ich,file='.cretrack')
-    write (ich,'(5x,i0)') ng
-    do i = 1,ng
-      write (ich,'(1x,i8,1x,i7,1x,i7)') i,degen(2,i),degen(3,i)
-    end do
-    close (ich)
-  end if
-
-  !>-- some ensemble data, entropy and G (including all structures)
-  A0 = 0
-  eav = 0
-  do i = 1,nall
-    A0 = A0+p(i)*log(p(i)+1.d-12)
-    eav = eav+p(i)*erel(i)
-  end do
-  beta = 1.0d0/(T*8.314510/4.184/1000.+1.d-14)
-  g = (1.0d0/beta)*A0
-  s = -1000.0d0*4.184*g/T
-  ss = -1000.0d0*g/T
-
-  write (ch,'(''T /K                                  :'', F9.2)') T
-  write (ch,'(''E lowest                              :'',f12.5)') eref
-  !>---- elow printout in between routines
-  if (.not.env%confgo) then
-    write (stdout,'("CREGEN> E lowest :",f12.5)') eref
-  end if
-  if (env%QCG) then
-    write (ch,'(''ensemble average energy (kcal)        :'', F14.8)') eav
-    write (ch,'(''ensemble entropy (cal/mol K)          :'',F14.8)') ss
-    write (ch,'(''ensemble free energy (kcal/mol)       : '',F14.8)') g
-  else
-    write (ch,'(''ensemble average energy (kcal)        :'', F9.3)') eav
-    write (ch,'(''ensemble entropy (J/mol K, cal/mol K) :'',2F9.3)') s,ss
-    write (ch,'(''ensemble free energy (kcal/mol)       : '',F8.3)') g
-  end if
-  write (ch,'(''population of lowest in %             : '',F8.3)') pg(1)*100.d0
-
-  !>-- some ensemble data, entropy and G (including only unique conformers)
-  allocate (egrp(ng),source=0.0_wp)
-  do i = 1,ng
-    a = degen(2,i)
-    egrp(i) = (er(a)-eref)*autokcal
-  end do
-  call boltz(ng,T,egrp,pg)
-  A0 = 0
-  do i = 1,ng
-    A0 = A0+pg(i)*log(pg(i)+1.d-12)
-  end do
-  deallocate (egrp)
-  beta = 1.0d0/(T*8.314510/4.184/1000.+1.d-14)
-  g = (1.0d0/beta)*A0
-  ss = -1000.0d0*g/T
-  env%emtd%sapprox = ss  !> save for entropy mode
-
-  !>-- MF-MD-GC legacy option
-  if ((env%crestver .eq. 1).and.(.not.env%confgo)) then
-    inquire (file='.tmpxtbmodef',exist=ex)
-    if (ex) then
-      open (unit=66,file='.tmpxtbmodef')
-      read (66,*) i
-      read (66,*) elow
-      close (66)
-    else
-      elow = er(1)
-    end if
-    if ((elow-eref)*autokcal .lt. -0.2) then
-      write (ch,*) '...............................................'
-      write (ch,*) 'WARNING: new (best) energy less than that from '
-      write (ch,*) 'WARNING: preceding Hessian calculation:  '
-      write (ch,*) 'Improved by ',elow-eref,' Eh or ', (elow-eref)*autokcal,'kcal'
-      write (ch,*) '...............................................'
-      call touch('LOWER_FOUND')
-    end if
-  end if
-
-  deallocate (pg)
-  deallocate (p,erel,origin)
-  return
-end subroutine cregen_pr2
-
-subroutine cregen_econf_list(ch,nall,er,ng,degen)
-  use crest_parameters
-  implicit none
-  integer :: nall
-  real(wp) :: er(nall)
-  integer :: ng
-  integer :: degen(3,ng)
-  integer :: ch,ich2,i,j
-  real(wp) :: eref,ewrt
-
-  write (ch,*) 'number of unique conformers for further calc ',ng
-  write (ch,*) 'list of relative energies saved as "crest.energies"'
-  open (newunit=ich2,file='crest.energies')
-  eref = er(1)
-  do i = 1,ng
-    j = degen(2,i)
-    ewrt = er(j)-eref
-    ewrt = ewrt*autokcal
-    write (ich2,'(2x,i0,2x,f12.3)') i,ewrt
-  end do
-  close (ich2)
-
-  return
-end subroutine cregen_econf_list
-
-subroutine cregen_pr3(ch,infile,nall,comments)
-  use crest_parameters
-  use strucrd
-  implicit none
-  integer :: ch
-  character(len=*) :: infile
-  integer :: nall
-  character(len=*) :: comments(nall)
-  real(wp),allocatable :: er(:)
-  real(wp) :: dE
-  integer :: i
-  allocate (er(nall))
-
-  do i = 1,nall
-    er(i) = grepenergy(comments(i))
-  end do
-
-  write (ch,*)
-  write (ch,'(a)') '====================================================='
-  write (ch,'(a)') '============== ordered structure list ==============='
-  write (ch,'(a)') '====================================================='
-  write (ch,'(a,a,a)') ' written to file <',trim(infile),'>'
-  write (ch,*)
-  write (ch,'(a10,4x,a15,a25)') 'structure','ΔE(kcal/mol)','Etot(Eh)'
-  !write (ch,'(''   structure    ΔE(kcal/mol)    Etot(Eh)'')')
-  do i = 1,nall
-    dE = (er(i)-er(1))*autokcal
-    write (ch,'(i10,3x,F15.4,F25.10)') i,dE,er(i)
-  end do
-  write (ch,*)
-
-  deallocate (er)
-  return
-end subroutine cregen_pr3
-
-subroutine cregen_pr4(ch,infile,nall,group)
-  use crest_parameters
-  use strucrd
-  implicit none
-  integer :: ch
-  character(len=*) :: infile
-  integer :: nall
-  integer :: group(0:nall)
-  integer :: i,ich
-  integer :: maxgroup
-  !write(ch,*) group(1:nall)
-  maxgroup = group(0)
-  write (ch,'(1x,i0,a,i0,a,a,a)') maxgroup,' unique groups for ', &
-  &    nall,' structures in file <',trim(infile),'>'
-
-  open (newunit=ich,file='.groups')
-  write (ich,'(5x,i0,3x,i0)') nall,maxgroup
-  do i = 1,nall
-    write (ich,'(2x,i10,2x,i10)') i,group(i)
-  end do
-  close (ich)
-  return
-end subroutine cregen_pr4
-
-!=========================================================================================!
-!=========================================================================================!
-!> END OF CREGEN FILE
-!=========================================================================================!
-!=========================================================================================!
diff --git a/src/crest_main.f90 b/src/crest_main.f90
index e9809d4c..687ec10a 100644
--- a/src/crest_main.f90
+++ b/src/crest_main.f90
@@ -24,10 +24,11 @@ program CREST
 !  use iso_fortran_env,wp => real64
   use crest_parameters !> Datatypes and constants
   use crest_data !> module for the main data storage (imports systemdata and timer)
-  use crest_restartlog 
-    USE, INTRINSIC :: IEEE_EXCEPTIONS
+  use crest_calculator
+  USE,INTRINSIC :: IEEE_EXCEPTIONS
   implicit none
   type(systemdata) :: env  !> MAIN STORAGE OF SYSTEM DATA
+  type(calcdata),target :: calc_origin
   type(timer)   :: tim     !> timer object
 
   integer :: i,j,l,args,io
@@ -36,10 +37,10 @@ program CREST
   character(len=512) :: thisdir
   character(len=1024) :: cmd
   real(wp) :: dumfloat,dumfloat2,d3,d4,d5,d6,d7,d8
-  logical :: ex,ex1,ex2
+  logical :: ex,ex1,ex2,iterate
 
   intrinsic :: iargc,getarg
-    LOGICAL :: overflow, division_by_zero, invalid_operation
+  LOGICAL :: overflow,division_by_zero,invalid_operation
 
   call initsignal() !SIGTERM catcher
 
@@ -47,17 +48,23 @@ program CREST
 !>  Initialize system clock time
   call tim%init(20)
 
+  env%calc => calc_origin
 !=========================================================================================!
 !> set defaults and pars flags
   args = iargc()
-  l = len_trim(cmd)
-  allocate (arg(args),source=repeat(' ',l))
+  allocate (arg(args),source=repeat(' ',1024))
   do i = 1,args
     call getarg(i,arg(i))
   end do
   call parseflags(env,arg,args)
   deallocate (arg)
-  call restart_save_env(env)
+
+!=========================================================================================!
+!> post-parsing sanity checks on the assembled env%calc object
+!=========================================================================================!
+!>--- g-xTB (05/2026) has no implicit solvation; stop safely if requested
+  call gxtb_solvation_guard(env)
+
 !=========================================================================================!
 !> scratch dir handling
 
@@ -82,14 +89,14 @@ program CREST
 !>   DRY run stop
 !=========================================================================================!
   if (env%dryrun) then
-    call crest_dry(env)
+    call crest_dry_run(env,tim)
   end if
 
 !=========================================================================================!
 !> SOME I/O STUFF
 !=========================================================================================!
 !>--- check for the coord file in the working directory
-  if (env%crestver /= crest_solv) then
+  if (env%crestver /= crest_solv.and.env%crestver /= crest_sorting) then
     inquire (file='coord',exist=ex)
     if (.not.ex) then
       error stop 'No coord file found. Exit.'
@@ -100,36 +107,8 @@ program CREST
 !>        PRE-CONFSEARCH PROPERTY CALCS
 !=========================================================================================!
   select case (env%properties)
-!>--- only CREGEN routine
-  case (p_cregen)
-    call tim%start(1,'CREGEN')
-    write (*,*) 'Using only the cregen sorting routine.'
-    env%cgf(6) = .true.   !write confg output to file <tmp>
-    if (env%doNMR) then
-      env%cgf(3) = .true.
-      if (.not.env%fullcre) then
-        env%cgf(2) = .false.
-      end if
-    end if
-    if (env%newcregen) then
-      block
-      use cregen_interface
-      call newcregen(env,0)
-      end block
-    else
-      call cregen2(env)
-    end if
-    if (env%doNMR.and.env%fullcre) then
-      call entropic(env,.true.,.false.,.false.,env%ensemblename, &
-      &    env%tboltz,dumfloat,dumfloat2)
-    end if
-    if (env%cluster) then
-      call ccegen(env,.true.,ensemblefile)
-    end if
-    call tim%stop(1)
-    call propquit(tim)
 !>--- zsort routine
-  case(p_zsort) 
+  case (p_zsort)
     call zsort
     write (*,*)
     write (*,*) 'The z-matrix of the input coord file has been sorted.'
@@ -138,26 +117,11 @@ program CREST
     write (*,*) 'exit.'
     call propquit(tim)
 
-!>--- only ensemble comparison
-  case (p_compare)
-    call compare_ensembles(env)     
-    call propquit(tim)
-! !>--- protonation tool
-!  case (p_protonate)
-!    call protonate(env,tim)
-!    call propquit(tim)
-!>--- deprotonation
-!  case (p_deprotonate)
-!    call deprotonate(env,tim)
-!    call propquit(tim)
-!>--- tautomerization
-!  case (p_tautomerize)
-!    call tautomerize(env,tim)
-!    call propquit(tim)
 !>--- extended tautomerization
   case (p_tautomerize2)
     call tautomerize_ext(env%ensemblename,env,tim)
     call propquit(tim)
+
 !>--- stereoisomerization
   case (p_isomerize)
     call stereoisomerize(env,tim)
@@ -166,8 +130,8 @@ program CREST
 !>--- reactor setup
   case (p_reactorset)
     call reactor_setup(env)
-
     stop
+
 !>--- enhanched ensemble entropy
   case (p_CREentropy)
     call entropic(env,.true.,.true.,.false.,env%ensemblename, &
@@ -179,10 +143,6 @@ program CREST
     call calcSrrhoav(env,env%ensemblename)
     call tim%stop(4)
     call propquit(tim)
-!>--- to PCA and k-Means clustering for given file
-  case (p_cluster)
-    call ccegen(env,.true.,env%ensemblename)
-    call propquit(tim)
 !>--- properties for enesemble file
   case (p_propcalc)
     call propcalc(env%ensemblename,env%properties2,env,tim)
@@ -222,100 +182,132 @@ program CREST
   case default
     continue
   end select
+
+!>--- alkylation prep
+  if (env%alkylize) then
+    call crest_setup_alkylize(env)
+  end if
+
 !=========================================================================================!
 !>         PRE-OPTIMIZATION OF THE GEOMETRY
 !=========================================================================================!
-  if (env%preopt) then
-    call trialOPT(env)
-  else if (env%presp) then
-    call xtbsp(env)
+  if (env%crestver /= crest_none) then
+    if (env%preopt) then
+      call trialOPT(env)
+    else if (env%presp) then
+      call xtbsp(env)
+    end if
   end if
 !=========================================================================================!
-!>         MAIN WORKFLOW CALLS START HERE
+!>         SET UP QUEUES, IF REQUIRED
+!=========================================================================================!
+  call crest_queue_setup(env,iterate)
+!=========================================================================================!
+!>         MAIN WORKFLOW CALLS START HERE (including iterator)
 !=========================================================================================!
-!> many of these routine calls take a detour through legacy_wrappers.f90 !
-  select case (env%crestver)
-  case (crest_mfmdgc)           !> MF-MD-GC algo (deprecated)
-    call confscript1(env,tim)
 
-  case (crest_imtd,crest_imtd2) !> MTD-GC algo
-    call confscript2i(env,tim)
+  ITERATOR: do while (iterate)
+    call crest_queue_iter(env,iterate)
 
-  case (crest_mdopt, crest_mdopt2)
-    call mdopt(env,tim)        !> MDOPT
+!> NOTE: many of these routine calls take a detour through legacy_wrappers.f90 !
+    select case (env%crestver)
+    case (crest_mfmdgc)           !> MF-MD-GC algo (deprecated)
+      call confscript1(env,tim)
 
-  case (crest_screen)
-    call screen(env,tim)       !> SCREEN
+    case (crest_imtd,crest_imtd2) !> MTD-GC algo
+      call confscript2i(env,tim)
 
-  case (crest_nano)
-    call reactor(env,tim)      !> NANO-REACTOR
+    case (crest_mdopt,crest_mdopt2)
+      call mdopt(env,tim)        !> MDOPT
 
-  case (crest_compr)
-    call compress(env,tim)     !> MTD COMPRESS mode
+    case (crest_screen)
+      call screen(env,tim)       !> SCREEN
 
-  case (crest_msreac)
-    call msreact_handler(env,tim) !> MSREACT sub-program
+    case (crest_nano)
+      call reactor(env,tim)      !> NANO-REACTOR
 
-  case (crest_pka)
-    call pkaquick(env,tim)
+    case (crest_compr)
+      call compress(env,tim)     !> MTD COMPRESS mode
 
-  case (crest_solv)             !> microsolvation tools
-    call crest_solvtool(env,tim)
+    case (crest_msreac)
+      call msreact_handler(env,tim) !> MSREACT sub-program
 
-  case (crest_sp)
-    call crest_singlepoint(env,tim)
+    case (crest_pka)
+      call pkaquick(env,tim)
 
-  case (crest_optimize)
-    call crest_optimization(env,tim)
+    case (crest_solv)             !> microsolvation tools
+      call crest_solvtool(env,tim)
 
-  case (crest_moldyn)
-    call crest_moleculardynamics(env,tim)
+    case (crest_sp)
+      call crest_singlepoint(env,tim)
 
-  case (crest_s1)
-    call crest_search_1(env,tim)
+    case (crest_optimize)
+      call crest_optimization(env,tim)
 
-  case (crest_mecp)
-    call crest_search_mecp(env,tim)
+    case (crest_moldyn)
+      call crest_moleculardynamics(env,tim)
 
-  case (crest_numhessian)
-    call crest_numhess(env,tim)
+    case (crest_s1)
+      call crest_search_1(env,tim)
 
-  case (crest_scanning)
-    call crest_scan(env,tim)
+    case (crest_mecp)
+      call crest_search_mecp(env,tim)
 
-  case (crest_rigcon) !> rule-based conformer generation
-    call crest_rigidconf(env,tim)
+    case (crest_numhessian)
+      call crest_numhess(env,tim)
 
-  case (crest_trialopt) !> test optimization standalone
-    call trialOPT(env)
+    case (crest_scanning)
+      call crest_scan(env,tim)
 
-  case (crest_ensemblesp) !> singlepoints along ensemble
-    call crest_ensemble_singlepoints(env,tim)    
+    case (crest_rigcon) !> rule-based conformer generation
+      call crest_rigidconf(env,tim)
 
-  case(crest_protonate)
-    call protonate(env,tim)
- 
-  case(crest_deprotonate)
-    call deprotonate(env,tim)
+    case (crest_trialopt) !> test optimization standalone
+      call trialOPT(env)
 
-  case(crest_tautomerize)
-    call tautomerize(env,tim) 
+    case (crest_ensemblesp) !> singlepoints along ensemble
+      call crest_ensemble_singlepoints(env,tim)
 
-  case (crest_test)
-    call crest_playground(env,tim)
+    case (crest_ensemblehess) !> Hessians + thermochemistry along ensemble
+      call crest_ensemble_hessians(env,tim)
 
-  case default
-    continue
-  end select
+    case (crest_protonate)
+      call protonate(env,tim)
 
-  if (env%outputsdf.or.env%sdfformat) then
-    if (any((/crest_mfmdgc,crest_imtd,crest_imtd2/) == env%crestver)) then
-      call new_wrsdfens(env,conformerfile,conformerfilebase//'.sdf',.false.)
-    end if
-    if (any((/crest_screen,crest_mdopt/) == env%crestver)) then
-      call new_wrsdfens(env,'crest_ensemble.xyz','crest_ensemble.sdf',.false.)
-    end if
-  end if
+    case (crest_deprotonate)
+      call deprotonate(env,tim)
+
+    case (crest_tautomerize)
+      call tautomerize(env,tim)
+
+    case (crest_sorting) !> interface to standalone ensemble sorting
+      call crest_sort(env,tim)
+
+    case (crest_bh) !> Standard basin-hopping
+      call crest_basinhopping(env,tim)
+
+    case (crest_test)
+      call crest_playground(env,tim)
+
+    case (crest_none)
+      call crest_no_runtype_selected()
+
+    case default
+      continue
+    end select
+
+    !> additional processing
+    call crest_queue_iter_resort(env,iterate)
+
+  end do ITERATOR
+
+  env%calc => calc_origin
+  call crest_queue_reconstruct(env,tim)
+
+!=========================================================================================!
+!>        ADDITIONAL OUTPUT FORMATTING
+!=========================================================================================!
+  call crest_ensemble_reformat(env)
 
 !=========================================================================================!
 !>        POST-CONFSEARCH PROPERTY CALCS
@@ -325,19 +317,23 @@ program CREST
     do i = 1,env%npq
       j = env%pqueue(i)
       select case (j)
-      case (1:8,10,20,100,998)
+      case (p_prop_hess,p_prop_autoir,p_prop_ohess,p_prop_reopt,p_prop_dipole,p_prop_finalhess)
         call propcalc(conformerfile,j,env,tim)
-      case (45)
+
+      case (abs(p_CREentropy))
         call tim%start(15,'Conf. entropy evaluation')
         call newentropyextrapol(env)
         call tim%stop(15)
-      case (50:59)  !hybrid reoptimization (e.g. gfn2@gff)
+
+      case (p_prop_multilevel:p_prop_multilevel+9)  !hybrid reoptimization (e.g. gfn2@gff)
         call propcalc(infile,j,env,tim)
-        infile = 'crest_reopt.xyz'
-      case (70) !PCA and clustering
+
+      case (abs(p_cluster)) !PCA and clustering
         call ccegen(env,.true.,conformerfile)
-      case (555)
+
+      case (abs(p_tautomerize2))
         call tautomerize_ext(infile,env,tim)
+
       case default
         continue
       end select
@@ -351,17 +347,18 @@ program CREST
     call scrend(env)
   end if
 
-!=========================================================================================!
-!> shout down hosted subprocesses
-  block
-  use ConfSolv_module
-  call cs_shutdown(io)
-  end block
-
 !=========================================================================================!
 !> one final cleanup
   call custom_cleanup(env)
 
+!=========================================================================================!
+!> Print a summary of output files written in this run
+  call crest_output_summary(env)
+
+!=========================================================================================!
+!> Repeat the g-xTB syscall note (non-WITH_GXTB path) if g-xTB was requested
+  if (env%gfnver == '--gxtb') call gxtb_syscall_warning()
+
 !=========================================================================================!
 !> Evaluate and print timings, then stop the program
   call eval_timer(tim)
diff --git a/src/crest_pars.f90 b/src/crest_pars.f90
index c18ebbe7..0bc28740 100644
--- a/src/crest_pars.f90
+++ b/src/crest_pars.f90
@@ -1,22 +1,23 @@
 module crest_parameters
-  use iso_fortran_env, only: wp => real64, sp => real32
-  use iso_fortran_env, only: ap => real64 
-  use iso_fortran_env, only: dp => int64
-  use iso_fortran_env, only: int8,int16,int32,int64,real64,real32
-  use iso_fortran_env, only: stdout => output_unit
-  use iso_fortran_env, only: stderr => error_unit
+  use iso_fortran_env,only:wp => real64,sp => real32
+  use iso_fortran_env,only:ap => real64
+  use iso_fortran_env,only:dp => int64
+  use iso_fortran_env,only:int8,int16,int32,int64,real64,real32
+  use iso_fortran_env,only:stdout => output_unit
+  use iso_fortran_env,only:stderr => error_unit
 
   public :: wp,sp,ap,dp,stdout,stderr
   public :: int8,int16,int32,int64,real64,real32
 
   real(wp),parameter,public :: bohr = 0.52917726_wp
-  real(wp),parameter,public :: angstrom = 1.0_wp / bohr
+  real(wp),parameter,public :: angstrom = 1.0_wp/bohr
   real(wp),parameter,public :: autoaa = bohr
   real(wp),parameter,public :: aatoau = angstrom
 
-  real(wp),parameter,public :: pi  = acos(0.0_wp)*2.0_wp
-  real(wp),parameter,public :: radtodeg = 180.0_wp / pi
-  real(wp),parameter,public :: degtorad = 1.0_wp / radtodeg
+  real(wp),parameter,public :: pi = acos(0.0_wp)*2.0_wp
+  real(wp),parameter,public :: radtodeg = 180.0_wp/pi
+  real(wp),parameter,public :: euler = 2.718281828459045_wp
+  real(wp),parameter,public :: degtorad = 1.0_wp/radtodeg
 
   real(wp),parameter,public :: amutokg = 1.660539040e-27_wp
   real(wp),parameter,public :: autokj = 2625.49964038_wp
@@ -26,8 +27,17 @@ module crest_parameters
   real(wp),parameter,public :: kcaltokj = autokj/autokcal
   real(wp),parameter,public :: autorcm = 219474.63067_wp
   real(wp),parameter,public :: rcmtoau = 1.0_wp/autorcm
-  real(wp),parameter,public :: metokg  = 9.10938356e-31_wp
-  real(wp),parameter,public :: kgtome  = 1.0_wp/metokg
+  real(wp),parameter,public :: metokg = 9.10938356e-31_wp
+  real(wp),parameter,public :: kgtome = 1.0_wp/metokg
+
+  real(wp),parameter,public :: c_vacuum = 299792458e0_wp
+  real(wp),parameter,public :: mhztorcm = 1.0_wp/(c_vacuum*10e-05_wp)
+  !> Coulomb to atomic charge units (electrons)
+  real(wp),public,parameter :: autoc = 1.6021766208e-19_wp
+  real(wp),parameter,public :: ctoau = 1.0_wp/autoc
+  real(wp),parameter,private :: fine_structure_constant = 7.2973525693e-3_wp
+  real(wp),parameter,public :: jtoau = 1.0_wp/(metokg*c_vacuum**2*fine_structure_constant**2)
+  real(wp),parameter,public :: vatoau = jtoau/(ctoau*aatoau)
 
   real(wp),parameter,public :: Rcal = 8.31446261815324_wp/kcaltokj
   real(wp),parameter,public :: kB = 3.166808578545117e-06_wp
@@ -35,14 +45,13 @@ module crest_parameters
   real(wp),parameter,public :: planck = 6.62606957e-34_wp ! J*s
   real(wp),parameter,public :: hbar = planck/(2.0_wp*pi)
 
-  real(wp),public,parameter :: lightspeed = 137.0359990740_wp 
+  real(wp),public,parameter :: lightspeed = 137.0359990740_wp
   !> femtosectons to atomic time units
-  real(wp), public, parameter :: fstoau = 41.3413733365614_wp
-  !> Coulomb to atomic charge units (electrons)
-  real(wp), public, parameter :: autoc = 1.6021766208e-19_wp
+  real(wp),public,parameter :: fstoau = 41.3413733365614_wp
+
   !> Debye to atomic units
-  real(wp), public, parameter :: autod = autoc * lightspeed * autoaa**2 * fstoau * 1.0e+16_wp
-  real(wp), public, parameter :: dtoau = 1.0_wp / autod
+  real(wp),public,parameter :: autod = autoc*lightspeed*autoaa**2*fstoau*1.0e+16_wp
+  real(wp),public,parameter :: dtoau = 1.0_wp/autod
 
   character(len=1),public,parameter :: sep = '/'
   character(len=12),public,parameter :: dev0 = ' 2>/dev/null'
diff --git a/src/discretize/discretize.f90 b/src/discretize/discretize.f90
index 9bf8408a..c7f993eb 100644
--- a/src/discretize/discretize.f90
+++ b/src/discretize/discretize.f90
@@ -29,7 +29,7 @@ subroutine discretize_trj(env)
   use zdata,only:readwbo
   use adjacency
   use INTERNALS_mod
-  use rigidconf_analyze
+  use molbuilder_rigidconf_analyze
   use discretize_module
   implicit none
   !> INPUT/OUTPUT
@@ -105,7 +105,8 @@ subroutine discretize_trj(env)
   if (.true.) then
     zmax = mol%nat
     allocate (ztod(zmax),source=0)
-    call rigidconf_count_fallback(mol%nat,na,nb,nc,wbo,ndieder,ztod)
+    Amat(:,:) = nint(wbo(:,:))
+    call rigidconf_count_fallback(mol%nat,na,nb,nc,Amat,ndieder,ztod)
     if (ndieder < 1) stop 'no dihedral angles detected!'
 
     allocate (drep(ndieder),source=0)
diff --git a/src/dynamics/dynamics_module.f90 b/src/dynamics/dynamics_module.f90
index e71d63f1..1f317766 100644
--- a/src/dynamics/dynamics_module.f90
+++ b/src/dynamics/dynamics_module.f90
@@ -1,7 +1,7 @@
 !================================================================================!
 ! This file is part of crest.
 !
-! Copyright (C) 2021 - 2023 Philipp Pracht
+! Copyright (C) 2021 - 2026 Philipp Pracht
 !
 ! crest is free software: you can redistribute it and/or modify it under
 ! the terms of the GNU Lesser General Public License as published by
@@ -23,6 +23,7 @@
 module dynamics_module
   use crest_parameters
   use crest_calculator
+  use iomod
   use strucrd
   use atmasses
   use shake_module
@@ -60,6 +61,7 @@ module dynamics_module
     integer :: simtype = type_md !> type of the molecular dynamics simulation
     logical :: restart = .false.
     character(len=:),allocatable :: restartfile
+    logical :: wrtrj = .true.
     character(len=:),allocatable :: trajectoryfile
     !>--- data
     real(wp) :: length_ps = 0.0_wp !20.0_wp  !> total simulation length in ps
@@ -77,8 +79,12 @@ module dynamics_module
     type(shakedata) :: shk !> SHAKE bond information
 
     real(wp) :: tsoll = 0.0_wp !298.15_wp  !> wanted temperature
+    real(wp) :: Tavg = 0.0_wp  !> trajectory-average temperature (set after dynamics())
+    real(wp) :: Tvar = 0.0_wp  !> trajectory temperature variance (set after dynamics())
+    integer  :: Ndf = 0       !> degrees of freedom used in the run (set after dynamics())
     logical :: thermostat = .true. !> apply thermostat?
     character(len=64) :: thermotype = 'berendsen'
+    integer :: thermotype_i = 2 !> integer mapping thermostats, 2=berendsen
     real(wp) :: thermo_damp = 500.0_wp !> thermostat damping parameter
     logical :: samerand = .false.
 
@@ -108,6 +114,12 @@ module dynamics_module
   public :: dynamics
   public :: mdautoset
 
+  character(len=30),parameter,private :: thermostattype(4) = [ &
+     & 'None                         ', &
+     & 'Berendsen                    ', &
+     & 'Langevin                     ', &
+     & 'Bussi-Donadio-Parrinello     ']
+
 !========================================================================================!
 !========================================================================================!
 contains  !> MODULE PROCEDURES START HERE
@@ -118,8 +130,8 @@ subroutine dynamics(mol,dat,calc,pr,term)
 !*************************************************************
 !* subroutine dynamics
 !* perform a molecular dynamics simulation
-!* the coordinate propagation is made with an 
-!* Leap-Frog algorithm (Velert-type algo)
+!* the coordinate propagation is made with an
+!* Leap-Frog algorithm (Verlet-type algo)
 !*************************************************************
     implicit none
 
@@ -134,7 +146,9 @@ subroutine dynamics(mol,dat,calc,pr,term)
     real(wp) :: epot,ekin,edum
     real(wp) :: temp,thermoscal
 !>--- averages & errors
-    real(wp) :: Tav,Epav,Ekav,Eerror
+    real(wp) :: Tav,Tav2,Epav,Ekav,Eerror
+!>--- block statistics (computed before printout)
+    real(wp) :: eblk_mean,eblk_std,eblk_drift
 
     real(wp),allocatable :: grd(:,:)
     real(wp),allocatable :: velo(:,:)
@@ -142,53 +156,70 @@ subroutine dynamics(mol,dat,calc,pr,term)
     real(wp),allocatable :: veln(:,:)
     real(wp),allocatable :: acc(:,:)
     real(wp),allocatable :: mass(:)
-    real(wp),allocatable :: xyz_angstrom(:,:)
     real(wp),allocatable :: backupweights(:)
     type(coord) :: molo
     real(wp) :: f,rt,rtshift
     real(wp) :: molmass,tmass
+    real(wp),allocatable :: cn(:)
     character(len=:),allocatable :: trajectory
     integer :: trj
     character(len=256) :: commentline
     integer :: i,j,k,l,ich,och,io
     integer :: dcount,printcount
-    logical :: ex,fail,bdump
+    integer,allocatable :: iseed(:)
+    logical :: ex,fail,bdump,shakefallback
 
     call initsignal()
 
 !>--- pre-settings and calculations
     !$omp critical
     call dat%defaults() !> check for unset parameters
+!>--- seed RNG before any stochastic use (velocity init or thermostat steps)
+    if (dat%samerand) then
+      call random_seed(size=i)
+      allocate (iseed(i),source=1)
+      call random_seed(put=iseed)
+      deallocate (iseed)
+    else
+      call random_seed()
+    end if
     term = 0
     tstep_au = dat%tstep*fstoau
     nfreedom = 3*mol%nat
-    if(calc%nfreeze > 0)then
-      nfreedom = nfreedom - 3*calc%nfreeze
-    endif
+    shakefallback = .false.
+    if (calc%nfreeze > 0) then
+      nfreedom = nfreedom-3*calc%nfreeze
+    end if
     if (dat%shake) then
-      if(calc%nfreeze > 0)then
+      if (calc%nfreeze > 0) then
         dat%shk%freezeptr => calc%freezelist
       else
-        nullify(dat%shk%freezeptr)
-      endif
+        nullify (dat%shk%freezeptr)
+      end if
+      if (.not.allocated(dat%shk%wbo)) then
+        !> fake bondorder fallback for shake
+        shakefallback = .true.
+        call mol%cn_to_bond(cn,dat%shk%wbo)
+        deallocate (cn)
+      end if
       call init_shake(mol%nat,mol%at,mol%xyz,dat%shk,pr)
       dat%nshake = dat%shk%ncons
       nfreedom = nfreedom-dat%nshake
     end if
 !>--- averages
     tav = 0.0_wp
+    tav2 = 0.0_wp
     eerror = 0.0_wp
     ekav = 0.0_wp
     epav = 0.0_wp
     temp = 0.0_wp
 
 !>--- on-the-fly multiscale definition
-    if(allocated(dat%active_potentials))then
+    if (allocated(dat%active_potentials)) then
       call calc%active(dat%active_potentials)
-    endif
+    end if
 
 !>--- allocate data fields
-    allocate (xyz_angstrom(3,mol%nat))
     allocate (molo%at(mol%nat),molo%xyz(3,mol%nat))
     allocate (grd(3,mol%nat),vel(3,mol%nat),velo(3,mol%nat),source=0.0_wp)
     allocate (veln(3,mol%nat),acc(3,mol%nat),mass(mol%nat),source=0.0_wp)
@@ -198,31 +229,41 @@ subroutine dynamics(mol,dat,calc,pr,term)
 
 !>--- settings printout
     if (pr) then
-      write (*,*)
-      write (*,'("> ",a)') 'Molecular dynamics settings'
-      write (*,'('' MD time /ps        :'',f10.2)') dat%length_ps
-      write (*,'('' dt /fs             :'',f10.2)') dat%tstep
-      write (*,'('' temperature /K     :'',f10.2)') dat%tsoll
-      write (*,'('' max steps          :'',i10  )') dat%length_steps
-      write (*,'('' block length (av.) :'',i10  )') dat%blockl
-      write (*,'('' dumpstep(trj) /fs  :'',f10.2,i6)') dat%dumpstep,dat%sdump
-      write (*,'('' # deg. of freedom  :'',i10  )') nfreedom
-      if(calc%nfreeze > 0)then
-      write (*,'('' # frozen atoms     :'',i10  )') calc%nfreeze
-      endif
+      write (stdout,*)
+      write (stdout,'(1x,15("─"),1x,a,1x,14("─"))') 'Molecular Dynamics Settings'
+      write (stdout,'("  Simulation type",t25,       ":",1x)',advance='no')
+      if (dat%thermostat) then
+        write (stdout,'(a9)') 'NVT'
+      else
+        write (stdout,'(a9)') 'NVE'
+      end if
+      write (stdout,'("  MD time (length)",t25,       ":",f10.2,a)') dat%length_ps,' ps'
+      write (stdout,'("  dt (timetep)",t25,            ":",f10.2,a)') dat%tstep,' fs'
+      write (stdout,'("  temperature",t25,    ":",f10.2,a)') dat%tsoll,' K'
+      write (stdout,'("  max steps",t25,         ":",i10  )') dat%length_steps
+      write (stdout,'("  block length (av.)",t25,":",i10  )') dat%blockl
+      write (stdout,'("  dumpstep(trj) /fs",t25, ":",f10.2,1x,"(",i0,")")') dat%dumpstep,dat%sdump
+      write (stdout,'("  # deg. of freedom",t25, ":",i10  )') nfreedom
+      if (calc%nfreeze > 0) then
+        write (stdout,'("  # frozen atoms",t25,     ":",i10  )') calc%nfreeze
+      end if
       call thermostatprint(dat,pr)
-      write (*,'('' SHAKE constraint   :'',8x,l)') dat%shake
+      write (stdout,'("  SHAKE constraint",t25,   ":",1x,a9)') to_str(dat%shake)
       if (dat%shake) then
+        if (shakefallback) then
+          write (stdout,'("  SHAKE using CN fallback",t25,":",9x,l)') shakefallback
+        end if
         if (dat%shk%shake_mode == 2) then
-          write (*,'('' # SHAKE bonds      :'',i10,a)') dat%nshake,' (all bonds)'
+          write (stdout,'("  # SHAKE bonds",t25,":",i10,a)') dat%nshake,' (all bonds)'
         elseif (dat%shk%shake_mode == 1) then
-          write (*,'('' # SHAKE bonds      :'',i10,a)') dat%nshake,' (H only)'
+          write (stdout,'("  # SHAKE bonds",t25,":",i10,a)') dat%nshake,' (H only)'
         end if
       end if
-      write (*,'('' hydrogen mass /u   :'',f10.5 )') dat%md_hmass
-      if(allocated(dat%active_potentials))then
-       write (*,'('' active potentials  :'',i10)') size(dat%active_potentials,1)
-      endif
+      write (stdout,'("  hydrogen mass /u",t25,":",f10.5 )') dat%md_hmass
+      if (allocated(dat%active_potentials)) then
+        write (stdout,'("  active potentials",t25,":",i10)') size(dat%active_potentials,1)
+      end if
+
     end if
 
 !>--- set atom masses
@@ -249,28 +290,29 @@ subroutine dynamics(mol,dat,calc,pr,term)
     end if
     edum = f*dat%tsoll*0.5_wp*kB*float(nfreedom)
     rtshift = 0.0_wp
-    if(.not.dat%restart .or. .not.allocated(dat%restartfile))then 
-     call mdinitu(mol,dat,velo,mass,edum,pr)
+    if (.not.dat%restart.or..not.allocated(dat%restartfile)) then
+      call mdinitu(mol,dat,velo,mass,edum,pr)
     else
-     call rdmdrestart(mol,dat,velo,fail,rtshift)
-     if(fail)then
+      call rdmdrestart(mol,dat,velo,fail,rtshift,pr)
+      if (fail) then
         call mdinitu(mol,dat,velo,mass,edum,pr)
-     else
-       call ekinet(mol%nat,velo,mass,ekin)
-       temp = 2.0_wp*ekin/float(nfreedom)/kB
-       tav = temp
-     endif
-    endif 
+      else
+        call ekinet(mol%nat,velo,mass,ekin)
+        temp = 2.0_wp*ekin/float(nfreedom)/kB
+        tav = temp
+        tav2 = temp**2
+      end if
+    end if
     call ekinet(mol%nat,velo,mass,ekin)
-    if(calc%nfreeze > 0)then
-       do i = 1,mol%nat
-         if(calc%freezelist(i))then
-           acc(:,i) = 0.0_wp
-           grd(:,i) = 0.0_wp
-           velo(:,i) = 0.0_wp
-         endif
-       end do
-     endif
+    if (calc%nfreeze > 0) then
+      do i = 1,mol%nat
+        if (calc%freezelist(i)) then
+          acc(:,i) = 0.0_wp
+          grd(:,i) = 0.0_wp
+          velo(:,i) = 0.0_wp
+        end if
+      end do
+    end if
 
 !>--- initialize MTDs (if required)
     !$omp critical
@@ -287,17 +329,20 @@ subroutine dynamics(mol,dat,calc,pr,term)
       trajectory = trim(commentline)
     end if
     !$omp critical
-    open (newunit=trj,file=trajectory)
+    if (dat%wrtrj) open (newunit=trj,file=trajectory)
+    mol%wrextxyz = calc%logextxyz
     !$omp end critical
 
 !>--- begin printout
     if (pr) then
-      write (*,'(/,"> ",a)') 'Starting simulation'
+      write (stdout,'(1x,58("─"))')
+
+      write (stdout,'(/,"> ",a)') 'Starting simulation'
       if (.not.dat%thermostat) then
-        write (*,'(/,11x,"time (ps)",7x,"<Epot>",8x,"Ekin",5x,"<T>",7x,"T",12x, &
+        write (stdout,'(/,11x,"time (ps)",7x,"<Epot>",8x,"Ekin",5x,"<T>",7x,"T",12x, &
            &         "Etot",7x,"error")')
       else
-        write (*,'(/,11x,"time (ps)",7x,"<Epot>",8x,"Ekin",5x,"<T>",7x,"T",12x, &
+        write (stdout,'(/,11x,"time (ps)",7x,"<Epot>",8x,"Ekin",5x,"<T>",7x,"T",12x, &
            &         "Etot")')
       end if
     end if
@@ -315,6 +360,7 @@ subroutine dynamics(mol,dat,calc,pr,term)
       epot = 0.0_wp
       grd = 0.0_wp
       call engrad(mol,calc,epot,grd,io)
+      mol%energy = epot
 
       if (io /= 0) then
         if (dat%dumped > 0) then
@@ -340,12 +386,12 @@ subroutine dynamics(mol,dat,calc,pr,term)
       !>--- block data printouts
       call u_block(mol,dat,epot,temp,pr,bdump)
       !>--- MD restart files written for each block rather than at each timestep to reduce I/O
-      if(bdump)then
-        rt = float(t)*dat%tstep + rtshift
+      if (bdump) then
+        rt = float(t)*dat%tstep+rtshift
         !$omp critical
-        call wrmdrestart(mol,dat,velo,rt) 
+        call wrmdrestart(mol,dat,velo,rt)
         !$omp end critical
-      endif 
+      end if
 
       !===========================================!
       !>>-- write to trajectory and printout
@@ -353,22 +399,20 @@ subroutine dynamics(mol,dat,calc,pr,term)
         dcount = 0
         dat%dumped = dat%dumped+1
         !$omp critical
-        xyz_angstrom = mol%xyz*bohr
-        write (commentline,'(a,f22.12,1x,a)') 'Epot =',epot,''
-        call wrxyz(trj,mol%nat,mol%at,xyz_angstrom,commentline)
+        if (dat%wrtrj) call mol%append(trj)
         !$omp end critical
       end if
       if ((printcount == dat%printstep).or.(t == 1)) then
         if (t > 1) printcount = 0
         if (pr) then
-          rt = float(t)*dat%tstep + rtshift
+          rt = float(t)*dat%tstep+rtshift
           if (.not.dat%thermostat) then
-            write (*,'(i7,f10.2,F16.5,F12.4,2F8.1,F16.5,4F10.4)') &
+            write (stdout,'(i7,f10.2,F16.5,F12.4,2F8.1,F16.5,4F10.4)') &
                &   t,0.001_wp*rt, (Epav+Epot)/float(t), &
                &   Ekin,Tav/float(t),temp,Epot+Ekin, &
                &   Edum/float(t)-Epot-Ekin
           else
-            write (*,'(i7,f10.2,F16.5,F12.4,2F8.1,F16.5)') &
+            write (stdout,'(i7,f10.2,F16.5,F12.4,2F8.1,F16.5)') &
                &   t,0.001_wp*rt, (Epav+epot)/float(t), &
                &   Ekin,Tav/float(t),temp,Epot+Ekin
           end if
@@ -381,14 +425,14 @@ subroutine dynamics(mol,dat,calc,pr,term)
       end do
 
       !>--- special setup for frozen atoms
-      if(calc%nfreeze > 0)then
-       do i = 1,mol%nat
-         if(calc%freezelist(i))then
-           acc(:,i) = 0.0_wp
-           grd(:,i) = 0.0_wp
-         endif
-       end do
-      endif
+      if (calc%nfreeze > 0) then
+        do i = 1,mol%nat
+          if (calc%freezelist(i)) then
+            acc(:,i) = 0.0_wp
+            grd(:,i) = 0.0_wp
+          end if
+        end do
+      end if
 
       !>--- store positions (at t); velocities are at t-1/2dt
       !$omp critical
@@ -405,25 +449,45 @@ subroutine dynamics(mol,dat,calc,pr,term)
       call ekinet(mol%nat,veln,mass,ekin)
       temp = 2.0_wp*ekin/float(nfreedom)/kB
 
-      !>--- THERMOSTATING (determine factor thermoscal)
-      call thermostating(mol,dat,temp,thermoscal)
-
-      !>>-- STEP 3: velocity and position update
-      !>--- update velocities to t
-      vel = thermoscal*(velo + acc*tstep_au)
-
-      !>--- update positions to t+dt, except for frozen atoms
-      if(calc%nfreeze > 0)then
-       do i = 1,mol%nat
-         if(.not.calc%freezelist(i))then
-           mol%xyz(:,i) = molo%xyz(:,i)+vel(:,i)*tstep_au
-         else
-           vel(:,i) = 0.0_wp
-         endif
-       end do
-      else  
-        mol%xyz = molo%xyz+vel*tstep_au
-      endif
+      !>--- THERMOSTATING and velocity update
+      if (dat%thermotype_i == 3) then !'langevin') then
+        if (dat%thermostat) then
+          call langevin_step(mol%nat,dat,mass,velo,acc,tstep_au,vel)
+        else
+          vel = velo+acc*tstep_au
+        end if
+      else
+        !>>-- STEP 3: velocity update for scaling thermostats
+        !>--- compute trial velocity (unscaled leapfrog step)
+        vel = velo+acc*tstep_au
+        !>--- Bussi/CSVR: recompute ekin from the actual trial velocity so that
+        !>--- the scaling scal=sqrt(K_new/ekin) gives Ekin(vel_scaled)=K_new exactly.
+        !>--- Using the half-step estimate veln would give Ekin(vel_scaled)=K_new*(Efull/Ehalf)
+        !>--- and systematically overshoot the target temperature by ~Efull/Ehalf.
+        if (dat%thermostat.and. &
+           & dat%thermotype_i == 4) then
+          !& (trim(dat%thermotype) == 'bussi'.or.trim(dat%thermotype) == 'csvr')) then
+          call ekinet(mol%nat,vel,mass,ekin)
+          temp = 2.0_wp*ekin/float(nfreedom)/kB
+        end if
+        call thermostating(mol,dat,temp,ekin,nfreedom,thermoscal)
+        vel = thermoscal*vel
+      end if
+
+      !>--- update positions to t+dt, except for frozen atoms, and not at the final step
+      if (t < dat%length_steps) then
+        if (calc%nfreeze > 0) then
+          do i = 1,mol%nat
+            if (.not.calc%freezelist(i)) then
+              mol%xyz(:,i) = molo%xyz(:,i)+vel(:,i)*tstep_au
+            else
+              vel(:,i) = 0.0_wp
+            end if
+          end do
+        else
+          mol%xyz = molo%xyz+vel*tstep_au
+        end if
+      end if
 
       !>--- estimate new velocities at t
       veln = 0.5_wp*(velo+vel)
@@ -455,6 +519,7 @@ subroutine dynamics(mol,dat,calc,pr,term)
       edum = edum+epot+ekin
       eerror = edum/float(t)-epot-ekin
       tav = tav+temp
+      tav2 = tav2+temp**2
       epav = epav+epot
       ekav = ekav+ekin
       dcount = dcount+1
@@ -466,47 +531,76 @@ subroutine dynamics(mol,dat,calc,pr,term)
 !===============================================================!
 !>--- close trajectory file
     !$omp critical
-    close (trj)
+    if (dat%wrtrj) close (trj)
     !$omp end critical
 
+!>--- block energy statistics (blockrege still allocated here)
+    eblk_mean = 0.0_wp
+    eblk_std = 0.0_wp
+    eblk_drift = 0.0_wp
+    if (dat%nblock >= 1) then
+      eblk_mean = sum(dat%blockrege(1:dat%nblock))/real(dat%nblock,wp)
+    end if
+    if (dat%nblock >= 2) then
+      eblk_std = sqrt(sum((dat%blockrege(1:dat%nblock)-eblk_mean)**2) &
+               &      /real(dat%nblock-1,wp))
+      !> drift in Eh/ps: endpoint slope over all completed blocks
+      eblk_drift = (dat%blockrege(dat%nblock)-dat%blockrege(1)) &
+                 & /real(dat%nblock-1,wp) &
+                 & /(dat%blockl*dat%tstep*1.0e-3_wp)
+    end if
+
 !>--- averages printout
     if (pr) then
-      write (*,*)
-      write (*,*) 'average properties '
-      write (*,*) '----------------------'
-      write (*,*) '<Epot> / Eh          :',Epav/float(t)
-      write (*,*) '<Ekin> / Eh          :',Ekav/float(t)
-      write (*,*) '<Etot> / Eh          :', (Ekav+Epav)/float(t)
-      write (*,*) '<T> / K              :',Tav/float(t)
+      write (stdout,*)
+      write (stdout,'(1x,a)') 'average properties'
+      write (stdout,'(1x,a)') repeat('-',42)
+      write (stdout,'(1x,a,t22,f16.8,a)') '<Epot>',Epav/float(t),' Eh'
+      write (stdout,'(1x,a,t22,f16.8,a)') '<Ekin>',Ekav/float(t),' Eh'
+      write (stdout,'(1x,a,t22,f16.8,a)') '<Etot>', (Ekav+Epav)/float(t),' Eh'
+      write (stdout,'(1x,a,t28,f10.2,a)') '<T>',Tav/float(t),' K'
+      write (stdout,'(1x,a,t28,f10.2,a)') 'Tvar',tav2/float(t)-(tav/float(t))**2,' K²'
+      write (stdout,'(1x,a,t29,f10.2,a)') 'σ(T)',sqrt(max(tav2/float(t)-(tav/float(t))**2,0.0_wp)),' K'
+      if (dat%nblock >= 2) then
+        write (stdout,'(1x,a)') repeat('-',42)
+        write (stdout,'(1x,a,t28,i10,a)') 'blocks',dat%nblock,' '
+        write (stdout,'(1x,a,t23,f16.8,a)') 'block σ(Epot)',eblk_std,' Eh'
+        write (stdout,'(1x,a,t28,es10.2,a)') 'drift',eblk_drift,' Eh/ps'
+      end if
+      write (stdout,'(1x,a)') repeat('-',42)
     end if
 
 !>--- write restart file
-    rt = float(dat%length_steps)*dat%tstep + rtshift
+    rt = float(dat%length_steps)*dat%tstep+rtshift
     call wrmdrestart(mol,dat,velo,rt)
 
 !>--- termination printout
     if (pr) then
       select case (term)
       case (0)
-        write (*,*) 'normal MD termination'
+        write (stdout,*) 'normal MD termination'
       case (1)
         write (stderr,*) 'error in MD calculation'
       case (2)
-        write (*,*) 'MD terminated, but still taking as converged.'
+        write (stdout,*) 'MD terminated, but still taking as converged.'
       end select
     end if
 
+!>--- store trajectory-average temperature for callers
+    dat%Tavg = tav/float(t)
+    dat%Tvar = tav2/float(t)-(tav/float(t))**2
+    dat%Ndf = nfreedom
+
 !>--- deallocate data
     deallocate (dat%blockrege,dat%blockt,dat%blocke)
     deallocate (mass,acc,veln)
     deallocate (vel,velo,grd)
     deallocate (molo%xyz,molo%at)
-    deallocate (xyz_angstrom)
 
 !>--- restore weights if necessary
-    if(allocated(dat%active_potentials))then
+    if (allocated(dat%active_potentials)) then
       call calc%active_restore()
-    endif
+    end if
 
     return
   end subroutine dynamics
@@ -564,6 +658,65 @@ subroutine ekinet(n,velo,mass,E)
     return
   end subroutine ekinet
 
+!========================================================================================!
+! subroutine random_gauss
+! sample one standard normal N(0,1) via Box-Muller transform
+  subroutine random_gauss(z)
+    !*************************************
+    !* Sample one standard normal N(0,1) *
+    !* via Box-Muller transform.         *
+    !*************************************
+    implicit none
+    real(wp),intent(out) :: z
+    real(wp) :: u1,u2
+    real(wp),parameter :: twopi = 6.28318530717958647693_wp
+    do
+      call random_number(u1)
+      if (u1 > 0.0_wp) exit
+    end do
+    call random_number(u2)
+    z = sqrt(-2.0_wp*log(u1))*cos(twopi*u2)
+    return
+  end subroutine random_gauss
+
+!========================================================================================!
+! subroutine random_gamma
+! sample x ~ Gamma(a,1) using the Marsaglia-Tsang (2000) algorithm
+  subroutine random_gamma(a,x)
+    !*****************************************************
+    !* Sample x ~ Gamma(a,1) using Marsaglia-Tsang 2000. *
+    !* For a < 1: apply the relation Gamma(a) = Gamma(a+1)*U^(1/a). *
+    !*****************************************************
+    implicit none
+    real(wp),intent(in)  :: a
+    real(wp),intent(out) :: x
+    real(wp) :: d,c,z,v,u,aa
+    logical  :: small
+    small = (a < 1.0_wp)
+    aa = merge(a+1.0_wp,a,small)
+    d = aa-1.0_wp/3.0_wp
+    c = 1.0_wp/sqrt(9.0_wp*d)
+    do
+      do
+        call random_gauss(z)
+        v = (1.0_wp+c*z)**3
+        if (v > 0.0_wp) exit
+      end do
+      call random_number(u)
+      if (u < 1.0_wp-0.0331_wp*z**2*z**2) then
+        x = d*v; exit
+      end if
+      if (log(u) < 0.5_wp*z**2+d*(1.0_wp-v+log(v))) then
+        x = d*v; exit
+      end if
+    end do
+    if (small) then
+      call random_number(u)
+      x = x*u**(1.0_wp/a)
+    end if
+    return
+  end subroutine random_gamma
+
 !========================================================================================!
 ! subroutine u_block
 ! update block data and printout
@@ -595,8 +748,8 @@ subroutine u_block(mol,dat,epot,temp,pr,bdump)
         slope = 99.0_wp
       end if
       if (pr) then
-        write (*,'(''block <Epot> / <T> :'',f14.5,f7.1,4x, &
-           &             ''drift:'',d10.2,3x,''Tbath :'',f6.1)')  &
+        write (stdout,'("block <Epot> / <T> :",f14.5,f7.1,4x, &
+           &             "drift:",d10.2,3x,"Tbath :",f6.1)')  &
            &             bave,bavt,slope,dat%tsoll
       end if
     else
@@ -669,8 +822,8 @@ subroutine wrmdrestart(mol,dat,velo,realtime_fs)
     integer :: i,j,k,l,ich,och,io
     logical :: ex
     character(len=256) :: atmp
-    if (.not.allocated(dat%restartfile) .or. dat%restart) then
-    !>--- we must not overwrite the user-provided restart file!
+    if (.not.allocated(dat%restartfile).or.dat%restart) then
+      !>--- we must not overwrite the user-provided restart file!
       write (atmp,'(a,i0,a)') 'crest_',dat%md_index,'.mdrestart'
     else
       atmp = dat%restartfile
@@ -684,13 +837,14 @@ subroutine wrmdrestart(mol,dat,velo,realtime_fs)
     return
   end subroutine wrmdrestart
 
-  subroutine rdmdrestart(mol,dat,velo,fail,rtshift)
+  subroutine rdmdrestart(mol,dat,velo,fail,rtshift,pr)
     implicit none
     type(coord) :: mol
     type(mddata) :: dat
     real(wp),intent(inout) :: velo(3,mol%nat)
     logical,intent(out) :: fail
     real(wp),intent(out) :: rtshift
+    logical,intent(in) :: pr
     real(wp) :: dum
     character(len=256) :: atmp
     integer :: i,j,k,l,ich,och,io
@@ -706,7 +860,7 @@ subroutine rdmdrestart(mol,dat,velo,fail,rtshift)
       do
         read (ich,*,iostat=io) dum
         if (io < 0) exit
-        if(dum > 0.0_wp) rtshift = dum 
+        if (dum > 0.0_wp) rtshift = dum
         do i = 1,mol%nat
           read (ich,'(a)',iostat=io) atmp
           if (io < 0) exit
@@ -723,9 +877,10 @@ subroutine rdmdrestart(mol,dat,velo,fail,rtshift)
     else
       fail = .true.
     end if
-    if(.not.fail)then
-      write (*,'(1x,a,8x,l)') 'read restart file  :',.not.fail
-    endif
+    if (.not.fail.and.pr) then
+      write (stdout,'("  read RESTART file",t25,":",1x,a9)') to_str(.not.fail)
+      write (stdout,'("  restart file",t25,":",1x,a)') dat%restartfile
+    end if
 
     return
   end subroutine rdmdrestart
@@ -743,9 +898,7 @@ subroutine mdinitu(mol,dat,velo,mass,Ekin,pr)
     real(wp),intent(in) :: Ekin
     logical,intent(in) :: pr
     real :: x(3),ranf
-    integer :: n
     real(wp) :: eperat,v,f,t,edum,f2
-    integer,allocatable :: iseed(:)
     logical :: newvelos
     integer :: i
 
@@ -753,13 +906,6 @@ subroutine mdinitu(mol,dat,velo,mass,Ekin,pr)
 
     !>--- newly initialized
     if (newvelos) then
-      if (dat%samerand) then
-        call random_seed(size=n)
-        allocate (iseed(n),source=1)
-        call random_seed(put=iseed)
-      else
-        call random_seed()
-      end if
       eperat = Ekin/(3.0_wp*float(mol%nat))
       do i = 1,mol%nat
         call random_number(x)
@@ -787,30 +933,96 @@ end subroutine mdinitu
 ! helper routine to re-scale velocities,
 ! i.e., thermostating
 
-  subroutine thermostating(mol,dat,t,scal)
+  subroutine thermostating(mol,dat,t,ekin,nfreedom,scal)
+    !**************************************************************
+    !* Apply velocity-scaling thermostat and return scale factor. *
+    !* Supports: berendsen, bussi/csvr                            *
+    !**************************************************************
     implicit none
     type(coord) :: mol
     type(mddata) :: dat
     real(wp),intent(in) :: t
+    real(wp),intent(in) :: ekin
+    integer,intent(in)  :: nfreedom
     real(wp),intent(out) :: scal
-    integer :: i,j,k,l,ich,och,io
+    real(wp) :: c1,K_ref,K_new,gam,xi,chi2
+    integer  :: Nf
 
     scal = 1.0_wp
 
     if (.not.dat%thermostat) return
 
-    select case (trim(dat%thermotype))
-    case ('berendsen')
-      scal = dsqrt(1.0d0+(dat%tstep/dat%thermo_damp) &
-                  &     *(dat%tsoll/t-1.0_wp))
-    case default 
-    !>-- (no scaling, other thermostats require special implementation)
+    select case (dat%thermotype_i) !(trim(dat%thermotype))
+    case (2) !('berendsen')
+      scal = sqrt(1.0d0+(dat%tstep/dat%thermo_damp) &
+                 &     *(dat%tsoll/t-1.0_wp))
+    case (4) !('bussi','csvr')
+      !> Bussi-Donadio-Parrinello CSVR (J. Chem. Phys. 126, 014101, 2007)
+      !> Stochastic velocity rescaling for correct NVT ensemble sampling.
+      !>
+      !> Exact discrete update (paper Eq. A7):
+      !>   K_new = K*c1 + K_ref*(1-c1)/Nf * sum_i(z_i^2) + 2*sqrt(K*K_ref*c1*(1-c1)/Nf)*z1
+      !>   E[K_new] = K*c1 + K_ref*(1-c1)  →  converges to K_ref = Nf/2*kB*T
+      !>
+      !> Setting A = sqrt(K_ref*(1-c1)/Nf), B = sqrt(K*c1):
+      !>   sum term:  A^2*(z1^2 + chi2(Nf-1))  with chi2(Nf-1) = 2*Gamma((Nf-1)/2)
+      !>   cross term: 2*A*B*z1
+      !>   combined: (A*z1 + B)^2 + A^2*chi2(Nf-1)   <- always non-negative
+      Nf = nfreedom
+      c1 = exp(-dat%tstep/dat%thermo_damp)
+      K_ref = 0.5_wp*real(Nf,wp)*kB*dat%tsoll
+      xi = sqrt(K_ref*(1.0_wp-c1)/real(Nf,wp))   ! A = sqrt(K_ref*(1-c1)/Nf)
+      call random_gauss(chi2)                         ! z1 ~ N(0,1)
+      K_new = (xi*chi2+sqrt(ekin*c1))**2             ! (A*z1 + B)^2, B = sqrt(K*c1)
+      if (Nf > 1) then
+        call random_gamma(0.5_wp*real(Nf-1,wp),gam)  ! gam ~ Gamma((Nf-1)/2)
+        K_new = K_new+xi**2*2.0_wp*gam               ! + A^2 * chi2(Nf-1)
+      end if
+      scal = sqrt(K_new/max(ekin,1.0e-30_wp))
+    case default
+      !>-- (no scaling; langevin uses a separate integration path)
       scal = 1.0_wp
     end select
 
     return
   end subroutine thermostating
 
+!========================================================================================!
+! subroutine langevin_step
+! BBK Langevin velocity update for leapfrog MD
+  subroutine langevin_step(nat,dat,mass,velo,acc,tstep_au,vel)
+    !*************************************************************
+    !* Langevin BBK velocity update for leapfrog MD.             *
+    !* velo = v(t-dt/2), acc = a(t), vel = v(t+dt/2) on output.  *
+    !* Uses dat%thermo_damp as relaxation time tau (in fs).      *
+    !*************************************************************
+    implicit none
+    integer,intent(in)      :: nat
+    type(mddata),intent(in) :: dat
+    real(wp),intent(in)     :: mass(nat)
+    real(wp),intent(in)     :: velo(3,nat),acc(3,nat)
+    real(wp),intent(in)     :: tstep_au
+    real(wp),intent(out)    :: vel(3,nat)
+    real(wp) :: tau_au,gamma_dt,c1,c2,sigma
+    real(wp) :: xi
+    integer  :: i,k
+
+    tau_au = dat%thermo_damp*fstoau
+    gamma_dt = tstep_au/tau_au
+    c1 = (1.0_wp-0.5_wp*gamma_dt)/(1.0_wp+0.5_wp*gamma_dt)
+    c2 = tstep_au/(1.0_wp+0.5_wp*gamma_dt)
+
+    do i = 1,nat
+      sigma = sqrt(2.0_wp*kB*dat%tsoll*tstep_au/(mass(i)*tau_au)) &
+            & /(1.0_wp+0.5_wp*gamma_dt)
+      do k = 1,3
+        call random_gauss(xi)
+        vel(k,i) = c1*velo(k,i)+c2*acc(k,i)+sigma*xi
+      end do
+    end do
+    return
+  end subroutine langevin_step
+
   subroutine thermostatprint(dat,pr)
     implicit none
     type(mddata) :: dat
@@ -818,20 +1030,50 @@ subroutine thermostatprint(dat,pr)
     integer :: i,j,k,l,ich,och,io
 
     if (.not.pr) return
+    write (stdout,'("  thermostat",t25,":")',advance='no')
     if (dat%thermostat) then
       select case (trim(dat%thermotype))
       case ('berendsen')
-        write (*,'('' thermostat         :'',1x,a  )') trim(dat%thermotype)
-      case default !>-- (also berendsen thermostat)
-        write (*,'('' thermostat         :'',1x,a  )') 'berendsen'
+        write (stdout,'(1x,a  )') trim(thermostattype(2))
+      case ('bussi','csvr')
+        write (stdout,'(1x,a )') trim(thermostattype(4))
+      case ('langevin','bbk')
+        write (stdout,'(1x,a  )') trim(thermostattype(3))
+      case default
+        write (stdout,'(1x,a  )') trim(thermostattype(1))
       end select
     else
-      write (*,'('' thermostat         :'',1x,a  )') 'OFF'
+      write (stdout,'(1x,a  )') trim(thermostattype(1))
     end if
 
     return
   end subroutine thermostatprint
 
+  subroutine thermostat2int(dat)
+    implicit none
+    type(mddata) :: dat
+    integer :: i,j,k,l,ich,och,io
+
+    if (dat%thermostat) then
+      select case (trim(dat%thermotype))
+      case ('berendsen')
+        dat%thermotype_i = 2
+      case ('bussi','csvr')
+        dat%thermotype_i = 4
+      case ('langevin','bbk')
+        dat%thermotype_i = 3
+      case default
+        dat%thermotype_i = 1
+        dat%thermostat = .false.
+      end select
+    else
+      dat%thermotype_i = 1
+      dat%thermostat = .false.
+    end if
+
+    return
+  end subroutine thermostat2int
+
 !========================================================================================!
 ! subroutine zeroz
 ! remove z-directional acceleration of selected atoms
@@ -1202,11 +1444,13 @@ subroutine md_defaults_fallback(self)
     end if
 
     !> block length (for average analysis and restart dump)
-    if(self%blockl <= 0 )then
+    if (self%blockl <= 0) then
       self%blockl = min(5000,idint(5000.0_wp/self%tstep))
-    endif
+    end if
     self%maxblock = nint(self%length_steps/float(self%blockl))
 
+    call thermostat2int(self)
+
   end subroutine md_defaults_fallback
 !========================================================================================!
 !========================================================================================!
diff --git a/src/dynamics/metadynamics_module.f90 b/src/dynamics/metadynamics_module.f90
index 587028e3..f4cd42d5 100644
--- a/src/dynamics/metadynamics_module.f90
+++ b/src/dynamics/metadynamics_module.f90
@@ -101,7 +101,9 @@ subroutine mtd_ini(mol,pot,tstep,mdlength,pr)
     integer,allocatable :: at(:)
 
     if (pr) then
-      write (stdout,'(">--- metadynamics parameter ---")')
+      write (stdout,'(1X,17("─"))', advance='no')
+      write (stdout,'(1X,"Metadynamics Parameters")', advance='no')
+      write (stdout,'(1X,17("─"))')
     end if
 
     dum1 = anint((mdlength*1000.0_wp)/tstep)
@@ -158,7 +160,7 @@ subroutine mtd_ini(mol,pot,tstep,mdlength,pr)
       if (nat .ne. mol%nat) then !> can't do that! something is wrong
         if (allocated(pot%cvxyz)) deallocate (pot%cvxyz)
         pot%mtdtype = 0
-        write (*,'(1x,a)') '*WARNING* static metadynamics setup failed! Mismatch of #atoms'
+        write (stdout,'(1x,a)') '*WARNING* static metadynamics setup failed! Mismatch of #atoms'
         !return
         error stop
       end if
@@ -180,9 +182,9 @@ subroutine mtd_ini(mol,pot,tstep,mdlength,pr)
     !>--- printout
     if (pr) then
       call pot%info(stdout)
+      write (stdout,'(1X,59("─"))')
     end if
 
-
     return
   end subroutine mtd_ini
 
@@ -226,25 +228,30 @@ subroutine mtd_info(self,iunit)
     !write (iunit,'(" --- metadynamics parameter ---")')
     select case (self%mtdtype)
     case (cv_std_mtd)
-      write (iunit,'(" MTD/CV type   :",1x,a)') 'standard'
+      write (iunit,'("  MTD/CV type",t25,":",1x,a)') 'standard'
     case (cv_rmsd)
-      write (*,'(" MTD/CV type   :",1x,a)') 'RMSD bias'
+      write (stdout,'("  MTD/CV type",t25,":",1x,a)') 'RMSD bias'
     case (cv_rmsd_static)
-      write (iunit,'(" MTD/CV type   :",1x,a)') 'RMSD bias (static)'
+      write (iunit,'("  MTD/CV type",t25,":",1x,a)') 'RMSD bias (static)'
     end select
-    write (iunit,'(" kpush /Eh     :",f10.4)') self%kpush
-    write (iunit,'(" alpha /bohr⁻² :",f10.4)') self%alpha
+    write (iunit,'("  kpush /Eh",t25,":",f10.4)') self%kpush
+    write (iunit,'("  alpha /Bohr⁻²",t28,":",f10.4)') self%alpha
 
     select case (self%mtdtype)
     case (cv_rmsd)
-      write (iunit,'(" ramp          :",f10.4,1x,i0)') self%ramp,check_dump_steps_rmsd(self)
-      write (iunit,'(" dump/fs       :",f10.4,1x,i0 )') self%cvdump_fs,self%cvdumpstep
-      write (iunit,'(" # CVs (max)   :",i10 )') self%maxsave
+      write (iunit,'("  ramp rate",t25,":",f10.4,1x,"(",i0,")")') self%ramp,check_dump_steps_rmsd(self)
+      write (iunit,'("  dump/fs",t25,":",f10.4,1x,"(",i0,")")') self%cvdump_fs,self%cvdumpstep
+      write (iunit,'("  # CVs (max)",t25,":",i10 )') self%maxsave
     case (cv_rmsd_static)
-      if (allocated(self%biasfile)) write (iunit,'(" reading from  :",1x,a)') self%biasfile
-      write (iunit,'(" ramp (adjust.):",f10.4,1x,i0)') self%ramp,check_dump_steps_rmsd(self)
-      write (iunit,'(" # CVs (loaded):",i10 )') self%maxsave
+      if (allocated(self%biasfile)) write (iunit,'(" reading from",t25,":",1x,a)') self%biasfile
+      write (iunit,'("  ramp (adjust.)",t25,":",f10.4,1x,i0)') self%ramp,check_dump_steps_rmsd(self)
+      write (iunit,'("  # CVs (loaded)",t25,":",i10 )') self%maxsave
     end select
+    if (self%mtdtype == cv_rmsd.or.self%mtdtype == cv_rmsd_static) then
+      if (allocated(self%atinclude)) then
+        write (iunit,'("  # of atoms affected",t25,":",i10)') count(self%atinclude,1)
+      end if
+    end if
 
     return
   end subroutine mtd_info
@@ -278,7 +285,7 @@ subroutine cv_dump(mol,pot,cv,pr)
           call rmsdcv_perturb(mol%nat,pot%cvxyz(:,:,pot%ncur))
         end if
         if (pr) then
-          write (*,'(2x,"adding snapshot to metadynamics bias, now at ",i0," CVs")') pot%ncur
+          write (stdout,'(2x,"adding snapshot to metadynamics bias, now at ",i0," CVs")') pot%ncur
         end if
       end if
 
diff --git a/src/ensemblecomp.f90 b/src/ensemblecomp.f90
deleted file mode 100644
index 241fcbb0..00000000
--- a/src/ensemblecomp.f90
+++ /dev/null
@@ -1,380 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2018-2020 Philipp Pracht
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!================================================================================!
-
-!================================================================================!
-! ENSEMBLE COMPARISON FUNCTION.
-! To use execute:
-!   crest --compare <ensemble1> <ensemble2>
-!================================================================================!
-subroutine compare_ensembles(env)
-  use iso_fortran_env,only:wp => real64
-  use ls_rmsd
-  use iomod
-  use crest_data
-  use strucrd,only:rdensembleparam,rdensemble
-  use cregen_interface
-  implicit none
-
-  type(systemdata) :: env
-
-  integer :: i,j,k,l,kk,ll
-  integer :: be,ed
-  integer :: tr1,tr2
-  integer :: nat
-  integer :: dum,T,Tn
-  integer :: nat1,nat2
-  integer :: nall1,nall2
-  integer :: nconf1,nconf2
-  integer :: nrot1,nrot2
-  integer :: rcount
-  integer :: ich,ich2
-
-  real(wp) :: rthr
-  real(wp) :: rval
-  real(wp) :: min_1,min_2,min_tot
-
-  real(wp),allocatable :: gdum(:,:),Udum(:,:),xdum(:),ydum(:)  ! rmsd dummy stuff
-  real(wp),allocatable :: rmat(:,:),rmat2(:)
-  real(wp),allocatable :: c1(:,:),c2(:,:)
-  real(wp),allocatable :: xyz1(:,:,:),xyz2(:,:,:)
-  real(wp),allocatable :: conf1(:,:,:),conf2(:,:,:)
-  real(wp),allocatable :: eread1(:),eread2(:),en1(:),en2(:)
-  integer,allocatable  :: at1(:),at2(:)
-  integer,allocatable  :: b1(:),b2(:)
-  integer,allocatable  :: e1(:),e2(:)
-  integer,allocatable  :: rots1(:),rots2(:)
-
-  character(len=128) :: ensname1,ensname1backup
-  character(len=128) :: ensname2
-  character(len=60)  :: track1,track2
-  character(len=6)   :: connect
-
-  logical :: matching,ex
-
-  real(wp),parameter :: autokcal = 627.509541d0
-
-  associate (ensemblename => env%ensemblename,ensemblename2 => env%ensemblename2, &
-  & thresholds => env%thresholds,cgf => env%cgf,maxcompare => env%maxcompare)
-    nat = env%nat
-
-!----
-    call compens_cleanup()
-
-!---- check if two valid files were given
-    inquire (file=ensemblename,exist=ex)
-    if (.not.ex) then
-      write (*,'(2x,a,a,a)') 'File <',trim(ensemblename),'> does not exist!'
-      error stop
-    end if
-    inquire (file=ensemblename2,exist=ex)
-    if (.not.ex) then
-      write (*,'(2x,a,a,a)') 'File <',trim(ensemblename2),'> does not exist!'
-      error stop
-    end if
-
-!---- settings
-    allocate (gdum(3,3),Udum(3,3),xdum(3),ydum(3))
-    rthr = env%rthr      ! RMSD threshold
-
-    ensname1 = 'ensemble1.inp.xyz'
-    ensname2 = 'ensemble2.inp.xyz'
-    track1 = 'track.1'
-    track2 = 'track.2'
-
-!---- sort the input files with CREGEN
-    env%confgo = .true. !needs to be activated here
-!----- first file
-    call smallhead('Sorting file <'//trim(ensemblename)//'>')
-    ensname1backup = trim(ensemblename)
-
-    call newcregen(env,0)
-
-    call rename(trim(ensemblename)//'.sorted',trim(ensname1))
-    call rename('.cretrack',track1)
-    call rdensembleparam(trim(ensname1),nat1,nall1)
-    allocate (xyz1(3,nat1,nall1),eread1(nall1),at1(nat1))
-    call rdensemble(trim(ensname1),nat1,nall1,at1,xyz1,eread1)
-    !---- read tracking information (which conformer has which rotamers from the files?)
-    open (newunit=tr1,file=track1)
-    read (tr1,*) nconf1  !ensemble 1 has "nconf1" conformers
-    !to compare a limited number "maxcompare" conformers, "nconf1/2" is normalized to maxcompare
-    !i.e. if nconf > maxcompare, nconf is set to maxcompare; if nconf < maxcompare, it is not changed
-    dum = nconf1
-    nconf1 = min(nconf1,maxcompare)
-    !---- set up the mapping
-    allocate (b1(nconf1),e1(nconf1),rots1(nconf1))
-    do i = 1,nconf1
-      read (tr1,*) l,b1(i),e1(i)
-      rots1(i) = e1(i)-b1(i)+1
-    end do
-    close (tr1)
-    write (*,'(2x,a,a,a,i0,a)') 'File <',trim(ensemblename),'> contains ',dum,' conformers.'
-    if (dum .lt. maxcompare) then
-      write (*,'(2x,a,i0,a)') 'All of the ',dum,' conformers will be taken for the comparison:'
-    else
-      write (*,'(2x,a,i0,a)') 'The ',nconf1,' lowest conformers will be taken for the comparison:'
-    end if
-    write (*,'(2x,a9,2x,a9)') 'conformer','#rotamers'
-    do i = 1,nconf1
-      write (*,'(i9,2x,i9)') i,rots1(i)
-    end do
-    write (*,*)
-
-!----- second file
-    ensemblename = ensemblename2 !done so that CREGEn sorts the correct file
-    call smallhead('Sorting file <'//trim(ensemblename2)//'>')
-
-    call newcregen(env,0)
-
-    ensemblename = trim(ensname1backup)
-    call rename(trim(ensemblename2)//'.sorted',trim(ensname2))
-    call rename('.cretrack',track2)
-    call rdensembleparam(trim(ensname2),nat2,nall2)
-    allocate (xyz2(3,nat2,nall2),eread2(nall2),at2(nat2))
-    call rdensemble(trim(ensname2),nat2,nall2,at2,xyz2,eread2)
-!---- read tracking information (which conformer has which rotamers from the files?)
-    open (newunit=tr2,file=track2)
-    read (tr2,*) nconf2  !ensemble 2 has "nconf2" conformers
-    !to compare a limited number "maxcompare" conformers, "nconf1/2" is normalized to maxcompare
-    !i.e. if nconf > maxcompare, nconf is set to maxcompare; if nconf < maxcompare, it is not changed
-    dum = nconf2
-    nconf2 = min(nconf2,maxcompare)
-!-----set up the mapping
-    allocate (b2(nconf2),e2(nconf2),rots2(nconf2))
-    do i = 1,nconf2
-      read (tr2,*) l,b2(i),e2(i)
-      rots2(i) = e2(i)-b2(i)+1
-    end do
-    close (tr2)
-    write (*,'(2x,a,a,a,i0,a)') 'File <',trim(ensemblename2),'> contains ',dum,' conformers.'
-    if (dum .lt. maxcompare) then
-      write (*,'(2x,a,i0,a)') 'All of the ',dum,' conformers will be taken for the comparison:'
-    else
-      write (*,'(2x,a,i0,a)') 'The ',nconf2,' lowest conformers will be taken for the comparison:'
-    end if
-    write (*,'(2x,a9,2x,a9)') 'conformer','#rotamers'
-    do i = 1,nconf2
-      write (*,'(i9,2x,i9)') i,rots2(i)
-    end do
-    write (*,*)
-
-!---- run some checks that are mandatory in order for the compariso to work properly
-    if (nat1 /= nat2) then
-      write (*,'(a)') "Nat1 /= Nat2 : Number of atoms of the two ensembles don't match!"
-      write (*,'(a)') "You are trying to compare two different molecules!"
-      error stop "exit."
-    else
-      nat = nat1
-    end if
-    do i = 1,nat
-      if (at1(i) /= at2(i)) then
-        write (*,'(a)') "The ordering of atoms apparently is different between the two ensembles!"
-        write (*,'(a)') "This way it is impossible to calculate RMSDs!"
-        error stop "exit."
-      end if
-    end do
-
-!---- set the threads for the RMSD calculation (OMP parallel)
-    call new_ompautoset(env,'max',0,T,Tn)
-
-!---- printout
-    call smallhead('Comparing the Ensembles')
-
-!----- set up some more arrays
-    allocate (rmat(nconf1,nconf2),c1(3,nat),c2(3,nat),en1(nconf1),en2(nconf2))
-!---- get energies of lowest conformers
-    do i = 1,nconf1
-      en1(i) = eread1(b1(i))
-    end do
-    do i = 1,nconf2
-      en2(i) = eread2(b2(i))
-    end do
-    deallocate (eread2,eread1)
-
-    write (*,'(1x,a)',advance='no') 'Calculating RMSDs between conformers...'
-!-----compare conformer-block-wise, i.e. all rotamers of each conformer pair of ensemble 1 and 2
-!----- THIS IS THE MAIN LOOP OF THE SUBROUTINE
-    do i = 1,nconf1
-      be = b1(i)
-      ed = e1(i)
-      nrot1 = ed-be+1
-      !write(*,*) b,e,nrot1
-      allocate (conf1(3,nat,nrot1))
-      conf1(1:3,1:nat,1:nrot1) = xyz1(1:3,1:nat,be:ed)
-      do j = 1,nconf2
-        be = b2(j)
-        ed = e2(j)
-        nrot2 = ed-be+1
-        allocate (conf2(3,nat,nrot2))
-        conf2(1:3,1:nat,1:nrot2) = xyz2(1:3,1:nat,be:ed)
-        rcount = nrot1*nrot2 !total number of RMSDs between
-        allocate (rmat2(rcount))
-        rmat2 = 100 !<--only done so we can easily get the minimum rmsd later
-
-        do k = 1,nrot1
-          c1(1:3,1:nat) = conf1(1:3,1:nat,k)
-!$omp parallel private (l,rcount,c2,ydum,xdum,Udum,gdum) &
-!$omp shared (k,c1,rmat2,nat,conf2,nrot2)
-!$omp do
-          do l = 1,nrot2
-            rcount = ((k-1)*nrot2)+l
-            c2(1:3,1:nat) = conf2(1:3,1:nat,l)
-            call rmsd(nat,c1,c2,0,Udum,xdum,ydum,rmat2(rcount),.false.,gdum) ! all atoms
-            !write(*,*)rmat2(rcount)
-          end do
-!$omp end do
-!$omp end parallel
-        end do
-        rmat(i,j) = minval(rmat2)
-        deallocate (rmat2,conf2)
-      end do
-      deallocate (conf1)
-    end do
-    write (*,'(1x,a)') 'done.'
-!---------
-    !--- print the RMSD matrix
-    write (*,'(1x,a,f8.4,a)') 'RMSD threshold:',rthr,' Å'
-    call pr_rmat(rmat,nconf1,nconf2)
-!--------
-    write (*,*)
-    call smallhead('Correlation between Conformers :')
-    write (*,'(4x,a,5x,a10,13x,a,4x,a10)') '#','Ensemble A','#','Ensemble B'
-    dum = nconf1+nconf2
-    kk = nconf1
-    ll = nconf2
-    connect = '<---->'
-    do
-      matching = .false.
-      if (kk .gt. 0.and.ll .gt. 0) then
-        min_1 = en1(kk)
-        min_2 = en2(ll)
-        rval = rmat(kk,ll)
-        if (rval .le. rthr) then  !<--- two matching conformers from ensembles
-          write (*,'(1x,i4,1x,f14.5,3x,a,1x,i4,f14.5)') kk,min_1,connect,ll,min_2
-          kk = kk-1
-          ll = ll-1
-          matching = .true.
-        end if
-      end if
-      if (.not.matching) then
-        if (kk .gt. 0.and.ll .gt. 0) then
-          min_1 = en1(kk)
-          min_2 = en2(ll)
-          if (min_1 .ge. min_2) then
-            write (*,'(1x,i4,1x,f14.5)') kk,min_1
-            kk = kk-1
-          else
-            write (*,'(30x,i4,f14.5)') ll,min_2
-            ll = ll-1
-          end if
-        end if
-        if (kk .gt. 0.and.ll .eq. 0) then
-          min_1 = en1(kk)
-          write (*,'(1x,i4,1x,f14.5)') kk,min_1
-          kk = kk-1
-        end if
-        if (kk .eq. 0.and.ll .gt. 0) then
-          min_2 = en2(ll)
-          write (*,'(30x,i4,f14.5)') ll,min_2
-          ll = ll-1
-        end if
-      end if
-      if (kk .eq. 0.and.ll .eq. 0) exit
-    end do
-
-!----- plotfiles
-    !--- convert to relative energies
-    min_1 = minval(en1)
-    min_2 = minval(en2)
-    min_tot = min(min_1,min_2)
-    !en1=(en1-min_tot)*autokcal
-    !en2=(en2-min_tot)*autokcal
-    !--- energies of ensemble 1
-    open (newunit=ich,file='energy_1.dat')
-    do i = 1,nconf1
-      write (ich,'(2x,f10.5,2x,f14.8)') (en1(i)-min_tot)*autokcal,en1(i)
-    end do
-    close (ich)
-    !--- energies of ensemble 2
-    open (newunit=ich,file='energy_2.dat')
-    do i = 1,nconf2
-      write (ich,'(2x,f10.5,2x,f14.8)') (en2(i)-min_tot)*autokcal,en2(i)
-    end do
-    close (ich)
-    !--- correlation between conformers of the two ensembles
-    open (newunit=ich2,file='rmsdmatch.dat')
-    do i = 1,nconf1
-      do j = 1,nconf2
-        rval = rmat(i,j)
-        if (rval .le. rthr) then
-          write (ich2,'(2x,i6,i6)') i,j
-        end if
-      end do
-    end do
-    close (ich2)
-
-!-----
-    deallocate (rmat,c1,c2,en1,en2)
-    deallocate (b1,e1,b2,e2)
-    deallocate (xyz2,xyz1,at2,at1)
-    deallocate (ydum,xdum,Udum,gdum)
-!-----
-    call compens_cleanup()
-
-  end associate
-
-end subroutine compare_ensembles
-
-!---------------------------------------------------------------------------------------
-subroutine compens_cleanup()
-  use iso_fortran_env,only:wp => real64
-  use iomod
-  implicit none
-  call remove('scoord.1')
-  call remove('ensemble1.inp.xyz')
-  call remove('ensemble2.inp.xyz')
-  call remove('track.1')
-  call remove('track.2')
-  call remove('crest_best.xyz')
-  call remove('cregen.out.tmp')
-end subroutine compens_cleanup
-
-!--------------------------------------------------------------------------------------
-subroutine pr_rmat(rmat,acon,bcon)
-  use iso_fortran_env,only:wp => real64
-  implicit none
-  integer :: acon,bcon
-  real(wp) :: rmat(acon,bcon)
-  integer :: i,j
-  write (*,*)
-  write (*,*) 'RMSD matrix:'
-  write (*,'(2x,a9)',advance='no') 'conformer'
-  do j = 1,bcon
-    write (*,'(1x,i10)',advance='no') j
-  end do
-  write (*,*)
-  do i = 1,acon
-    write (*,'(1x,i5,5x)',advance='no') i
-    do j = 1,bcon
-      write (*,'(1x,f10.5)',advance='no') rmat(i,j)
-    end do
-    write (*,*)
-  end do
-end subroutine pr_rmat
-
diff --git a/src/entropy/CMakeLists.txt b/src/entropy/CMakeLists.txt
index 20af53d3..38ce822c 100644
--- a/src/entropy/CMakeLists.txt
+++ b/src/entropy/CMakeLists.txt
@@ -22,6 +22,7 @@ list(APPEND srcs
   "${dir}/mie.f90"
   "${dir}/entropic.f90"
   "${dir}/entropy.f90"
+  "${dir}/thermochem_module.f90"
 )
 
 set(srcs ${srcs} PARENT_SCOPE)
diff --git a/src/entropy/entropic.f90 b/src/entropy/entropic.f90
index bb5471e5..8d21caac 100644
--- a/src/entropy/entropic.f90
+++ b/src/entropy/entropic.f90
@@ -1254,6 +1254,7 @@ subroutine analsym(zmol,fac,pr)
 !*******************************************************
   use crest_parameters,only:wp,idp => dp
   use zdata
+  use symmetry_i,only: getsym
   implicit none
   type(zmolecule) :: zmol
   real(wp),intent(out) :: fac
@@ -1263,19 +1264,14 @@ subroutine analsym(zmol,fac,pr)
   integer,allocatable  :: at(:)
   integer :: i
   character(len=4) :: sfsym
-  real(wp),parameter :: desy = 0.1_wp
-  integer,parameter  :: maxat = 200
   fac = 1.0_wp
   nat = zmol%nat
-  if (nat .gt. maxat) then
-    return
-  end if
   allocate (xyz(3,nat),at(nat))
   do i = 1,nat
     xyz(:,i) = zmol%zat(i)%cart(:)
   end do
   at = zmol%at
-  call getsymmetry2(.false.,6,nat,at,xyz,desy,maxat,sfsym)
+  call getsym(.false.,6,nat,at,xyz,sfsym)
 
   if (pr) then
     write (*,'(1x,a,4x,a)') 'symmetry:',sfsym(1:3)
@@ -1287,6 +1283,7 @@ end subroutine analsym
 subroutine analsym_geo(grp,nat,xyz,at,fac,pr,sfsm)
   use crest_parameters,only:wp,idp => dp
   use zdata
+  use symmetry_i,only: getsym
   implicit none
   type(zequal) :: grp
   real(wp),intent(out) :: fac
@@ -1297,10 +1294,8 @@ subroutine analsym_geo(grp,nat,xyz,at,fac,pr,sfsm)
   character(len=4) :: sfsym
   character(len=4),intent(out) :: sfsm
   real(wp),external :: symfactor
-  real(wp),parameter :: desy = 0.1_wp
-  integer,parameter  :: maxat = 200
   fac = 1.0_wp
-  call getsymmetry2(pr,6,nat,at,xyz,desy,maxat,sfsym)
+  call getsym(pr,6,nat,at,xyz,sfsym)
 
   fac = 1.0_wp/symfactor(grp,sfsym)
   sfsm = sfsym(1:3)
diff --git a/src/entropy/entropy.f90 b/src/entropy/entropy.f90
index a48148a2..5aeaef0f 100644
--- a/src/entropy/entropy.f90
+++ b/src/entropy/entropy.f90
@@ -442,6 +442,10 @@ subroutine entropyprintout(T,Srrho,S,Cp,H)
   write (*,*)
   write (*,'(3x,''Cp(total) =      '',f12.6,1x,a)') cp, sunit
   write (*,*)
+  write (*,'(3x,a)') 'Note: S and G above are conformational contributions only.'
+  write (*,'(3x,a)') 'They are additive to the free energy of the lowest-energy conformer.'
+  write (*,'(3x,a)') 'Ref.: P.Pracht, S.Grimme, Chem. Sci., 2021, 12, 6551-6568.'
+  write (*,*)
 
   return
 end subroutine entropyprintout
diff --git a/src/entropy/meson.build b/src/entropy/meson.build
index 08194304..161fabff 100644
--- a/src/entropy/meson.build
+++ b/src/entropy/meson.build
@@ -20,4 +20,5 @@ srcs += files(
    'mie.f90',
    'entropic.f90',
    'entropy.f90',
+   'thermochem_module.f90',
 )
diff --git a/src/entropy/thermo.f90 b/src/entropy/thermo.f90
index 6ffc22de..ca31b5d4 100644
--- a/src/entropy/thermo.f90
+++ b/src/entropy/thermo.f90
@@ -21,23 +21,23 @@
 ! Taken from the xtb code and modified for crest
 !========================================================================!
 module crest_thermo
-   use iso_fortran_env, only : wp => real64
-   implicit none
-
-   real(wp),private,parameter :: pi = 3.1415926535897932384626433832795029_wp
-   real(wp),private,parameter :: twopi = 2.0_wp * pi
-   real(wp),private,parameter :: kB = 3.166808578545117e-06_wp
-
-   real(wp),private,parameter :: autoaa = 0.52917726_wp
-   real(wp),private,parameter :: aatoau = 1.0_wp/autoaa
-   real(wp),private,parameter :: amutokg = 1.660539040e-27_wp
-   real(wp),private,parameter :: autokj = 2625.49964038_wp
-   real(wp),private,parameter :: autokcal = 627.50947428_wp
-   real(wp),private,parameter :: kcaltoau = 1.0_wp/autokcal
-   real(wp),private,parameter :: autorcm = 219474.63067_wp
-   real(wp),private,parameter :: rcmtoau = 1.0_wp/autorcm
-   real(wp),private,parameter :: metokg  = 9.10938356e-31_wp
-   real(wp),private,parameter :: kgtome  = 1.0_wp/metokg
+  use iso_fortran_env,only:wp => real64
+  implicit none
+
+  real(wp),private,parameter :: pi = 3.1415926535897932384626433832795029_wp
+  real(wp),private,parameter :: twopi = 2.0_wp*pi
+  real(wp),private,parameter :: kB = 3.166808578545117e-06_wp
+
+  real(wp),private,parameter :: autoaa = 0.52917726_wp
+  real(wp),private,parameter :: aatoau = 1.0_wp/autoaa
+  real(wp),private,parameter :: amutokg = 1.660539040e-27_wp
+  real(wp),private,parameter :: autokj = 2625.49964038_wp
+  real(wp),private,parameter :: autokcal = 627.50947428_wp
+  real(wp),private,parameter :: kcaltoau = 1.0_wp/autokcal
+  real(wp),private,parameter :: autorcm = 219474.63067_wp
+  real(wp),private,parameter :: rcmtoau = 1.0_wp/autorcm
+  real(wp),private,parameter :: metokg = 9.10938356e-31_wp
+  real(wp),private,parameter :: kgtome = 1.0_wp/metokg
 
 !========================================================================================!
 !========================================================================================!
@@ -45,327 +45,401 @@ module crest_thermo
 !========================================================================================!
 !========================================================================================!
 
-subroutine thermodyn(iunit,A_rcm,B_rcm,C_rcm,avmom_si,linear,atom,sym,molmass, &
-      &              vibs,nvibs,T,sthr_rcm,et,ht,g,ts,zp,pr)
-   use iso_fortran_env, only : wp => real64
-   implicit none
-   integer, intent(in)  :: iunit       !< output_unit
-   integer, intent(in)  :: nvibs       !< number of vibrational frequencies
-   real(wp),intent(in)  :: A_rcm       !< rotational constants in cm-1
-   real(wp),intent(in)  :: B_rcm       !< rotational constants in cm-1
-   real(wp),intent(in)  :: C_rcm       !< rotational constants in cm-1
-   real(wp),intent(in)  :: avmom_si    !< average moment of inertia in whatever
-   real(wp),intent(in)  :: sym         !< symmetry number
-   real(wp),intent(in)  :: molmass     !< molecular mass in in amu
-   real(wp),intent(in)  :: T           !< temperature in K
-   real(wp),intent(in)  :: sthr_rcm    !< rotor cutoff in cm-1
-   real(wp),intent(out) :: et          !< enthalpy in Eh
-   real(wp),intent(out) :: ht          !< enthalpy in Eh
-   real(wp),intent(out) :: g           !< free energy in Eh
-   real(wp),intent(out) :: ts          !< entropy in Eh
-   real(wp),intent(in)  :: zp          !< zero point vibrational energy in Eh
-   real(wp),intent(in)  :: vibs(nvibs) !< vibrational frequencies in cm-1
-   logical, intent(in)  :: linear      !< is linear
-   logical, intent(in)  :: atom        !< only one atom
-   logical, intent(in)  :: pr          !< clutter the screen with printout
-   real(wp),parameter :: R = 1.98726D0    ! GAS CONSTANT IN CALORIES/MOLE
-   real(wp),parameter :: H = 6.626176D-27 ! PLANCK'S CONSTANT IN ERG-SECONDS
-   real(wp),parameter :: AK = 1.3807D-16  ! BOLTZMANN CONSTANT IN ERG/DEGREE
-   real(wp),parameter :: conv3 = amutokg*1000 ! 1.6606d-24
-   real(wp),parameter :: magic4 = 2.2868d0 ! unknown
-   real(wp),parameter :: magic5 = 2.3135d0 ! unknown
-   real(wp),parameter :: caltoj = autokj/autokcal
-
-   integer  :: i
-   real(wp) :: s_tr,s_rot,s_vib,s_int,s_tot
-   real(wp) :: h_tr,h_rot,h_vib,h_int,h_tot
-   real(wp) :: q_tr,q_rot,q_vib,q_int
-   real(wp) :: cptr,cprot,cpvib,cpint,cptot
-   real(wp) :: beta,sthr,avmom,A,B,C
-   real(wp) :: ewj,omega,mu
-   real(wp) :: wofrot
-   real(wp) :: cp_ho,cp_rr
-   real(wp) :: sv_ho,sv_rr
-   !*******************************************************************
-
-   ! convert EVERYTHING to atomic units NOW and avoid horror and dispair later
-   beta=1.0_wp/kB/T ! beta in 1/Eh
-   !c1=h*ac/ak/T    ! beta in cm
-   sthr  = sthr_rcm * rcmtoau ! sthr in Eh
-   avmom = avmom_si*kgtome*aatoau**2*1.0e+20_wp ! in me·α² (au)
-   A = A_rcm * rcmtoau
-   B = B_rcm * rcmtoau
-   C = C_rcm * rcmtoau
-
-   !   ***   INITIALISE SOME VARIABLES   ***
-   q_vib = 1.0_wp
-   h_vib = 0.0_wp
-   cpvib = 0.0_wp
-   s_vib = 0.0_wp
-   q_rot = 1.0_wp
-   h_rot = 0.0_wp
-   cprot = 0.0_wp
-   s_rot = 0.0_wp
-   ! free rotor heat capacity is constant 0.5*R
-   ! we use the below to work with Eh² units 
-   ! conversion to cal/mol/K is done later
-   cp_rr = 0.5_wp/(beta**2) 
-
-   ! construct the frequency dependent parts of partition function
-   do i=1,nvibs
-      omega=vibs(i)
+  subroutine thermodyn(iunit,A_rcm,B_rcm,C_rcm,avmom_si,linear,atom,sym,molmass, &
+        &              vibs,nvibs,T,sthr_rcm,et,ht,g,ts,zp,pr,emodel)
+    use iso_fortran_env,only:wp => real64
+    implicit none
+    integer,intent(in)  :: iunit       !< output_unit
+    integer,intent(in)  :: nvibs       !< number of vibrational frequencies
+    real(wp),intent(in)  :: A_rcm       !< rotational constants in cm-1
+    real(wp),intent(in)  :: B_rcm       !< rotational constants in cm-1
+    real(wp),intent(in)  :: C_rcm       !< rotational constants in cm-1
+    real(wp),intent(in)  :: avmom_si    !< average moment of inertia in whatever
+    real(wp),intent(in)  :: sym         !< symmetry number
+    real(wp),intent(in)  :: molmass     !< molecular mass in in amu
+    real(wp),intent(in)  :: T           !< temperature in K
+    real(wp),intent(in)  :: sthr_rcm    !< rotor cutoff in cm-1
+    real(wp),intent(out) :: et          !< enthalpy in Eh
+    real(wp),intent(out) :: ht          !< enthalpy in Eh
+    real(wp),intent(out) :: g           !< free energy in Eh
+    real(wp),intent(out) :: ts          !< entropy in Eh
+    real(wp),intent(in)  :: zp          !< zero point vibrational energy in Eh
+    real(wp),intent(in)  :: vibs(nvibs) !< vibrational frequencies in cm-1
+    logical,intent(in)  :: linear      !< is linear
+    logical,intent(in)  :: atom        !< only one atom
+    logical,intent(in)  :: pr          !< clutter the screen with printout
+    integer,intent(in),optional :: emodel
+    real(wp),parameter :: R = 1.98726D0    ! GAS CONSTANT IN CALORIES/MOLE
+    real(wp),parameter :: H = 6.626176D-27 ! PLANCK'S CONSTANT IN ERG-SECONDS
+    real(wp),parameter :: AK = 1.3807D-16  ! BOLTZMANN CONSTANT IN ERG/DEGREE
+    real(wp),parameter :: conv3 = amutokg*1000 ! 1.6606d-24
+    real(wp),parameter :: magic4 = 2.2868d0 ! unknown
+    real(wp),parameter :: magic5 = 2.3135d0 ! unknown
+    real(wp),parameter :: caltoj = autokj/autokcal
+
+    integer  :: i,model
+    real(wp) :: s_tr,s_rot,s_vib,s_int,s_tot
+    real(wp) :: h_tr,h_rot,h_vib,h_int,h_tot
+    real(wp) :: q_tr,q_rot,q_vib,q_int
+    real(wp) :: cptr,cprot,cpvib,cpint,cptot
+    real(wp) :: beta,sthr,avmom,A,B,C
+    real(wp) :: ewj,omega,mu
+    real(wp) :: wofrot
+    real(wp) :: cp_ho,cp_rr
+    real(wp) :: sv_ho,sv_rr
+    !*******************************************************************
+
+    if (present(emodel)) then
+      !> selecting vib. entropy approximation: 1=Grimme (2012), 2=Truhlar (2011)
+      model = emodel
+    else
+      model = 1
+    end if
+
+    ! convert EVERYTHING to atomic units NOW and avoid horror and dispair later
+    beta = 1.0_wp/kB/T ! beta in 1/Eh
+    !c1=h*ac/ak/T    ! beta in cm
+    sthr = sthr_rcm*rcmtoau ! sthr in Eh
+    avmom = avmom_si*kgtome*aatoau**2*1.0e+20_wp ! in me·α² (au)
+    A = A_rcm*rcmtoau
+    B = B_rcm*rcmtoau
+    C = C_rcm*rcmtoau
+
+    !   ***   INITIALISE SOME VARIABLES   ***
+    q_vib = 1.0_wp
+    h_vib = 0.0_wp
+    cpvib = 0.0_wp
+    s_vib = 0.0_wp
+    q_rot = 1.0_wp
+    h_rot = 0.0_wp
+    cprot = 0.0_wp
+    s_rot = 0.0_wp
+    ! free rotor heat capacity is constant 0.5*R
+    ! we use the below to work with Eh² units
+    ! conversion to cal/mol/K is done later
+    cp_rr = 0.5_wp/(beta**2)
+
+    ! construct the frequency dependent parts of partition function
+    do i = 1,nvibs
+      select case (model)
+      case (1) !> Grimme mod.RRHO (2012)
+        omega = vibs(i)
+      case (2) !> Truhlar cutoff (2011)
+        if (vibs(i) >= 0.0_wp) then
+          omega = max(sthr,vibs(i))
+        else
+          omega = vibs(i)
+        end if
+      end select
       ! omega in Eh, beta in 1/Eh
-      ewj=exp(-omega*beta)
-      q_vib=q_vib/(1.0_wp-ewj)
+      ewj = exp(-omega*beta)
+      q_vib = q_vib/(1.0_wp-ewj)
       ! h_vib in Eh
-      h_vib=h_vib+omega*ewj/(1.0_wp-ewj)
+      h_vib = h_vib+omega*ewj/(1.0_wp-ewj)
       ! cp_ho in Eh²
-      cp_ho=omega**2 * ewj/(1.0_wp-ewj)/(1.0_wp-ewj)
+      cp_ho = omega**2*ewj/(1.0_wp-ewj)/(1.0_wp-ewj)
       ! replace low-lying vibs for S by rotor approx.
-      mu = 0.5_wp / (omega + 1.0e-14_wp)
+      mu = 0.5_wp/(omega+1.0e-14_wp)
       ! this reduced moment limits the rotational moment of inertia for
       ! this vibration to that of the total molecule rotation/3
       ! avmom and xmom are in me·α² (au)
       mu = mu*avmom/(mu+avmom)
-      if(omega.gt.0)then
-         ! sv is S/R which is dimensionless
-         ! harm. osc. entropy
-         sv_ho = vibs(i)*beta*ewj/(1.0_wp-ewj) - log(1.0_wp-ewj)
-         ! free rotor entropy
-         ! Cramer, page 328 for one degree of freedom or
-         ! http://cccbdb.nist.gov/thermo.asp, eq. 35, sigma=1
-         !sv_rr = (0.5_wp+log(sqrt(8.0_wp*pi**3*xmom*sik*t)/sih))
-         sv_rr = 0.5_wp + log(sqrt(pi/beta*2.0_wp*mu))
+      if (omega .gt. 0) then
+        ! sv is S/R which is dimensionless
+        ! harm. osc. entropy
+        sv_ho = omega*beta*ewj/(1.0_wp-ewj)-log(1.0_wp-ewj)
+        ! free rotor entropy
+        ! Cramer, page 328 for one degree of freedom or
+        ! http://cccbdb.nist.gov/thermo.asp, eq. 35, sigma=1
+        sv_rr = 0.5_wp+log(sqrt(pi/beta*2.0_wp*mu))
       else
-         sv_ho = 0.0_wp
-         sv_rr = 0.0_wp
-      endif
-      ! fermi weigthing
-      ! wofrot=1./(1.+exp( (omega-sthr)/20.0 ) )
-      ! Head-Gordon weighting
-      wofrot=1.0_wp-chg_switching(omega,sthr)
-      ! heat capacity (cp_rr is a constant), all in Eh²
-      cpvib = cpvib + ((1.0_wp-wofrot)*cp_ho + wofrot*cp_rr)
-      ! entropy s_vib is converted to cal/mol/K... by multiplying with R
-      s_vib=s_vib+R*((1.0_wp-wofrot)*sv_ho + wofrot*sv_rr)
-   enddo
-   !   ***   FINISH CALCULATION OF VIBRATIONAL PARTS   ***
-   ! now unit conversion again...
-   ! h_vib in Eh, beta is in 1/Eh, T is in K, R is in cal/mol/K,
-   h_vib=h_vib*R*beta*T
-   ! same here
-   ! cpvib is in Eh², beta in 1/Eh, R in cal/mol/K
-   cpvib=cpvib*R*beta**2
-   !   ***   NOW CALCULATE THE ROTATIONAL PARTS  (FIRST LINEAR MOLECULES)
-   if (.not.atom) then
-      if(linear) then
-         ! A is in Eh, beta is in 1/Eh, q_rot is dimensionless
-         q_rot=1/(beta*A*sym)
-         ! h_rot is in cal/mol
-         h_rot=R*T
-         ! cprot  is in cal/mol/K
-         cprot=R
-         ! s_rot is in cal/mol/K
-         s_rot=R*((log(1.0_wp/(beta*A*sym)))+1.0_wp)
+        sv_ho = 0.0_wp
+        sv_rr = 0.0_wp
+      end if
+      select case (model)
+      case (1) !> Grimme mod.RRHO (2012)
+        ! Head-Gordon weighting
+        wofrot = 1.0_wp-chg_switching(omega,sthr)
+        ! heat capacity (cp_rr is a constant), all in Eh²
+        cpvib = cpvib+((1.0_wp-wofrot)*cp_ho+wofrot*cp_rr)
+        ! entropy s_vib is converted to cal/mol/K... by multiplying with R
+        s_vib = s_vib+R*((1.0_wp-wofrot)*sv_ho+wofrot*sv_rr)
+      case (2) !> Truhlar cutoff (2011)
+        ! heat capacity in Eh²
+        cpvib = cpvib+(cp_ho)
+        ! entropy s_vib is converted to cal/mol/K... by multiplying with R
+        s_vib = s_vib+R*(sv_ho)
+      end select
+    end do
+    !   ***   FINISH CALCULATION OF VIBRATIONAL PARTS   ***
+    ! now unit conversion again...
+    ! h_vib in Eh, beta is in 1/Eh, T is in K, R is in cal/mol/K,
+    h_vib = h_vib*R*beta*T
+    ! same here
+    ! cpvib is in Eh², beta in 1/Eh, R in cal/mol/K
+    cpvib = cpvib*R*beta**2
+    !   ***   NOW CALCULATE THE ROTATIONAL PARTS  (FIRST LINEAR MOLECULES)
+    if (.not.atom) then
+      if (linear) then
+        ! A is in Eh, beta is in 1/Eh, q_rot is dimensionless
+        q_rot = 1/(beta*A*sym)
+        ! h_rot is in cal/mol
+        h_rot = R*T
+        ! cprot  is in cal/mol/K
+        cprot = R
+        ! s_rot is in cal/mol/K
+        s_rot = R*((log(1.0_wp/(beta*A*sym)))+1.0_wp)
       else
-         ! see above
-         q_rot=sqrt(pi/(A*B*C*beta**3))/sym
-         h_rot=3.0_wp*R*T/2.0_wp
-         cprot=3.0_wp*R/2.0_wp
-         s_rot=0.5_wp*R*(-2.0_wp*log(sym)+log(pi/(A*B*C*beta**3))+3.0_wp)
-      endif
-   endif
-   !   ***   CALCULATE INTERNAL CONTRIBUTIONS   ***
-   q_int=q_vib*q_rot
-   h_int=h_vib+h_rot
-   cpint=cpvib+cprot
-   s_int=s_vib+s_rot
-   !   ***   CONSTRUCT TRANSLATION CONTRIBUTIONS   ***
-   q_tr=(sqrt(2.0_wp*pi*molmass*t*ak*conv3)/h)**3
-   ! this is 3/2rt+pv=5/2rt
-   h_tr=5.0_wp*R*T/2.0_wp
-   cptr=5.0_wp*R/2.0_wp
-   s_tr=magic4*(5.0_wp*log10(t)+3.0_wp*log10(molmass))-magic5
-   !   ***   CONSTRUCT TOTALS   ***
-   cptot=cptr+cpint
-   s_tot=s_tr+s_int
-   h_tot=h_tr+h_int
-
-   if(pr)then
-      write(iunit,'(a)')
-      write(iunit,'("   temp. (K)  partition function ", &
+        ! see above
+        q_rot = sqrt(pi/(A*B*C*beta**3))/sym
+        h_rot = 3.0_wp*R*T/2.0_wp
+        cprot = 3.0_wp*R/2.0_wp
+        s_rot = 0.5_wp*R*(-2.0_wp*log(sym)+log(pi/(A*B*C*beta**3))+3.0_wp)
+      end if
+    end if
+    !   ***   CALCULATE INTERNAL CONTRIBUTIONS   ***
+    q_int = q_vib*q_rot
+    h_int = h_vib+h_rot
+    cpint = cpvib+cprot
+    s_int = s_vib+s_rot
+    !   ***   CONSTRUCT TRANSLATION CONTRIBUTIONS   ***
+    q_tr = (sqrt(2.0_wp*pi*molmass*t*ak*conv3)/h)**3
+    ! this is 3/2rt+pv=5/2rt
+    h_tr = 5.0_wp*R*T/2.0_wp
+    cptr = 5.0_wp*R/2.0_wp
+    s_tr = magic4*(5.0_wp*log10(t)+3.0_wp*log10(molmass))-magic5
+    !   ***   CONSTRUCT TOTALS   ***
+    cptot = cptr+cpint
+    s_tot = s_tr+s_int
+    h_tot = h_tr+h_int
+
+    if (pr) then
+      write (iunit,'(a)')
+      write (iunit,'("   temp. (K)  partition function ", &
          & "  enthalpy   heat capacity  entropy")')
-      write(iunit,'(  "                                   ", &
+      write (iunit,'(  "                                   ", &
          & "cal/mol     cal/K/mol   cal/K/mol   J/K/mol")')
-      write(iunit,'(  f7.2,"  VIB ",G10.3,10X,3F11.3)') &
-         & T,q_vib,  h_vib,  cpvib,  s_vib
-      write(iunit,'(7X,"  ROT ",G10.3,10X,3F11.3)') &
-         & q_rot,  h_rot,  cprot,  s_rot
-      write(iunit,'(7X,"  INT ",G10.3,10X,3F11.3)') &
+      write (iunit,'(  f7.2,"  VIB ",G10.3,10X,3F11.3)') &
+         & T,q_vib,h_vib,cpvib,s_vib
+      write (iunit,'(7X,"  ROT ",G10.3,10X,3F11.3)') &
+         & q_rot,h_rot,cprot,s_rot
+      write (iunit,'(7X,"  INT ",G10.3,10X,3F11.3)') &
          & q_int,h_int,cpint,s_int
-      write(iunit,'(7X,"  TR  ",G10.3,10X,3F11.3)') &
-         & q_tr, h_tr, cptr, s_tr
-      write(iunit,'(7X,"  TOT ",21X,F11.4,3F11.4)') &
+      write (iunit,'(7X,"  TR  ",G10.3,10X,3F11.3)') &
+         & q_tr,h_tr,cptr,s_tr
+      write (iunit,'(7X,"  TOT ",21X,F11.4,3F11.4)') &
          & h_tot,cptot,s_tot,s_tot*caltoj
-   endif
-
-   ht=h_tot/1000.0_wp*kcaltoau
-   et=ht+zp
-   ts=s_tot*t/1000.0_wp*kcaltoau
-
-   g=et-ts
-
-   return
-end subroutine thermodyn
-
-pure elemental function lnqrot(temp,f,avmom) result(lnq_r)
-   implicit none
-   real(wp), parameter :: rcmtoj = rcmtoau*autokj*1000.0_wp
-   real(wp), parameter :: avogadro = 6.0221413e23_wp ! 1/mol
-   real(wp), parameter :: planck = 6.62606957e-34_wp ! J*s
-   real(wp), parameter :: hbar = planck/(2.0_wp*pi)
-   real(wp), parameter :: kb = 1.3806488e-23_wp ! J/K
-   real(wp), intent(in) :: temp   !< temperature in K
-   real(wp), intent(in) :: f      !< vibrational frequency in cm⁻¹
-   real(wp), intent(in) :: avmom  !< average moment of inertia in kg·m²
-   real(wp):: e
-   real(wp):: mu
-   real(wp):: lnq_r
-   real(wp):: t_rot
-
-   ! moment of inertia corresponding to the rotor with frequency f(ifreq)
-   ! convert frequency first from cm⁻¹ to J, we add also a little offset to avoid Infinities
-   e = ((f*rcmtoJ)+1.0e-14_wp)/avogadro
-   mu = hbar**2/(2.0_wp*e)
-   ! the vibrational moment of inertia is now in SI
-   ! reduce the moment relative to the total rotational moment
-   mu = avmom*mu/(avmom+mu)
-   ! now we need a rotational temperature of mu,
-   ! since we are SI already no unit conversion needed
-   t_rot = hbar**2/(2.0_wp*mu*kb)
-   ! ln(q) of the free rotor partition function, we assume σ=1
-   lnq_r = log(sqrt(pi*temp/t_rot))
-
-end function lnqrot
-
-pure elemental function lnqvib(temp,f) result(lnq_v)
-   implicit none
-   real(wp), parameter  :: planck = 6.62606957e-34_wp ! J*s
-   real(wp), parameter  :: kb = 1.3806488e-23_wp ! J/K
-   real(wp), parameter  :: speed_of_light = 299792458.0_wp ! m/s
-   real(wp), parameter  :: factor = planck*100.0_wp*speed_of_light/kb
-   real(wp), intent(in) :: temp   !< temperature in K
-   real(wp), intent(in) :: f      !< vibrational frequency in cm⁻¹
-   real(wp):: lnq_v
-   real(wp):: t_vib
-   ! get the vibrational temperature (which is in K, BTW)
-   t_vib = factor*f
-   ! modified oscillator, for sthr = 0 -> HO.
-   ! ln(q) of the harmonic oscillator partition function
-   lnq_v = - 0.5_wp*t_vib/temp - log(1.0_wp - exp(-t_vib/temp))
-
-end function lnqvib
-
-pure elemental function lnqvibmod(temp,f,sthr,avmom) result(lnq)
-   implicit none
-   real(wp), intent(in) :: temp   !< temperature in K
-   real(wp), intent(in) :: f      !< vibrational frequency in cm⁻¹
-   real(wp), intent(in) :: sthr   !< rotor cutoff in cm⁻¹
-   real(wp), intent(in) :: avmom  !< average moment of inertia in kg·m²
-   real(wp):: fswitch
-   real(wp):: lnq_r,lnq_v,lnq
-   ! ln(q) of the harmonic oscillator partition function
-   lnq_v = lnqvib(temp,f)
-   ! ln(q) of the free rotor partition function, we assume σ=1
-   lnq_r =  lnqrot(temp,f,avmom)
-
-   ! Chai--Head-Gordon weighting
-   fswitch = 1.0_wp - chg_switching(sthr,f)
-
-   ! now final modified vibrational partiation function
-   lnq = (1.0_wp-fswitch) * lnq_v + fswitch * lnq_r
-
-end function lnqvibmod
-
-pure elemental function chg_switching(omega,sthr) result(f)
-   real(wp),intent(in) :: omega
-   real(wp),intent(in) :: sthr
-   real(wp) :: f
-   if(sthr.ge.0.0_wp) then
+    end if
+
+    ht = h_tot/1000.0_wp*kcaltoau
+    et = ht+zp
+    ts = s_tot*t/1000.0_wp*kcaltoau
+
+    g = et-ts
+
+    return
+  end subroutine thermodyn
+
+  pure elemental function lnqrot(temp,f,avmom) result(lnq_r)
+    implicit none
+    real(wp),parameter :: rcmtoj = rcmtoau*autokj*1000.0_wp
+    real(wp),parameter :: avogadro = 6.0221413e23_wp ! 1/mol
+    real(wp),parameter :: planck = 6.62606957e-34_wp ! J*s
+    real(wp),parameter :: hbar = planck/(2.0_wp*pi)
+    real(wp),parameter :: kb = 1.3806488e-23_wp ! J/K
+    real(wp),intent(in) :: temp   !< temperature in K
+    real(wp),intent(in) :: f      !< vibrational frequency in cm⁻¹
+    real(wp),intent(in) :: avmom  !< average moment of inertia in kg·m²
+    real(wp):: e
+    real(wp):: mu
+    real(wp):: lnq_r
+    real(wp):: t_rot
+
+    ! moment of inertia corresponding to the rotor with frequency f(ifreq)
+    ! convert frequency first from cm⁻¹ to J, we add also a little offset to avoid Infinities
+    e = ((f*rcmtoJ)+1.0e-14_wp)/avogadro
+    mu = hbar**2/(2.0_wp*e)
+    ! the vibrational moment of inertia is now in SI
+    ! reduce the moment relative to the total rotational moment
+    mu = avmom*mu/(avmom+mu)
+    ! now we need a rotational temperature of mu,
+    ! since we are SI already no unit conversion needed
+    t_rot = hbar**2/(2.0_wp*mu*kb)
+    ! ln(q) of the free rotor partition function, we assume σ=1
+    lnq_r = log(sqrt(pi*temp/t_rot))
+
+  end function lnqrot
+
+  pure elemental function lnqvib(temp,f) result(lnq_v)
+    implicit none
+    real(wp),parameter  :: planck = 6.62606957e-34_wp ! J*s
+    real(wp),parameter  :: kb = 1.3806488e-23_wp ! J/K
+    real(wp),parameter  :: speed_of_light = 299792458.0_wp ! m/s
+    real(wp),parameter  :: factor = planck*100.0_wp*speed_of_light/kb
+    real(wp),intent(in) :: temp   !< temperature in K
+    real(wp),intent(in) :: f      !< vibrational frequency in cm⁻¹
+    real(wp):: lnq_v
+    real(wp):: t_vib
+    ! get the vibrational temperature (which is in K, BTW)
+    t_vib = factor*f
+    ! modified oscillator, for sthr = 0 -> HO.
+    ! ln(q) of the harmonic oscillator partition function
+    lnq_v = -0.5_wp*t_vib/temp-log(1.0_wp-exp(-t_vib/temp))
+
+  end function lnqvib
+
+  pure elemental function lnqvibmod(temp,f,sthr,avmom) result(lnq)
+    implicit none
+    real(wp),intent(in) :: temp   !< temperature in K
+    real(wp),intent(in) :: f      !< vibrational frequency in cm⁻¹
+    real(wp),intent(in) :: sthr   !< rotor cutoff in cm⁻¹
+    real(wp),intent(in) :: avmom  !< average moment of inertia in kg·m²
+    real(wp):: fswitch
+    real(wp):: lnq_r,lnq_v,lnq
+    ! ln(q) of the harmonic oscillator partition function
+    lnq_v = lnqvib(temp,f)
+    ! ln(q) of the free rotor partition function, we assume σ=1
+    lnq_r = lnqrot(temp,f,avmom)
+
+    ! Chai--Head-Gordon weighting
+    fswitch = 1.0_wp-chg_switching(sthr,f)
+
+    ! now final modified vibrational partiation function
+    lnq = (1.0_wp-fswitch)*lnq_v+fswitch*lnq_r
+
+  end function lnqvibmod
+
+  pure elemental function chg_switching(omega,sthr) result(f)
+    real(wp),intent(in) :: omega
+    real(wp),intent(in) :: sthr
+    real(wp) :: f
+    if (sthr .ge. 0.0_wp) then
       f = 1.0_wp/(1.0_wp+(sthr/omega)**4)
-   else
+    else
       f = 1.0_wp
-   endif
-end function chg_switching
-
-pure elemental function chg_inverted(f,sthr) result(omega)
-   real(wp),intent(in) :: f
-   real(wp),intent(in) :: sthr
-   real(wp) :: omega
-   omega = sthr/(1.0_wp/f - 1.0_wp)**0.25_wp
-
-end function chg_inverted
-
-
-subroutine print_thermo_sthr_ts(iunit,nvib,vibs,avmom_si,sthr_rcm,temp)
-   implicit none
-
-   integer, intent(in) :: iunit      !< output unit, usually STDOUT
-   integer, intent(in) :: nvib       !< number of frequencies
-   real(wp),intent(in) :: vibs(nvib) !< frequencies in Eh
-   real(wp),intent(in) :: avmom_si   !< average moment
-   real(wp),intent(in) :: sthr_rcm   !< rotor cutoff
-   real(wp),intent(in) :: temp       !< temperature
-
-   integer  :: i
-   real(wp) :: maxfreq,omega,s_r,s_v,fswitch
-   real(wp) :: beta,ewj,mu,RT,sthr,avmom
-   beta = 1.0_wp/kB/temp ! beta in 1/Eh
-   sthr = sthr_rcm * rcmtoau ! sthr in Eh
-   RT = kb*temp*autokcal ! RT in kcal/mol for printout
-   avmom = avmom_si*kgtome*aatoau**2*1.0e+20_wp ! in me·α²
-
-   write(iunit,'(a)')
-   maxfreq = max(300.0_wp,chg_inverted(0.99_wp,sthr_rcm))
-   write(iunit,'(1x,a,f6.2,a,/)') 'Frequencies up to ',maxfreq,' cm⁻¹ treated with '// &
-   & 'the modified RRHO approximation:'
-   write(iunit,'(a8,a14,1x,a27,a27,a12)') &
+    end if
+  end function chg_switching
+
+  pure elemental function chg_inverted(f,sthr) result(omega)
+    real(wp),intent(in) :: f
+    real(wp),intent(in) :: sthr
+    real(wp) :: omega
+    omega = sthr/(1.0_wp/f-1.0_wp)**0.25_wp
+
+  end function chg_inverted
+
+  subroutine print_thermo_sthr_ts(iunit,nvib,vibs,avmom_si,sthr_rcm,temp)
+    implicit none
+
+    integer,intent(in) :: iunit      !< output unit, usually STDOUT
+    integer,intent(in) :: nvib       !< number of frequencies
+    real(wp),intent(in) :: vibs(nvib) !< frequencies in Eh
+    real(wp),intent(in) :: avmom_si   !< average moment
+    real(wp),intent(in) :: sthr_rcm   !< rotor cutoff
+    real(wp),intent(in) :: temp       !< temperature
+
+    integer  :: i
+    real(wp) :: maxfreq,omega,s_r,s_v,fswitch
+    real(wp) :: beta,ewj,mu,RT,sthr,avmom
+    beta = 1.0_wp/kB/temp ! beta in 1/Eh
+    sthr = sthr_rcm*rcmtoau ! sthr in Eh
+    RT = kb*temp*autokcal ! RT in kcal/mol for printout
+    avmom = avmom_si*kgtome*aatoau**2*1.0e+20_wp ! in me·α²
+
+    write (iunit,'(a)')
+    maxfreq = max(300.0_wp,chg_inverted(0.99_wp,sthr_rcm))
+    write (iunit,'(1x,a,f6.2,a,/)') 'Frequencies up to ',maxfreq,' cm⁻¹ treated with '// &
+    & 'the modified RRHO approximation:'
+    write (iunit,'(a8,a14,1x,a27,a27,a12)') &
       "mode","ω/cm⁻¹","T·S(HO)/kcal·mol⁻¹","T·S(FR)/kcal·mol⁻¹","T·S(vib)"
-   write(iunit,'(3x,72("-"))')
-   do i = 1, nvib
+    write (iunit,'(3x,72("-"))')
+    do i = 1,nvib
       ! frequency is Eh
-      omega=vibs(i)
+      omega = vibs(i)
       ! omega in Eh, beta in 1/Eh
-      ewj=exp(-omega*beta)
+      ewj = exp(-omega*beta)
       ! moment of intertia corresponding to the rotor with frequency omega
       ! mu is in me·α² (au)
-      mu = 0.5_wp / (omega+1.0e-14_wp)
+      mu = 0.5_wp/(omega+1.0e-14_wp)
       ! this reduced moment limits the rotational moment of inertia for
       ! this vibration to that of the total molecule rotation/3
       ! avmom and mu are in au
-      mu=mu*avmom/(mu+avmom)
+      mu = mu*avmom/(mu+avmom)
       !              free rotor entropy
       ! Cramer, page 328 for one degree of freedom or
       ! http://cccbdb.nist.gov/thermo.asp, eq. 35, sigma=1
       !              harm. osc. entropy
-      if(omega.gt.0)then
-         ! this is S/R which is dimensionless
-         s_v = omega*beta*ewj/(1.0_wp-ewj) - log(1.0_wp-ewj)
-         s_r = 0.5_wp + log(sqrt(pi/beta*2.0_wp*mu))
+      if (omega .gt. 0) then
+        ! this is S/R which is dimensionless
+        s_v = omega*beta*ewj/(1.0_wp-ewj)-log(1.0_wp-ewj)
+        s_r = 0.5_wp+log(sqrt(pi/beta*2.0_wp*mu))
       else
-         s_v = 0.0_wp
-         s_r = 0.0_wp
-      endif
+        s_v = 0.0_wp
+        s_r = 0.0_wp
+      end if
       ! Head-Gordon weighting
-      fswitch=1.0_wp-chg_switching(omega,sthr)
-      if (omega > maxfreq*rcmtoau) exit
-      write(iunit,'(i8,f10.2,2(f12.5,1x,"(",f6.2,"%)"),f12.5)') &
-         i,omega*autorcm,-RT*s_v,(1.0_wp-fswitch)*100, &
-         -RT*s_r,fswitch*100,-RT*((1.0_wp-fswitch) * s_v + fswitch * s_r)
-   enddo
-   write(iunit,'(3x,72("-"))')
-
-end subroutine print_thermo_sthr_ts
+      fswitch = 1.0_wp-chg_switching(omega,sthr)
+      if (omega > maxfreq*rcmtoau) then
+        if (i == 1) write (iunit,'(a8,4x,a,10x,a,21x,a,20x,a)') 'none','-','-','-','-'
+        exit
+      end if
+      write (iunit,'(i8,f10.2,2(f12.5,1x,"(",f6.2,"%)"),f12.5)') &
+        i,omega*autorcm,-RT*s_v, (1.0_wp-fswitch)*100, &
+        -RT*s_r,fswitch*100,-RT*((1.0_wp-fswitch)*s_v+fswitch*s_r)
+    end do
+    write (iunit,'(3x,72("-"))')
+
+  end subroutine print_thermo_sthr_ts
+
+  subroutine print_thermo_sthr_cut(iunit,nvib,vibs,sthr_rcm,temp)
+    implicit none
+
+    integer,intent(in) :: iunit      !< output unit, usually STDOUT
+    integer,intent(in) :: nvib       !< number of frequencies
+    real(wp),intent(in) :: vibs(nvib) !< frequencies in Eh
+    real(wp),intent(in) :: sthr_rcm   !< rotor cutoff
+    real(wp),intent(in) :: temp       !< temperature
+
+    integer  :: i
+    real(wp) :: maxfreq,omega,s_r,s_v,omega_cut
+    real(wp) :: beta,ewj,mu,RT,sthr,avmom,ewj_cut
+    beta = 1.0_wp/kB/temp ! beta in 1/Eh
+    sthr = sthr_rcm*rcmtoau ! sthr in Eh
+    RT = kb*temp*autokcal ! RT in kcal/mol for printout
+
+    write (iunit,'(a)')
+    maxfreq = sthr_rcm
+    write (iunit,'(1x,a,f6.2,a,/)') 'Frequencies up to ',maxfreq,' cm⁻¹ will '// &
+    & 'crudely be cut to exactly this value (Truhlar, 2011)'
+    write (iunit,'(a8,a14,1x,a27,a27,a13)') &
+      "mode","ω/cm⁻¹","T·S(HO)/kcal·mol⁻¹","T·S(cut)/kcal·mol⁻¹","ΔT·S"
+    write (iunit,'(3x,72("-"))')
+    do i = 1,nvib
+      ! frequency is Eh
+      omega = vibs(i)
+      if (omega > maxfreq*rcmtoau) then
+        if (i == 1) write (iunit,'(a8,4x,a,10x,a,20x,a,25x,a)') 'none','-','-','-','-'
+        exit
+      end if
+      omega_cut = maxfreq*rcmtoau
+      ! omega in Eh, beta in 1/Eh
+      ewj = exp(-omega*beta)
+      ewj_cut = exp(-omega_cut*beta)
+
+      if (omega .gt. 0) then
+        ! this is S/R which is dimensionless
+        s_v = omega*beta*ewj/(1.0_wp-ewj)-log(1.0_wp-ewj)
+        s_r = omega_cut*beta*ewj_cut/(1.0_wp-ewj_cut)-log(1.0_wp-ewj_cut)
+      else
+        s_v = 0.0_wp
+        s_r = 0.0_wp
+      end if
+      write (iunit,'(i8,f10.2,9x,f12.5,10x,f12.5,1x,f12.5)') &
+        i,omega*autorcm,-RT*s_v,-RT*s_r,-RT*(s_v-s_r)
+    end do
+    write (iunit,'(3x,72("-"))')
+
+  end subroutine print_thermo_sthr_cut
 
 !========================================================================================!
 !========================================================================================!
diff --git a/src/entropy/thermocalc.f90 b/src/entropy/thermocalc.f90
index 2aa2e64f..95c863fc 100644
--- a/src/entropy/thermocalc.f90
+++ b/src/entropy/thermocalc.f90
@@ -17,272 +17,6 @@
 ! along with crest.  If not, see <https://www.gnu.org/licenses/>.
 !================================================================================!
 
-!=========================================================================================!
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC!
-!=========================================================================================!
-
-subroutine prepthermo(nat,at,xyz,pr,molmass,rabc,avmom,symnum,symchar)
-!***********************************************************************
-!* Prepare the calculation of thermodynamic properties of a structure
-!* In particular, determine rotational constants and check the symmetry
-!***********************************************************************
-  use crest_parameters,only:wp,bohr,stdout
-  use atmasses,only:molweight
-  use iomod,only:to_lower
-  use axis_module
-  implicit none
-  integer,intent(in)     :: nat
-  integer,intent(in)     :: at(nat)
-  real(wp),intent(inout) :: xyz(3,nat) !> in Angstroem
-  logical,intent(in)     :: pr
-  real(wp),intent(out)   :: molmass
-  real(wp),intent(inout) :: rabc(3)
-  real(wp),intent(out)   :: avmom
-  real(wp),intent(out)   :: symnum
-
-  real(wp) :: a,b,c
-  character(len=4) :: sfsym
-  character(len=3) :: sym,symchar
-  real(wp),parameter :: desy = 0.1_wp
-  integer,parameter  :: maxat = 200
-
-  !>--- molecular mass in amu
-  molmass = molweight(nat,at)
-
-  if (pr) then
-    write (stdout,'(1x,a,f15.2)') 'Mol. weight /amu  : ',molmass
-  end if
-
-  !>--- rotational constants in cm-1
-  rabc = 0.0d0
-  call axis(nat,at,xyz,rabc(1:3),avmom)
-  a = rabc(3)
-  b = rabc(2)
-  c = rabc(1)
-  rabc(1) = a
-  rabc(3) = c
-  if (pr) then
-    write (stdout,'(1x,a,3f15.2)') 'Rot. const. /MHz  : ',rabc(1:3)
-  end if
-  rabc = rabc/2.99792458d+4   ! MHz to cm-1
-  if (pr) then
-    write (stdout,'(1x,a,3f15.2)') 'Rot. const. /cm-1 : ',rabc(1:3)
-  end if
-
-  !>--- symmetry number from rotational symmetry
-  xyz = xyz/bohr
-  call getsymmetry2(.false.,6,nat,at,xyz,desy,maxat,sfsym)
-  xyz = xyz*bohr
-  sym = sfsym(1:3)
-  symchar = sym
-  symnum = 1.0d0
-  if (a .lt. 1.d-9.or.b .lt. 1.d-9.or.c .lt. 1.d-9) then
-    if (index(sym,'d') .ne. 0) symnum = 2.0d0
-  else
-    call to_lower(sym)
-    if (index(sym,'c2') .ne. 0) symnum = 2.0d0
-    if (index(sym,'s4') .ne. 0) symnum = 2.0d0
-    if (index(sym,'c3') .ne. 0) symnum = 3.0d0
-    if (index(sym,'s6') .ne. 0) symnum = 3.0d0
-    if (index(sym,'c4') .ne. 0) symnum = 4.0d0
-    if (index(sym,'s8') .ne. 0) symnum = 4.0d0
-    if (index(sym,'c5') .ne. 0) symnum = 5.0d0
-    if (index(sym,'c6') .ne. 0) symnum = 6.0d0
-    if (index(sym,'c7') .ne. 0) symnum = 7.0d0
-    if (index(sym,'c8') .ne. 0) symnum = 8.0d0
-    if (index(sym,'c9') .ne. 0) symnum = 9.0d0
-    if (index(sym,'d2') .ne. 0) symnum = 4.0d0
-    if (index(sym,'d3') .ne. 0) symnum = 6.0d0
-    if (index(sym,'d4') .ne. 0) symnum = 8.0d0
-    if (index(sym,'d5') .ne. 0) symnum = 10.0d0
-    if (index(sym,'d6') .ne. 0) symnum = 12.0d0
-    if (index(sym,'d7') .ne. 0) symnum = 14.0d0
-    if (index(sym,'d8') .ne. 0) symnum = 16.0d0
-    if (index(sym,'d9') .ne. 0) symnum = 18.0d0
-    if (index(sym,'t') .ne. 0) symnum = 12.0d0
-    if (index(sym,'td') .ne. 0) symnum = 12.0d0
-    if (index(sym,'th') .ne. 0) symnum = 12.0d0
-    if (index(sym,'o') .ne. 0) symnum = 24.0d0
-    if (index(sym,'oh') .ne. 0) symnum = 24.0d0
-    if (index(sym,'ih') .ne. 0) symnum = 60.0d0
-  end if
-
-  if (pr) then
-    write (stdout,'(1x,a,4x,a)') 'Symmetry:',sym
-  end if
-  return
-end subroutine prepthermo
-
-!=========================================================================================!
-subroutine calcthermo(nat,at,xyz,freq,pr,ithr,fscal,sthr,nt,temps, &
-    &      et,ht,gt,stot)
-!**************************************************************
-!* Calculate thermodynamic contributions for a given structure
-!* from it's frequencies (from second derivatives/the Hessian)
-!* Based on xtb's "print_thermo" routine
-!**************************************************************
-  use crest_parameters,only:wp,bohr,stdout
-  use crest_thermo
-  use atmasses,only:molweight
-  use iomod,only:to_lower
-  implicit none
-  integer,intent(in)     :: nat
-  integer,intent(in)     :: at(nat)
-  real(wp),intent(inout) :: xyz(3,nat)  !in Angstroem
-  real(wp),intent(inout) :: freq(3*nat) !in cm-1
-  logical,intent(in)     :: pr
-  real(wp),intent(in) :: ithr     !imag. inv. in cm-1
-  real(wp),intent(in) :: fscal    !freq scaling
-  real(wp),intent(in) :: sthr     !rotor cut
-  integer,intent(in)  :: nt
-  real(wp),intent(in) :: temps(nt)
-  real(wp) :: et(nt)          !< enthalpy in Eh
-  real(wp) :: ht(nt)          !< enthalpy in Eh
-  real(wp) :: gt(nt)          !< free energy in Eh
-  real(wp) :: stot(nt)        !< entropy in cal/molK
-  real(wp) :: ts(nt)          !< entropy*T in Eh
-  real(wp) :: rabc(3),a,b,c
-  real(wp) :: avmom
-  real(wp) :: molmass
-  real(wp) :: sym
-  real(wp) :: zp
-  character(len=3) :: symchar
-  logical :: pr2
-  logical :: linear = .false.
-  logical :: atom = .false.
-  integer :: nvib_theo
-  integer :: nvib,nimag
-  real(wp) :: vibthr
-  real(wp),allocatable :: vibs(:)
-
-  integer :: i,j
-  integer :: n3,rt
-  real(wp) :: adum(nt)
-  character(len=64) :: atmp
-
-  character(len=*),parameter :: outfmt = &
-  &  '(9x,"::",1x,a,f24.12,1x,a,1x,"::")'
-  character(len=*),parameter :: dblfmt = &
-  &  '(10x,":",2x,a,f24.7,1x,a,1x,":")'
-  character(len=*),parameter :: intfmt = &
-  &  '(10x,":",2x,a,i24,       6x,":")'
-  character(len=*),parameter :: chrfmt = &
-  &  '(10x,":",2x,a,a24,       6x,":")'
-
-  real(wp),parameter :: autorcm = 219474.63067_wp
-  real(wp),parameter :: rcmtoau = 1.0_wp/autorcm
-  real(wp),parameter :: autocal = 627.50947428_wp*1000.0_wp
-
-  call prepthermo(nat,at,xyz,pr,molmass,rabc,avmom,sym,symchar)
-
-  n3 = 3*nat
-  allocate (vibs(n3))
-  vibthr = 1.0
-  a = rabc(1)
-  b = rabc(2)
-  c = rabc(3)
-
-  nvib_theo = 3*nat-6
-  if (c .lt. 1.d-10 .or. (symchar=='din')) linear = .true.
-  if (linear) nvib_theo = 3*nat-5
-
-  if (a+b+c .lt. 1.d-6) then
-    atom = .true.
-    nvib = 0
-    nvib_theo = 0
-  end if
-
-  nvib = 0
-  vibs = 0.0
-  do i = 1,n3
-    if (abs(freq(i)) .gt. vibthr) then
-      nvib = nvib+1
-      vibs(nvib) = freq(i)
-    end if
-  end do
-  !> scale
-  vibs(1:nvib) = vibs(1:nvib)*fscal
-
-  !> invert imaginary modes
-  nimag = 0
-  do i = 1,nvib
-    if (vibs(i) .lt. 0.and.vibs(i) .gt. ithr) then
-      vibs(i) = -vibs(i)
-      if (pr) write (stdout,'(a,i5," :",f10.2)') 'Inverting frequency',i,vibs(i)
-    end if
-    if (vibs(i) < 0.0) then
-      nimag = nimag+1
-    end if
-  end do
-
-  if (pr) then
-    write (stdout,'(a)')
-    write (stdout,'(10x,51("."))')
-    write (stdout,'(10x,":",22x,a,22x,":")') "SETUP"
-    write (stdout,'(10x,":",49("."),":")')
-    write (stdout,intfmt) "# frequencies    ",nvib
-    write (stdout,intfmt) "# imaginary freq.",nimag
-    write (atmp,*) linear
-    write (stdout,chrfmt) "linear?          ",trim(atmp)
-    write (stdout,chrfmt) "symmetry         ",adjustr(symchar)
-    write (stdout,intfmt) "rotational number",nint(sym)
-    write (stdout,dblfmt) "scaling factor   ",fscal,"    "
-    write (stdout,dblfmt) "rotor cutoff     ",sthr,"cm⁻¹"
-    write (stdout,dblfmt) "imag. cutoff     ",ithr,"cm⁻¹"
-    write (stdout,'(10x,":",49("."),":")')
-  end if
-
-  vibs = vibs*rcmtoau   ! thermodyn needs vibs and zp in Eh
-
-  zp = 0.5_wp*sum(vibs(1:nvib))
-  adum = abs(temps-298.15d0)
-  rt = minloc(adum,1)  !temperature closest to 298.15 is the ref.
-  do j = 1,nt
-    if ((j == rt).and.pr) then
-      pr2 = .true.
-    else
-      pr2 = .false.
-    end if
-    if (pr2) then
-      call print_thermo_sthr_ts(stdout,nvib,vibs,avmom,sthr,temps(j))
-    end if
-    call thermodyn(stdout,a,b,c,avmom,linear,atom,sym,molmass,vibs,nvib, &
-    & temps(j),sthr,et(j),ht(j),gt(j),ts(j),zp,pr2)
-    stot(j) = (ts(j)/temps(j))*autocal
-  end do
-
-  if ((nt > 1).and.pr) then
-    write (stdout,'(a)')
-    write (stdout,'(a10)',advance='no') "T/K"
-    write (stdout,'(a16)',advance='no') "H(0)-H(T)+PV"
-    write (stdout,'(a16)',advance='no') "H(T)/Eh"
-    write (stdout,'(a16)',advance='no') "T*S/Eh"
-    write (stdout,'(a16)',advance='no') "G(T)/Eh"
-    write (stdout,'(a)')
-    write (stdout,'(3x,72("-"))')
-    do i = 1,nt
-      write (stdout,'(3f10.2)',advance='no') temps(i)
-      write (stdout,'(3e16.6)',advance='no') ht(i)
-      write (stdout,'(3e16.6)',advance='no') et(i)
-      write (stdout,'(3e16.6)',advance='no') ts(i)
-      write (stdout,'(3e16.6)',advance='no') gt(i)
-      if (i == rt) then
-        write (stdout,'(1x,"(used)")')
-      else
-        write (stdout,'(a)')
-      end if
-    end do
-    write (stdout,'(3x,72("-"))')
-  end if
-
-  deallocate (vibs)
-  return
-end subroutine calcthermo
-
-!=========================================================================================!
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC!
-!=========================================================================================!
-
 subroutine thermo_wrap_legacy(env,pr,nat,at,xyz,dirname, &
         &  nt,temps,et,ht,gt,stot,bhess)
 !**********************************************
@@ -295,6 +29,7 @@ subroutine thermo_wrap_legacy(env,pr,nat,at,xyz,dirname, &
   use crest_data
   use iomod
   use strucrd
+  use thermochem_module
   implicit none
   !> INPUT
   type(systemdata) :: env
@@ -325,7 +60,7 @@ subroutine thermo_wrap_legacy(env,pr,nat,at,xyz,dirname, &
   integer :: nfreq
   real(wp),allocatable :: freq(:)
   real(wp) :: ithr,fscal,sthr
-
+  type(coord) :: mol
   integer :: TID,OMP_GET_THREAD_NUM
 
 !!$OMP PARALLEL PRIVATE(TID)
@@ -387,9 +122,9 @@ subroutine thermo_wrap_legacy(env,pr,nat,at,xyz,dirname, &
 
   if (subdir) then
     jobcall2 = 'cd '//trim(dirname)//' && '//trim(jobcall)
-    call command( jobcall2, io )
+    call command(jobcall2,io)
   else
-    call command( jobcall, io )
+    call command(jobcall,io)
   end if
 
   et = 0.0_wp
@@ -402,18 +137,19 @@ subroutine thermo_wrap_legacy(env,pr,nat,at,xyz,dirname, &
   end if
 
 !$omp critical
-  call rdxmol(trim(optpath)//'xtbopt.xyz',nat,at,xyz,atmp)
+  !call rdxmol(trim(optpath)//'xtbopt.xyz',nat,at,xyz,atmp)
+  call mol%open(trim(optpath)//'xtbopt.xyz')
   etot = grepenergy(atmp)
-  nfreq = 3*nat
+  nfreq = 3*mol%nat
 
   allocate (freq(nfreq))
-  call rdfreq(trim(optpath)//'vibspectrum',nfreq,freq)
+  call rdfreq(mol,trim(optpath)//'vibspectrum',nfreq,freq)
 
   ithr = env%thermo%ithr
   fscal = env%thermo%fscal
   sthr = env%thermo%sthr
-  call calcthermo(nat,at,xyz,freq,pr,ithr,fscal,sthr, &
-  &    nt,temps,et,ht,gt,stot)
+  call calcthermo(mol%nat,mol%at,mol%xyz,freq,pr,ithr,fscal,sthr, &
+  &    nt,temps,et,ht,gt,stot,stdout,emodel=env%thermo%emodel)
   deallocate (freq)
 !$omp end critical
   call initsignal()
@@ -421,7 +157,49 @@ subroutine thermo_wrap_legacy(env,pr,nat,at,xyz,dirname, &
 end subroutine thermo_wrap_legacy
 
 !=========================================================================================!
-subroutine rdfreq(fname,nmodes,freq)
+
+subroutine rdfreq(mol,fname,nmodes,freq)
+!**************************************
+!* read vibspectrum file in TM format
+!**************************************
+  use crest_parameters,only:wp
+  use crest_data
+  use iomod
+  use strucrd
+  implicit none
+  type(coord),intent(in) :: mol
+  character(len=*),intent(in) :: fname
+  integer,intent(in)   :: nmodes
+  real(wp),intent(out) :: freq(nmodes)    !frequencies
+
+  logical :: ex,ex2,ex3
+  type(coord) :: moltmp
+  freq(:) = 0.0_wp
+
+  inquire (file=fname,exist=ex)
+  if (.not.ex) return
+
+  call minigrep(fname,'$vibrational spectrum',ex)
+  if (ex) then
+    !> TURBOMOLE "vibspectrum"-style file
+    call rdfreq_vibspectrum_file(fname,nmodes,freq)
+  end if
+  call minigrep(fname,'$orca_hessian_file',ex)
+  call minigrep(fname,'$hessian',ex2)
+  call minigrep(fname,'$ir_spectrum',ex3)
+  !if (ex.and.ex3) then
+  !  !> ORCA ".hess" file --> frequencies directly
+  !  call rdfreq_orca_ir_spectrum(fname,nmodes,freq)
+  !else if (ex.and.ex2) then
+  if(ex.and.ex2)then
+    !> ORCA ".hess" file --> from Hessian
+    moltmp = mol
+    call rdfreq_orca_hess(moltmp,fname,nmodes,freq)
+  end if
+
+end subroutine rdfreq
+
+subroutine rdfreq_vibspectrum_file(fname,nmodes,freq)
 !**************************************
 !* read vibspectrum file in TM format
 !**************************************
@@ -438,12 +216,6 @@ subroutine rdfreq(fname,nmodes,freq)
   logical :: ex
   integer :: TID,OMP_GET_THREAD_NUM
 
-!!$OMP PARALLEL PRIVATE(TID)
-  TID = OMP_GET_THREAD_NUM()
-!      write(*,*) '---->',TID
-!!$OMP END PARALLEL
-  ich = (TID+1)*1000   ! generate CPU dependent file channel number
-
   freq = 0.0_wp
   inquire (file=fname,exist=ex)
   if (.not.ex) return
@@ -466,7 +238,141 @@ subroutine rdfreq(fname,nmodes,freq)
   end do rdfile
   close (ich)
   return
-end subroutine rdfreq
+end subroutine rdfreq_vibspectrum_file
+
+subroutine rdfreq_orca_ir_spectrum(fname,nmodes,freq)
+!**************************************
+!* read vibspectrum file in TM format
+!**************************************
+  use crest_parameters,only:wp,stdout
+  use crest_data
+  use iomod
+  implicit none
+  character(len=*),intent(in) :: fname
+  integer,intent(in)   :: nmodes
+  real(wp),intent(out) :: freq(nmodes)    !frequencies
+  integer :: k,ich,io,n,nref
+  character(len=256) :: atmp
+  real(wp) :: floats(10)
+  logical :: ex
+
+  freq = 0.0_wp
+  k = 1 !modes
+  open (file=fname,unit=ich)
+  rdfile: do
+    read (ich,'(a)',iostat=io) atmp
+    if (io < 0) exit
+    if (index(atmp,'$ir_spectrum') .ne. 0) then
+      read (ich,'(a)',iostat=io) atmp
+      if (io < 0) exit rdfile
+      read (atmp,*,iostat=io) nref
+      if (io .ne. 0) exit rdfile
+      if (nref .ne. nmodes) exit rdfile
+      rdblock: do
+        read (ich,'(a)',iostat=io) atmp
+        if (io < 0) exit rdfile
+        if (index(atmp,'$end') .ne. 0) exit rdfile
+        if (index(atmp,'#') .ne. 0) cycle rdblock !skip comment lines
+        call readl(atmp,floats,n)
+        freq(k) = floats(1)
+        if (k == nref) exit rdfile
+        k = k+1
+      end do rdblock
+    end if
+  end do rdfile
+  if (k .ne. nmodes) then
+    write (stdout,*) '** WARNING ** error while reading '//trim(fname)
+  end if
+  close (ich)
+  return
+end subroutine rdfreq_orca_ir_spectrum
+
+subroutine rdfreq_orca_hess(mol,fname,nmodes,freq)
+!**************************************
+!* read vibspectrum file in TM format
+!**************************************
+  use crest_parameters,only:wp,stdout
+  use crest_data
+  use iomod
+  use strucrd
+  use thermochem_module
+  implicit none
+  type(coord),intent(inout) :: mol
+  character(len=*),intent(in) :: fname
+  integer,intent(in)   :: nmodes
+  real(wp),intent(out) :: freq(nmodes)    !frequencies
+  integer :: k,ich,io,n,nref
+  integer :: ii,jj,kk,iblocks,jblocks,ll
+  character(len=256) :: atmp
+  real(wp) :: floats(10)
+  logical :: ex
+  real(wp),allocatable :: hess(:,:)
+
+  freq = 0.0_wp
+  allocate (hess(nmodes,nmodes),source=0.0_wp)
+  k = 1 !modes
+  open (file=fname,unit=ich)
+  rdfile: do
+    read (ich,'(a)',iostat=io) atmp
+    if (io < 0) exit
+    if (index(atmp,'$hessian') .ne. 0) then
+      read (ich,'(a)',iostat=io) atmp
+      if (io < 0) exit rdfile
+      read (atmp,*,iostat=io) nref
+      if (io .ne. 0) exit rdfile
+      if (nref .ne. nmodes) exit rdfile
+      iblocks = (floor(real(nref,wp)/5.0_wp))
+      jblocks = nref-(iblocks*5)
+      rdblock1: do ii = 1,iblocks
+        do jj = 0,nref
+          read (ich,'(a)',iostat=io) atmp
+          if (io < 0) exit rdfile
+          if (index(atmp,'$end') .ne. 0) exit rdfile
+          if (index(atmp,'#') .ne. 0) cycle rdblock1 !skip comment lines
+          call readl(atmp,floats,n)
+          if (jj > 0) then
+            kk = (ii-1)*5
+            do ll = 1,5
+              hess(kk+ll,jj) = floats(1+ll)
+            end do
+          end if
+        end do
+      end do rdblock1
+      if (jblocks > 0) then
+        do jj = 0,nref
+          read (ich,'(a)',iostat=io) atmp
+          if (io < 0) exit rdfile
+          if (index(atmp,'$end') .ne. 0) exit rdfile
+          if (index(atmp,'#') .ne. 0) cycle
+          call readl(atmp,floats,n)
+          if (jj > 0) then
+            kk = (ii-1)*5
+            do ll = 1,jblocks
+              hess(kk+ll,jj) = floats(1+ll)
+            end do
+          end if
+        end do
+      end if
+    end if
+  end do rdfile
+  if (nref .ne. nmodes) then
+    write (stdout,*) '** WARNING ** error while reading '//trim(fname)
+  end if
+  close (ich)
+
+  write(stdout,'(a)',advance='no') ' Processing (raw) Hessian read from ORCA '//trim(fname)//' ... '
+  flush(stdout)
+  !!$omp critical
+  !>-- Projects and mass-weights the Hessian
+  call prj_mw_hess(mol%nat,mol%at,nmodes,mol%xyz,hess)
+  !>-- Computes the Frequencies
+  call frequencies(mol%nat,mol%at,mol%xyz,nmodes,hess,freq,io)
+  !!$omp end critical
+  write(stdout,'(a)') 'done.'
+
+  deallocate (hess)
+  return
+end subroutine rdfreq_orca_hess
 
 !=========================================================================================!
 
@@ -484,7 +390,7 @@ subroutine thermo_wrap_new(env,pr,nat,at,xyz,dirname, &
   use crest_calculator
   use iomod
   use strucrd
-  use hessian_tools
+  use thermochem_module
   implicit none
   !> INPUT
   type(systemdata) :: env
@@ -527,7 +433,6 @@ subroutine thermo_wrap_new(env,pr,nat,at,xyz,dirname, &
   if (len_trim(dirname) > 0) subdir = .true.
 
 !>-- create a calculation object locally, modify calc dir
-!$omp critical
   calctmp = env%calc
   calctmp%pr_energies = .false. !> never do that!
   mol%nat = nat
@@ -546,7 +451,6 @@ subroutine thermo_wrap_new(env,pr,nat,at,xyz,dirname, &
   nfreq = 3*nat
   allocate (freq(nfreq),source=0.0_wp)
   allocate (hess(nfreq,nfreq),source=0.0_wp)
-!$omp end critical
 
 !>-- numerical Hessian
 
@@ -563,27 +467,20 @@ subroutine thermo_wrap_new(env,pr,nat,at,xyz,dirname, &
   end if
 
 !>-- project and get frequencies
-!$omp critical
-  !>-- Projects and mass-weights the Hessian
   call prj_mw_hess(mol%nat,mol%at,nfreq,mol%xyz,hess)
-  !>-- Computes the Frequencies
-  call frequencies(mol%nat,mol%at,mol%xyz,nfreq,calctmp,hess,freq,io)
-!$omp end critical
+  call frequencies(mol%nat,mol%at,mol%xyz,nfreq,hess,freq,io)
 
 !>--- get thermodynamics
-!$omp critical
   et = 0.0_wp
   ht = 0.0_wp
   gt = 0.0_wp
   stot = 0.0_wp
-
   ithr = env%thermo%ithr
   fscal = env%thermo%fscal
   sthr = env%thermo%sthr
-  call calcthermo(nat,at,xyz,freq,pr,ithr,fscal,sthr, &
-  &    nt,temps,et,ht,gt,stot)
+  call calcthermo(mol%nat,mol%at,mol%xyz,freq,pr,ithr,fscal,sthr, &
+  &    nt,temps,et,ht,gt,stot,stdout,emodel=env%thermo%emodel)
   deallocate (hess,freq)
-!$omp end critical
   call initsignal()
   return
 end subroutine thermo_wrap_new
@@ -595,10 +492,11 @@ subroutine calcSrrhoav(env,ensname)
 !*******************************************************
 !* Calculate S_RRHO averages for a given ensemlbe
 !*******************************************************
-  use crest_parameters
+  use crest_parameters,only:wp,stdout,autokcal,aatoau
   use crest_data
   use strucrd
   use iomod
+  use parallel_interface
   implicit none
   !> INPUT
   type(systemdata) :: env
@@ -624,24 +522,17 @@ subroutine calcSrrhoav(env,ensname)
   real(wp) :: psum,emin,sdum
   real(wp) :: quick_rmsd,rmsdval
   integer :: eloc,ploc
-  logical :: avbhess
-
   integer :: nt
   real(wp),allocatable :: temps(:)
   real(wp),allocatable :: et(:)
   real(wp),allocatable :: ht(:)
   real(wp),allocatable :: gt(:)
-  real(wp),allocatable :: stot(:)
-  real(wp),allocatable :: c0(:,:)
   real(wp),allocatable :: sref(:)
   character(len=64) :: atmp
-  integer :: i,j,k,ich,io,popf,ii,T,Tn
+  integer :: i,j,k,ich,io,popf,ii
   logical :: ex
-  logical :: niceprint
-  real(wp) :: percent
-  character(len=52) :: bar
-  integer :: ncalc,vz,nlimit,nav
-  character(len=512) :: thispath,tmppath
+  integer :: ncalc,nlimit,nav
+  character(len=512) :: tmppath
 
   real(wp),parameter :: Tref = 298.15  !> room temperature is reference
   real(wp),parameter :: kcal = autokcal
@@ -736,70 +627,24 @@ subroutine calcSrrhoav(env,ensname)
 !>--- calculate Hessians for ncalc lowest structures
   allocate (gatt(nall,nt),satt(nall,nt),source=0.0_wp)
 
-  io = makedir('HESSIANS')
-  call getcwd(thispath)
-  inquire (file='gfnff_topo',exist=ex)
-
-  call chdir('HESSIANS')
-  if (env%legacy) then
-    if (env%gfnver == '--gff'.and.ex) then
-      call getcwd(tmppath)
-      io = sylnk(trim(thispath)//'/'//'gfnff_topo',trim(tmppath)//'/'//'gfnff_topo')
-    end if
-    if (index(env%fixfile,'none selected') .eq. 0) then
-      io = sylnk(trim(thispath)//'/'//env%fixfile,trim(tmppath)//'/'//env%fixfile)
-    end if
-  end if
-
-  k = 0
-  niceprint = env%niceprint
-
-!>--- OMP stuff
-  call new_ompautoset(env,'auto',ncalc,T,Tn)
-
-!>--- the parallel loop
-  avbhess = env%thermo%avbhess
-  write (stdout,'(1x,a,i0,a)') 'Running ',ncalc,' calculations ...'
-  call crest_oloop_pr_progress(env,ncalc,0)
-!$omp parallel &
-!$omp shared( vz,tmppath,ncalc,percent,k,bar,niceprint) &
-!$omp shared( env,nat,at,xyz,c0,et,ht,gt,stot,temps,nt,gatt,satt,avbhess,pindex )
-!$omp single
-  allocate (et(nt),ht(nt),gt(nt),stot(nt))
-  allocate (c0(3,nat))
-  do i = 1,ncalc
-    call initsignal()
-    vz = pindex(i) !> restore index
-    !$omp task firstprivate( vz ) private( tmppath,et,ht,gt,stot,c0 )
-    call initsignal()
-    !$omp critical
-    write (tmppath,'(''hess'',i0)') vz
-    c0(1:3,1:nat) = xyz(1:3,1:nat,vz)
-    !$omp end critical
-
-    call thermo_wrap(env,.false.,nat,at,c0,tmppath, &
-    &    nt,temps,et,ht,gt,stot,avbhess)
-
-    !$omp critical
-    gatt(vz,1:nt) = gt(1:nt)
-    satt(vz,1:nt) = stot(1:nt)
-    !$omp end critical
-    if (.not.env%keepModef) call rmrf(trim(tmppath))
-
-    !$omp critical
-    k = k+1
-    call crest_oloop_pr_progress(env,ncalc,k)
-    !$omp end critical
-    !$omp end task
-  end do
-  deallocate (c0)
-  deallocate (stot,gt,ht,et)
-!$omp taskwait
-!$omp end single
-!$omp end parallel
-  call crest_oloop_pr_progress(env,ncalc,-1)
-  call chdir(thispath)
-  if (.not.env%keepModef) call rmrf('HESSIANS')
+! ── build coordinate subset and call parallel Hessian loop ───────
+  block
+    integer :: ii
+    real(wp),allocatable :: xyz_calc(:,:,:),er_calc(:)
+    real(wp),allocatable :: gt_out(:,:),stot_out(:,:)
+    allocate (xyz_calc(3,nat,ncalc),er_calc(ncalc))
+    allocate (gt_out(ncalc,nt),stot_out(ncalc,nt))
+    do ii = 1,ncalc
+      xyz_calc(:,:,ii) = xyz(:,:,pindex(ii))*aatoau  !> Å → Bohr
+    end do
+    write (stdout,'(1x,a,i0,a)') 'Running ',ncalc,' calculations ...'
+    call crest_hessloop(env,nat,ncalc,at,xyz_calc,er_calc,gt_out,stot_out)
+    do ii = 1,ncalc
+      gatt(pindex(ii),1:nt) = gt_out(ii,1:nt)
+      satt(pindex(ii),1:nt) = stot_out(ii,1:nt)
+    end do
+    deallocate (xyz_calc,er_calc,gt_out,stot_out)
+  end block
 
 !========================================================================================!
 !>--- process the calculated free energies and entropies into accurate populations
diff --git a/src/entropy/thermochem_module.f90 b/src/entropy/thermochem_module.f90
new file mode 100644
index 00000000..0e537a55
--- /dev/null
+++ b/src/entropy/thermochem_module.f90
@@ -0,0 +1,851 @@
+module thermochem_module
+  use crest_parameters
+  use symmetry_i
+  use optimize_maths
+  use atmasses,only:molweight
+  use iomod,only:to_lower,directory_exist
+  use axis_module
+  use strucrd
+  use crest_thermo
+  implicit none
+  private
+
+  public :: frequencies
+  public :: effective_hessian
+  public :: prj_mw_hess,mass_weight_hess
+  public :: calcthermo,calc_thermo_from_hess
+  public :: print_vib_spectrum,print_hessian,print_g98_fake
+
+!=============================================================================!
+contains  !> MODULE PROCEDURES STARTE HERE
+!=============================================================================!
+
+  subroutine frequencies(nat,at,xyz,nat3,prj_mw_hess,freq,io)
+!*************************************************
+!* Returns the Frequencies from a Hessian in cm-1
+!*************************************************
+    implicit none
+
+    integer,intent(in) :: nat
+    integer,intent(in) :: at(nat)
+    real(wp),intent(in) :: xyz(3,nat)
+    real(wp) :: prj_mw_hess(nat3,nat3)
+
+    integer :: io,nat3
+    logical :: pr
+    real(wp) :: energy
+    real(wp) :: freq(nat3)
+    real(wp),allocatable :: pmode(:,:)
+
+    integer,allocatable :: iwork(:)
+    real(wp),allocatable :: work(:)
+
+    integer :: lwork,liwork,info,i
+    integer :: unit
+    !>LAPCK
+    external :: dsyevd
+
+    io = 0
+    nat3 = nat*3
+
+    !Parameters for diagonalization
+    lwork = 1+6*nat3+2*nat3**2
+    liwork = 3+5*nat3
+
+    !$omp critical
+    allocate (work(lwork),iwork(liwork))
+    !$omp end critical
+
+    !Diagonalization
+    call dsyevd('V','U',nat3,prj_mw_hess,nat3,freq,work,lwork,iwork,liwork,info)
+    io = info
+    deallocate (work,iwork)
+
+    !Convert eigenvalues to frequencies
+    do i = 1,nat3
+      if (freq(i) .gt. 0.0_wp) then
+        freq(i) = sqrt(freq(i))*autorcm
+      else
+        freq(i) = -sqrt(abs(freq(i)))*autorcm
+      end if
+    end do
+
+    !open (newunit=unit,file="frequencies")
+    !write (unit,*) "Frequencies:"
+    !do i = 1,size(freq)
+    !  write (unit,*) freq(i)
+    !end do
+    !close (unit)
+
+    return
+
+  end subroutine frequencies
+
+  subroutine mass_weight_hess(nat,at,nat3,hess)
+    implicit none
+
+    !> Mass weighting the Hessian
+    integer,intent(in) :: nat                   !Number of atoms
+    integer,intent(in) :: at(nat)               !atomic number of all atoms
+
+    real(wp),intent(inout) :: hess(nat3,nat3)   !Hessian matrix
+    real(wp) :: mass_in_au             !Masses of all atoms of the periodic table
+    integer :: i,j,nat3,i3,i33,j3,j33
+
+    !mass_in_au = (1.66054e-27_wp/9.1094e-31_wp)**2
+    mass_in_au = (amutokg/metokg)**2
+
+    do i = 1,nat
+      do j = i,nat
+
+        i3 = 3*(i-1)+1
+        i33 = 3*(i-1)+3
+        j3 = 3*(j-1)+1
+        j33 = 3*(j-1)+3
+
+        hess(i3:i33,j3:j33) = 1/sqrt(ams(at(i))*ams(at(j))*mass_in_au)*hess(i3:i33,j3:j33)
+        !Hessian is symmetric hence upper triangular can be copied
+        hess(j3:j33,i3:i33) = hess(i3:i33,j3:j33)
+
+      end do
+    end do
+
+    return
+  end subroutine mass_weight_hess
+
+!=========================================================================================!
+
+  subroutine prj_mw_hess(nat,at,nat3,xyz,hess,phess_ut)
+!***************************************************************
+!* Projection of the translational and rotational DOF out of
+!* the numerical Hessian plus the mass-weighting of the Hessian
+!***************************************************************
+    implicit none
+
+    integer,intent(in) :: nat,nat3
+    integer,intent(in) :: at(nat)
+    real(wp),intent(inout) :: hess(nat3,nat3)
+    real(wp),intent(in) ::  xyz(3,nat)
+    real(wp),intent(in),optional,target :: phess_ut(:)
+    !real(wp) ::  hess_ut(nat3*(nat3+1)/2),pmode(nat3,1)
+    real(wp),allocatable,target :: hess_ut(:)
+    real(wp),allocatable :: pmode(:,:)
+    real(wp),pointer :: phess(:)
+    integer :: i
+
+    if (present(phess_ut)) then
+      phess => phess_ut
+    else
+      !$omp critical
+      allocate (hess_ut(nat3*(nat3+1)/2),source=0.0_wp)
+      phess => hess_ut
+      !$omp end critical
+    end if
+    !$omp critical
+    allocate (pmode(nat3,1),source=0.0_wp)
+    !$omp end critical
+
+    !> Transforms matrix of the upper triangle vector
+    call dsqtoh(nat3,hess,phess)
+
+    !> Projection
+    call trproj(nat,nat3,xyz,phess,.false.,0,pmode,1)
+
+    !> Transforms vector of the upper triangle into matrix
+    call dhtosq(nat3,hess,phess)
+
+    !> Mass weighting
+    call mass_weight_hess(nat,at,nat3,hess)
+
+  end subroutine prj_mw_hess
+
+  !============================================================================!
+  !############################################################################!
+  !============================================================================!
+
+  subroutine prepthermo(nat,at,xyz,pr,molmass,rabc,avmom,symnum,symchar,iunit)
+!***********************************************************************
+!* Prepare the calculation of thermodynamic properties of a structure
+!* In particular, determine rotational constants and check the symmetry
+!***********************************************************************
+    implicit none
+    integer,intent(in)     :: nat
+    integer,intent(in)     :: at(nat)
+    real(wp),intent(inout) :: xyz(3,nat) !> in Angstroem
+    logical,intent(in)     :: pr
+    real(wp),intent(out)   :: molmass
+    real(wp),intent(inout) :: rabc(3)
+    real(wp),intent(out)   :: avmom
+    real(wp),intent(out)   :: symnum
+    integer,intent(in)     :: iunit
+
+    real(wp) :: a,b,c
+    character(len=4) :: sfsym
+    character(len=3) :: sym,symchar
+    !>--- molecular mass in amu
+    molmass = molweight(nat,at)
+
+    if (pr) then
+      write (iunit,'(1x,a,f15.2)') 'Mol. weight /amu  : ',molmass
+    end if
+
+    !>--- rotational constants in cm-1
+    rabc = 0.0d0
+    call axis(nat,at,xyz,rabc(1:3),avmom)
+    a = rabc(3)
+    b = rabc(2)
+    c = rabc(1)
+    rabc(1) = a
+    rabc(3) = c
+    if (pr) then
+      write (iunit,'(1x,a,3f15.2)') 'Rot. const. /MHz  : ',rabc(1:3)
+    end if
+    !rabc = rabc/2.99792458d+4   ! MHz to cm-1
+    rabc = rabc*mhztorcm
+    if (pr) then
+      write (iunit,'(1x,a,3f15.2)') 'Rot. const. /cm-1 : ',rabc(1:3)
+    end if
+
+    !>--- symmetry number from rotational symmetry
+    xyz = xyz/bohr
+    !$omp critical
+    call getsym(.false.,iunit,nat,at,xyz,sfsym)
+    !$omp end critical
+    xyz = xyz*bohr
+    sym = sfsym(1:3)
+    symchar = sym
+    symnum = 1.0d0
+    if (a .lt. 1.d-9.or.b .lt. 1.d-9.or.c .lt. 1.d-9) then
+      if (index(sym,'d') .ne. 0) symnum = 2.0d0
+    else
+      call to_lower(sym)
+      if (index(sym,'c2') .ne. 0) symnum = 2.0d0
+      if (index(sym,'s4') .ne. 0) symnum = 2.0d0
+      if (index(sym,'c3') .ne. 0) symnum = 3.0d0
+      if (index(sym,'s6') .ne. 0) symnum = 3.0d0
+      if (index(sym,'c4') .ne. 0) symnum = 4.0d0
+      if (index(sym,'s8') .ne. 0) symnum = 4.0d0
+      if (index(sym,'c5') .ne. 0) symnum = 5.0d0
+      if (index(sym,'c6') .ne. 0) symnum = 6.0d0
+      if (index(sym,'c7') .ne. 0) symnum = 7.0d0
+      if (index(sym,'c8') .ne. 0) symnum = 8.0d0
+      if (index(sym,'c9') .ne. 0) symnum = 9.0d0
+      if (index(sym,'d2') .ne. 0) symnum = 4.0d0
+      if (index(sym,'d3') .ne. 0) symnum = 6.0d0
+      if (index(sym,'d4') .ne. 0) symnum = 8.0d0
+      if (index(sym,'d5') .ne. 0) symnum = 10.0d0
+      if (index(sym,'d6') .ne. 0) symnum = 12.0d0
+      if (index(sym,'d7') .ne. 0) symnum = 14.0d0
+      if (index(sym,'d8') .ne. 0) symnum = 16.0d0
+      if (index(sym,'d9') .ne. 0) symnum = 18.0d0
+      if (index(sym,'t') .ne. 0) symnum = 12.0d0
+      if (index(sym,'td') .ne. 0) symnum = 12.0d0
+      if (index(sym,'th') .ne. 0) symnum = 12.0d0
+      if (index(sym,'o') .ne. 0) symnum = 24.0d0
+      if (index(sym,'oh') .ne. 0) symnum = 24.0d0
+      if (index(sym,'ih') .ne. 0) symnum = 60.0d0
+    end if
+
+    if (pr) then
+      write (iunit,'(1x,a,4x,a)') 'Symmetry:',sym
+    end if
+    return
+  end subroutine prepthermo
+
+  subroutine calcthermo(nat,at,xyz,freq,pr,ithr,fscal,sthr,nt,temps, &
+      &      et,ht,gt,stot,iunit_in,emodel)
+!**************************************************************
+!* Calculate thermodynamic contributions for a given structure
+!* from it's frequencies (from second derivatives/the Hessian)
+!* Based on xtb's "print_thermo" routine
+!**************************************************************
+
+    implicit none
+    integer,intent(in)     :: nat
+    integer,intent(in)     :: at(nat)
+    real(wp),intent(inout) :: xyz(3,nat)  !in Bohr
+    real(wp),intent(inout) :: freq(3*nat) !in cm-1
+    logical,intent(in)     :: pr
+    real(wp),intent(in) :: ithr     !imag. inv. in cm-1
+    real(wp),intent(in) :: fscal    !freq scaling
+    real(wp),intent(in) :: sthr     !rotor cut
+    integer,intent(in)  :: nt
+    real(wp),intent(in) :: temps(nt)
+    integer,intent(in),optional     :: iunit_in
+    character(len=*),intent(in),optional :: emodel
+    real(wp) :: et(nt)          !< enthalpy in Eh
+    real(wp) :: ht(nt)          !< enthalpy in Eh
+    real(wp) :: gt(nt)          !< free energy in Eh
+    real(wp) :: stot(nt)        !< entropy in cal/molK
+    real(wp) :: ts(nt)          !< entropy*T in Eh
+    real(wp) :: rabc(3),a,b,c
+    real(wp) :: avmom
+    real(wp) :: molmass
+    real(wp) :: sym
+    real(wp) :: zp
+    character(len=3) :: symchar
+    logical :: pr2
+    logical :: linear = .false.
+    logical :: atom = .false.
+    integer :: nvib_theo
+    integer :: nvib,nimag
+    real(wp) :: vibthr
+    real(wp),allocatable :: vibs(:)
+
+    integer :: i,j,iunit,emodelunit
+    integer :: n3,rt
+    real(wp) :: adum(nt)
+    character(len=64) :: atmp
+
+    character(len=*),parameter :: outfmt = &
+    &  '(9x,"::",1x,a,f24.12,1x,a,1x,"::")'
+    character(len=*),parameter :: dblfmt = &
+    &  '(10x,":",2x,a,f24.7,1x,a,t63,":")'
+    character(len=*),parameter :: intfmt = &
+    &  '(10x,":",2x,a,i24,       t63,":")'
+    character(len=*),parameter :: chrfmt = &
+    &  '(10x,":",2x,a,a24,       t63,":")'
+
+    !real(wp),parameter :: autorcm = 219474.63067_wp
+    !real(wp),parameter :: rcmtoau = 1.0_wp/autorcm
+    real(wp),parameter :: autocal = autokcal*1000.0_wp
+
+    xyz = xyz*autoaa  !> NOTE: FROM HERE ON WE WORK IN ANGSTRÖM
+
+    if (present(iunit_in)) then
+      iunit = iunit_in
+    else
+      iunit = stdout
+    end if
+
+    if (present(emodel)) then
+      select case (emodel)
+      case ('grimme')
+        emodelunit = 1
+      case ('truhlar')
+        emodelunit = 2
+      case default
+        emodelunit = 1
+      end select
+    else
+      emodelunit = 1
+    end if
+
+    call prepthermo(nat,at,xyz,pr,molmass,rabc,avmom,sym,symchar,iunit)
+
+    n3 = 3*nat
+    !$omp critical
+    allocate (vibs(n3))
+    !$omp end critical
+    vibthr = 1.0
+    a = rabc(1)
+    b = rabc(2)
+    c = rabc(3)
+
+    nvib_theo = 3*nat-6
+    if (c .lt. 1.d-10.or.(symchar == 'din')) linear = .true.
+    if (linear) nvib_theo = 3*nat-5
+
+    if (a+b+c .lt. 1.d-6) then
+      atom = .true.
+      nvib = 0
+      nvib_theo = 0
+    end if
+
+    nvib = 0
+    vibs = 0.0
+    do i = 1,n3
+      if (abs(freq(i)) .gt. vibthr) then
+        nvib = nvib+1
+        vibs(nvib) = freq(i)
+      end if
+    end do
+    !> scale
+    vibs(1:nvib) = vibs(1:nvib)*fscal
+
+    !> invert imaginary modes
+    nimag = 0
+    do i = 1,nvib
+      if (vibs(i) .lt. 0.and.vibs(i) .gt. ithr) then
+        vibs(i) = -vibs(i)
+        if (pr) write (stdout,'(a,i5," :",f10.2)') 'Inverting frequency',i,vibs(i)
+      end if
+      if (vibs(i) < 0.0) then
+        nimag = nimag+1
+      end if
+    end do
+
+    if (pr) then
+      write (iunit,'(a)')
+      write (iunit,'(10x,53("."))')
+      write (iunit,'(10x,":",23x,a,23x,":")') "SETUP"
+      write (iunit,'(10x,":",51("."),":")')
+      write (iunit,intfmt) "# frequencies    ",nvib
+      write (iunit,intfmt) "# imaginary freq.",nimag
+      write (atmp,*) linear
+      write (iunit,chrfmt) "linear?          ",trim(atmp)
+      write (iunit,chrfmt) "symmetry         ",adjustr(symchar)
+      write (iunit,intfmt) "rotational number",nint(sym)
+      write (iunit,dblfmt) "scaling factor   ",fscal,"    "
+      select case (emodelunit)
+      case (1)
+        write (iunit,chrfmt) "vib.entropy model      ","Grimme (2012)"
+        write (iunit,dblfmt) "rotor cutoff     ",sthr,"cm^-1"
+      case (2)
+        write (iunit,chrfmt) "vib.entropy model      ","Truhlar (2011)"
+        write (iunit,dblfmt) "frequency cutoff ",sthr,"cm^-1"
+      end select
+
+      write (iunit,dblfmt) "imag. cutoff     ",ithr,"cm^-1"
+      write (iunit,'(10x,":",51("."),":")')
+    end if
+
+    vibs = vibs*rcmtoau   ! thermodyn needs vibs and zp in Eh
+
+    zp = 0.5_wp*sum(vibs(1:nvib))
+    adum = abs(temps-298.15d0)
+    rt = minloc(adum,1)  !temperature closest to 298.15 is the ref.
+    do j = 1,nt
+      if ((j == rt).and.pr) then
+        pr2 = .true.
+      else
+        pr2 = .false.
+      end if
+      if (pr2) then
+        select case (emodelunit)
+        case (1)
+          call print_thermo_sthr_ts(iunit,nvib,vibs,avmom,sthr,temps(j))
+        case (2)
+          call print_thermo_sthr_cut(iunit,nvib,vibs,sthr,temps(j))
+        end select
+      end if
+      call thermodyn(iunit,a,b,c,avmom,linear,atom,sym,molmass,vibs,nvib, &
+      & temps(j),sthr,et(j),ht(j),gt(j),ts(j),zp,pr2,emodel=emodelunit)
+      stot(j) = (ts(j)/temps(j))*autocal
+    end do
+
+    if (pr) then
+      write (iunit,'(a)')
+      write (iunit,'(a10)',advance='no') "T/K"
+      write (iunit,'(a16)',advance='no') "H(0)-H(T)+PV"
+      write (iunit,'(a16)',advance='no') "H(T)/Eh"
+      write (iunit,'(a16)',advance='no') "T*S/Eh"
+      write (iunit,'(a16)',advance='no') "G(T)/Eh"
+      write (iunit,'(a)')
+      write (iunit,'(3x,72("-"))')
+      do i = 1,nt
+        write (iunit,'(3f10.2)',advance='no') temps(i)
+        write (iunit,'(3e16.6)',advance='no') ht(i)
+        write (iunit,'(3e16.6)',advance='no') et(i)
+        write (iunit,'(3e16.6)',advance='no') ts(i)
+        write (iunit,'(3e16.6)',advance='no') gt(i)
+        if (i == rt.and.nt > 1) then
+          write (iunit,'(1x,"(used)")')
+        else
+          write (iunit,'(a)')
+        end if
+      end do
+      write (iunit,'(3x,72("-"))')
+    end if
+
+    xyz = xyz*aatoau !> NOTE: BACK TO BOHRS
+
+    !$omp critical
+    deallocate (vibs)
+    !$omp end critical
+    return
+  end subroutine calcthermo
+
+  subroutine calc_thermo_from_hess(mol,hess,pr,nt,temps,ithr,&
+  & fscal,sthr,et,ht,gt,stot,etot)
+    type(coord),intent(inout) :: mol
+    integer :: nat3
+    integer :: io,iunit
+    logical :: pr
+    real(wp) :: ithr,fscal,sthr
+    real(wp),intent(in) :: temps(nt)
+    integer,intent(in) :: nt
+    real(wp),allocatable,intent(out) :: et(:),ht(:),gt(:),stot(:)
+    real(wp),intent(inout) :: hess(:,:)
+    real(wp),allocatable :: freq(:)
+    real(wp),intent(in) :: etot
+    real(wp) :: zpve
+    integer :: nrt
+    real(wp),allocatable :: int_temps(:)
+    character(len=*),parameter :: outfmt = &
+    &  '(10x,"::",1x,a,f24.12,1x,a,1x,"::")'
+
+    nat3 = 3*mol%nat
+    !$omp critical
+    allocate (freq(nat3))
+    allocate (et(nt))
+    allocate (ht(nt))
+    allocate (gt(nt))
+    allocate (stot(nt))
+    allocate (int_temps(nt))
+    !$omp end critical
+
+    int_temps = abs(temps-298.15_wp)
+    nrt = minloc(int_temps(:),1)
+
+    call prj_mw_hess(mol%nat,mol%at,nat3,mol%xyz,hess)
+
+    call frequencies(mol%nat,mol%at,mol%xyz,nat3,hess,freq,io)
+
+    call calcthermo(mol%nat,mol%at,mol%xyz,freq,pr,ithr,fscal,sthr,nt,temps, &
+        &      et,ht,gt,stot)
+
+    zpve = et(nrt)-ht(nrt)
+    if (pr) then
+      write (stdout,*)
+      write (stdout,'(10x,a)') repeat(':',50)
+      write (stdout,'(10x,"::",7x,a,f12.2,1x,a,8x,"::")') "THERMODYNAMICS at",temps(nrt),'K'
+      write (stdout,'(10x,a)') repeat(':',50)
+      write (stdout,outfmt) 'TOTAL FREE ENERGY',etot+gt(nrt),'Eh'
+      write (stdout,'(10x,a)') '::'//repeat('-',46)//'::'
+      write (stdout,outfmt) 'total energy     ',etot,'Eh'
+      write (stdout,outfmt) 'ZPVE             ',zpve,'Eh'
+      write (stdout,outfmt) 'G(RRHO) w/o ZPVE ',gt(nrt)-zpve,'Eh'
+      write (stdout,outfmt) 'G(RRHO) total    ',gt(nrt),'Eh'
+      write (stdout,'(10x,a)') repeat(':',50)
+    end if
+
+  end subroutine calc_thermo_from_hess
+
+  subroutine effective_hessian(nat,nat3,grad1_i,grad2_i,hess1,hess2,heff)
+!******************************************************************
+!* Effective Hessian at an MECP is computed via Eq. 27 and Eq. 28
+!* in https://doi.org/10.1002/qua.25124
+!******************************************************************
+    implicit none
+    integer,intent(in) :: nat,nat3
+    integer :: i,j,ii
+    real(wp),intent(in) :: grad1_i(3,nat3),grad2_i(3,nat3)
+    real(wp) :: grad1(nat3),grad2(nat3),dot
+
+    real(wp),intent(in) :: hess1(nat3,nat3),hess2(nat3,nat3)
+
+    real(wp) :: gnorm1,gnorm2,grad_diff_norm
+    real(wp) :: grad_diff(nat3),heff_temp(nat3,nat3)
+
+    real(wp),intent(inout) :: heff(nat3,nat3)
+    real(wp),allocatable :: proj_vec(:,:)
+
+    real(wp) :: freq(nat3)
+
+    integer,allocatable :: iwork(:)
+    real(wp),allocatable :: work(:)
+
+    integer :: lwork,liwork,info
+
+    !$omp critical
+    allocate (proj_vec(nat3,nat3),source=0.0_wp)
+    !$omp end critical
+
+    grad1 = reshape(grad1_i, (/nat3/))
+    grad2 = reshape(grad2_i, (/nat3/))
+
+    gnorm1 = norm2(grad1)
+
+    gnorm2 = norm2(grad2)
+
+    grad_diff = grad1-grad2
+
+    grad_diff_norm = norm2(grad_diff)
+
+    dot = dot_product(grad1,grad2)
+
+    if (dot .gt. 0.0_wp) then !sloped: dot > 0.0 --> -  | peaked: dot <= 0.0 --> +
+
+      write (stdout,*) 'MECI is considered as a sloped CI'
+      write (stdout,*)
+
+      heff = (gnorm1*hess2-gnorm2*hess1)/grad_diff_norm
+
+    else
+
+      write (stdout,*) 'MECI is considered as a peaked CI'
+      write (stdout,*)
+
+      heff = (gnorm1*hess2+gnorm2*hess1)/grad_diff_norm
+
+    end if
+
+    !Outer Product of grad_diff
+
+    !Building projection matrix
+
+    !proj_vec = 1 - (dg/|dg| o dg.T/|dg|) = 1 - (dg o dg.T)/|dg|**2
+
+    grad_diff_norm = grad_diff_norm**2
+
+    do i = 1,nat3
+      proj_vec(i,:) = -grad_diff(i)*grad_diff/grad_diff_norm
+      proj_vec(i,i) = proj_vec(i,i)+1
+    end do
+
+    !Projection
+    heff = matmul(matmul(proj_vec,heff),proj_vec)
+
+    !Check if hess1 and hess2 are assigned correctly, otherwise change
+    lwork = 1+6*nat3+2*nat3**2
+    liwork = 3+5*nat3
+    !$omp critical
+    allocate (work(lwork),iwork(liwork))
+    !$omp end critical
+
+    heff_temp = heff
+
+    call dsyevd('V','U',nat3,heff_temp,nat3,freq,work,lwork,iwork,liwork,info)
+
+    deallocate (work,iwork)
+
+    if (0 .gt. sum(freq)) then
+      heff = -heff
+    end if
+
+  end subroutine effective_hessian
+
+!============================================================================!
+!############################################################################!
+!============================================================================!
+!> PRINTOUT ROUTINES
+  subroutine print_vib_spectrum(nat,at,nat3,xyz,freq,dir,fname,ir_int)
+!******************************************************************
+!* Prints the frequencies in Turbomole "vibspectrum" format.
+!* When ir_int is provided, genuine intensities (km/mol) and
+!* a threshold-based IR-activity flag are written; otherwise a
+!* dummy intensity of 1000 km/mol is used for all active modes.
+!* Input:
+!*   ir_int (optional) - IR intensities in km/mol, shape (nat3)
+!******************************************************************
+    integer,intent(in) :: nat,nat3
+    integer :: at(nat),i,ich
+    real(wp) ::  xyz(3,nat)
+    real(wp) ::  freq(nat3),thr
+    real(wp),intent(in),optional :: ir_int(nat3)
+    character(len=*) :: fname
+    character(len=*) :: dir
+    !> IR-activity threshold in km/mol
+    real(wp),parameter :: ir_thr = 1.0_wp
+    real(wp) :: irint_i
+    character(len=3) :: ir_flag
+
+    thr = 0.01_wp
+    if (len_trim(dir) .eq. 0) then
+      open (newunit=ich,file=fname)
+    else
+      if (directory_exist(dir)) then
+        open (newunit=ich,file=dir//'/'//fname)
+      else
+        open (newunit=ich,file=fname)
+      end if
+    end if
+
+    write (ich,'("$vibrational spectrum")')
+    write (ich,'("#  mode    symmetry    wave number    IR intensity    selection rules")')
+    write (ich,'("#                       1/cm              km/mol         IR    RAMAN")')
+
+    do i = 1,nat3
+      if (abs(freq(i)) .lt. thr) then
+        write (ich,'(i6,9x,    f18.2,f16.5,7x," - ",5x," - ")') &
+          i,freq(i),0.0_wp
+      else
+        if (present(ir_int)) then
+          irint_i = ir_int(i)
+          if (irint_i >= ir_thr) then
+            ir_flag = 'YES'
+          else
+            ir_flag = 'NO '
+          end if
+        else
+          irint_i = 1000.0_wp
+          ir_flag = 'YES'
+        end if
+        write (ich,'(i6,8x,"a",f18.2,f16.5,7x,a3,5x,"YES")') &
+          i,freq(i),irint_i,ir_flag
+      end if
+    end do
+
+    write (ich,'("$end")')
+
+    close (ich)
+
+  end subroutine print_vib_spectrum
+
+!=========================================================================================!
+
+  subroutine print_g98_fake(nat,at,nat3,xyz,freq,hess,dir,fname,ir_int)
+!******************************************************************
+!* Prints the vibration spectrum of a system as a g98.out file.
+!* Routine is adapted from the xtb code.
+!* When ir_int is provided, genuine IR intensities (km/mol) are
+!* written; otherwise a dummy value of 99 km/mol is used.
+!* Input:
+!*   ir_int (optional) - IR intensities in km/mol, shape (nat3)
+!******************************************************************
+    integer,intent(in) :: nat,nat3
+    integer :: at(nat)
+    integer  :: gu,i,j,ka,kb,kc,la,lb,k
+
+    real(wp) ::  xyz(3,nat)
+    real(wp),intent(in) :: hess(nat3,nat3)
+    real(wp),intent(in),optional :: ir_int(nat3)
+    real(wp) ::  freq(nat3),red_mass(nat3),force(nat3),ir_f(nat3),zero(1),f2(nat3),u(nat3,nat3)
+
+    character(len=2) :: irrep
+    character(len=*) :: fname
+    character(len=*) :: dir
+
+    irrep = 'a'
+
+    red_mass = 99.0
+    force = 99.0
+    ir_f = 99.0
+    zero = 0.0
+
+    k = 0
+
+    do i = 1,nat3
+      if (abs(freq(i)) .gt. 1.d-1) then
+        k = k+1
+        u(1:nat3,k) = hess(1:nat3,i)
+        f2(k) = freq(i)
+        if (present(ir_int)) ir_f(k) = ir_int(i)
+      end if
+    end do
+
+    if (len_trim(dir) .eq. 0) then
+      open (newunit=gu,file=fname)
+    else
+      if (directory_exist(dir)) then
+        open (newunit=gu,file=dir//'/'//fname)
+      else
+        open (newunit=gu,file=fname)
+      end if
+    end if
+
+    write (gu,'('' Entering Gaussian System'')')
+    write (gu,'('' *********************************************'')')
+    write (gu,'('' Gaussian 98:'')')
+    write (gu,'('' frequency output generated by the crest code'')')
+    write (gu,'('' *********************************************'')')
+
+    write (gu,*) '                        Standard orientation:'
+    write (gu,*) '---------------------------------------------', &
+        & '-----------------------'
+    write (gu,*) ' Center     Atomic     Atomic', &
+        & '              Coordinates (Angstroms)'
+    write (gu,*) ' Number     Number      Type ', &
+        & '             X           Y           Z'
+    write (gu,*) '-----------------------', &
+        & '---------------------------------------------'
+    j = 0
+    do i = 1,nat
+      write (gu,111) i,at(i),j,xyz(1:3,i)*0.52917726
+    end do
+    write (gu,*) '----------------------', &
+        & '----------------------------------------------'
+    write (gu,*) '    1 basis functions        1 primitive gaussians'
+    write (gu,*) '    1 alpha electrons        1 beta electrons'
+    write (gu,*)
+111 format(i5,i11,i14,4x,3f12.6)
+
+    write (gu,*) 'Harmonic frequencies (cm**-1), IR intensities',' (km*mol⁻¹),'
+    write (gu,*) 'Raman scattering activities (A**4/amu),', &
+        & ' Raman depolarization ratios,'
+    write (gu,*) 'reduced masses (AMU), force constants (mDyne/A)', &
+        & ' and normal coordinates:'
+
+    ka = 1
+    kc = 3
+
+60  kb = min0(kc,k)
+    write (gu,100) (j,j=ka,kb)
+    write (gu,105) (irrep,j=ka,kb)
+    write (gu,110) ' Frequencies --', (f2(j),j=ka,kb)
+    write (gu,110) ' Red. masses --', (red_mass(j),j=ka,kb)
+    write (gu,110) ' Frc consts  --', (force(j),j=ka,kb)
+    write (gu,110) ' IR Inten    --', (ir_f(j),j=ka,kb)
+    write (gu,110) ' Raman Activ --', (zero,j=ka,kb)
+    write (gu,110) ' Depolar     --', (zero,j=ka,kb)
+    write (gu,*) 'Atom AN      X      Y      Z        X      Y', &
+        & '      Z        X      Y      Z'
+    la = 1
+70  lb = nat
+    do i = la,lb
+      write (gu,130) i,at(i), (u(i*3-2,j),u(i*3-1,j),u(i*3,j),j=ka,kb)
+    end do
+    if (lb .eq. nat) go to 90
+    go to 70
+90  if (kb .eq. k) then
+      goto 200
+    end if
+
+    ka = kc+1
+    kc = kc+3
+    go to 60
+
+100 format(3(20x,i3))
+105 format(3x,3(18x,a5))
+110 format(a15,f11.4,12x,f11.4,12x,f11.4)
+130 format(2i4,3(2x,3f7.2))
+200 continue
+    write (gu,'(''end of file'')')
+    close (gu)
+
+  end subroutine print_g98_fake
+
+!=========================================================================================!
+
+  subroutine print_hessian(hess,nat3,dir,fname)
+!*******************************
+!* Prints the numerical hessian
+!*******************************
+    integer :: nat3,i,j,k,ich
+    real(wp) :: hess(nat3,nat3)
+    character(len=*) :: fname
+    character(len=*) :: dir
+
+    if (len_trim(dir) .eq. 0) then
+      open (newunit=ich,file=fname)
+      write (stdout,'(1x,a)',advance='no') 'Will be written to file "'//fname//'" ...'
+    else
+      if (directory_exist(dir)) then
+        open (newunit=ich,file=dir//'/'//fname)
+        write (stdout,'(1x,a)',advance='no') 'Will be written to file "'//dir//'/'//fname//'" ...'
+      else
+        open (newunit=ich,file=fname)
+        write (stdout,'(1x,a)',advance='no') 'Will be written to file "'//fname//'" ...'
+      end if
+    end if
+    flush (stdout)
+
+    write (ich,'(1x,a)') '$hessian'
+    do i = 1,nat3
+      k = 0
+      do j = 1,nat3
+        k = k+1
+        if (k .le. 4) then
+          write (ich,'(f16.8)',advance='no') hess(i,j)
+        else
+          write (ich,'(f16.8)') hess(i,j)
+          k = 0
+        end if
+      end do
+      if (k .ne. 0) then
+        write (ich,*)
+      end if
+    end do
+    write (ich,'(1x,a)') '$end'
+    close (ich)
+
+    write (stdout,*) 'done.'
+    write (stdout,*)
+
+  end subroutine print_hessian
+
+!============================================================================!
+!############################################################################!
+!============================================================================!
+end module thermochem_module
diff --git a/src/eval_timer.f90 b/src/eval_timer.f90
index 4d4b570e..439c3f58 100644
--- a/src/eval_timer.f90
+++ b/src/eval_timer.f90
@@ -23,32 +23,39 @@ subroutine eval_timer(tim)
 !********************************
   use crest_parameters
   use crest_data
-  use crest_calculator,only: engrad_total
+  use crest_calculator,only:engrad_total
   use crest_restartlog
+  use iomod,only:get_peak_rss_kb,to_str
   implicit none
   type(timer) :: tim
-  real(wp) :: time_total,time_avg
+  real(wp) :: time_total,time_avg,mem
   character(len=40) :: atmp
   write (stdout,*)
   call smallhead('Wall Time Summary')
   call tim%write(stdout,'CREST runtime',verbose=.true.)
   time_total = tim%get()
   call tim%clear
-  if(engrad_total > 0)then
-  write(atmp,'(f30.3)') time_total/real(engrad_total,wp)
-  write(stdout,'(" * Total number of energy+grad calls: ",i0)') & !,a,1x,a,a)') & 
-  &  engrad_total!,' (avg. wall-time',trim(adjustl(atmp)),' sec)'
-  write(stdout,*)
-  call dump_restart() 
-  endif
+  mem = real(get_peak_rss_kb(),wp)
+  write (stdout,'(" * Peak RSS: ",f8.2, " MiB")') mem/1024.0_wp
+  if (engrad_total > 0.0_wp) then
+    write (atmp,'(f30.3)') time_total/real(engrad_total,wp)
+    if (engrad_total < 10.0_wp**5) then
+      write (stdout,'(" * Total number of energy+grad calls: ",i0)') &
+      &  nint(engrad_total)
+    else
+      write (stdout,'(" * Total number of energy+grad calls: ",es11.4)') &
+      &  engrad_total
+    end if
+    write (stdout,*)
+    !call dump_restart()
+  end if
 end subroutine eval_timer
 
 subroutine propquit(tim)
-  use crest_parameters, only: stdout
+  use crest_parameters,only:stdout
   use crest_data
   implicit none
   type(timer) :: tim
   call eval_timer(tim)
-  write (stdout,*) 'CREST terminated normally.'
-  stop
+  call creststop(status_normal)
 end subroutine propquit
diff --git a/src/filemod.f90 b/src/filemod.f90
index 15e437d3..5e36f8d3 100644
--- a/src/filemod.f90
+++ b/src/filemod.f90
@@ -17,12 +17,9 @@
 ! along with crest.  If not, see <https://www.gnu.org/licenses/>.
 !================================================================================!
 
-
 !> fortran module for simple plain-text file handling
 
 module filemod
-  use iso_fortran_env,wp => real64
-
   implicit none
 
   public :: filetype
@@ -426,7 +423,6 @@ function lwidth(fname)
     close (ich)
   end function lwidth
 
-
 !========================================================================================!
 !get n-th element of a line (seperated by blanks)
   function getlarg(line,n)
diff --git a/src/graphs/adjacency.f90 b/src/graphs/adjacency.f90
index 84262c0d..8393e5d4 100644
--- a/src/graphs/adjacency.f90
+++ b/src/graphs/adjacency.f90
@@ -90,10 +90,12 @@ subroutine setup_fragments(V,A,frag)
     integer,intent(in) :: V
     integer,intent(in) :: A(V,V)
     !> OUTPUT
-    integer,intent(out) :: frag(V)
+    integer,allocatable,intent(out) :: frag(:)
     !> LOCAL
     integer :: i,j,k,nfrag
     integer,allocatable :: tmp(:)
+    if(allocated(frag)) deallocate(frag)
+    allocate(frag(V))
     frag = 0
     nfrag = 0
     allocate (tmp(V),source=0)
@@ -147,11 +149,12 @@ subroutine check_rings_min(V,A,rings)
     integer,intent(in) :: V
     integer,intent(in) :: A(V,V)
     !> OUTPUT
-    logical,intent(out) :: rings(V,V)
+    logical,allocatable,intent(out) :: rings(:,:)
     !> LOCAL
     integer,allocatable  :: Adum(:,:)
     integer,allocatable  :: tmp(:)
     integer :: i,j
+    if(.not.allocated(rings)) allocate(rings(V,V))
     rings = .false.
     allocate(Adum(V,V), source = 0)
     allocate(tmp(V), source = 0)
@@ -196,7 +199,7 @@ subroutine get_ring_min(V,A,M,N,path,nring)
 
     path  = 0
     nring = 0
-    allocate(Atmp(V,V), source=0)
+    allocate(Atmp(V,V), source=A)
     Atmp(:,:) = A(:,:)
     Atmp(M,N) = 0
     Atmp(N,M) = 0
diff --git a/src/graphs/dijkstra.f90 b/src/graphs/dijkstra.f90
index e6182f85..942eb3e9 100644
--- a/src/graphs/dijkstra.f90
+++ b/src/graphs/dijkstra.f90
@@ -65,13 +65,11 @@ subroutine Dijkstra_classic(V,A,E,start,dist,prev)
       !>-- loop over the neighbours of vertex k
       do u = 1,V
         if (A(vc,u) == 0) cycle
-        if (prev(u) .ne. v) then
-          newdist = dist(vc) + E(vc,u)
-          !>-- is the new dist value of u better than the previous one?
-          if (newdist < dist(u)) then
-            dist(u) = newdist
-            prev(u) = vc
-          end if
+        newdist = dist(vc) + E(vc,u)
+        !>-- is the new dist value of u better than the previous one?
+        if (newdist < dist(u)) then
+          dist(u) = newdist
+          prev(u) = vc
         end if
       end do
     end do
@@ -119,13 +117,11 @@ subroutine Dijkstra_simple(V,A,start,dist,prev)
       !>-- loop over the neighbours of vertex k
       do u = 1,V
         if (A(vc,u) == 0) cycle
-        if (prev(u) .ne. v) then
-          newdist = dist(vc) + float(A(vc,u))
-          !>-- is the new dist value of u better than the previous one?
-          if (newdist < dist(u)) then
-            dist(u) = newdist
-            prev(u) = vc
-          end if
+        newdist = dist(vc) + float(A(vc,u))
+        !>-- is the new dist value of u better than the previous one?
+        if (newdist < dist(u)) then
+          dist(u) = newdist
+          prev(u) = vc
         end if
       end do
     end do
@@ -185,48 +181,5 @@ recursive subroutine getPathD(V,lpath,start,pos,prev,path)
     return
   end subroutine getPathD
 
-!========================================================================================!
-
-!> A wrapper for an example with Dijkstra's algorithm
-  subroutine Dijkstra_Example(V,A,E,start,end)
-    implicit none
-    !> INPUT
-    integer,intent(in)  :: V        !> number of vertices
-    integer,intent(in)  :: A(V,V)   !> adjacency matrix
-    real(wp),intent(in) :: E(V,V)   !> distance matrix
-    integer,intent(in) :: start,end !> start and end vertex
-    !> LOCAL
-    real(wp),allocatable :: dist(:)
-    integer,allocatable :: prev(:)
-    integer,allocatable :: path(:)
-    real(wp) :: dummy
-    integer :: lpath
-    integer :: i
-
-    !>-- allocate space for the dist and prev vectors
-    allocate (dist(V),prev(V))
-
-    !>-- run Dijkstra's algo, get distance and prev
-    call Dijkstra(V,A,E,start,dist,prev)
-
-    !>-- allocate an array for analyzing the path
-    allocate (path(V),source=0)
-    if (dist(end) == huge(dummy)) then
-      write (*,'(a,i0,a,i0)') 'There is no path from vertex ',start,' to vertex ',end
-    else
-      lpath = 0
-      call getPathD(V,lpath,start,end,prev,path)
-      write (*,'(a,i0,a,i0,a)') "shortest path from vertex ",start," to vertex ",end,":"
-      do i = 1,lpath
-        write (*,'(1x,i0)',advance='no') path(i)
-      end do
-      write (*,*)
-      write (*,'(a,f12.4)') 'with a total path length of ',dist(end)
-    end if
-
-    deallocate (path,prev,dist)
-    return
-  end subroutine
-
 !========================================================================================!
 end module dijkstra_mod
diff --git a/src/internals2.f90 b/src/internals2.f90
index 6788a907..08f4e352 100644
--- a/src/internals2.f90
+++ b/src/internals2.f90
@@ -18,13 +18,12 @@
 !================================================================================!
 
 module INTERNALS_mod
-   use crest_parameters
-   use adjacency
-   use geo
-   use strucrd, only: i2e
-   implicit none
-   public
-
+  use crest_parameters
+  use adjacency
+  use geo
+  use strucrd,only:i2e
+  implicit none
+  public
 
 !========================================================================================!
 !========================================================================================!
@@ -32,7 +31,6 @@ module INTERNALS_mod
 !========================================================================================!
 !========================================================================================!
 
-
   SUBROUTINE BETTER_XYZINT(nat,xyz,amat,NA,NB,NC,geo)
 !***********************************************************************
 !*
@@ -286,19 +284,21 @@ SUBROUTINE XYZGEO2(nat,xyz,NA,NB,NC,DEGREE,GEO)
     !> first atom at zero
     GEO(1:3,1) = 0.0_wp
     !> select second atom
-    do i = 2,nat
+    do i = 1,nat
       j = NA(i)
       k = NB(i)
       l = NC(i)
-      GEO(1,i) = sqrt((xyz(1,i)-xyz(1,j))**2+ &
-    &                  (xyz(2,i)-xyz(2,j))**2+ &
-    &                  (xyz(3,i)-xyz(3,j))**2)
-      if (k /= 0) then
-        call BANGLE2(xyz,i,j,k,geo(2,i))
-        geo(2,i) = geo(2,i)*DEGREE
-        if (l /= 0) then
-          call DIHED2(xyz,i,j,k,l,geo(3,i))
-          geo(3,i) = geo(3,i)*DEGREE
+      if (j /= 0) then
+        GEO(1,i) = sqrt((xyz(1,i)-xyz(1,j))**2+ &
+      &                  (xyz(2,i)-xyz(2,j))**2+ &
+      &                  (xyz(3,i)-xyz(3,j))**2)
+        if (k /= 0) then
+          call BANGLE2(xyz,i,j,k,geo(2,i))
+          geo(2,i) = geo(2,i)*DEGREE
+          if (l /= 0) then
+            call DIHED2(xyz,i,j,k,l,geo(3,i))
+            geo(3,i) = geo(3,i)*DEGREE
+          end if
         end if
       end if
     end do
@@ -347,11 +347,15 @@ SUBROUTINE GMETRY2(nat,geo,coord,na,nb,nc)
     !taken(:) = .false.
 
 !>--- first atom at origin
-    COORD(1:3,1) = 0.0_wp
+    do i = 1,nat
+      if (na(i) == 0) then
+        COORD(1:3,i) = 0.0_wp
+      end if
+    end do
     !taken(1) = .true.
 !>--- second atom
-    do i = 2,nat
-      if (na(i) == 1.and.nb(i) == 0.and.nc(i) == 0) then
+    do i = 1,nat
+      if (na(i) /= 0.and.nb(i) == 0.and.nc(i) == 0) then
         COORD(1,i) = GEO(1,i)
         COORD(2,i) = 0.0_wp
         COORD(3,i) = 0.0_wp
@@ -361,7 +365,7 @@ SUBROUTINE GMETRY2(nat,geo,coord,na,nb,nc)
       end if
     end do
 !>--- third atom
-    do i = 2,nat
+    do i = 1,nat
       if (na(i) /= 0.and.nb(i) /= 0.and.nc(i) == 0) then
         COSC = COS(GEO(2,i))
         j = na(i)
@@ -378,17 +382,17 @@ SUBROUTINE GMETRY2(nat,geo,coord,na,nb,nc)
       end if
     end do
 
-   ! TAKELOOP: do while (any(.not.taken(:)))
-   TAKELOOP : do while ( any(COORD(:,:) > verylarge))
-      DO I = 2,nat
+    ! TAKELOOP: do while (any(.not.taken(:)))
+    TAKELOOP: do while (any(COORD(:,:) > verylarge))
+      DO I = 1,nat
 !>--- CYCLE the atom if already generated
         !if (taken(i)) cycle
-        if (COORD(1,i) < verylarge ) cycle
+        if (COORD(1,i) < verylarge) cycle
 !>--- CYCLE if any of the depending atoms have not been generated
-       ! if ((.not.taken(NA(i))).or.(.not.taken(NB(i))) &
-       !&   .or.(.not.taken(NC(i)))) cycle
-        if ( coord(1,NA(i)) > verylarge .or. &
-        &    coord(1,NB(i)) > verylarge .or. &
+        ! if ((.not.taken(NA(i))).or.(.not.taken(NB(i))) &
+        !&   .or.(.not.taken(NC(i)))) cycle
+        if (coord(1,NA(i)) > verylarge.or. &
+        &    coord(1,NB(i)) > verylarge.or. &
         &    coord(1,NC(i)) > verylarge) cycle
 
         COSA = COS(GEO(2,I))
@@ -501,35 +505,36 @@ subroutine print_zmat(ch,nat,at,geo,na,nb,nc,nice)
     character(len=120) :: atmp
     integer :: i
 
-    if(nice)then
-    write (ch,'(1x,a5,1x,a12,1x,a12,1x,a12,a5,a5,a5)') 'A','d(AB)','θ(ABC)','ϕ(ABCD)','B','C','D'
-    do i = 1,nat
-      if (na(i) .ne. 0) then
-        if (nb(i) .ne. 0) then
-          if (nc(i) .ne. 0) then
-            write (atmp,'(1x,i5,1x,3f12.4,3i5)') i,geo(1:3,i),na(i),nb(i),nc(i)
+    if (nice) then
+      write (ch,'(1x,a2,1x,a5,1x,a12,1x,a12,1x,a12,a5,a5,a5)') &
+        & 'at','A','d(AB)','θ(ABC)','ϕ(ABCD)','B','C','D'
+      do i = 1,Nat
+        if (na(i) .ne. 0) then
+          if (nb(i) .ne. 0) then
+            if (nc(i) .ne. 0) then
+              write (atmp,'(1x,a2,1x,i5,1x,3f12.4,3i5)') i2e(at(i)),i,geo(1:3,i),na(i),nb(i),nc(i)
+            else
+              write (atmp,'(1x,a2,1x,i5,1x,2f12.4,a12,2i5)') i2e(at(i)),i,geo(1:2,i),'-',na(i),nb(i)
+              atmp = trim(atmp)//'    -'
+            end if
           else
-            write (atmp,'(1x,i5,1x,2f12.4,a12,2i5)') i,geo(1:2,i),'-',na(i),nb(i)
-            atmp = trim(atmp)//'    -'
+            write (atmp,'(1x,a2,1x,i5,1x,f12.4,a12,a12,i5)') i2e(at(i)),i,geo(1,i),'-','-',na(i)
+            atmp = trim(atmp)//'    -    -'
           end if
         else
-          write (atmp,'(1x,i5,1x,f12.4,a12,a12,i5)') i,geo(1,i),'-','-',na(i)
-          atmp = trim(atmp)//'    -    -'
+          write (atmp,'(1x,a2,1x,i5,1x,a12,a12,a12)') i2e(at(i)),i,'-','-','-'
+          atmp = trim(atmp)//'    -    -    -'
         end if
-      else
-        write (atmp,'(1x,i5,1x,a12,a12,a12)') i,'-','-','-'
-        atmp = trim(atmp)//'    -    -    -'
-      end if
-      write (ch,'(a)') trim(atmp)
-    end do
+        write (ch,'(a)') trim(atmp)
+      end do
     else
-      write(ch,*) nat
-     do i = 1,nat
-      write (atmp,'(1x,a,1x,3f12.4,3i5)') i2e(at(i),'nc'),geo(1:3,i),na(i),nb(i),nc(i)
-      write (ch,'(a)') trim(atmp)
-     end do
+      write (ch,*) nat
+      do i = 1,nat
+        write (atmp,'(1x,a,1x,3f12.4,3i5)') i2e(at(i),'nc'),geo(1:3,i),na(i),nb(i),nc(i)
+        write (ch,'(a)') trim(atmp)
+      end do
 
-    endif
+    end if
 
   end subroutine print_zmat
 
@@ -549,46 +554,46 @@ subroutine rd_zmat(fname,nat,at,zmat,na,nb,nc)
     character(len=300) line
 
     at(:) = 0
-    na(:) = 0 
+    na(:) = 0
     nb(:) = 0
     nc(:) = 0
     zmat(:,:) = 0.0_wp
-    open(newunit=ich,file=trim(fname))
-    read(ich,*) j
-    if(j /= nat) error stop 'Nat mismatch in rd_zmat()' 
-    do i=1,nat
-      read(ich,'(a)') line
+    open (newunit=ich,file=trim(fname))
+    read (ich,*) j
+    if (j /= nat) error stop 'Nat mismatch in rd_zmat()'
+    do i = 1,nat
+      read (ich,'(a)') line
       call zmatline(line,sym,zmat(:,i),na(i),nb(i),nc(i),io)
-      if(io /= 0) error stop 'error while reading zmat'
-      at(i) = e2i(sym)  
-    enddo 
-    close(ich)
-   contains
+      if (io /= 0) error stop 'error while reading zmat'
+      at(i) = e2i(sym)
+    end do
+    close (ich)
+  contains
     subroutine zmatline(line,sym,xyz,a,b,c,io)
-    implicit none
-    character(len=*) :: line
-    character(len=*) :: sym
-    real(wp) :: xyz(3)
-    integer :: a,b,c
-    integer,intent(out) :: io
-
-    io = 0
-    xyz(1:3) = 0
-    a = 0
-    b = 0
-    c = 0
-    read (line,*,iostat=io) sym,xyz(1:3),a,b,c
-    if (io .ne. 0) then
-      read (line,*,iostat=io) sym,xyz(1:2),a,b
-    if(io.ne.0)then
-       read (line,*,iostat=io) sym,xyz(1),a
-    if(io.ne.0)then
-       read (line,*,iostat=io) sym
-    endif
-    endif
-    end if
+      implicit none
+      character(len=*) :: line
+      character(len=*) :: sym
+      real(wp) :: xyz(3)
+      integer :: a,b,c
+      integer,intent(out) :: io
+
+      io = 0
+      xyz(1:3) = 0
+      a = 0
+      b = 0
+      c = 0
+      read (line,*,iostat=io) sym,xyz(1:3),a,b,c
+      if (io .ne. 0) then
+        read (line,*,iostat=io) sym,xyz(1:2),a,b
+        if (io .ne. 0) then
+          read (line,*,iostat=io) sym,xyz(1),a
+          if (io .ne. 0) then
+            read (line,*,iostat=io) sym
+          end if
+        end if
+      end if
 
-    return
+      return
     end subroutine zmatline
 
   end subroutine rd_zmat
diff --git a/src/iomod.F90 b/src/iomod.F90
index 50c9bc12..82b02e89 100644
--- a/src/iomod.F90
+++ b/src/iomod.F90
@@ -1,7 +1,7 @@
 !================================================================================!
 ! This file is part of crest.
 !
-! Copyright (C) 2018-2025 Philipp Pracht
+! Copyright (C) 2018-2026 Philipp Pracht
 !
 ! crest is free software: you can redistribute it and/or modify it under
 ! the terms of the GNU Lesser General Public License as published by
@@ -55,6 +55,20 @@ integer(kind=c_int) function c_symlink(c_from,c_to) bind(c,name="symlink")
     end function
   end interface
 
+  interface
+    integer(c_int) function c_isatty(fd) bind(c,name="isatty")
+      use iso_c_binding
+      integer(c_int),value :: fd
+    end function c_isatty
+  end interface
+
+  interface
+    function get_peak_rss_kb() bind(C,name="get_peak_rss_kb") result(kb)
+      import :: c_long_long
+      integer(c_long_long) :: kb
+    end function
+  end interface
+
   interface wrshort
     module procedure wrshort_real
     module procedure wrshort_int
@@ -748,6 +762,15 @@ function filechecker(fin,fout) result(have)
     return
   end function filechecker
 
+  function file_exists(fin) result(have)
+    implicit none
+    logical :: have
+    character(len=*),intent(in) :: fin
+    have = .false.
+    inquire (file=fin,exist=have)
+    return
+  end function file_exists
+
 !=========================================================================================!
 !=========================================================================================!
 !=========================================================================================!
@@ -758,7 +781,7 @@ end function filechecker
   function directory_exist(file) result(exist)
     character(len=*),intent(in) :: file
     logical :: exist
-#ifdef __INTEL_COMPILER
+#if defined(__INTEL_COMPILER) || defined(__INTEL_LLVM_COMPILER)
     !> Intel provides the directory extension to inquire to handle this case
     inquire (directory=file,exist=exist)
 #else
@@ -772,19 +795,222 @@ end function directory_exist
 !=========================================================================================!
 !=========================================================================================!
 
-!> a wrapper for the intrinsic isatty function.
-!> ifort only seems to work if isatty is declard as external
-!> while gfortran does not want that...
   function myisatty(channel) result(term)
+!************************************************************
+!* a wrapper for the intrinsic isatty function.
+!* ifort only seems to work if isatty is declard as external
+!* while gfortran does not want that...
+!************************************************************
     implicit none
     integer,intent(in) :: channel
     logical :: term
-#ifdef __INTEL_COMPILER
+#if defined(__INTEL_COMPILER) || defined(__INTEL_LLVM_COMPILER)
     logical,external :: isatty
 #endif
     term = isatty(channel)
   end function myisatty
 
+  logical function is_terminal()
+!*****************************************************************************
+!* Helper function to check if stdout (fd=1) is a TTY
+!* This version runs via the iso_c interface rather than the isatty function
+!* Also, it doesn't need an output channel
+!*****************************************************************************
+    use iso_c_binding
+    implicit none
+    is_terminal = (c_isatty(1_c_int) /= 0)
+  end function is_terminal
+
+!=========================================================================================!
+!=========================================================================================!
+!=========================================================================================!
+
+  function colorify(text,color) result(colored_text)
+!******************************************************************************
+!* colorify(text, color) returns a string that wraps `text` in
+!* ANSI color codes if stdout is a TTY, or returns `text` as-is otherwise.
+!******************************************************************************
+    implicit none
+    !> INPUT
+    character(len=*),intent(in) :: text
+    character(len=*),intent(in) :: color
+    !> We will build the returned string with a deferred-length character
+    character(len=:),allocatable :: colored_text
+    !> Escape sequence for ANSI codes
+    character(len=*),parameter :: ESC = char(27)//"["
+    !> Decide if we want color (only if stdout is a terminal)
+    if (is_terminal()) then
+      select case (trim(adjustl(color)))
+      case ("red")
+        colored_text = ESC//"31m"//trim(text)//ESC//"0m"
+      case ("green")
+        colored_text = ESC//"32m"//trim(text)//ESC//"0m"
+      case ("blue")
+        colored_text = ESC//"34m"//trim(text)//ESC//"0m"
+      case ("yellow")
+        colored_text = ESC//"33m"//trim(text)//ESC//"0m"
+      case ("gold")
+        !> 256-color code for a “gold-ish” color
+        colored_text = ESC//"38;5;214m"//trim(text)//ESC//"0m"
+      case default
+        !> If color not recognized (or empty), return text unmodified
+        colored_text = text
+      end select
+
+    else
+      ! Not a terminal => no color codes
+      colored_text = text
+    end if
+
+  end function colorify
+
+!=========================================================================================!
+
+  subroutine drawbox(prch,str,width,charset,padl,padr,ltab,procedual,color)
+  !***********************************************************************
+  !* Print a text string inside a drawn box to Fortran unit prch.
+  !*
+  !* Arguments:
+  !*   prch      - Fortran output unit (e.g. stdout)
+  !*   str       - text to display on the centre line
+  !*   charset   - border style (default 1):
+  !*                 1 → ******   2 → +-+|++   3 → === ==
+  !*                 4 → ┌─┐│└┘  5 → ┏━┓┃┗┛   6 → ╔═╗║╚╝
+  !*                 7 → ┍━┑│┕┙  (mixed: flat top/bottom, straight sides)
+  !*   width     - total box width including borders; if omitted, box is
+  !*               sized to str + padding
+  !*   padl/padr - inner padding spaces left/right of str (default 1 each);
+  !*               when width is given, padl is auto-centred and padr fills
+  !*   ltab      - leading spaces before the box (default 0)
+  !*   procedual - which lines to emit: -1=all three (default),
+  !*               0=top only, 1=centre line only, 2=bottom only,
+  !*               3=separator (T-intersection) line only
+  !*   color     - optional border colour name passed to colorify()
+  !***********************************************************************
+    implicit none
+    integer,intent(in) :: prch
+    character(len=*),intent(in) :: str
+    integer,intent(in),optional :: charset
+    integer,intent(in),optional :: width,padl,padr,ltab
+    integer,intent(in),optional :: procedual
+    character(len=*),intent(in),optional :: color
+
+    integer :: strlen,padd,wid,ltabb,procc,paddl,paddr
+    character(len=*),parameter :: set1 = '******'
+    character(len=*),parameter :: set2 = '+-+|++'
+    character(len=*),parameter :: set3 = '=== =='
+    character(len=*),parameter :: set4 = '┌─┐│└┘'
+    character(len=*),parameter :: set5 = '┏━┓┃┗┛'
+    character(len=*),parameter :: set6 = '╔═╗║╚╝'
+    character(len=*),parameter :: set7 = '┍━┑│┕┙'
+
+    integer :: ul,ho,ur,ve,ll,lr,d
+    character(len=:),allocatable :: boxchars,sepchars
+
+    ul = 1; ho = 2; ur = 3; ve = 4; ll = 5; lr = 6; d = 0
+    if (present(charset)) then
+      if (charset >= 4) then
+        !> technically, utf-8 chars are wider ...
+        ul = 1; ho = 4; ur = 7; ve = 10; ll = 13; lr = 16; d = 2
+      end if
+      select case (charset)
+      case (2)
+        boxchars = set2
+        sepchars = '++'
+      case (3)
+        boxchars = set3
+        sepchars = '=='
+      case (4)
+        boxchars = set4
+        sepchars = '├┤'
+      case (5)
+        boxchars = set5
+        sepchars = '┣┫'
+      case (6)
+        boxchars = set6
+        sepchars = '╠╣'
+      case (7)
+        boxchars = set7
+        sepchars = '┝┥'
+      case default
+        boxchars = set1
+        sepchars = '**'
+      end select
+    else
+      boxchars = set1
+      sepchars = '**'
+    end if
+
+    strlen = len(str)
+    if (present(padl)) then
+      paddl = max(padl,0)
+    else
+      paddl = 1
+    end if
+    if (present(padr)) then
+      paddr = max(padr,0)
+    else
+      paddr = 1
+    end if
+    if (present(width)) then
+      wid = width-2
+      if (.not.present(padl)) then
+        paddl = (wid-strlen)/2
+      end if
+      paddr = wid-strlen-paddl
+    else
+      wid = (strlen+paddl+paddr)
+    end if
+
+    if (present(ltab)) then
+      ltabb = ltab
+    else
+      ltabb = 0
+    end if
+
+    procc = -1
+    if (present(procedual)) procc = procedual
+
+    if (procc == -1.or.procc == 0) then
+      write (prch,'(a)',advance='no') repeat(' ',ltabb)
+      if (present(color)) then
+        write (prch,'(a)') colorify(boxchars(ul:ul+d)//repeat(boxchars(ho:ho+d),wid)//boxchars(ur:ur+d),color)
+      else
+        write (prch,'(a)') boxchars(ul:ul+d)//repeat(boxchars(ho:ho+d),wid)//boxchars(ur:ur+d)
+      end if
+    end if
+
+    if (procc == -1.or.procc == 1) then
+      write (prch,'(a)',advance="no") repeat(' ',ltabb)
+      if (present(color)) then
+        write (prch,'(a)') colorify(boxchars(ve:ve+d),color)// &
+          & repeat(' ',paddl)//str//repeat(' ',paddr)// &
+          & colorify(boxchars(ve:ve+d),color)
+      else
+        write (prch,'(a)') boxchars(ve:ve+d)//repeat(' ',paddl)//str//repeat(' ',paddr)//boxchars(ve:ve+d)
+      end if
+    end if
+
+    if (procc == -1.or.procc == 2) then
+      write (prch,'(a)',advance='no') repeat(' ',ltabb)
+      if (present(color)) then
+        write (prch,'(a)') colorify(boxchars(ll:ll+d)//repeat(boxchars(ho:ho+d),wid)//boxchars(lr:lr+d),color)
+      else
+        write (prch,'(a)') boxchars(ll:ll+d)//repeat(boxchars(ho:ho+d),wid)//boxchars(lr:lr+d)
+      end if
+    end if
+
+    if (procc == 3) then
+      write (prch,'(a)',advance='no') repeat(' ',ltabb)
+      if (present(color)) then
+        write (prch,'(a)') colorify(sepchars(1:1+d)//repeat(boxchars(ho:ho+d),wid)//sepchars(2+d:2*(1+d)),color)
+      else
+        write (prch,'(a)') sepchars(1:1+d)//repeat(boxchars(ho:ho+d),wid)//sepchars(2+d:2*(1+d))
+      end if
+    end if
+
+  end subroutine drawbox
+
 !=========================================================================================!
 !=========================================================================================!
 !=========================================================================================!
@@ -931,9 +1157,8 @@ function truncate_zeros(str_in) result(str_out)
     end if
   end function truncate_zeros
 
-!========================================================================================!
-!========================================================================================!
-!========================================================================================!
+! ══════════════════════════════════════════════════════════════════════════════
+! ══════════════════════════════════════════════════════════════════════════════
 
   subroutine getpath(fname,path)
     implicit none
@@ -1161,9 +1386,49 @@ subroutine split_path(fullpath,dir_part,base_part,has_slash)
 
   end subroutine split_path
 
-!========================================================================================!
-!========================================================================================!
-!========================================================================================!
+!=========================================================================================!
+
+  function random_tmp_name() result(fname)
+    implicit none
+    character(len=20) :: fname
+    character(len=16) :: core
+    integer :: i,idx
+    real(wp) :: idxr
+    character(len=*),parameter :: letters = &
+    & "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    integer,parameter :: lenletters = len(letters)
+
+    do i = 1,len(core)
+      call random_number(idxr)
+      idx = int(idxr*lenletters)+1
+      core(i:i) = letters(idx:idx)
+    end do
+
+    fname = trim(core)//".tmp"
+  end function random_tmp_name
+
+!==========================================================================================!
+!
+  function dump_array_to_tmp(arr) result(fname)
+    implicit none
+    real(wp),intent(in) :: arr(:)
+    character(len=:),allocatable :: fname
+    integer :: unit,i
+
+    fname = trim(random_tmp_name())
+
+    open (newunit=unit,file=fname,status="replace",action="write",iostat=i)
+    if (i /= 0) stop "Could not open temp file."
+
+    do i = 1,size(arr)
+      write (unit,'(f25.15)') arr(i)
+    end do
+
+    close (unit)
+  end function dump_array_to_tmp
+
+! ══════════════════════════════════════════════════════════════════════════════
+! ══════════════════════════════════════════════════════════════════════════════
 
 !> For some reason the behaviour of "call system"  and "call execute_command_line"
 !> differs slightly beteen Intel and GNU versions of the program that I have build.
@@ -1187,5 +1452,53 @@ end subroutine command
 !========================================================================================!
 !========================================================================================!
 !========================================================================================!
+!> subroutine readl
+!> Parse a line of text and extract all real(wp) numbers from it.
+!> Numbers may be separated by whitespace (spaces or tabs).
+!> Handles integers, reals, signed values, and scientific notation (E/D exponent).
+!> This is a modern replacement for the legacy standalone readl subroutine.
+  subroutine readl(a1,x,n)
+    implicit none
+    character(len=*),intent(in) :: a1
+    real(wp),intent(out) :: x(:)
+    integer,intent(out) :: n
+    integer :: pos,next_pos,slen,io
+    real(wp) :: val
+    character(len=:),allocatable :: token
+
+    n = 0
+    slen = len_trim(a1)
+    if (slen == 0) return
+
+    pos = 1
+    do
+      !> skip whitespace (spaces and tabs)
+      do while (pos <= slen)
+        if (a1(pos:pos) /= ' ' .and. a1(pos:pos) /= char(9)) exit
+        pos = pos+1
+      end do
+      if (pos > slen) exit
+
+      !> find end of token
+      next_pos = pos
+      do while (next_pos <= slen)
+        if (a1(next_pos:next_pos) == ' ' .or. a1(next_pos:next_pos) == char(9)) exit
+        next_pos = next_pos+1
+      end do
+
+      !> try to parse token as a real number
+      token = a1(pos:next_pos-1)
+      read (token,*,iostat=io) val
+      if (io == 0) then
+        n = n+1
+        if (n <= size(x)) x(n) = val
+      end if
+
+      pos = next_pos
+    end do
+  end subroutine readl
+
+! ══════════════════════════════════════════════════════════════════════════════
+! ══════════════════════════════════════════════════════════════════════════════
 end module iomod
 
diff --git a/src/legacy_algos/CMakeLists.txt b/src/legacy_algos/CMakeLists.txt
index af63c5b0..292e8de8 100644
--- a/src/legacy_algos/CMakeLists.txt
+++ b/src/legacy_algos/CMakeLists.txt
@@ -34,6 +34,8 @@ list(APPEND srcs
   "${dir}/stereoisomers.f90"
   "${dir}/tautomerize.f90"
   "${dir}/trialmd_legacy.f90"
+  "${dir}/identifiers.f90"
+  "${dir}/sortens.f90"
   "${dir}/zsort.f90"
 )
 
diff --git a/src/legacy_algos/confscript2_misc.f90 b/src/legacy_algos/confscript2_misc.f90
index 11be311e..4e6353a5 100644
--- a/src/legacy_algos/confscript2_misc.f90
+++ b/src/legacy_algos/confscript2_misc.f90
@@ -685,7 +685,7 @@ subroutine setMDrun2(fname,hmass,mdtime,mdtemp,mdstep,shake,mddumpxyz, &
   use crest_data
   use utilities
   implicit none
-  type(constra) :: cts
+  type(legacy_constraints) :: cts
   character(len=*) :: fname
   real(wp) :: hmass
   real(wp) :: mdtime
@@ -990,7 +990,6 @@ end subroutine append_INPUT_to
 subroutine remaining_in(filename,ewin,nall)
   use crest_data
   use crest_parameters
-  use crest_restartlog, only: restart_write_dummy
   use strucrd,only:rdensembleparam,rdensemble
   implicit none
   integer :: nall
@@ -998,8 +997,6 @@ subroutine remaining_in(filename,ewin,nall)
   character(len=*) :: filename
   integer :: k,nat,io
 
-  call restart_write_dummy(trim(filename))
-
   open (newunit=k,file=trim(filename))
   read (k,*,iostat=io) nat
   if(io/=0)then
diff --git a/src/legacy_algos/cregen_old.f90 b/src/legacy_algos/cregen_old.f90
index 5d788bae..1d01eaa2 100644
--- a/src/legacy_algos/cregen_old.f90
+++ b/src/legacy_algos/cregen_old.f90
@@ -34,6 +34,7 @@ subroutine cregen2(env)
       use utilities
       use omp_lib
       use crest_cn_module
+      use cregen_utils, only: distcheck
       implicit none
       type(systemdata) :: env    ! MAIN STORAGE OS SYSTEM DATA
 
@@ -81,7 +82,7 @@ subroutine cregen2(env)
       logical :: fail
       logical :: substruc
       logical :: ttag
-      logical, external :: distcheck,equalrot,equalrotall
+      logical, external :: equalrot,equalrotall
 
       settingNames: associate( crestver => env%crestver, confgo => env%confgo, &
       &             methautocorr => env%methautocorr, printscoords => env%printscoords,  &
@@ -1367,26 +1368,6 @@ subroutine compare(n,nall,s1,s2,dist,athr,relat)
 
 end subroutine compare
 
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-logical function distcheck(n,xyz)
-      implicit none
-      real*8,allocatable :: rij(:)
-      integer :: n
-      real*8 :: xyz(3,n)
-      integer i,j
-      distcheck=.true.
-      allocate(rij(3))
-      do i=1,n-1
-         do j=i+1,n
-         rij=xyz(:,j)-xyz(:,i)
-         if(sum(rij*rij).lt.1.d-3) distcheck=.false.
-         enddo
-      enddo
-      deallocate(rij)
-      return
-end function distcheck
-
 
 !==========================================================!
 ! bactrack is used to find the element "val" of array "arr"
diff --git a/src/identifiers.f90 b/src/legacy_algos/identifiers.f90
similarity index 98%
rename from src/identifiers.f90
rename to src/legacy_algos/identifiers.f90
index ef63192a..b5f432b2 100644
--- a/src/identifiers.f90
+++ b/src/legacy_algos/identifiers.f90
@@ -241,18 +241,6 @@ subroutine countnonh(nat,iz,n)    !count all non-hydrogen atoms
   end do
 end subroutine countnonh
 
-subroutine counth(nat,iz,n)    !count all hydrogen atoms
-  implicit none
-  integer :: nat,iz(nat),n,i
-  n = 0
-  do i = 1,nat
-    if (iz(i) .eq. 1) then
-      cycle
-    else
-      n = n+1
-    end if
-  end do
-end subroutine counth
 
 subroutine countnonh2(icn,idarr,n2)
   implicit none
diff --git a/src/legacy_algos/meson.build b/src/legacy_algos/meson.build
index 29dbea0f..281dee9d 100644
--- a/src/legacy_algos/meson.build
+++ b/src/legacy_algos/meson.build
@@ -32,5 +32,7 @@ srcs += files(
   'stereoisomers.f90',
   'tautomerize.f90',
   'trialmd_legacy.f90',
+  'identifiers.f90',
+  'sortens.f90',
   'zsort.f90',
 )
diff --git a/src/legacy_algos/reactor.f90 b/src/legacy_algos/reactor.f90
index f9c27049..15869a32 100644
--- a/src/legacy_algos/reactor.f90
+++ b/src/legacy_algos/reactor.f90
@@ -739,7 +739,7 @@ end subroutine reactorreopt
 subroutine collectproducts(optdir,base,ndirs,oname,iso)
     use crest_parameters, only: wp, bohr
     use iomod
-    use strucrd, only: wrxyz,rdnat,rdcoord
+    use strucrd, only: wrxyz,rdnat,rdcoord,sumform
     implicit none
     character(len=*),intent(in) :: optdir
     character(len=*),intent(in) :: base
@@ -757,7 +757,6 @@ subroutine collectproducts(optdir,base,ndirs,oname,iso)
     real(wp),allocatable :: xyz(:,:)
     integer,allocatable :: at(:)
     character(len=40),allocatable :: sumformulas(:)
-    character(len=40) :: sumform
     real(wp),allocatable :: energies(:)
     integer,allocatable :: nats(:)
     logical,allocatable :: taken(:)
diff --git a/src/sortens.f90 b/src/legacy_algos/sortens.f90
similarity index 100%
rename from src/sortens.f90
rename to src/legacy_algos/sortens.f90
diff --git a/src/legacy_wrappers.f90 b/src/legacy_wrappers.f90
index cad970f3..e1419ed9 100644
--- a/src/legacy_wrappers.f90
+++ b/src/legacy_wrappers.f90
@@ -35,7 +35,7 @@ subroutine env2calc(env,calc,molin)
   !> OUTPUT
   type(calcdata) :: calc
   !> LOCAL
-  type(calculation_settings) :: cal,cal2
+  type(calculation_settings) :: cal,cal2,cal_rerank,cal_reopt
   type(coord) :: mol
 
 !>--- Calculator level
@@ -47,18 +47,23 @@ subroutine env2calc(env,calc,molin)
   end if
 
   cal%uhf = env%uhf
+  call cal%sync_multiplicity()   !> keep the multiplicity store aligned with uhf
   cal%chrg = env%chrg
+  cal%spin_polarized = env%spin_polarized
 !>-- obtain WBOs OFF by default
   cal%rdwbo = .false.
   cal%rddip = .false.
   !> except for SP runtype (from command line!)
   if (env%crestver == crest_sp) then
     cal%rdgrad = env%gradsp
-    if (cal%id .ne. jobtype%turbomole) then
+    !> ORCA/Turbomole drivers and fmlip-relay MLIPs do not provide
+    !> WBOs/dipoles/charges to read back
+    if (cal%id .ne. jobtype%turbomole .and. cal%id .ne. jobtype%orca &
+    &   .and. cal%id .ne. jobtype%mlip) then
       cal%rdwbo = .true.
       cal%rddip = .true.
       cal%rdqat = .true.
-    else
+    else if (cal%id == jobtype%turbomole .or. cal%id == jobtype%orca) then
       if (.not.env%gradsp) then
         cal%other = ''
       end if
@@ -80,6 +85,16 @@ subroutine env2calc(env,calc,molin)
   !> do not reset parameters between calculations (opt for speed)
   cal%apiclean = .false.
 
+  ! ── ORCA driver set up from CLI (--orca <template> <exe>) ───────────
+  if (trim(env%gfnver) == '--orca') then
+    cal%id = jobtype%orca
+    if (allocated(env%orca_cmd)) then
+      cal%ORCA%cmd = trim(env%orca_cmd)
+      cal%binary = trim(env%orca_cmd)
+    end if
+    if (allocated(env%orca_template)) call cal%ORCA%read(trim(env%orca_template))
+  end if
+
   call cal%autocomplete(1)
   call calc%add(cal)
 
@@ -90,6 +105,7 @@ subroutine env2calc(env,calc,molin)
 
     cal2%chrg = cal%chrg
     cal2%uhf = cal%uhf
+    cal2%spin_polarized = cal%spin_polarized
     if (env%gbsa) then
       cal2%solvmodel = cal%solvmodel
       cal2%solvent = cal%solvent
@@ -103,6 +119,49 @@ subroutine env2calc(env,calc,molin)
     call env%addrefine(refine%singlepoint)
   end if
 
+!>--- Post-search SP reranking level (--rerank)
+  if (trim(env%rerank_lvl) .ne. '') then
+    call cal_rerank%create(trim(env%rerank_lvl))
+    cal_rerank%chrg = cal%chrg
+    cal_rerank%uhf  = cal%uhf
+    cal_rerank%spin_polarized = cal%spin_polarized
+    if (env%gbsa) then
+      cal_rerank%solvmodel = cal%solvmodel
+      cal_rerank%solvent   = cal%solvent
+    end if
+    call cal_rerank%autocomplete(2)
+    cal_rerank%refine_lvl = refine%post_sp
+    call calc%add(cal_rerank)
+  end if
+
+!>--- Post-search geometry re-optimization level (--reopt)
+  if (trim(env%reopt_lvl) .ne. '') then
+    call cal_reopt%create(trim(env%reopt_lvl))
+    cal_reopt%chrg = cal%chrg
+    cal_reopt%uhf  = cal%uhf
+    cal_reopt%spin_polarized = cal%spin_polarized
+    if (env%gbsa) then
+      cal_reopt%solvmodel = cal%solvmodel
+      cal_reopt%solvent   = cal%solvent
+    end if
+    call cal_reopt%autocomplete(2)
+    cal_reopt%refine_lvl = refine%post_reopt
+    call calc%add(cal_reopt)
+  end if
+
+  if (.not.allocated(env%calc%temperatures)) then
+    if (.not.allocated(env%thermo%temps)) then
+      call env%thermo%get_temps()
+    end if
+    env%calc%nt = env%thermo%ntemps
+    allocate (env%calc%temperatures(env%calc%nt),source=0.0_wp)
+
+    env%calc%temperatures = env%thermo%temps
+    env%calc%ithr = env%thermo%ithr
+    env%calc%sthr = env%thermo%sthr
+    env%calc%fscal = env%thermo%fscal
+  end if
+
   return
 end subroutine env2calc
 
@@ -141,6 +200,77 @@ end subroutine env2calc
   ! env%calc = calc
 end subroutine env2calc_setup
 
+subroutine env2calc_modify(env)
+!******************************************
+!* Modify the calc object within env with
+!* additional settings
+!******************************************
+  use crest_parameters
+  use crest_data
+  use crest_calculator
+  use strucrd
+  use lwoniom_module
+  implicit none
+  !> INOUT
+  type(systemdata),intent(inout) :: env
+  !> LOCAL
+  integer :: i,j
+
+!>--- pass on opt-level to new calculator
+  env%calc%optlev = nint(env%optlev)
+
+!>--- pass electric field to tblite
+  if (allocated(env%ref%efield)) then
+    do i = 1,env%calc%ncalculations
+      if (env%calc%calcs(i)%id == jobtype%tblite) then
+        if (.not.allocated(env%calc%calcs(i)%efield)) allocate (env%calc%calcs(i)%efield(3),source=0.0_wp)
+        env%calc%calcs(i)%efield(1:3) = env%ref%efield(1:3)
+      end if
+    end do
+  end if
+
+  !>--- pass on CEH guess flag
+  if (env%ceh_guess) then
+    do i = 1,env%calc%ncalculations
+      env%calc%calcs(i)%ceh_guess = env%ceh_guess
+    end do
+  end if
+
+  !>--- pass on spin-polarized flag
+  if (env%spin_polarized) then
+    do i = 1,env%calc%ncalculations
+      env%calc%calcs(i)%spin_polarized = env%spin_polarized
+    end do
+  end if
+
+!>--- ONIOM setup from toml file
+  if (allocated(env%ONIOM_toml)) then
+    if (.not.allocated(env%calc%ONIOM)) allocate (env%calc%ONIOM)
+    call ONIOM_read_toml(env%ONIOM_toml,env%nat,env%ref%at,env%ref%xyz,env%calc%ONIOM)
+    call env%calc%ONIOMexpand()
+  end if
+
+!>--- pass on thermo data to the calculator
+  if (.not.allocated(env%calc%temperatures)) then
+    if (.not.allocated(env%thermo%temps)) then
+      call env%thermo%get_temps()
+    end if
+    env%calc%nt = env%thermo%ntemps
+    allocate (env%calc%temperatures(env%calc%nt),source=0.0_wp)
+
+    env%calc%temperatures = env%thermo%temps
+    env%calc%ithr = env%thermo%ithr
+    env%calc%sthr = env%thermo%sthr
+    env%calc%fscal = env%thermo%fscal
+    env%calc%emodel = env%thermo%emodel
+  end if
+
+! ── apply GFN-FF special cases for CLI-only setups ───────────────
+!   Also a safety net for refine_queue; duplicate-level guard is idempotent.
+  call env_calcdat_specialcases(env)
+
+end subroutine env2calc_modify
+
 !================================================================================!
 subroutine confscript2i(env,tim)
   use iso_fortran_env,only:wp => real64
@@ -351,7 +481,9 @@ subroutine trialOPT(env)
   if (env%crestver == crest_trialopt) then
 !>-- if we reach this point in the standalone trialopt the geometry is ok!
     write (stdout,*)
-    stop 'Geometry ok!'
+    write (stdout,*) 'Geometry ok!'
+    write (stdout,*)
+    call creststop(status_normal)
   end if
 end subroutine trialOPT
 
diff --git a/src/meson.build b/src/meson.build
index 1fd7359b..d3d3e024 100644
--- a/src/meson.build
+++ b/src/meson.build
@@ -14,6 +14,7 @@
 # You should have received a copy of the GNU Lesser General Public License
 # along with crest.  If not, see <https://www.gnu.org/licenses/>.
 
+subdir('molecule')
 subdir('qcg')
 subdir('dynamics')
 subdir('calculator')
@@ -22,40 +23,36 @@ subdir('algos')
 subdir('parsing')
 subdir('qmhelpers')
 subdir('graphs') 
-subdir('rigidconf')
+subdir('molbuilder')
 subdir('discretize')
 subdir('entropy')
 subdir('legacy_algos')
 subdir('msreact')
-
+subdir('sorting')
+subdir('basinhopping')
+subdir('chelpers')
 
 srcs += files(
   'atmasses.f90',
   'axis_module.f90',
   'biasmerge.f90',
   'bondconstraint.f90',
-  'canonical.f90',
-  'ccegen.f90',
   'choose_settings.f90',
   'classes.f90',
   'cleanup.f90',
   'cn.f90',
   'compress.f90',
   'confparse.f90',
-  'cregen.f90',
   'crest_pars.f90',
-  'ensemblecomp.f90',
   'eval_timer.f90',
   'filemod.f90',
   'flexi.F90',
   'freqmasses.f90',
   'geo.f90',
-  'identifiers.f90',
   'internals.f90', 
   'internals2.f90',
   'iomod.F90',
   'legacy_wrappers.f90',
-  'ls_rmsd.f90',
   'marqfit.f90',
   'minitools.f90',
   'miscdata.f90',
@@ -63,26 +60,15 @@ srcs += files(
   'ompmklset.F90',
   'printouts.f90',
   'prmat.f90',
-  'propcalc.f90',
-  'quicksort.f90',
-  'readl.f90',
   'restartlog.f90',
-  'rotcompare.f90',
   'scratch.f90',
-  'sdfio.f90',
   'select.f90',
-  'signal.c',
-  'sigterm.f90',
-  'sortens.f90',
-  'strucreader.f90',
-  'symmetry2.f90',
-  'symmetry_i.c',
+  'sigterm.F90',
+  'symmetry_i.f90',
   'timer.f90',
   'trackorigin.f90',
   'utilmod.f90',
   'wallsetup.f90',
-  'zdata.f90',
-  'ztopology.f90',
 )
 
 prog += files(
diff --git a/src/minitools.f90 b/src/minitools.f90
index a6be69f2..1aa27306 100644
--- a/src/minitools.f90
+++ b/src/minitools.f90
@@ -25,7 +25,7 @@ subroutine splitfile(fname,up,low)
 !********************************************************
   use crest_parameters
   use iomod
-  use strucrd,only: rdensemble,coord
+  use strucrd,only:rdensemble,coord
   implicit none
   character(len=*) :: fname
   integer :: up,low
@@ -48,9 +48,6 @@ subroutine splitfile(fname,up,low)
 
   call getcwd(thispath) !current dir= thispath
 
-  !call rdensembleparam(fname,nat,nall)
-  !allocate (xyz(3,nat,nall),at(nat))
-  !call rdensemble(fname,nat,nall,at,xyz)
   call rdensemble(fname,nall,structures)
 
   r = makedir("SPLIT")  !create new directory
@@ -75,12 +72,17 @@ subroutine splitfile(fname,up,low)
     write (tmppath2,'(a,i0)') "STRUC",i
     r = makedir(trim(tmppath2))
     call chdir(tmppath2)
-    !call wrxyz("struc.xyz",nat,at,xyz(:,:,i))
     call structures(i)%write("struc.xyz")
     call chdir(tmppath1)
   end do
 
   call chdir(thispath)
+  write (stdout,*)
+  write (stdout,'(a,i0,a,i0,a)') '>  Created subdirectories SPLIT/STRUC{',low,'-',nc,'}/'
+  write (stdout,'(a)') '>  All directories contain a "struc.xyz" with molecular coordinates'
+  write (stdout,'(a)') '>  The order of SPLIT/STRUC*/ is the same as in '//trim(fname)
+  write (stdout,*)
+  write (stdout,'(a)') 'exit.'
   return
 end subroutine splitfile
 
@@ -94,9 +96,10 @@ subroutine printaniso(fname,bmin,bmax,bshift)
   use crest_parameters
   use strucrd
   use axis_module
+  use rotaniso_mod
   implicit none
   character(len=*) :: fname
-  type(ensemble) :: ens
+  type(coord),allocatable :: structures(:)
 
   integer :: nat
   integer :: nall
@@ -104,29 +107,34 @@ subroutine printaniso(fname,bmin,bmax,bshift)
   integer,allocatable :: at(:)
 
   real(wp),allocatable :: rot(:,:)
-  real(wp) :: rotaniso !function
   real(wp),allocatable :: anis(:)
+  real(wp) :: evec(3,3),evecavg(3,3)
 
-  real(wp) :: bthrerf
   real(wp) :: bmin,bmax,bshift
   real(wp) :: thr
   real(wp) :: dum
   integer :: i
 
-  call ens%open(fname)
-  nat = ens%nat
-  nall = ens%nall
+  call rdensemble(fname,nall,structures)
+  nat = structures(1)%nat
 
   allocate (c1(3,nat),at(nat))
   allocate (rot(3,nall))
   allocate (anis(nall))
 
-  at = ens%at
+  at(:) = structures(1)%at(:)
+  evecavg(:,:) = 0.0_wp
+  do i = 1,nall
+    c1(1:3,:) = structures(i)%xyz(1:3,:)*autoaa
+    call axis(nat,at,c1,rot(1:3,i),dum,evec)
+    evecavg(:,:) = evecavg(:,:)+evec(:,:)
+  end do
+  evecavg(:,:) = evecavg(:,:)/real(nall)
 
   do i = 1,nall
-    c1(1:3,:) = ens%xyz(1:3,:,i)
-    call axis(nat,at,c1,rot(1:3,i),dum)
-    anis(i) = rotaniso(i,nall,rot)
+    c1(1:3,:) = structures(i)%xyz(1:3,:)*autoaa
+    call axis(nat,at,c1,rot(1:3,i),dum,evec)
+    anis(i) = rotaniso(rot(1:3,i))
     thr = bthrerf(bmin,anis(i),bmax,bshift)
     write (*,'(3f10.2,2x,f8.4,2x,f8.4)') rot(1:3,i),anis(i),thr
   end do
@@ -139,6 +147,66 @@ end subroutine printaniso
 
 !=========================================================================================!
 
+subroutine rotalign_tool(fname)
+!****************************************************
+!* print the anisotropy of the rotational constants
+!* for all structures in a given ensemble file
+!****************************************************
+  use crest_parameters
+  use strucrd
+  use axis_module
+  implicit none
+  character(len=*) :: fname
+  type(coord),allocatable :: structures(:)
+
+  integer :: nat
+  integer :: nall
+  real(wp),allocatable :: c1(:,:),c2(:,:)
+  integer,allocatable :: at(:)
+
+  real(wp),allocatable :: rot(:,:)
+  real(wp) :: rotaniso !function
+  real(wp),allocatable :: anis(:)
+  real(wp) :: evec(3,3),evecavg(3,3)
+
+  real(wp) :: bthrerf
+  real(wp) :: bmin,bmax,bshift
+  real(wp) :: thr
+  real(wp) :: dum
+  integer :: i
+
+  real(wp),parameter :: Ry90(3,3) = reshape([ &
+                  &    0.0_wp,0.0_wp,-1.0_wp, &
+                  &    0.0_wp,1.0_wp,0.0_wp,  &
+                  &    1.0_wp,0.0_wp,0.0_wp   &
+                  &    ], [3,3])
+
+  call rdensemble(fname,nall,structures)
+  nat = structures(1)%nat
+
+  allocate (c1(3,nat),c2(3,nat),at(nat))
+  allocate (rot(3,nall))
+
+  at(:) = structures(1)%at(:)
+  write (*,'(3a10)') 'A/MHz','B/MHz','C/MHz'
+  do i = 1,nall
+    c1(1:3,:) = structures(i)%xyz(1:3,:)*autoaa
+    call axis(nat,at,c1,rot(1:3,i))
+    c2 = c1
+    structures(i)%xyz = c2*aatoau
+    write (*,'(3f10.2)') rot(1:3,i)
+  end do
+
+  deallocate (rot,at,c2,c1)
+
+  call wrensemble('rotalign.xyz',nall,structures)
+
+  stop
+  return
+end subroutine rotalign_tool
+
+!=========================================================================================!
+
 subroutine prbweight(fname,Targ)
 !*****************************************************
 !* read in a file with 1 to 2 columns
@@ -149,6 +217,7 @@ subroutine prbweight(fname,Targ)
 !* comment lines (#) are ignored
 !*****************************************************
   use crest_parameters
+  use iomod, only: readl
   implicit none
 
   character(len=*) :: fname
@@ -326,14 +395,15 @@ subroutine testtopo(fname,env,tmode)
   use atmasses
   use zdata
   use strucrd
+  use molbuilder_classify
   implicit none
   type(systemdata) :: env
   character(len=*) :: fname
   character(len=:),allocatable :: wbofile
   character(len=*) :: tmode
-  character(len=40) :: sumform
   type(zmolecule) :: zmol
   type(coord) :: mol
+  type(coord_classify) :: molc
   real(wp),allocatable :: xyz(:,:)
   real(wp) :: dum
   integer,allocatable :: inc(:)
@@ -406,7 +476,6 @@ subroutine testtopo(fname,env,tmode)
     if (.not.env%legacy.and.env%calc%ncalculations == 0) then
       call env2calc_setup(env)
     end if
-
     call thermo_wrap(env,.true.,zmol%nat,zmol%at,xyz,'', &
     &    nt,temps,et,ht,gt,stot,.false.)
     deallocate (stot,gt,ht,et,temps)
@@ -414,7 +483,6 @@ subroutine testtopo(fname,env,tmode)
   case ('methyl')
     do i = 1,zmol%nat
       l1 = zmol%methyl(i)
-      !write(*,*) l1
       if (l1) write (*,'(a,i0,a)') 'Atom ',i,' is methyl (or similar)'
     end do
 
@@ -437,46 +505,27 @@ subroutine testtopo(fname,env,tmode)
     end do
     close (ich)
 
+  case ('func')
+    call setup_classify(mol,molc)
+    call functional_group_classify(molc)
+    call molc%print_funcgroups(stdout)
+
+
   end select
   deallocate (xyz)
   write (*,*)
-  stop
+  call creststop(status_normal)
 end subroutine testtopo
 
 !========================================================================================!
 
-character(len=40) function sumform(nat,at)
-!************************************************
-!* get sumformula as a string from the AT array
-!************************************************
-  use strucrd,only:i2e
-  implicit none
-  integer :: nat
-  integer :: at(nat)
-  integer :: sumat(94)
-  integer :: i
-  character(len=6) :: str
-  sumform = ''
-  sumat = 0
-  do i = 1,nat
-    sumat(at(i)) = sumat(at(i))+1
-  end do
-  do i = 1,94
-    if (sumat(i) .lt. 1) cycle
-    write (str,'(a,i0)') trim(adjustl(i2e(i,'nc'))),sumat(i)
-    sumform = trim(sumform)//trim(str)
-  end do
-  return
-end function sumform
-
-!=========================================================================================!
-
 subroutine ensemble_analsym(fname,pr)
 !*****************************************************************
 !* read an ensemble and determine the symmetry for all structures
 !*****************************************************************
   use crest_parameters
   use strucrd
+  use symmetry_i,only: getsym
   implicit none
   character(len=*) :: fname
   logical :: pr
@@ -487,8 +536,6 @@ subroutine ensemble_analsym(fname,pr)
   integer,allocatable  :: at(:)
   integer :: i,ich
   character(len=4) :: sfsym,sfsm
-  real(wp),parameter :: desy = 0.1_wp
-  integer,parameter  :: maxat = 200
   character(len=80) :: atmp
 
   call rdensembleparam(fname,nat,nall)
@@ -509,7 +556,7 @@ subroutine ensemble_analsym(fname,pr)
   open (file='symmetries',newunit=ich)
   do i = 1,nall
     c0(1:3,1:nat) = xyz(:,:,i)
-    call getsymmetry2(.false.,6,nat,at,c0,desy,maxat,sfsym)
+    call getsym(.false.,6,nat,at,c0,sfsym)
     sfsm = sfsym(1:3)
     write (atmp,'(3x,a,i10,2x,f18.8,2x,a)') 'structure',i,er(i),sfsm
     write (ich,'(a)') trim(atmp)
@@ -585,20 +632,32 @@ end function quick_rmsd
 subroutine quick_rmsd_tool(fname1,fname2,heavy)
   use crest_parameters
   use strucrd
+  use irmsd_module
   implicit none
-  character(len=*) :: fname1
-  character(len=*) :: fname2
-  logical :: heavy
-  type(coord) :: mol1
+  character(len=*),intent(in) :: fname1
+  character(len=*),intent(in) :: fname2
+  logical,intent(in) :: heavy
+  type(coord) :: mol,ref
   real(wp) :: rmsdval
-  real(wp) :: quick_rmsd
-
-  call mol1%open(fname1)
+  integer :: i
+  logical,allocatable :: mask(:)
 
-  mol1%xyz = mol1%xyz*bohr !to Angstroem
+  call ref%open(fname1)
+  call mol%open(fname2)
 
-  rmsdval = quick_rmsd(fname2,mol1%nat,mol1%at,mol1%xyz,heavy)
+  if (heavy) then
+    allocate (mask(ref%nat),source=.false.)
+    do i = 1,ref%nat
+      if (ref%at(i) > 1) then
+        mask(i) = .true.
+      end if
+    end do
+    rmsdval = rmsd(ref,mol,mask=mask)
+  else
+    rmsdval = rmsd(ref,mol)
+  end if
 
+  rmsdval = rmsdval*autoaa
   if (heavy) then
     write (*,'(1x,a,f16.8)') 'Calculated heavy atom RMSD (Å):',rmsdval
   else
@@ -651,6 +710,100 @@ end function quick_rmsd2
 
 !=========================================================================================!
 
+subroutine quick_hungarian_match(fname1,fname2,heavy)
+  use crest_parameters
+  use strucrd
+  use hungarian_module
+  use axis_module,only:axis
+  implicit none
+  character(len=*),intent(in) :: fname1
+  character(len=*),intent(in) :: fname2
+  logical,intent(in) :: heavy
+  type(coord) :: mol,ref
+  real(wp) :: rmsdval
+  integer :: i,ii,jj,nat,io,ich
+  logical,allocatable :: mask(:)
+  real(wp),allocatable :: C(:,:)
+  real(wp),allocatable :: answers(:)
+  integer,allocatable :: mapping(:)
+  integer,allocatable :: hmap(:),rhmap(:)
+  integer,allocatable :: a(:),b(:)
+  real(wp) :: dists(3)
+
+  call ref%open(fname1)
+  call mol%open(fname2)
+
+  !> align to rotational axes and shift to center of mass
+  call axis(ref%nat,ref%at,ref%xyz)
+  call axis(mol%nat,mol%at,mol%xyz)
+
+  if (heavy) then
+    allocate (mask(ref%nat),source=.false.)
+    allocate (hmap(ref%nat),rhmap(ref%nat),source=0)
+    nat = count((ref%at(:) > 1))
+    ii = 0
+    do i = 1,ref%nat
+      if (ref%at(i) > 1) then
+        mask(i) = .true.
+        ii = ii+1
+        hmap(i) = ii
+        rhmap(ii) = i
+      end if
+    end do
+  else
+    allocate (mask(ref%nat),source=.true.)
+    nat = ref%nat
+  end if
+
+  allocate (C(nat,nat),answers(nat))
+  allocate (mapping(nat+1))
+  do ii = 1,nat
+    if (.not.mask(ii)) cycle
+    do jj = 1,nat
+      if (.not.mask(jj)) cycle
+      dists(:) = (ref%xyz(:,ii)-mol%xyz(:,jj))**2
+      if (heavy) then
+        C(hmap(jj),hmap(ii)) = sqrt(sum(dists))
+      else
+        C(jj,ii) = sqrt(sum(dists))
+      end if
+    end do
+  end do
+  allocate (a(nat),b(nat))
+  call lsap(C,nat,nat,a,b)
+
+  write (*,'(a,3(1x,a))') 'Assignment:',fname2,'-->',fname1
+  do i = 1,nat
+    if (heavy) then
+      write (*,'(i6," --> ",i6)') rhmap(a(i)),rhmap(b(i))
+    else
+      write (*,'(i6," --> ",i6)') a(i),b(i)
+    end if
+  end do
+  write (*,*)
+  !> write the rotated and shifted coordinates to one file
+  open (newunit=ich,file='lsap.xyz')
+  call ref%append(ich)
+  call mol%append(ich)
+  close (ich)
+
+  !> reconstruct RMSD from assignment (since our costs are already distances!)
+  rmsdval = 0.0_wp
+  do i = 1,nat
+    rmsdval = rmsdval+C(a(i),b(i))/real(nat,wp)
+  end do
+  rmsdval = sqrt(abs(rmsdval))*autoaa
+  if (heavy) then
+    write (*,'(1x,a,f16.8)') 'Calculated heavy atom RMSD (Å):',rmsdval
+  else
+    write (*,'(1x,a,f16.8)') 'Calculated RMSD (Å):',rmsdval
+  end if
+
+  return
+end subroutine quick_hungarian_match
+
+!=========================================================================================!
+
 subroutine resort_ensemble(fname)
 !************************************************
 !* resort all structures of a given ensemblefile
diff --git a/src/miscdata.f90 b/src/miscdata.f90
index 79dc3a7f..d2359ae2 100644
--- a/src/miscdata.f90
+++ b/src/miscdata.f90
@@ -99,6 +99,30 @@ module miscdata
    &                 1.36_wp,1.43_wp,1.46_wp,1.58_wp,1.48_wp,1.57_wp ] ! Nh-Og   
 !&>
 
+!&<
+  !> Colvlent Radii as used in QCG. No idea where they originate from; Legacy.
+  real(wp),parameter :: rcov_qcg(1:94) = [ &
+     &  2.18230009,1.73469996,3.49559999,3.09820008,3.21600008, & 
+     &  2.91030002,2.62249994,2.48169994,2.29959989,2.13739991, & 
+     &  3.70819998,3.48390007,4.01060009,3.79169989,3.50169992, & 
+     &  3.31069994,3.10459995,2.91479993,4.24109983,4.10349989, & 
+     &  3.89030004,3.76419997,3.72110009,3.44140005,3.54620004, & 
+     &  3.44210005,3.43269992,3.34619999,3.30080009,3.23090005, & 
+     &  3.95790005,3.86190009,3.66249990,3.52679992,3.36619997, & 
+     &  3.20959997,4.61759996,4.47639990,4.21960020,4.05970001, & 
+     &  3.85960007,3.75430012,3.56900001,3.46230006,3.39750004, & 
+     &  3.35249996,3.33080006,3.46199989,4.26230001,4.18739986, & 
+     &  4.01499987,3.89010000,3.73799992,3.58890009,5.05670023, & 
+     &  5.18139982,4.62610006,4.62010002,4.57019997,4.52710009, & 
+     &  4.48960018,4.45149994,4.42339993,4.12430000,4.24270010, & 
+     &  4.15409994,4.27939987,4.24499989,4.22079992,4.19859982, & 
+     &  4.01300001,4.24499989,4.09800005,3.98550010,3.89549994, & 
+     &  3.74900007,3.44560003,3.35249996,3.25640011,3.35990000, & 
+     &  4.31269979,4.27640009,4.11749983,4.00540018,3.86439991, & 
+     &  3.72160006,5.07959986,4.92939997,4.70429993,4.42519999, & 
+     &  4.45940018,4.39569998,4.35389996,4.43410015]
+!&>
+
 
 !&<
   !> D3 pairwise van-der-Waals radii (only homoatomic pairs present here)
diff --git a/src/molbuilder/CMakeLists.txt b/src/molbuilder/CMakeLists.txt
new file mode 100644
index 00000000..027d1499
--- /dev/null
+++ b/src/molbuilder/CMakeLists.txt
@@ -0,0 +1,37 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+#
+# crest is free software: you can redistribute it and/or modify it under
+# the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# crest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with crest.  If not, see <https://www.gnu.org/licenses/>.
+
+set(dir "${CMAKE_CURRENT_SOURCE_DIR}")
+
+list(APPEND srcs
+  "${dir}/rigidconf.f90"
+  "${dir}/tree.f90"
+  "${dir}/analyze.f90"
+  "${dir}/reconstruct.f90"
+  "${dir}/construct.f90"
+  "${dir}/construct_list.f90"
+  "${dir}/classify.f90"
+  "${dir}/classify_type.f90" 
+  "${dir}/classify_func.f90" 
+)
+
+set(srcs ${srcs} PARENT_SCOPE)
+
+
+
+
+
+
diff --git a/src/rigidconf/analyze.f90 b/src/molbuilder/analyze.f90
similarity index 75%
rename from src/rigidconf/analyze.f90
rename to src/molbuilder/analyze.f90
index 2c040233..bf8cf78c 100644
--- a/src/rigidconf/analyze.f90
+++ b/src/molbuilder/analyze.f90
@@ -1,7 +1,7 @@
 !================================================================================!
 ! This file is part of crest.
 !
-! Copyright (C) 2023 Philipp Pracht, Christopher Zurek, Christoph Bannwarth
+! Copyright (C) 2026 Philipp Pracht
 !
 ! crest is free software: you can redistribute it and/or modify it under
 ! the terms of the GNU Lesser General Public License as published by
@@ -15,14 +15,10 @@
 !
 ! You should have received a copy of the GNU Lesser General Public License
 ! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!
-! Routines were adapted from the xtb code (github.com/grimme-lab/xtb)
-! under the Open-source software LGPL-3.0 Licencse.
 !================================================================================!
 
-module rigidconf_analyze
+module molbuilder_rigidconf_analyze
   use crest_parameters
-  use crest_data
   use strucrd
   use geo
   use INTERNALS_mod
@@ -35,7 +31,7 @@ module rigidconf_analyze
 !========================================================================================!
 !========================================================================================!
 
-  subroutine rigidconf_analyze_fallback(env,mol,zmat,na,nb,nc,wbo, &
+  subroutine rigidconf_analyze_fallback(mol,zmat,na,nb,nc,wbo, &
   &                                     ndieder,dvalues,dstep,ztod)
 !************************************************************
 !* Fallback routine for the dihedral setup.
@@ -46,7 +42,7 @@ subroutine rigidconf_analyze_fallback(env,mol,zmat,na,nb,nc,wbo, &
 !* dstep of 120°
 !*
 !* Input:
-!*    env,mol,zmat,na,nb,nc,wbo,ndieder
+!*   mol,zmat,na,nb,nc,wbo,ndieder
 !*
 !* Output:
 !*    dvalues, dstep, ztod
@@ -54,7 +50,6 @@ subroutine rigidconf_analyze_fallback(env,mol,zmat,na,nb,nc,wbo, &
 !************************************************************
     implicit none
     !> INPUT
-    type(systemdata),intent(inout) :: env
     type(coord),intent(in) :: mol  !> by convention mol is in Bohrs
     real(wp),intent(in) :: zmat(3,mol%nat)
     integer,intent(in)  :: na(mol%nat),nb(mol%nat),nc(mol%nat)
@@ -101,7 +96,7 @@ subroutine rigidconf_analyze_fallback(env,mol,zmat,na,nb,nc,wbo, &
   end subroutine rigidconf_analyze_fallback
 
 !========================================================================================!
-  subroutine rigidconf_count_fallback(nat,na,nb,nc,wbo,ndieder,ztod)
+  subroutine rigidconf_count_fallback(nat,na,nb,nc,A,ndieder,ztod)
 !************************************************************
 !* Count number of unique single-bond dihedral angles that
 !* correspond to an entry in the zmat.
@@ -110,7 +105,7 @@ subroutine rigidconf_count_fallback(nat,na,nb,nc,wbo,ndieder,ztod)
     !> INPUT
     integer,intent(in)  :: nat
     integer,intent(in)  :: na(nat),nb(nat),nc(nat)
-    real(wp),intent(in) :: wbo(nat,nat)
+    integer,intent(in) :: A(nat,nat)
     !> OUTPUT
     integer,intent(out)  :: ndieder
     integer,intent(out),optional :: ztod(nat)
@@ -131,7 +126,7 @@ subroutine rigidconf_count_fallback(nat,na,nb,nc,wbo,ndieder,ztod)
         if (Amap(j,l) > 0) then
           m = Amap(j,l)
         else
-          if (nint(wbo(j,l)) == 1) then
+          if (A(j,l) == 1) then
             k = k+1
             Amap(j,l) = k
             Amap(l,j) = k
@@ -147,44 +142,76 @@ subroutine rigidconf_count_fallback(nat,na,nb,nc,wbo,ndieder,ztod)
   end subroutine rigidconf_count_fallback
 
 !========================================================================================!
-  subroutine prune_zmat_dihedrals(nat,xyz,zmat,na,nb,nc,ztod)
+  subroutine prune_zmat_dihedrals(mol,zmat,na,nb,nc,ztod,hpyrad,bond)
 !********************************************************
 !* Remove zmat entries that correspond
 !* to the same bond and replace them with internal
-!* dihedral angles. There you go, Christoph...
+!* dihedral angles.
+!* Giving preference to non-H-atoms in the selection
 !********************************************************
     implicit none
-    integer,intent(in)  :: nat
-    real(wp),intent(in) :: xyz(3,nat)
-    real(wp),intent(inout) :: zmat(3,nat)
-    integer,intent(inout)  :: na(nat),nb(nat),nc(nat)
-    integer,intent(inout)  :: ztod(nat)
+    class(coord),intent(in) :: mol
+    real(wp),intent(inout) :: zmat(3,mol%nat)
+    integer,intent(inout)  :: na(mol%nat),nb(mol%nat),nc(mol%nat)
+    integer,intent(inout)  :: ztod(mol%nat)
+    logical,intent(in),optional :: hpyrad
+    integer,intent(in),optional :: bond(mol%nat,mol%nat)
     integer :: i,j,k,l
     integer :: maxgroup,nmembers,refi
 
-    write (*,*) ztod
-    maxgroup = maxval(ztod,1)
-    do i = 1,maxgroup
-      nmembers = count(ztod(:) .eq. i)
-      if (nmembers < 2) cycle
-      do j = 1,nat
-        if (ztod(j) == i) then
-          refi = j
-          exit
+    associate (nat => mol%nat,at => mol%at,xyz => mol%xyz)
+      maxgroup = maxval(ztod,1)
+      do i = 1,maxgroup
+        nmembers = count(ztod(:) .eq. i)
+        if (nmembers < 2) cycle
+        refi = 0
+        do j = 1,nat
+          if (ztod(j) == i.and.at(j) > 1) then
+            refi = j
+            exit
+          end if
+        end do
+        if (refi == 0) then
+          do j = 1,nat
+            if (ztod(j) == i) then
+              refi = j
+              exit
+            end if
+          end do
         end if
+        do j = 1,nat
+          if (j == refi) cycle
+          if (j == nc(refi)) cycle
+          if (ztod(j) == i) then
+            nc(j) = refi
+            call DIHED2(xyz,j,na(j),nb(j),nc(j),zmat(3,j))
+            ztod(j) = 0
+          end if
+        end do
       end do
-      do j = 1,nat
-        if (j == refi) cycle
-        if (ztod(j) == i) then
-          !nc(j) = nb(j)
-          nc(j) = refi
-          !call BANGLE2( xyz, j, na(j), nb(j), zmat(2,j) )
-          call DIHED2(xyz,j,na(j),nb(j),nc(j),zmat(3,j))
-          ztod(j) = 0
+      if (present(hpyrad).and.present(bond)) then
+        if (hpyrad) then
+          k = maxgroup
+          iloop : do i=1,nat
+             !> select H entries with full zmat entries (to avoid collaps)
+             if(at(i) .eq. 1 .and.nc(i).ne.0)then
+               refi=na(i)
+               do j=1,nat
+                 if(at(j).eq.1) cycle
+                 !> search to replace the dihedral with a pyramidal angle
+                 if(bond(j,refi) > 0 .and. .not.(nb(i)==j))then
+                    nc(i) = j
+                    call DIHED2(xyz,i,na(i),nb(i),nc(i),zmat(3,i))
+                    k = k + 1
+                    ztod(i) = k
+                    cycle iloop
+                 endif
+               enddo
+             endif
+          enddo iloop
         end if
-      end do
-    end do
-    write (*,*) ztod
+      end if
+    end associate
   end subroutine prune_zmat_dihedrals
 
 !========================================================================================!
@@ -208,10 +235,6 @@ subroutine rigidconf_user_file(fname,nat,na,nb,nc,wbo,ndieder,ztod,dvalues,dstep
     integer,intent(out),allocatable  :: ztod(:)
     integer,intent(out),allocatable  :: dvalues(:)
     real(wp),intent(out),allocatable :: dstep(:)
-    !integer,intent(in)  :: ndieder
-    !integer,intent(out)  :: ztod(nat)
-    !integer,intent(out)  :: dvalues(ndieder)
-    !real(wp),intent(out) :: dstep(ndieder)
     !> LOCAL
     integer :: V,i,j,k,l,m,ich,io,n
     integer,allocatable :: Amap(:,:)
@@ -268,7 +291,7 @@ subroutine rigidconf_user_file(fname,nat,na,nb,nc,wbo,ndieder,ztod,dvalues,dstep
         write (stdout,'(a,i0,1x,i0)') '**WARNING** no bond defined for atoms ',i,j
         cycle
       end if
-      write(stdout,'(">",1x,a,i0,a,i0,a,i0)') 'adding ',abs(n),' points for bond between atoms ', &
+      write (stdout,'(">",1x,a,i0,a,i0,a,i0)') 'adding ',abs(n),' points for bond between atoms ', &
       & i,' and ',j
       tmppairs(i,j) = abs(n)
       tmppairs(j,i) = abs(n)
@@ -278,16 +301,16 @@ subroutine rigidconf_user_file(fname,nat,na,nb,nc,wbo,ndieder,ztod,dvalues,dstep
       allocate (dvalues(ndieder),source=0)
       allocate (dstep(ndieder),source=0.0_wp)
       dvalues(:) = 0
-      dstep(:) = 360.0_wp * degtorad
+      dstep(:) = 360.0_wp*degtorad
       k = 0
       do i = 1,nat
         do j = 1,i-1
           if (tmppairs(j,i) > 0) then
             m = Amap(j,i)
-            if(m == 0) cycle
+            if (m == 0) cycle
             n = tmppairs(j,i)
             dvalues(m) = n
-            dstep(m) = (360.0_wp / real(n)) * degtorad  
+            dstep(m) = (360.0_wp/real(n))*degtorad
           end if
         end do
       end do
@@ -299,4 +322,4 @@ end subroutine rigidconf_user_file
 
 !========================================================================================!
 !========================================================================================!
-end module rigidconf_analyze
+end module molbuilder_rigidconf_analyze
diff --git a/src/molbuilder/classify.f90 b/src/molbuilder/classify.f90
new file mode 100644
index 00000000..5257189f
--- /dev/null
+++ b/src/molbuilder/classify.f90
@@ -0,0 +1,36 @@
+!=============================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!=============================================================================!
+
+module molbuilder_classify
+  use molbuilder_classify_type
+  use molbuilder_classify_func
+  implicit none
+  private
+
+  !> RE-EXEPORTS
+  public :: coord_classify  !> the extended coord type
+  public :: setup_classify  !> setup a coord_classify from coord
+  public :: atinfo_classify !> add atinfo string to a coord_classify
+  public :: functional_group_classify !> try to determine some functional groups
+
+!==============================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!==============================================================================!
+
+end module molbuilder_classify
diff --git a/src/molbuilder/classify_func.f90 b/src/molbuilder/classify_func.f90
new file mode 100644
index 00000000..13bc1bc4
--- /dev/null
+++ b/src/molbuilder/classify_func.f90
@@ -0,0 +1,302 @@
+!=============================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!=============================================================================!
+
+module molbuilder_classify_func
+  use crest_parameters,only:wp,stdout
+  use strucrd,only:coord,i2e
+  use adjacency
+  use canonical_mod
+  use molbuilder_classify_type
+  use quicksort_interface,only:qqsorti
+  implicit none
+  private
+
+  public :: functional_group_classify !> try to determine some functional groups
+
+!==============================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!==============================================================================!
+
+!> FUNCTIONAL GROUP CLASSIFICATION ROUTINES
+
+  subroutine functional_group_classify(molc)
+    implicit none
+    type(coord_classify),intent(inout) :: molc
+    type(functional_group) :: fg
+    integer :: ii,jj,nn,nfunc,nfunc2
+    logical :: success,updated,duplicate
+
+    if (.not.allocated(molc%atinfo)) then
+      call atinfo_classify(molc)
+    end if
+
+    !> basic functional groups from single atoms
+    do ii = 1,molc%nat
+      call functional_group_classify_simple(molc,ii,fg,success)
+      if (success) then
+        call molc%add(fg)
+      end if
+    end do
+
+    updated = .true.
+    nfunc = molc%nfuncs
+    do while (updated)
+
+      do ii = 1,nfunc
+        if (molc%funcgroups(ii)%seeded) cycle
+        call functional_group_classify_extended(molc,ii,fg,success)
+        if (success) then
+          !> check for duplicates, only add new ones
+          duplicate = .false.
+          nfunc2 = molc%nfuncs
+          do jj = 1,nfunc2
+            if (molc%funcgroups(jj)%natms .ne. fg%natms) cycle
+            if (all(molc%funcgroups(jj)%ids .eq. fg%ids)) duplicate = .true.
+          end do
+          if (.not.duplicate) call molc%add(fg)
+        end if
+        molc%funcgroups(ii)%seeded = .true.
+      end do
+
+      nn = molc%nfuncs
+      if (nn == nfunc) then
+        updated = .false.
+      else
+        nfunc = nn
+      end if
+    end do
+
+  end subroutine functional_group_classify
+
+  subroutine functional_group_classify_simple(molc,ii,fg,success)
+    implicit none
+    type(coord_classify),intent(in) :: molc
+    type(functional_group),intent(out) :: fg
+    integer,intent(in) :: ii
+    logical,intent(out) :: success
+    integer :: jj,kk
+    success = .false.
+    call fg%clear()
+    select case (trim(molc%atinfo(ii)))
+    case ('CH3')
+      fg%name = 'methyl'
+      fg%natms = 4
+      allocate (fg%ids(4),source=0)
+      fg%ids(1) = ii
+      kk = 1
+      do jj = 1,molc%nat
+        if (molc%bond(jj,ii) == 1) then
+          if (molc%at(jj) == 1) then
+            kk = kk+1
+            fg%ids(kk) = jj
+          else
+            fg%attached_to = jj
+          end if
+        end if
+      end do
+      success = .true.
+
+    case ('OH')
+      fg%name = "hydroxy"
+      fg%natms = 2
+      allocate (fg%ids(2),source=0)
+      fg%ids(1) = ii
+      kk = 1
+      do jj = 1,molc%nat
+        if (molc%bond(jj,ii) == 1) then
+          if (molc%at(jj) == 1) then
+            kk = kk+1
+            fg%ids(kk) = jj
+          else
+            fg%attached_to = jj
+          end if
+        end if
+      end do
+      success = .true.
+
+    case ('SH')
+      fg%name = "thiol"
+      fg%natms = 2
+      allocate (fg%ids(2),source=0)
+      fg%ids(1) = ii
+      kk = 1
+      do jj = 1,molc%nat
+        if (molc%bond(jj,ii) == 1) then
+          if (molc%at(jj) == 1) then
+            kk = kk+1
+            fg%ids(kk) = jj
+          else
+            fg%attached_to = jj
+          end if
+        end if
+      end do
+      success = .true.
+
+    case ('NH2','NR2','NR3')
+      fg%name = "amine"
+      if (trim(molc%atinfo(ii)) == 'NH2') fg%name = fg%name//' (1°)'
+      if (trim(molc%atinfo(ii)) == 'NR2') fg%name = fg%name//' (2°)'
+      if (trim(molc%atinfo(ii)) == 'NR3') fg%name = fg%name//' (3°)'
+      fg%natms = 3
+      allocate (fg%ids(3),source=0)
+      fg%ids(1) = ii
+      kk = 1
+      do jj = 1,molc%nat
+        if (molc%bond(jj,ii) == 1) then
+          if (molc%at(jj) == 1) then
+            kk = kk+1
+            fg%ids(kk) = jj
+          else
+            !TODO: logic for NR2 and NR3
+            fg%attached_to = jj
+          end if
+        end if
+      end do
+      success = .true.
+
+    case ('o')
+      fg%natms = 2
+      allocate (fg%ids(2),source=0)
+      fg%ids(1) = ii
+      kk = 1
+      do jj = 1,molc%nat
+        if (molc%bond(jj,ii) == 1) then
+          if (molc%at(jj) == 6) then
+            kk = kk+1
+            fg%ids(kk) = jj
+            fg%attached_to = jj
+          end if
+        end if
+      end do
+      if (kk == 2) then
+        fg%name = 'carbonyl'
+      end if
+      success = .true.
+
+    case ('F','Cl','Br','I')
+      fg%name = 'halide'
+      fg%natms = 1
+      allocate (fg%ids(1),source=ii)
+      fg%attached_to = maxloc(molc%bond(:,ii),1)
+      success = .true.
+
+    end select
+  end subroutine functional_group_classify_simple
+
+  subroutine functional_group_classify_extended(molc,ii,fg,success)
+    implicit none
+    type(coord_classify),intent(inout) :: molc
+    type(functional_group),intent(out) :: fg
+    integer,intent(in) :: ii
+    logical,intent(out) :: success
+    integer :: jj,kk
+    success = .false.
+    call fg%clear()
+    select case (trim(molc%funcgroups(ii)%name))
+    case ('methyl')
+
+      !> n-alkyl chains always start from methyl
+      call check_alkyl(molc,ii,fg,success)
+      if (success) then
+        fg%natms = count(molc%lwork)
+        allocate (fg%ids(fg%natms),source=0)
+        kk = 0
+        do jj = 1,molc%nat
+          if (molc%lwork(jj)) then
+            kk = kk+1
+            fg%ids(kk) = jj
+          end if
+        end do
+        call qqsorti(fg%ids,1,fg%natms)
+      end if
+
+    end select
+  end subroutine functional_group_classify_extended
+
+!=============================================================================!
+!#############################################################################!
+!=============================================================================!
+
+!> routines to check for specific functional groups
+
+  subroutine check_alkyl(molc,istart,fg,success)
+    implicit none
+    type(coord_classify),intent(inout) :: molc
+    type(functional_group),intent(out) :: fg
+    integer,intent(in) :: istart
+    logical,intent(out) :: success
+    logical :: contin
+    integer :: ii,jj,nat,ati,atii
+
+    success = .false.
+
+    !> prepare
+    nat = molc%nat
+    if (.not.allocated(molc%lwork)) allocate (molc%lwork(nat))
+
+    molc%lwork(:) = .false.
+    ati = molc%funcgroups(istart)%ids(1)
+    do ii = 1,molc%funcgroups(istart)%natms
+      molc%lwork(molc%funcgroups(istart)%ids(ii)) = .true.
+    end do
+    !> walk
+    contin = .true.
+    atii = ati
+    do while (contin)
+      do ii = 1,nat
+        if (molc%lwork(ii)) cycle !> skip alreaty iterated atoms
+        if (molc%bond(ii,ati) == 1) then
+          if (molc%at(ii) == 1) then
+            molc%lwork(ii) = .true. !> H's simply set to true
+          else if (molc%at(ii) == 6) then
+            if (trim(molc%atinfo(ii)) == 'CH2') then
+              !> continue chain
+              fg%name = 'alkyl'
+              success = .true. !> at the first occurence of CH2 we have at least ethyl
+              atii = ii
+              molc%lwork(ii) = .true.
+            else if (trim(molc%atinfo(ii)) == 'CH3') then
+              !> continue chain
+              fg%name = 'alkane'
+              success = .true. !> at the first occurence of CH2 we have at least ethyl
+              atii = ii
+              molc%lwork(ii) = .true.
+            else
+              !> terminate chain on non-CH2
+              if (success) fg%attached_to = ii
+              contin = .false.
+            end if
+          else
+            !> terminate chain for hetero atoms
+            if (success) fg%attached_to = ii
+            contin = .false.
+          end if
+        end if
+      end do
+      if (atii == ati) contin = .false.
+      ati = atii
+    end do
+
+  end subroutine check_alkyl
+
+!=============================================================================!
+!#############################################################################!
+!=============================================================================!
+end module molbuilder_classify_func
+
diff --git a/src/molbuilder/classify_type.f90 b/src/molbuilder/classify_type.f90
new file mode 100644
index 00000000..2ef6c882
--- /dev/null
+++ b/src/molbuilder/classify_type.f90
@@ -0,0 +1,606 @@
+!=============================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!=============================================================================!
+
+module molbuilder_classify_type
+  use crest_parameters,only:wp,stdout
+  use strucrd,only:coord,i2e,sumform
+  use adjacency
+  use canonical_mod
+  use molbuilder_rigidconf_analyze
+  use INTERNALS_mod
+  implicit none
+  private
+
+  type :: functional_group
+    character(len=:),allocatable :: name
+    integer :: natms = 0
+    integer,allocatable :: ids(:)
+    integer :: attached_to = 0
+    logical :: seeded = .false.
+  contains
+    procedure :: clear => clear_func_group
+    procedure :: copy => copy_func_group
+  end type functional_group
+
+  type,private:: dihedral_types
+    integer :: unknown = 0
+    integer :: single = 1
+    integer :: improper = 2
+    integer :: stiff = 3
+    integer :: macrocycle = 4
+  end type dihedral_types
+  type(dihedral_types),parameter,public :: dtypes = dihedral_types()
+
+  type,extends(coord) :: coord_classify
+    !> new components that are added to the coord type:
+    !integer,allocatable :: A(:,:)  !> molecular graph/adjacency matrix
+    integer,allocatable :: Ah(:,:) !> heavy-atom molecular graph/adjacency
+
+    !> per-atom properties/information
+    real(wp),allocatable :: CN(:)               !> coordination number
+    integer,allocatable :: hyb(:)               !> hybridization/neighbours count
+    integer,allocatable :: nhn(:)               !> non-H-neighbours count
+    integer,allocatable :: prio(:)              !> "invariants"/atom priorities
+    logical,allocatable :: inring(:)            !> atom part of ring?
+    logical,allocatable :: term(:)              !> terminal atom (H,F,Cl,...,=O,etc.)
+    character(len=10),allocatable :: atinfo(:)  !> atom info
+
+    !> functional groups
+    integer :: nfuncs = 0
+    type(functional_group),allocatable :: funcgroups(:)
+
+    !> internal coordinates
+    integer :: ndieder = 0
+    real(wp),allocatable :: zmat(:,:)
+    integer,allocatable  :: zmap(:,:) !> na,nb,nc
+    integer,allocatable  :: ztod(:)
+    integer,allocatable  :: hatsort(:,:)
+    integer,allocatable  :: dtype(:)
+
+    !> utility storage
+    logical,allocatable :: lwork(:)
+    integer,allocatable :: iwork(:)
+
+  contains
+    procedure :: as_coord
+    procedure :: from_coord
+    generic,public :: add => coord_classify_add_fg
+    procedure,private :: coord_classify_add_fg
+    procedure :: get_zmat => coord_classify_calculate_zmat
+    procedure :: from_zmat => coord_classify_reconstruct_from_zmat
+    procedure :: update_zmat => coord_classify_update_zmat
+    procedure :: check_dihedrals => coord_classify_check_dihedrals
+    procedure :: print_funcgroups => coord_classify_print_functional
+    procedure :: print_zmat => coord_classify_print_zmat
+  end type coord_classify
+
+  public :: coord_classify   !> the extended coord type
+  public :: functional_group !> subtype of coord_classify
+  public :: setup_classify   !> setup a coord_classify from coord
+  public :: atinfo_classify  !> add atinfo string to a coord_classify
+
+!==============================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!==============================================================================!
+
+!> BASIC TYPE PROCEDURES
+
+  function as_coord(this) result(mol)
+    class(coord_classify),intent(in) :: this
+    type(coord) :: mol
+
+    mol%nat = this%nat
+    if (allocated(this%at)) mol%at = this%at
+    if (allocated(this%xyz)) mol%xyz = this%xyz
+
+    mol%energy = this%energy
+    if (allocated(this%comment)) mol%comment = this%comment
+    mol%chrg = this%chrg
+    mol%uhf = this%uhf
+    mol%nbd = this%nbd
+    if (allocated(this%bond)) mol%bond = this%bond
+    if (allocated(this%lat)) mol%lat = this%lat
+    if (allocated(this%qat)) mol%qat = this%qat
+    mol%pdb = this%pdb
+
+  end function as_coord
+
+  subroutine from_coord(this,mol)
+    class(coord_classify),intent(inout) :: this
+    type(coord),intent(in) :: mol
+
+    this%nat = mol%nat
+    if (allocated(mol%at)) this%at = mol%at
+    if (allocated(mol%xyz)) this%xyz = mol%xyz
+
+    this%energy = mol%energy
+    if (allocated(mol%comment)) this%comment = mol%comment
+    this%chrg = mol%chrg
+    this%uhf = mol%uhf
+    this%nbd = mol%nbd
+    if (allocated(mol%bond)) this%bond = mol%bond
+    if (allocated(mol%lat)) this%lat = mol%lat
+    if (allocated(mol%qat)) this%qat = mol%qat
+    this%pdb = mol%pdb
+  end subroutine from_coord
+
+  subroutine clear_func_group(self)
+    implicit none
+    class(functional_group) :: self
+    if (allocated(self%name)) deallocate (self%name)
+    if (allocated(self%ids)) deallocate (self%ids)
+    self%attached_to = 0
+    self%natms = 0
+    self%seeded = .false.
+  end subroutine clear_func_group
+
+  subroutine copy_func_group(self,fg)
+    implicit none
+    class(functional_group) :: self
+    type(functional_group) :: fg
+    if (allocated(fg%name)) self%name = fg%name
+    if (allocated(fg%ids)) self%ids = fg%ids
+    self%attached_to = fg%attached_to
+    self%natms = fg%natms
+    self%seeded = fg%seeded
+  end subroutine copy_func_group
+
+  subroutine coord_classify_add_fg(self,fg)
+    implicit none
+    class(coord_classify) :: self
+    type(functional_group) :: fg
+    type(functional_group),allocatable :: fg_list(:)
+    integer :: ii,jj
+    if (.not.allocated(self%funcgroups)) then
+      allocate (self%funcgroups(1))
+      call self%funcgroups(1)%copy(fg)
+    else
+      ii = size(self%funcgroups,1)
+      allocate (fg_list(ii+1))
+      do jj = 1,ii
+        call fg_list(jj)%copy(self%funcgroups(jj))
+      end do
+      call fg_list(ii+1)%copy(fg)
+      call move_alloc(fg_list,self%funcgroups)
+    end if
+    self%nfuncs = size(self%funcgroups,1)
+  end subroutine coord_classify_add_fg
+
+!=============================================================================!
+!#############################################################################!
+!=============================================================================!
+
+!> CLASSIFICATION ROUTINES
+
+  subroutine setup_classify(mol,molc,wbo)
+    !***************************************************
+    !* set up the derived coord_classify object "molc"
+    !* from a standard coord object "mol".
+    !* in particular, adjacency graphs, CN, etc.
+    !***************************************************
+    implicit none
+    type(coord),intent(in) :: mol
+    type(coord_classify),intent(out) :: molc
+    real(wp),intent(in),optional :: wbo(:,:)
+
+    real(wp),allocatable :: Bmat(:,:)
+    logical,allocatable :: rings(:,:)
+    type(canonical_sorter),allocatable :: tmpcan
+    integer :: nat
+    integer :: ii,jj
+
+    !> Initialize
+    call molc%from_coord(mol)
+    nat = molc%nat
+
+    !> set up CN, and from that topology
+    call mol%cn_to_bond(molc%CN,Bmat,'cov')
+    if (present(wbo)) then
+      Bmat(:,:) = wbo(:,:)
+    end if
+    call wbo2adjacency(molc%nat,Bmat,molc%bond,0.02_wp)
+    deallocate (Bmat)
+
+    !> set up other parameters
+    allocate (molc%hyb(nat),source=0)
+    allocate (molc%inring(nat),source=.false.)
+    allocate (molc%term(nat),source=.false.)
+    call check_rings_min(nat,molc%bond,rings)
+    do ii = 1,nat
+      molc%hyb(ii) = sum(molc%bond(:,ii))
+      if (any(rings(:,ii))) molc%inring(ii) = .true.
+      if (molc%hyb(ii) .eq. 1) molc%term(ii) = .true.
+    end do
+
+    allocate (tmpcan)
+    call tmpcan%init(mol,invtype='apsp+',heavy=.false.)
+    call move_alloc(tmpcan%rank,molc%prio)
+    call move_alloc(tmpcan%hadjac,molc%Ah)
+    deallocate (tmpcan)
+
+    allocate (molc%nhn(nat),source=0)
+    do ii = 1,nat
+      molc%nhn(ii) = sum(molc%Ah(:,ii))
+    end do
+
+  end subroutine setup_classify
+
+  subroutine atinfo_classify(molc)
+    !*****************************************
+    !* Update a coord_classify object "molc"
+    !* and fill in its atinfo strings based
+    !* on some basic chemoinformatics.
+    !****************************************
+    implicit none
+    type(coord_classify),intent(inout) :: molc
+    integer :: nat
+    integer :: ii,jj
+
+    if (molc%nat <= 0) then
+      write (stdout,*) 'molc not allocated in atinfo_classify()'
+      return
+    end if
+    if (allocated(molc%atinfo)) deallocate (molc%atinfo)
+    nat = molc%nat
+    allocate (molc%atinfo(nat),source=repeat(' ',10))
+
+    do ii = 1,molc%nat
+      associate (str => molc%atinfo(ii),ati => molc%at(ii))
+        str = trim(i2e(ati))
+        select case (ati)
+
+        case (6) !> carbon
+          if (molc%hyb(ii) == 3) then !> sp2
+            str = trim(i2e(ati,'lc'))
+          else if (molc%hyb(ii) == 4) then !> sp3
+            if (molc%nhn(ii) == 1) then
+              str = trim(str)//'H3'
+            else if (molc%nhn(ii) == 2) then
+              str = trim(str)//'H2'
+            else if (molc%nhn(ii) == 0) then
+              str = 'methane'
+            end if
+          end if
+
+        case (7) !> nitrogen
+          if (molc%hyb(ii) == 3) then
+            if (molc%nhn(ii) == 1) then
+              str = trim(str)//'H2'
+            else if (molc%nhn(ii) == 2) then
+              str = trim(str)//'R2'
+            else if (molc%nhn(ii) == 3) then
+              str = trim(str)//'R3'
+            else if (molc%nhn(ii) == 0) then
+              str = 'ammonia'
+            end if
+          else if (molc%hyb(ii) == 4) then
+            str = trim(str)//'4+'
+          end if
+
+        case (8) !> oxygen
+          if (molc%hyb(ii) == 1) then
+            str = 'o'
+          else if (molc%hyb(ii) == 2) then
+            if (molc%nhn(ii) == 1) then
+              str = trim(str)//'H'
+            else if (molc%nhn(ii) == 0) then
+              str = 'water'
+            end if
+          end if
+
+        case (16) !> sulfur
+          if (molc%hyb(ii) == 2) then
+            if (molc%nhn(ii) == 1) then
+              str = trim(str)//'H'
+            end if
+          end if
+
+        end select
+      end associate
+    end do
+  end subroutine atinfo_classify
+
+  subroutine coord_classify_calculate_zmat(molc,natural)
+    implicit none
+    class(coord_classify),intent(inout) :: molc
+    logical,intent(in),optional :: natural
+
+    if (.not.allocated(molc%xyz)) return
+
+    if (allocated(molc%zmat)) deallocate (molc%zmat)
+    if (allocated(molc%zmap)) deallocate (molc%zmap)
+    if (allocated(molc%ztod)) deallocate (molc%ztod)
+
+    if (present(natural)) then
+      if (natural) then
+        !write (stdout,'(/,a)') 'NOTE: atom order will temporarily be changed!'
+        call coord_classify_hatsort(molc)
+      end if
+    end if
+
+    allocate (molc%zmap(molc%nat,3),source=0)
+    allocate (molc%zmat(3,molc%nat),source=0.0_wp)
+    call BETTER_XYZINT(molc%nat,molc%xyz,molc%bond, &
+    &    molc%zmap(:,1),molc%zmap(:,2),molc%zmap(:,3),molc%zmat)
+
+    allocate (molc%ztod(molc%nat),source=0)
+    call rigidconf_count_fallback(molc%nat, &
+   & molc%zmap(:,1),molc%zmap(:,2),molc%zmap(:,3), &
+   & molc%bond,molc%ndieder,molc%ztod)
+    if (present(natural)) then
+      if (natural) then
+        call prune_zmat_dihedrals(molc,molc%zmat, &
+        & molc%zmap(:,1),molc%zmap(:,2),molc%zmap(:,3),molc%ztod, &
+        hpyrad=.true.,bond=molc%bond)
+        !call molc%print_zmat(stdout)
+        call coord_classify_hatsort_restore(molc)
+        deallocate (molc%hatsort)
+      end if
+    end if
+
+  end subroutine coord_classify_calculate_zmat
+
+  subroutine coord_classify_reconstruct_from_zmat(molc,mol)
+    implicit none
+    class(coord_classify),intent(inout) :: molc
+    type(coord),intent(out),optional :: mol
+
+    if (.not.allocated(molc%zmat)) then
+      write (stdout,*) '** ERROR ** in coord_classify_reconstruct_from_zmat(): zmat not allocated!'
+      return
+    end if
+    call GMETRY2(molc%nat,molc%zmat, &
+      &              molc%xyz,        &
+      &  molc%zmap(:,1),molc%zmap(:,2),molc%zmap(:,3))
+
+    if (present(mol)) then
+      mol = molc%as_coord()
+    end if
+  end subroutine coord_classify_reconstruct_from_zmat
+
+  subroutine coord_classify_update_zmat(molc,mol)
+    !************************************************************
+    !* Update the Z-matrix with fresh coords from Cartesian ones
+    !* (The mapping must exist at this point)
+    !************************************************************
+    implicit none
+    class(coord_classify),intent(inout) :: molc
+    type(coord),intent(in),optional :: mol
+    integer :: ii,jj,a,b,c,d
+
+    if (.not.allocated(molc%zmat)) then
+      write (stdout,*) '** ERROR ** in coord_classify_update_zmat(): zmat not allocated!'
+      return
+    end if
+    if (.not.allocated(molc%zmap)) then
+      write (stdout,*) '** ERROR ** in coord_classify_update_zmat(): zmapping not allocated!'
+      return
+    end if
+    if (present(mol)) then
+      if (.not.all(mol%at .eq. molc%at)) then
+        write (stdout,*) '** ERROR ** in coord_classify_update_zmat(): mismatch in atom order'
+        return
+      end if
+      molc%xyz = mol%xyz
+    end if
+    do a = 1,molc%nat
+      b = molc%zmap(a,1)
+      if (b == 0) cycle
+      molc%zmat(1,a) = molc%dist(a,b)
+      c = molc%zmap(a,2)
+      if (c == 0) cycle
+      molc%zmat(2,a) = molc%angle(a,b,c)
+      d = molc%zmap(a,3)
+      if (d == 0) cycle
+      molc%zmat(3,a) = molc%dihedral(a,b,c,d)
+    end do
+  end subroutine coord_classify_update_zmat
+
+  subroutine coord_classify_check_dihedrals(molc)
+    !************************************************************
+    !* Attempt to assign dihedral angles to a type of dihedral
+    !************************************************************
+    implicit none
+    class(coord_classify),intent(inout) :: molc
+    integer :: ii,jj,a,b,c,d
+
+    if (.not.allocated(molc%zmap)) then
+      write (stdout,*) '** ERROR ** in coord_classify_update_zmat(): zmapping not allocated!'
+      return
+    end if
+
+    if (allocated(molc%dtype)) deallocate (molc%dtype)
+    allocate (molc%dtype(molc%nat),source=dtypes%unknown)
+
+    do ii = 1,molc%nat
+      if (molc%zmap(3,ii) .eq. 0) cycle
+      a = ii
+      b = molc%zmap(ii,1)
+      c = molc%zmap(ii,2)
+      d = molc%zmap(ii,3)
+
+      if (molc%bond(a,b) > 0.and. &
+      &  molc%bond(b,c) > 0.and. &
+      &  molc%bond(c,d) > 0) then
+        molc%dtype(ii) = dtypes%single
+      else if(molc%bond(a,b) > 0.and. & 
+      &       molc%bond(b,c) > 0.and. &  
+      &       molc%bond(b,d) > 0) then   
+        molc%dtype(ii) = dtypes%improper
+      end if
+      !write(*,*) ii, molc%dtype(ii)
+    end do
+
+  end subroutine coord_classify_check_dihedrals
+
+!=============================================================================!
+
+  subroutine coord_classify_hatsort(molc)
+    !**************************************************************
+    !* a routine that resorts the atomorder in molc so that
+    !* hydrogen atoms come last. required for natural z-mat setup
+    !* Also mapps the order to restore it later on
+    !**************************************************************
+    implicit none
+    class(coord_classify),intent(inout) :: molc
+
+    real(wp),allocatable :: xyztmp(:,:)
+    integer,allocatable :: attmp(:),bondtmp(:,:)
+
+    integer :: ii,kk,jj
+    if (allocated(molc%hatsort)) deallocate (molc%hatsort)
+    allocate (molc%hatsort(molc%nat,2),source=0)
+    allocate (attmp(molc%nat),source=0)
+    allocate (xyztmp(3,molc%nat),source=0.0_wp)
+
+    kk = 0
+    !> heavy atoms
+    do ii = 1,molc%nat
+      if (molc%at(ii) .ne. 1) then
+        kk = kk+1
+        molc%hatsort(kk,1) = ii
+        molc%hatsort(ii,2) = kk
+        xyztmp(1:3,kk) = molc%xyz(1:3,ii)
+        attmp(kk) = molc%at(ii)
+      end if
+    end do
+    !> hydrogen
+    do ii = 1,molc%nat
+      if (molc%at(ii) .eq. 1) then
+        kk = kk+1
+        molc%hatsort(kk,1) = ii
+        molc%hatsort(ii,2) = kk
+        xyztmp(1:3,kk) = molc%xyz(1:3,ii)
+        attmp(kk) = molc%at(ii)
+      end if
+    end do
+
+    call move_alloc(xyztmp,molc%xyz)
+    call move_alloc(attmp,molc%at)
+
+    if (allocated(molc%bond)) then
+      allocate (bondtmp(molc%nat,molc%nat),source=0)
+      do ii = 1,molc%nat
+        do jj = 1,molc%nat
+          bondtmp(molc%hatsort(jj,2),molc%hatsort(ii,2)) = molc%bond(jj,ii)
+        end do
+      end do
+      call move_alloc(bondtmp,molc%bond)
+    end if
+  end subroutine coord_classify_hatsort
+
+  subroutine coord_classify_hatsort_restore(molc)
+    !**********************************************
+    !* Restore original order from h-atom sorting
+    !*********************************************
+    implicit none
+    class(coord_classify),intent(inout) :: molc
+
+    real(wp),allocatable :: xyztmp(:,:)
+    integer,allocatable :: attmp(:),bondtmp(:,:)
+    integer,allocatable :: ztodtmp(:),zmaptmp(:,:)
+    real(wp),allocatable :: zmattmp(:,:)
+    integer :: ii,kk,jj
+    if (.not.allocated(molc%hatsort)) return
+
+    allocate (attmp(molc%nat),source=0)
+    allocate (xyztmp(3,molc%nat),source=0.0_wp)
+    do ii = 1,molc%nat
+      kk = molc%hatsort(ii,1)
+      xyztmp(1:3,kk) = molc%xyz(1:3,ii)
+      attmp(kk) = molc%at(ii)
+    end do
+    call move_alloc(xyztmp,molc%xyz)
+    call move_alloc(attmp,molc%at)
+    if (allocated(molc%bond)) then
+      allocate (bondtmp(molc%nat,molc%nat),source=0)
+      do ii = 1,molc%nat
+        do jj = 1,molc%nat
+          bondtmp(molc%hatsort(jj,1),molc%hatsort(ii,1)) = molc%bond(jj,ii)
+        end do
+      end do
+      call move_alloc(bondtmp,molc%bond)
+    end if
+
+    allocate (ztodtmp(molc%nat),source=0)
+    allocate (zmaptmp(molc%nat,3),source=0)
+    allocate (zmattmp(3,molc%nat),source=0.0_wp)
+    do ii = 1,molc%nat
+      ztodtmp(molc%hatsort(ii,1)) = molc%ztod(ii)
+      zmattmp(1:3,molc%hatsort(ii,1)) = molc%zmat(1:3,ii)
+      do jj = 1,3
+        if (molc%zmap(ii,jj) > 0) then
+          zmaptmp(molc%hatsort(ii,1),jj) = molc%hatsort(molc%zmap(ii,jj),1)
+        else
+          zmaptmp(molc%hatsort(ii,1),jj) = 0
+        end if
+      end do
+    end do
+    call move_alloc(ztodtmp,molc%ztod)
+    call move_alloc(zmaptmp,molc%zmap)
+    call move_alloc(zmattmp,molc%zmat)
+  end subroutine coord_classify_hatsort_restore
+
+!=============================================================================!
+!#############################################################################!
+!=============================================================================!
+
+!> PRINTOUTS and naming
+
+  subroutine coord_classify_print_functional(self,prch)
+    implicit none
+    class(coord_classify) :: self
+    integer,intent(in) :: prch
+
+    integer,allocatable :: at(:)
+    integer :: ii,jj,nn
+
+    if (.not.allocated(self%funcgroups)) return
+
+    do ii = 1,size(self%funcgroups,1)
+      nn = self%funcgroups(ii)%natms
+      allocate (at(nn),source=0)
+      do jj = 1,nn
+        at(jj) = self%at(self%funcgroups(ii)%ids(jj))
+      end do
+      write (prch,'(3(1x,a))') 'functional group:', &
+        & self%funcgroups(ii)%name,sumform(nn,at)
+      deallocate (at)
+    end do
+  end subroutine coord_classify_print_functional
+
+  subroutine coord_classify_print_zmat(self,prch)
+    implicit none
+    class(coord_classify) :: self
+    integer,intent(in) :: prch
+    if (.not.allocated(self%zmat)) then
+      write (prch,*) 'zmat not allocated!'
+      return
+    end if
+
+    write (prch,'(/,a)') 'Internal coordinates:'
+    call print_zmat(prch,self%nat,self%at,self%zmat, &
+    &    self%zmap(:,1),self%zmap(:,2),self%zmap(:,3),.true.)
+  end subroutine coord_classify_print_zmat
+
+!=============================================================================!
+!#############################################################################!
+!=============================================================================!
+end module molbuilder_classify_type
+
diff --git a/src/molbuilder/construct.f90 b/src/molbuilder/construct.f90
new file mode 100644
index 00000000..4f00765e
--- /dev/null
+++ b/src/molbuilder/construct.f90
@@ -0,0 +1,1127 @@
+module molbuilder_construct_mod
+  !***********************************************
+  !* A module for constructing molecules
+  !* E.g. replacing functional groups and so on
+  !***********************************************
+  use crest_parameters
+  use strucrd
+  use irmsd_module
+  use adjacency
+  use miscdata,only:rcov
+  implicit none
+  private
+
+  public :: attach
+
+  public :: split
+  interface split
+    module procedure split_onbond
+    module procedure split_onshared
+  end interface split
+
+  public :: binarysplit
+  interface binarysplit
+    module procedure binarysplit_onshared
+  end interface binarysplit
+
+!=============================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!=============================================================================!
+
+  subroutine attach(base,side,alignmap,new,clash, &
+      & original_map,remove_base,remove_side,remove_lastx,reficn)
+    !***********************************************************************
+    !* This routine attaches a side-molecule to a base-molecule
+    !* The assumption is that we have (at least) 3 proxy atoms
+    !* that are used to match the side to the base, specified
+    !* via the alignmap.
+    !* Args:
+    !*   base  - base molecule
+    !*   side  - side chain molecule to attach to base
+    !*  alignmap - (x,2) specification list of x proxy atoms in side/base
+    !*    new  - newly constructed molecule
+    !*
+    !* Optionl args:
+    !*         clash - logical, were clashes produced?
+    !*  original_map - original atom position mapping
+    !*   remove_base - list of atoms to remove from base upon
+    !*                 constructing the new mol
+    !*   remove_side - list of atoms to remove from side upon
+    !*                 constructing the new mol
+    !*   remove_lastx - integer (one for base and side) to remove
+    !*                  final x atoms in constructing new mol
+    !*   reficn       - CNs of the reference structure as integers
+    !***********************************************************************
+    implicit none
+    !> IN/OUTPUTS
+    type(coord),intent(in) :: base
+    type(coord),intent(in) :: side
+    integer,intent(in) :: alignmap(:,:)
+    type(coord),intent(out) :: new
+
+    logical,intent(out),optional :: clash
+    integer,intent(in),optional :: original_map(:,:)
+    integer,intent(in),optional :: remove_base(:)
+    integer,intent(in),optional :: remove_side(:)
+    integer,intent(in),optional :: remove_lastx(:)
+    integer,intent(in),optional :: reficn(:)
+
+    !> LOCAL
+    type(coord) :: cutout_base,cutout_side,side_tmp
+    logical,allocatable :: cutlist_base(:),cutlist_side(:)
+    integer,allocatable :: current_order(:),target_order(:),idx(:)
+    integer,allocatable :: revorder_base(:),revorder_side(:)
+    real(wp) :: rms,Umat(3,3),shift(3),center_base(3),center_side(3)
+    real(wp),allocatable :: cn(:)
+    integer :: nalign,nat_new
+    logical :: closcontact,failconstruct
+    integer :: ii,jj,kk,ll
+
+    character(len=*),parameter :: source = "attach()"
+    real(wp),parameter :: closedist = 0.95_wp
+
+    !> defaults/checks of the alignmap
+    nalign = size(alignmap,1)
+    if (nalign < 3) then
+      error stop source//": alignmap needs at least 3 atoms"
+    end if
+    if (size(alignmap,2) .ne. 2) then
+      error stop source//": alignmap has wrong dimension"
+    end if
+    !> alignmap(:,1) --> base atoms
+    if (any(alignmap(:,1) > base%nat).or.any(alignmap(:,1) < 1)) then
+      error stop source//": alignmap(:,1) has invalid values"
+    end if
+    !> alignmap(:,2) --> side atoms
+    if (any(alignmap(:,2) > side%nat).or.any(alignmap(:,2) < 1)) then
+      error stop source//": alignmap(:,2) has invalid values"
+    end if
+
+    !> helper arrays
+    allocate (target_order(nalign),current_order(nalign),idx(nalign),source=0)
+
+    !> generate cutout of base
+    allocate (cutlist_base(base%nat),source=.false.)
+    kk = 0
+    do ii = 1,nalign
+      cutlist_base(alignmap(ii,1)) = .true.
+      current_order(ii) = ii
+    end do
+    kk = 0
+    do ii = 1,base%nat
+      do jj = 1,nalign
+        if (alignmap(jj,1) == ii) then
+          kk = kk+1
+          target_order(kk) = jj
+        end if
+      end do
+    end do
+    cutout_base = base%cutout(cutlist_base)
+    call molatomsort(cutout_base,nalign,current_order,target_order,idx)
+
+    !> generate cutout of side
+    allocate (cutlist_side(side%nat),source=.false.)
+    do ii = 1,nalign
+      cutlist_side(alignmap(ii,2)) = .true.
+      current_order(ii) = ii
+    end do
+    kk = 0
+    do ii = 1,side%nat
+      do jj = 1,nalign
+        if (alignmap(jj,2) == ii) then
+          kk = kk+1
+          target_order(kk) = jj
+        end if
+      end do
+    end do
+    cutout_side = side%cutout(cutlist_side)
+    call molatomsort(cutout_side,nalign,current_order,target_order,idx)
+
+    !> determine offset and translate
+    do ii = 1,3
+      center_base(ii) = sum(cutout_base%xyz(ii,:))/real(cutout_base%nat)
+      center_side(ii) = sum(cutout_side%xyz(ii,:))/real(cutout_side%nat)
+    end do
+    shift(1:3) = center_base(1:3)-center_side(1:3)
+
+    !> determine the rotation matrix and translation
+    rms = rmsd(cutout_base,cutout_side,rotmat=Umat)
+
+    !> build the new rotated and translated side molecule
+    side_tmp = side
+    side_tmp%xyz = matmul(Umat,side_tmp%xyz)
+    !> determine offset and translate
+    shift = 0.0_wp
+    do jj = 1,nalign
+      shift(:) = shift(:)+base%xyz(:,alignmap(jj,1))-side_tmp%xyz(:,alignmap(jj,2))
+    end do
+    shift(:) = shift(:)/real(nalign)
+    do ii = 1,side_tmp%nat
+      side_tmp%xyz(1:3,ii) = side_tmp%xyz(1:3,ii)+shift(1:3)
+    end do
+
+    !> construct the new molecule, re-use cutlists
+    cutlist_base(:) = .false.
+    cutlist_side(:) = .false.
+    do ii = 1,nalign
+      !> always remove the align atoms on the side chain
+      cutlist_side(alignmap(ii,2)) = .true.
+    end do
+    if (present(remove_base)) then
+      !> optional removal on the base side
+      kk = size(remove_base,1)
+      do ii = 1,kk
+        cutlist_base(remove_base(ii)) = .true.
+      end do
+    end if
+    if (present(remove_side)) then
+      !> optional removal on the base side
+      kk = size(remove_side,1)
+      do ii = 1,kk
+        cutlist_side(remove_side(ii)) = .true.
+      end do
+    end if
+    if (present(remove_lastx)) then
+      !> useful for not transfering appended capping atoms
+      do ii = base%nat-(remove_lastx(1)-1),base%nat
+        cutlist_base(ii) = .true.
+      end do
+      do ii = side%nat-(remove_lastx(2)-1),side%nat
+        cutlist_side(ii) = .true.
+      end do
+    end if
+    allocate (revorder_base(base%nat),source=0)
+    allocate (revorder_side(side%nat),source=0)
+    if (present(original_map)) then
+      !> if we have info on the original order, avoid all atoms
+      !> present in all fragments
+      closcontact = .false.
+      do ii = 1,size(original_map,1)
+        if (all(original_map(ii,:) .ne. 0)) then
+          if (.not.closcontact) then
+            cutlist_side(original_map(ii,2)) = .true.
+          else
+            cutlist_base(original_map(ii,1)) = .true.
+          end if
+          jj = original_map(ii,1)
+          if (.not.closcontact) then
+            do kk = 1,size(original_map,1)
+              ll = original_map(kk,2)
+              if (ll .ne. 0.and.original_map(kk,1) .eq. 0) then
+                !write (*,*) ii,jj,ll,sqrt(sum((side_tmp%xyz(:,ll)-base%xyz(:,jj))**2))
+                if ((sum((side_tmp%xyz(:,ll)-base%xyz(:,jj))**2)) < closedist) then
+                  closcontact = .true.
+                  cutlist_side(original_map(ii,2)) = .false.
+                  cutlist_base(original_map(ii,1)) = .true.
+                end if
+              end if
+            end do
+          end if
+
+        end if
+        if (original_map(ii,1) .ne. 0) then
+          revorder_base(original_map(ii,1)) = ii
+        end if
+        if (original_map(ii,2) .ne. 0) then
+          revorder_side(original_map(ii,2)) = ii
+        end if
+      end do
+      if (closcontact) then
+        do kk = 1,size(original_map,1)
+          if (all(original_map(kk,:) .ne. 0).and. &
+              .not.any(original_map(kk,1) .eq. alignmap(:,1))) then
+            cutlist_side(original_map(kk,2)) = .false.
+            cutlist_base(original_map(kk,1)) = .true.
+          end if
+        end do
+      end if
+    end if
+    kk = max(maxval(revorder_base),maxval(revorder_side))
+    new%nat = 0
+    do ii = 1,base%nat
+      if (.not.cutlist_base(ii)) then
+        new%nat = new%nat+1
+        if (revorder_base(ii) .eq. 0) then
+          kk = kk+1
+          revorder_base(ii) = kk
+        end if
+      end if
+    end do
+    do ii = 1,side%nat
+      if (.not.cutlist_side(ii)) then
+        new%nat = new%nat+1
+        if (revorder_side(ii) .eq. 0) then
+          kk = kk+1
+          revorder_side(ii) = kk
+        end if
+      end if
+    end do
+    allocate (new%at(new%nat),source=0)
+    allocate (new%xyz(3,new%nat),source=0.0_wp)
+    !kk = 0
+    failconstruct = .false.
+    do ii = 1,base%nat
+      if (.not.cutlist_base(ii)) then
+        !kk = kk+1
+        kk = revorder_base(ii)
+        if (kk > new%nat) then
+          failconstruct = .true.
+          exit
+        end if
+        new%at(kk) = base%at(ii)
+        new%xyz(1:3,kk) = base%xyz(1:3,ii)
+      end if
+    end do
+    do ii = 1,side%nat
+      if (.not.cutlist_side(ii)) then
+        !kk = kk+1
+        kk = revorder_side(ii)
+        if (kk > new%nat) then
+          failconstruct = .true.
+          exit
+        end if
+        new%at(kk) = side_tmp%at(ii)
+        new%xyz(1:3,kk) = side_tmp%xyz(1:3,ii)
+      end if
+    end do
+
+    if (present(clash)) then
+      clash = .false.
+      !> TODO implement geometric clash check
+      if (failconstruct) then
+        clash = .true.
+      else if (present(reficn)) then
+        call new%get_cn(cn)
+        do ii = 1,new%nat
+          if (nint(cn(ii)) .ne. reficn(ii)) then
+            clash = .true.
+            !write(*,*) "removing clash"
+            exit
+          end if
+        end do
+      end if
+    end if
+  end subroutine attach
+
+!==============================================================================!
+
+  subroutine split_onbond(input,bond,base,side,wbo)
+    implicit none
+    !> IN/OUTPUTS
+    type(coord),intent(in) :: input
+    integer,intent(in) :: bond(2)
+    type(coord),intent(out) :: base
+    type(coord),intent(out) :: side
+    !> OPTIONAL
+    real(wp),intent(in),optional :: wbo(input%nat,input%nat)
+    !> LOCAL
+    real(wp),allocatable :: cn(:),wbofake(:,:)
+    integer :: V,fbase,fside
+    integer,allocatable :: A(:,:),Anew(:,:)
+    integer,allocatable :: frag(:),fragnew(:)
+    logical,allocatable :: in_ring(:,:)
+    integer,allocatable :: path_tmp(:)
+    integer :: npath,nbase,nside
+    logical :: needs_capping
+    real(wp) :: distcap
+    integer :: ii,jj,kk
+
+    character(len=*),parameter :: source = "split_onbond()"
+
+    !> checks
+    if (any(bond(:) > input%nat).or.(any(bond(:) < 1))) then
+      error stop source//": bond() has invalid atom specification"
+    end if
+
+    !> we will be working with graphs. define number of vertices = #atoms
+    V = input%nat
+
+    !> set up adjacency matrix
+    if (present(wbo)) then
+      call wbo2adjacency(V,wbo,A,0.01_wp)
+    else
+      call input%cn_to_bond(cn,wbofake)
+      call wbo2adjacency(V,wbofake,A,0.01_wp)
+      deallocate (wbofake,cn)
+    end if
+
+    !> get fragment array (indicates which atom is on which fragment)
+    call setup_fragments(V,A,frag)
+
+    !> if the two atoms are already on different fragments we
+    !> can immediatly proceed, otherwise we need to make some cuts
+    if (frag(bond(1)) .eq. frag(bond(2))) then
+      !> check if the two atoms actually correspond to an bond
+      if (A(bond(1),bond(2)) .eq. 0) then
+        error stop source//": specified atoms are not directly connected!"
+      end if
+
+      needs_capping = .true.
+      !> safety: check for rings (need more cuts)
+      call check_rings_min(V,A,in_ring)
+      !allocate (path_tmp(V),source=0)
+      !call get_ring_min(V,A,bond(1),bond(2),path_tmp,npath)
+      !if (npath > 0) then
+      if (in_ring(bond(1),bond(2))) then
+        !> TODO - Implement actual fallback
+        error stop "Bond is in a ring! Can not split."
+      else
+        !> delete the bond and set up new fragment array
+        allocate (Anew(V,V),source=A)
+        Anew(bond(1),bond(2)) = 0
+        Anew(bond(2),bond(1)) = 0
+        call setup_fragments(V,Anew,frag)
+      end if
+    else
+      needs_capping = .false.
+    end if
+
+    !> the logic here is: the fragment containing atom "bond(1)"
+    !> will be base, and includes everything except the fragment
+    !> containing atom "bond(2)"; even further fragments containing neither
+    fbase = frag(bond(1))
+    fside = frag(bond(2))
+
+    nbase = 0
+    nside = 0
+    do ii = 1,input%nat
+      if (frag(ii) == fside) then
+        nside = nside+1
+      else
+        nbase = nbase+1
+      end if
+    end do
+
+    !> capping off the cut bond (with H or smthg else)
+    if (needs_capping) then
+      nside = nside+1
+      nbase = nbase+1
+    end if
+
+    !> construct output mols
+    base%nat = nbase
+    allocate (base%at(nbase),source=0)
+    allocate (base%xyz(3,nbase),source=0.0_wp)
+    side%nat = nside
+    allocate (side%at(nside),source=0)
+    allocate (side%xyz(3,nside),source=0.0_wp)
+
+    jj = 0
+    kk = 0
+    do ii = 1,input%nat
+      if (frag(ii) == fside) then
+        jj = jj+1
+        side%at(jj) = input%at(ii)
+        side%xyz(1:3,jj) = input%xyz(1:3,ii)
+      else
+        kk = kk+1
+        base%at(kk) = input%at(ii)
+        base%xyz(1:3,kk) = input%xyz(1:3,ii)
+      end if
+    end do
+
+    if (needs_capping) then
+      jj = jj+1
+      side%at(jj) = 1 !> hydrogen
+      side%xyz(1:3,jj) = input%xyz(1:3,bond(1))
+      distcap = (rcov(1)+rcov(input%at(bond(2))))*(3.0_wp/4.0_wp)
+      call place_at_distance(input%xyz(1:3,bond(2)),side%xyz(1:3,jj),distcap)
+      kk = kk+1
+      base%at(kk) = 1   !> hydrogen
+      base%xyz(1:3,kk) = input%xyz(1:3,bond(2))
+      distcap = (rcov(1)+rcov(input%at(bond(1))))*(3.0_wp/4.0_wp)
+      call place_at_distance(input%xyz(1:3,bond(1)),base%xyz(1:3,kk),distcap)
+    end if
+
+    if (allocated(Anew)) deallocate (Anew)
+    if (allocated(frag)) deallocate (frag)
+  end subroutine split_onbond
+
+!==============================================================================!
+  subroutine split_onshared(input,sharedlist,structures,sharedmap,&
+      & wbo,ncap,position_mapping)
+    implicit none
+    !> IN/OUTPUTS
+    type(coord),intent(in) :: input
+    integer,intent(in) :: sharedlist(:)
+    type(coord),intent(out),allocatable :: structures(:)
+    integer,intent(out),allocatable :: sharedmap(:,:)
+    !> OPTIONAL
+    real(wp),intent(in),optional :: wbo(input%nat,input%nat)
+    integer,intent(out),allocatable,optional :: ncap(:)
+    integer,intent(out),allocatable,optional :: position_mapping(:,:)
+    !> LOCAL
+    type(coord) :: shared
+    real(wp),allocatable :: cn(:),wbofake(:,:)
+    integer :: V,fbase,fside,nshared,ftmp
+    integer,allocatable :: A(:,:),Anew(:,:)
+    integer,allocatable :: frag(:),fragnew(:),molassign(:)
+    integer,allocatable :: ncapped(:)
+    integer,allocatable :: pos_map(:,:)
+    logical,allocatable :: in_ring(:,:)
+    integer,allocatable :: path_tmp(:)
+    integer,allocatable :: number_of_neighbours(:)
+    logical,allocatable :: terminal_atom(:)
+    logical,allocatable :: connected_to_share(:)
+    logical,allocatable :: assign_to_mols(:,:)
+    logical,allocatable :: unassigned_fragments(:)
+    logical,allocatable :: capping_mapping(:,:)
+    logical,allocatable :: methylizemapping(:,:)
+
+    integer :: npath,nfrag,nfragnew,nbonds
+    real(wp) :: distcap,methylproxy(3,3)
+    integer :: ii,jj,jjj,kk,sii,sjj,M,mm,nn,ll,lll
+
+    integer :: bond(2)
+
+    character(len=*),parameter :: source = "split_onshared()"
+
+    !> we will be working with graphs. define number of vertices = #atoms
+    V = input%nat
+    !> how many atoms are shared
+    nshared = size(sharedlist,1)
+
+    !> checks
+    if (any(sharedlist(:) > input%nat).or.(nshared < 1)) then
+
+      error stop source//": sharedlist() has invalid atom specification"
+    end if
+
+    !> set up adjacency matrix
+    if (present(wbo)) then
+      call wbo2adjacency(V,wbo,A,0.01_wp)
+    else
+      call input%cn_to_bond(cn,wbofake)
+      call wbo2adjacency(V,wbofake,A,0.01_wp)
+      deallocate (wbofake,cn)
+    end if
+
+!> ----------------------------------------------------------------------------
+!> BOOKKEEPING START
+!> ----------------------------------------------------------------------------
+    !> get fragment array (indicates which atom is on which fragment)
+    call setup_fragments(V,A,frag)
+
+    !> some other mappings
+    allocate (number_of_neighbours(V),source=0)
+    do ii = 1,V
+      number_of_neighbours(ii) = sum(A(:,ii))
+    end do
+    allocate (terminal_atom(V),source=.false.)
+    do ii = 1,V
+      terminal_atom(ii) = (number_of_neighbours(ii) == 1)
+    end do
+
+    !> The cutting logic starts here.
+    !> First, we need to identify all atoms actually sharing fragments with the shared atoms
+    allocate (connected_to_share(V),source=.false.)
+    do ii = 1,V
+      ftmp = frag(ii)
+      do jj = 1,nshared
+        if (ftmp == frag(sharedlist(jj))) then
+          connected_to_share(ii) = .true.
+          exit
+        end if
+      end do
+    end do
+    !> all atoms NOT part of that list will be present in both output fragments
+
+    !> Then, we take the graph and construct a new one with detachted "shared" atoms
+    allocate (Anew(V,V),source=A)
+    do ii = 1,nshared
+      sii = sharedlist(ii)
+      do jj = 1,V
+        if (jj == sii) cycle
+        if ((A(jj,sii) == 1).and. &  !> look at existing bonds to shared section
+         & .not.any(sharedlist(:) == jj).and. & !> exctept to other shared section atoms
+         & .not.terminal_atom(jj)) then  !> and except terminal atoms (directly bound to shared section)
+          Anew(jj,sii) = 0
+          Anew(sii,jj) = 0
+        end if
+      end do
+    end do
+    !> get new fragments
+    call setup_fragments(V,Anew,fragnew)
+    !> due to the cutting we should have at least two more fragments in total, compared to before.
+    !> for now we only handle exactly that +2 fragment case
+    nfrag = maxval(frag)
+    nfragnew = maxval(fragnew)
+    M = 0
+    if (nfragnew < (nfrag+2)) then
+      error stop source//": system fragmentation yields currently unhandled edge-case"
+    else
+      M = nfragnew-nfrag
+      !> now we can check asignment to new, split-up fragments
+      !> we distinguish between the shared secion (:,1), and all M others (:,2:M)
+      allocate (assign_to_mols(V,M+1),source=.false.)
+      allocate (unassigned_fragments(nfragnew),source=.true.)
+      !> first, get the separated shared-region
+      mm = M+1
+      do ii = 1,nshared
+        sii = fragnew(sharedlist(ii))
+        unassigned_fragments(sii) = .false.
+        do jj = 1,V
+          if (fragnew(jj) == sii) then
+            assign_to_mols(jj,1:mm) = .true.
+          end if
+        end do
+      end do
+      !> then, all atoms that had no connection to the shared region
+      !> and hence are present everywhere (except the shard region)
+      do ii = 1,V
+        if (.not.connected_to_share(ii)) then
+          sii = fragnew(ii)
+          unassigned_fragments(sii) = .false.
+          do jj = 1,V
+            if (fragnew(jj) == sii) then
+              assign_to_mols(jj,2:mm) = .true.
+            end if
+          end do
+        end if
+      end do
+
+      !!> exactly M fragments should be remaining
+      if (count(unassigned_fragments) .ne. M) then
+        error stop source//": wrong number of unassigned_fragments"
+      end if
+      mm = 1
+      do ii = 1,V
+        if (all(assign_to_mols(ii,:).eqv..false.)) then
+          mm = mm+1 !> molecule new assignment number (except mm=1 because that is the shared region)
+          sii = fragnew(ii) !> the reference fragment
+          do jj = 1,V
+            if (fragnew(jj) .eq. sii) assign_to_mols(jj,mm) = .true.
+          end do
+        end if
+      end do
+    end if
+
+    !> prepare mapping and capping.
+    allocate (capping_mapping(V,M),source=.false.)
+    allocate (methylizemapping(nshared,M),source=.false.)
+    !> First, simple, chemoinformatic rules
+    do ii = 1,M
+      mm = ii+1
+      do jj = 1,nshared
+        nbonds = 0
+        kk = sharedlist(jj)
+        do ll = 1,V
+          if ((A(ll,kk) == 1).and.assign_to_mols(ll,mm)) then
+            nbonds = nbonds+1
+          end if
+        end do
+        if (nbonds == 1.and.input%at(kk) == 6) then
+          methylizemapping(jj,ii) = .true.
+        end if
+      end do
+    end do
+    !> then "regular" capping, we determine original atoms as proxy for
+    !> the cap (and later adjust the bondlength)
+    !> Entries will be .true. for atoms that need to be added to fragment
+    do ii = 1,M
+      mm = ii+1
+      do jj = 1,nshared
+        if (methylizemapping(jj,ii)) cycle
+        do kk = 1,V
+          if (A(kk,sharedlist(jj)) == 1.and..not.assign_to_mols(kk,mm)) then
+            capping_mapping(kk,ii) = .true.
+          end if
+        end do
+      end do
+    end do
+
+!> ----------------------------------------------------------------------------
+!> BOOKKEEPING END
+!> ----------------------------------------------------------------------------
+!> MOLECULE CONSTRUCTION START
+!> ----------------------------------------------------------------------------
+
+    allocate (structures(M)) !> we know that splitting produces M fragment
+    allocate (sharedmap(nshared,M),source=0)
+    allocate (ncapped(M),source=0)
+    allocate (pos_map(V,M),source=0)
+
+    do ii = 1,M
+      mm = ii+1
+      !> count atoms, allocate
+      nn = count(assign_to_mols(:,mm),1)+ &
+        &  count(capping_mapping(:,ii),1)+ &
+        &  count(methylizemapping(:,ii),1)*3
+      structures(ii)%nat = nn
+      allocate (structures(ii)%at(nn),source=2)
+      allocate (structures(ii)%xyz(3,nn),source=0.0_wp)
+      kk = 0
+      jjj = 0
+      !> directly assigned atoms
+      do jj = 1,V
+        if (assign_to_mols(jj,mm)) then
+          kk = kk+1
+          structures(ii)%at(kk) = input%at(jj)
+          structures(ii)%xyz(1:3,kk) = input%xyz(1:3,jj)
+          if (any(sharedlist(:) == jj)) then
+            jjj = jjj+1
+            sharedmap(jjj,ii) = kk
+          end if
+          pos_map(jj,ii) = kk
+        end if
+      end do
+      !> capping atoms
+      do jj = 1,V
+        if (capping_mapping(jj,ii)) then
+          kk = kk+1
+          ncapped(ii) = ncapped(ii)+1
+          structures(ii)%at(kk) = 1 !input%at(jj)
+          structures(ii)%xyz(1:3,kk) = input%xyz(1:3,jj)
+          !> repair distance for capping atoms
+          do ll = 1,V
+            if ((A(ll,jj) == 1).and.assign_to_mols(ll,mm)) then
+              distcap = (rcov(1)+rcov(input%at(ll)))*(3.0_wp/4.0_wp)
+              call place_at_distance(input%xyz(1:3,ll),structures(ii)%xyz(1:3,kk),distcap)
+            end if
+          end do
+        end if
+      end do
+      !> methylation atoms
+      do jj = 1,nshared
+        if (methylizemapping(jj,ii)) then
+          sjj = sharedlist(jj)
+          do ll = 1,V
+            if (A(ll,sjj) == 1.and.assign_to_mols(ll,mm)) then
+              call methylize(input%xyz(1:3,sjj),input%xyz(1:3,ll),methylproxy)
+              do lll = 1,3
+                kk = kk+1
+                ncapped(ii) = ncapped(ii)+1
+                structures(ii)%at(kk) = 1
+                structures(ii)%xyz(1:3,kk) = methylproxy(1:3,lll)
+              end do
+              exit
+            end if
+          end do
+        end if
+      end do
+    end do
+
+!> ----------------------------------------------------------------------------
+!> MOLECULE CONSTRUCTION END
+!> ----------------------------------------------------------------------------
+
+    if (present(ncap)) then
+      call move_alloc(ncapped,ncap)
+    end if
+
+    if (present(position_mapping)) then
+      call move_alloc(pos_map,position_mapping)
+    end if
+
+    if (allocated(pos_map)) deallocate (pos_map)
+    if (allocated(ncapped)) deallocate (ncapped)
+    if (allocated(assign_to_mols)) deallocate (assign_to_mols)
+    if (allocated(capping_mapping)) deallocate (capping_mapping)
+    if (allocated(unassigned_fragments)) deallocate (unassigned_fragments)
+    if (allocated(number_of_neighbours)) deallocate (number_of_neighbours)
+    if (allocated(terminal_atom)) deallocate (terminal_atom)
+    if (allocated(connected_to_share)) deallocate (connected_to_share)
+    if (allocated(Anew)) deallocate (Anew)
+    if (allocated(frag)) deallocate (frag)
+  end subroutine split_onshared
+!==============================================================================!
+  subroutine binarysplit_onshared(input,sharedlist,structures,sharedmap,&
+      & wbo,ncap,position_mapping)
+    implicit none
+    !> IN/OUTPUTS
+    type(coord),intent(in) :: input
+    integer,intent(in) :: sharedlist(:)
+    type(coord),intent(out),allocatable :: structures(:)
+    integer,intent(out),allocatable :: sharedmap(:,:)
+    !> OPTIONAL
+    real(wp),intent(in),optional :: wbo(input%nat,input%nat)
+    integer,intent(out),allocatable,optional :: ncap(:)
+    integer,intent(out),allocatable,optional :: position_mapping(:,:)
+    !> LOCAL
+    type(coord) :: shared
+    real(wp),allocatable :: cn(:),wbofake(:,:)
+    integer :: V,fbase,fside,nshared,ftmp
+    integer,allocatable :: A(:,:),Anew(:,:)
+    integer,allocatable :: frag(:),fragnew(:),molassign(:)
+    integer,allocatable :: ncapped(:)
+    integer,allocatable :: pos_map(:,:)
+    logical,allocatable :: in_ring(:,:)
+    integer,allocatable :: path_tmp(:)
+    integer,allocatable :: number_of_neighbours(:)
+    logical,allocatable :: terminal_atom(:)
+    logical,allocatable :: connected_to_share(:)
+    logical,allocatable :: assign_to_mols(:,:)
+    logical,allocatable :: unassigned_fragments(:)
+    logical,allocatable :: capping_mapping(:,:)
+    logical,allocatable :: methylizemapping(:,:)
+
+    integer :: npath,nfrag,nfragnew,nbonds
+    real(wp) :: distcap,methylproxy(3,3)
+    integer :: ii,jj,jjj,kk,sii,sjj,M,mm,nn,ll,lll
+
+    integer :: bond(2)
+
+    character(len=*),parameter :: source = "binarysplit_onshared()"
+
+    !> we will be working with graphs. define number of vertices = #atoms
+    V = input%nat
+    !> how many atoms are shared
+    nshared = size(sharedlist,1)
+
+    !> checks
+    if (any(sharedlist(:) > input%nat).or.(nshared < 1)) then
+
+      error stop source//": sharedlist() has invalid atom specification"
+    end if
+
+    !> set up adjacency matrix
+    if (present(wbo)) then
+      call wbo2adjacency(V,wbo,A,0.01_wp)
+    else
+      call input%cn_to_bond(cn,wbofake)
+      call wbo2adjacency(V,wbofake,A,0.01_wp)
+      deallocate (wbofake,cn)
+    end if
+
+!> ----------------------------------------------------------------------------
+!> BOOKKEEPING START
+!> ----------------------------------------------------------------------------
+    !> get fragment array (indicates which atom is on which fragment)
+    call setup_fragments(V,A,frag)
+
+    !> some other mappings
+    allocate (number_of_neighbours(V),source=0)
+    do ii = 1,V
+      number_of_neighbours(ii) = sum(A(:,ii))
+    end do
+    allocate (terminal_atom(V),source=.false.)
+    do ii = 1,V
+      terminal_atom(ii) = (number_of_neighbours(ii) == 1)
+    end do
+
+    !> The cutting logic starts here.
+    !> First, we need to identify all atoms actually sharing fragments with the shared atoms
+    allocate (connected_to_share(V),source=.false.)
+    do ii = 1,V
+      ftmp = frag(ii)
+      do jj = 1,nshared
+        if (ftmp == frag(sharedlist(jj))) then
+          connected_to_share(ii) = .true.
+          exit
+        end if
+      end do
+    end do
+    !> all atoms NOT part of that list will be present in both output fragments
+
+    !> Then, we take the graph and construct a new one with detachted "shared" atoms
+    nfrag = maxval(frag)
+    allocate (Anew(V,V),source=A)
+    iiloop1: do ii = 1,nshared
+      sii = sharedlist(ii)
+      do jj = 1,V
+        if (jj == sii) cycle
+        if ((A(jj,sii) == 1).and. &  !> look at existing bonds to shared section
+         & any(sharedlist(:) == jj).and. & !> must be connected to other shared section atoms
+         & .not.terminal_atom(jj)) then  !> and except terminal atoms (directly bound to shared section)
+          Anew(jj,sii) = 0
+          Anew(sii,jj) = 0
+
+          !> get new fragments
+          call setup_fragments(V,Anew,fragnew)
+          nfragnew = maxval(fragnew)
+          if ((nfragnew-nfrag) == 1) then
+            exit iiloop1
+          end if
+        end if
+      end do
+    end do iiloop1
+
+    M = 2
+    if (nfragnew == nfrag) then
+      error stop source//": system fragmentation yields currently unhandled edge-case"
+    else
+      !> now we can check asignment to new, split-up fragments
+      !> we distinguish between the shared secion (:,1), and all M others (:,2:M)
+      allocate (assign_to_mols(V,M+1),source=.false.)
+      allocate (unassigned_fragments(nfragnew),source=.true.)
+      !> distribute the separated fragments. Also assign the shared atoms themselves
+      mm = 1
+      do ii = 1,nshared
+        sii = fragnew(sharedlist(ii))
+        assign_to_mols(sharedlist(ii),:) = .true.
+        if (.not.unassigned_fragments(sii)) cycle
+        mm = mm+1
+        unassigned_fragments(sii) = .false.
+        do jj = 1,V
+          if (fragnew(jj) == sii) then
+            assign_to_mols(jj,mm) = .true.
+          end if
+        end do
+      end do
+      !> then, all atoms that had no connection to the shared region
+      !> and hence are present everywhere (except the shard region)
+      do ii = 1,V
+        if (.not.connected_to_share(ii)) then
+          sii = fragnew(ii)
+          unassigned_fragments(sii) = .false.
+          do jj = 1,V
+            if (fragnew(jj) == sii) then
+              assign_to_mols(jj,2:mm) = .true.
+            end if
+          end do
+        end if
+      end do
+
+      !!> exactly 0 fragments should be remaining because we had the even split
+      if (count(unassigned_fragments) .ne. 0) then
+        error stop source//": wrong number of unassigned_fragments"
+      end if
+    end if
+
+    !> prepare mapping and capping.
+    allocate (capping_mapping(V,M),source=.false.)
+    allocate (methylizemapping(nshared,M),source=.false.)
+    !> First, simple, chemoinformatic rules
+    do ii = 1,M
+      mm = ii+1
+      do jj = 1,nshared
+        nbonds = 0
+        sii = sharedlist(jj)
+        do ll = 1,V
+          if ((A(ll,sii) == 1).and.assign_to_mols(ll,mm)) then
+            nbonds = nbonds+1
+          end if
+        end do
+        if (nbonds == 1.and.input%at(sii) == 6) then
+          methylizemapping(jj,ii) = .true.
+        end if
+      end do
+    end do
+    !> then "regular" capping, we determine original atoms as proxy for
+    !> the cap (and later adjust the bondlength)
+    !> Entries will be .true. for atoms that need to be added to fragment
+    do ii = 1,M
+      mm = ii+1
+      do jj = 1,nshared
+        if (methylizemapping(jj,ii)) cycle
+        do kk = 1,V
+          if (A(kk,sharedlist(jj)) == 1.and..not.assign_to_mols(kk,mm)) then
+            capping_mapping(kk,ii) = .true.
+          end if
+        end do
+      end do
+    end do
+
+!> ----------------------------------------------------------------------------
+!> BOOKKEEPING END
+!> ----------------------------------------------------------------------------
+!> MOLECULE CONSTRUCTION START
+!> ----------------------------------------------------------------------------
+
+    allocate (structures(M)) !> we know that splitting produces M fragment
+    allocate (sharedmap(nshared,M),source=0)
+    allocate (ncapped(M),source=0)
+    allocate (pos_map(V,M),source=0)
+
+    do ii = 1,M
+      mm = ii+1
+      !> count atoms, allocate
+      nn = count(assign_to_mols(:,mm),1)+ &
+        &  count(capping_mapping(:,ii),1)+ &
+        &  count(methylizemapping(:,ii),1)*3
+      structures(ii)%nat = nn
+      allocate (structures(ii)%at(nn),source=2)
+      allocate (structures(ii)%xyz(3,nn),source=0.0_wp)
+      kk = 0
+      jjj = 0
+      !> directly assigned atoms
+      do jj = 1,V
+        if (assign_to_mols(jj,mm)) then
+          kk = kk+1
+          structures(ii)%at(kk) = input%at(jj)
+          structures(ii)%xyz(1:3,kk) = input%xyz(1:3,jj)
+          if (any(sharedlist(:) == jj)) then
+            jjj = jjj+1
+            sharedmap(jjj,ii) = kk
+          end if
+          pos_map(jj,ii) = kk
+        end if
+      end do
+      !> capping atoms
+      do jj = 1,V
+        if (capping_mapping(jj,ii)) then
+          kk = kk+1
+          ncapped(ii) = ncapped(ii)+1
+          structures(ii)%at(kk) = 1 !input%at(jj)
+          structures(ii)%xyz(1:3,kk) = input%xyz(1:3,jj)
+          !> repair distance for capping atoms
+          do ll = 1,V
+            if ((A(ll,jj) == 1).and.assign_to_mols(ll,mm)) then
+              distcap = (rcov(1)+rcov(input%at(ll)))*(3.0_wp/4.0_wp)
+              call place_at_distance(input%xyz(1:3,ll),structures(ii)%xyz(1:3,kk),distcap)
+            end if
+          end do
+        end if
+      end do
+      !> methylation atoms
+      do jj = 1,nshared
+        if (methylizemapping(jj,ii)) then
+          sjj = sharedlist(jj)
+          do ll = 1,V
+            if (A(ll,sjj) == 1.and.assign_to_mols(ll,mm)) then
+              call methylize(input%xyz(1:3,sjj),input%xyz(1:3,ll),methylproxy)
+              do lll = 1,3
+                kk = kk+1
+                ncapped(ii) = ncapped(ii)+1
+                structures(ii)%at(kk) = 1
+                structures(ii)%xyz(1:3,kk) = methylproxy(1:3,lll)
+              end do
+              exit
+            end if
+          end do
+        end if
+      end do
+    end do
+
+!> ----------------------------------------------------------------------------
+!> MOLECULE CONSTRUCTION END
+!> ----------------------------------------------------------------------------
+
+    if (present(ncap)) then
+      call move_alloc(ncapped,ncap)
+    end if
+
+    if (present(position_mapping)) then
+      call move_alloc(pos_map,position_mapping)
+    end if
+
+    if (allocated(pos_map)) deallocate (pos_map)
+    if (allocated(ncapped)) deallocate (ncapped)
+    if (allocated(assign_to_mols)) deallocate (assign_to_mols)
+    if (allocated(capping_mapping)) deallocate (capping_mapping)
+    if (allocated(unassigned_fragments)) deallocate (unassigned_fragments)
+    if (allocated(number_of_neighbours)) deallocate (number_of_neighbours)
+    if (allocated(terminal_atom)) deallocate (terminal_atom)
+    if (allocated(connected_to_share)) deallocate (connected_to_share)
+    if (allocated(Anew)) deallocate (Anew)
+    if (allocated(frag)) deallocate (frag)
+  end subroutine binarysplit_onshared
+
+!=============================================================================!
+  pure subroutine place_at_distance(ref,moving,dist,tol,ierr)
+    implicit none
+    real(wp),intent(in)    :: ref(3)
+    real(wp),intent(inout) :: moving(3)
+    real(wp),intent(in)    :: dist
+    real(wp),intent(in),optional :: tol
+    integer,intent(out),optional :: ierr
+
+    real(wp) :: v(3),r,t
+    real(wp),parameter :: default_tol = 1.0d-12
+
+    t = default_tol
+    if (present(tol)) t = tol
+
+    v = moving-ref
+    r = sqrt(dot_product(v,v))
+
+    if (present(ierr)) ierr = 0
+    if (r <= t) then
+      !> Direction is undefined (moving ~= ref), so we cannot keep the axis.
+      if (present(ierr)) ierr = 1
+      return
+    end if
+
+    moving = ref+(dist/r)*v
+  end subroutine place_at_distance
+
+!==============================================================================!
+
+  subroutine methylize(x,n,h_new,h_aligned,r_ch,ok)
+    use geo
+    implicit none
+    real(wp),intent(in)  :: x(3),n(3)
+    real(wp),intent(out) :: h_new(3,3)
+    real(wp),intent(out),optional :: h_aligned(3)
+    real(wp),intent(in),optional :: r_ch
+    logical,intent(out),optional :: ok
+
+    real(wp) :: rch,invs3,pi
+    real(wp) :: Htmpl(3,4)
+    real(wp) :: dir(3),a(3),axis(3),tmp(3)
+    real(wp) :: angle,d
+    integer  :: k
+    real(wp),parameter :: eps = 1.0e-12_wp
+    logical :: success
+
+    pi = acos(-1.0_wp)
+
+    rch = 1.09_wp*aatoau
+    if (present(r_ch)) rch = r_ch
+
+    !>--- methane proxy (C at origin), perfect tetrahedral directions
+    invs3 = 1.0_wp/sqrt(3.0_wp)
+    Htmpl(:,1) = rch*(/1.0_wp,1.0_wp,1.0_wp/)*invs3
+    Htmpl(:,2) = rch*(/1.0_wp,-1.0_wp,-1.0_wp/)*invs3
+    Htmpl(:,3) = rch*(/-1.0_wp,1.0_wp,-1.0_wp/)*invs3
+    Htmpl(:,4) = rch*(/-1.0_wp,-1.0_wp,1.0_wp/)*invs3
+
+    !>--- desired direction: outward from x away from neighbor n
+    dir = n-x
+    if (vec_len(dir) < eps) then
+      h_new = 0.0_wp
+      if (present(h_aligned)) h_aligned = 0.0_wp
+      if (present(ok)) ok = .false.
+      return
+    end if
+    call unitv(dir)
+
+    !>--- template direction: use H1 bond direction (unit)
+    a = Htmpl(:,1)
+    call unitv(a)
+
+    !>--- compute rotation: rotate a
+    call crosp(a,dir,axis)
+    d = dotp(a,dir,3)
+
+    if (vec_len(axis) < eps) then
+      !> a parallel or anti-parallel to dir
+      if (d > 0.0_wp) then
+        angle = 0.0_wp
+        axis = (/1.0_wp,0.0_wp,0.0_wp/)  ! dummy axis (unused)
+      else
+        !> 180° rotation: choose any axis perpendicular to a
+        tmp = (/1.0_wp,0.0_wp,0.0_wp/)
+        if (abs(dotp(a,tmp,3)) > 0.9_wp) tmp = (/0.0_wp,1.0_wp,0.0_wp/)
+        call crosp(a,tmp,axis)
+        call unitv(axis)
+        angle = pi
+      end if
+    else
+      call unitv(axis)
+      angle = tangle(a,dir)   !> radians, [0..pi]
+    end if
+
+    !> --- rotate & translate: H = x + R * Htmpl
+    !> Return the other three (2..4) as "new"
+    do k = 2,4
+      tmp = Htmpl(:,k)
+      if (abs(angle) > 0.0_wp) call rodrot(tmp,axis,angle)
+      h_new(:,k-1) = x+tmp
+    end do
+
+    if (present(h_aligned)) then
+      tmp = Htmpl(:,1)
+      if (abs(angle) > 0.0_wp) call rodrot(tmp,axis,angle)
+      h_aligned = x+tmp
+    end if
+
+    success = .true.
+    if (present(ok)) ok = success
+  end subroutine methylize
+
+!=============================================================================!
+!#############################################################################!
+!=============================================================================!
+end module molbuilder_construct_mod
+
diff --git a/src/molbuilder/construct_list.f90 b/src/molbuilder/construct_list.f90
new file mode 100644
index 00000000..775bec55
--- /dev/null
+++ b/src/molbuilder/construct_list.f90
@@ -0,0 +1,307 @@
+module molbuilder_construct_list
+  !**************************************************
+  !* Bookkeeping module for reconstructing molecules
+  !**************************************************
+  use crest_parameters
+  use crest_calculator
+  use strucrd
+  use quicksort_interface,only:qqsorti
+  implicit none
+  private
+
+  type :: split_atms
+    integer :: natms = 0
+    integer,allocatable :: atms(:)
+  end type split_atms
+
+  type :: origin_map
+    integer :: natms = 0
+    integer,allocatable :: map(:)
+  end type origin_map
+
+  type :: construct_layer
+    integer :: id = 0
+    integer :: parent = 0
+    integer :: parentnode = 0
+    integer :: nnodes = 0
+    real(wp) :: inverse_depth = 0.0_wp
+    type(coord),allocatable :: node(:)
+    integer,allocatable :: childlayer(:)
+    integer,allocatable :: alignmap(:,:)
+    integer,allocatable :: ncapped(:)
+    integer,allocatable :: position_mapping(:,:)
+    type(origin_map),allocatable :: origin(:)
+    !> initial/reconstructed molecule
+    integer :: nmols = 0
+    type(coord),allocatable :: mols(:)
+    !> reference
+    type(coord) :: refmol
+    real(wp),allocatable :: refcn(:)
+    integer,allocatable :: reficn(:)
+  end type construct_layer
+
+  type :: construct_queue
+    integer :: layer = 0
+    integer :: node = 0
+    integer :: duplicate_of_queue = 0
+    character(len=:),allocatable :: workdir
+    character(len=:),allocatable :: file
+    type(calcdata) :: calc
+  end type construct_queue
+
+  type :: construct_heap
+    !> The gerneral mapping
+    integer :: nlayer = 0
+    type(construct_layer),allocatable :: layer(:)
+    !> the queue to treat endpoints
+    integer :: nqueue = 0
+    type(construct_queue),allocatable :: queue(:)
+    !> originial data
+    type(coord) :: originmol
+    character(len=:),allocatable :: origindir
+    type(calcdata),pointer :: origincalc
+  contains
+    procedure map_origins_for_layer
+    procedure find_current_position
+    procedure count_endpoints
+    procedure setup_queue
+    procedure fill_inverse_depth
+  end type construct_heap
+
+  !> exported types
+  public :: split_atms
+  public :: construct_heap
+  !> exported helper functions
+  public :: add_to_splitqueue
+
+!=============================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!=============================================================================!
+
+  subroutine add_to_splitqueue(splitqueue,raw_split)
+    implicit none
+    type(split_atms),intent(inout),allocatable :: splitqueue(:)
+    integer,intent(in) :: raw_split(:)
+    type(split_atms) :: tmpsplit
+    type(split_atms),allocatable :: tmpsplitqueue(:)
+    integer :: ii,n,nall,nallnew
+    logical :: duplicate
+
+    n = size(raw_split,1)
+    allocate (tmpsplit%atms(n))
+    tmpsplit%natms = n
+    tmpsplit%atms(:) = raw_split(:)
+    call qqsorti(tmpsplit%atms,1,n)
+
+    if (.not.allocated(splitqueue)) then
+      allocate (splitqueue(1))
+      splitqueue(1) = tmpsplit
+    else
+      nall = size(splitqueue,1)
+      nallnew = nall+1
+      duplicate = .false.
+      do ii = 1,nall
+        if (all(splitqueue(ii)%atms(:) .eq. tmpsplit%atms(:))) then
+          duplicate = .true.
+          exit
+        end if
+      end do
+      if (.not.duplicate) then
+        allocate (tmpsplitqueue(nallnew))
+        do ii = 1,nall
+          tmpsplitqueue(ii) = splitqueue(ii)
+        end do
+        tmpsplitqueue(nallnew) = tmpsplit
+        call move_alloc(tmpsplitqueue,splitqueue)
+      end if
+    end if
+
+  end subroutine add_to_splitqueue
+
+  recursive subroutine find_original_atoms(heap,targetlayer,targetnode,atoms)
+    implicit none
+    type(construct_heap),intent(in) :: heap
+    integer,intent(in) :: targetlayer,targetnode
+    integer,intent(out),allocatable :: atoms(:)
+    integer :: this
+    integer :: ii,jj,kk,nat,dim1,dim2
+    integer,allocatable :: tmpatoms(:)
+
+    associate (layer => heap%layer(targetlayer))
+      nat = layer%node(targetnode)%nat
+      allocate (atoms(nat),source=0)
+      if (layer%parent == 0) then
+        call position_mapping_reverse( &
+          & layer%position_mapping,targetnode,nat,atoms)
+      else
+        ii = layer%parent
+        jj = layer%parentnode
+        call find_original_atoms(heap,ii,jj,tmpatoms)
+        dim1 = size(tmpatoms,1)
+        dim2 = size(layer%position_mapping,1)
+        if (dim1 .ne. dim2) then
+          stop "something went wrong in find_original_atoms()"
+        end if
+        do ii = 1,dim1
+          kk = layer%position_mapping(ii,targetnode)
+          do jj = 1,nat
+            if (kk == jj) then
+              atoms(jj) = tmpatoms(ii)
+            end if
+          end do
+        end do
+        deallocate (tmpatoms)
+      end if
+    end associate
+  end subroutine find_original_atoms
+
+  subroutine position_mapping_reverse(position_mapping,node,nat,revats)
+    !* get the original (one layer up) atom positions for ati
+    !* of a given node from the saved position_mapping  of the associated layer
+    !* Invalid setups return 0
+    implicit none
+    integer,intent(in) :: position_mapping(:,:)
+    integer,intent(in) :: node,nat
+    integer,intent(out),allocatable :: revats(:)
+    integer :: ii,jj,dim1,dim2
+    dim1 = size(position_mapping,1)
+    dim2 = size(position_mapping,2)
+    allocate (revats(nat),source=0)
+    if (node < 1.or.node > dim2) return
+    do ii = 1,dim1
+      jj = position_mapping(ii,node)
+      if (jj > 0) revats(jj) = ii
+    end do
+  end subroutine position_mapping_reverse
+
+  subroutine map_origins_for_layer(heap,targetlayer)
+    implicit none
+    class(construct_heap),intent(inout) :: heap
+    integer,intent(in) :: targetlayer
+    integer :: ii,jj
+    logical,parameter :: debug = .false.
+    if (targetlayer < 1.or.targetlayer > heap%nlayer) return
+    if (.not.allocated(heap%layer(targetlayer)%node)) return
+    associate (layer => heap%layer(targetlayer))
+      if (allocated(layer%origin)) deallocate (layer%origin)
+      allocate (layer%origin(layer%nnodes))
+      do ii = 1,layer%nnodes
+        layer%origin(ii)%natms = layer%node(ii)%nat
+        call find_original_atoms(heap,targetlayer,ii,layer%origin(ii)%map)
+      end do
+    end associate
+  end subroutine map_origins_for_layer
+
+  subroutine find_current_position(heap,atom,targetlayer,targetnode,current)
+    implicit none
+    class(construct_heap),intent(in) :: heap
+    integer,intent(in) :: atom,targetlayer,targetnode
+    integer,intent(out) :: current
+    integer :: ii,jj
+    current = 0
+    associate (layer => heap%layer(targetlayer))
+      do ii = 1,layer%node(targetnode)%nat
+        jj = layer%origin(targetnode)%map(ii)
+        if (jj == atom) then
+          current = ii
+          exit
+        end if
+      end do
+    end associate
+  end subroutine find_current_position
+
+  function count_endpoints(heap) result(nendpoints)
+    implicit none
+    class(construct_heap) :: heap
+    integer :: nendpoints
+    integer :: ii,jj,kk
+    nendpoints = 0
+    do ii = 1,heap%nlayer
+      if (.not.allocated(heap%layer(ii)%childlayer)) then
+        nendpoints = nendpoints+heap%layer(ii)%nnodes
+      else
+        do jj = 1,heap%layer(ii)%nnodes
+          if (heap%layer(ii)%childlayer(jj) == 0) then
+            nendpoints = nendpoints+1
+          end if
+        end do
+      end if
+    end do
+  end function count_endpoints
+
+  subroutine setup_queue(heap)
+    implicit none
+    class(construct_heap) :: heap
+    integer :: nqueue,kk,ii,jj
+
+    nqueue = heap%count_endpoints()
+    heap%nqueue = nqueue
+    allocate (heap%queue(nqueue))
+
+    kk = 0
+    do ii = 1,heap%nlayer
+      if (.not.allocated(heap%layer(ii)%childlayer)) then
+        do jj = 1,heap%layer(ii)%nnodes
+          kk = kk+1
+          heap%queue(kk)%layer = ii
+          heap%queue(kk)%node = jj
+        end do
+      else
+        do jj = 1,heap%layer(ii)%nnodes
+          if (heap%layer(ii)%childlayer(jj) == 0) then
+            kk = kk+1
+            heap%queue(kk)%layer = ii
+            heap%queue(kk)%node = jj
+          end if
+        end do
+      end if
+    end do
+
+  end subroutine setup_queue
+
+  subroutine fill_inverse_depth(heap)
+    !*****************************************************
+    !* Precompute inverse_depth for all layers by        *
+    !* recursing from each root layer (parent == 0).     *
+    !*****************************************************
+    implicit none
+    class(construct_heap),intent(inout) :: heap
+    integer :: ii
+    do ii = 1,heap%nlayer
+      if (heap%layer(ii)%parent == 0) then
+        call fill_inverse_depth_layer(heap,ii)
+      end if
+    end do
+  end subroutine fill_inverse_depth
+
+  recursive subroutine fill_inverse_depth_layer(heap,layerid)
+    !*************************************************************
+    !* Recursively assign inverse_depth to layer layerid and all *
+    !* its descendants. Leaves get 1.0; internal layers get the  *
+    !* sum of their children's inverse_depth values.             *
+    !*************************************************************
+    implicit none
+    type(construct_heap),intent(inout) :: heap
+    integer,intent(in) :: layerid
+    integer :: jj,childid
+    real(wp) :: s
+    associate (lyr => heap%layer(layerid))
+      if (.not.allocated(lyr%childlayer)) then
+        lyr%inverse_depth = 1.0_wp
+        return
+      end if
+      s = 0.0_wp
+      do jj = 1,lyr%nnodes
+        childid = lyr%childlayer(jj)
+        if (childid == 0) then
+          s = s+1.0_wp
+        else
+          call fill_inverse_depth_layer(heap,childid)
+          s = s+heap%layer(childid)%inverse_depth
+        end if
+      end do
+      lyr%inverse_depth = s
+    end associate
+  end subroutine fill_inverse_depth_layer
+
+end module molbuilder_construct_list
diff --git a/src/molbuilder/meson.build b/src/molbuilder/meson.build
new file mode 100644
index 00000000..be8febf5
--- /dev/null
+++ b/src/molbuilder/meson.build
@@ -0,0 +1,27 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+#
+# crest is free software: you can redistribute it and/or modify it under
+# the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# crest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with crest.  If not, see <https://www.gnu.org/licenses/>.
+
+srcs += files(
+  'rigidconf.f90',
+  'tree.f90',
+  'analyze.f90',
+  'reconstruct.f90',
+  'construct.f90',
+  'construct_list.f90',
+  'classify.f90',
+  'classify_type.f90', 
+  'classify_func.f90', 
+)
diff --git a/src/rigidconf/reconstruct.f90 b/src/molbuilder/reconstruct.f90
similarity index 100%
rename from src/rigidconf/reconstruct.f90
rename to src/molbuilder/reconstruct.f90
diff --git a/src/rigidconf/rigidconf.f90 b/src/molbuilder/rigidconf.f90
similarity index 94%
rename from src/rigidconf/rigidconf.f90
rename to src/molbuilder/rigidconf.f90
index 1d7abde9..5b9e5de8 100644
--- a/src/rigidconf/rigidconf.f90
+++ b/src/molbuilder/rigidconf.f90
@@ -81,12 +81,8 @@ subroutine this_header
     write (stdout,'(7x,"┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓")')
     write (stdout,'(7x,"┃          R I G I D C O N F           ┃ ")')
     write (stdout,'(7x,"┃     (name is work-in-progress)       ┃ ")')
-    !write(stdout,'(7x,"┃               R i C o                ┃")')
-    !write(stdout,'(7x,"┃              ConfAcc                 ┃")')
     write (stdout,'(7x,"┃    rule-based conformer generator    ┃")')
     write (stdout,'(7x,"┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛")')
-    !write(stdout,'(12x,"C.Zurek, C.Bannwarth, P.Pracht")')
-    !write(stdout,*)
   end subroutine this_header
 end subroutine crest_rigidconf
 !========================================================================================!
diff --git a/src/rigidconf/tree.f90 b/src/molbuilder/tree.f90
similarity index 97%
rename from src/rigidconf/tree.f90
rename to src/molbuilder/tree.f90
index 25afb8e7..29704c28 100644
--- a/src/rigidconf/tree.f90
+++ b/src/molbuilder/tree.f90
@@ -57,7 +57,7 @@ subroutine rigidconf_tree(env,mol)
   use zdata,only:readwbo
   use adjacency
   use INTERNALS_mod
-  use rigidconf_analyze
+  use molbuilder_rigidconf_analyze
   use miscdata,only:rcov
   use crest_cn_module
   implicit none
@@ -162,15 +162,16 @@ subroutine rigidconf_tree(env,mol)
   else !if (.true.) then
 !>--- fallback implementation for testing: All single-bonds with a corresponding
 !>    entry in the zmatrix (this excludes terminal atoms, e.g. H)
-    call rigidconf_count_fallback(mol%nat,na,nb,nc,wbo,ndieder)
+    Amat(:,:) = nint(wbo(:,:))
+    call rigidconf_count_fallback(mol%nat,na,nb,nc,Amat,ndieder)
     if (ndieder < 1) stop 'no dihedral angles selected!'
     allocate (dvalues(ndieder),source=0)
     allocate (dstep(ndieder),source=0.0_wp)
     allocate (ztod(mol%nat),source=0)
-    call rigidconf_analyze_fallback(env,mol,zmat,na,nb,nc,wbo, &
+    call rigidconf_analyze_fallback(mol,zmat,na,nb,nc,wbo, &
     &                               ndieder,dvalues,dstep,ztod)
 
-    !call prune_zmat_dihedrals(mol%nat, mol%xyz, zmat, na,nb,nc, ztod )
+    !call prune_zmat_dihedrals(mol, zmat, na,nb,nc, ztod )
     !call smallhead('New internal coordinates:')
     !call print_zmat(stdout,mol%nat,mol%at,zmat,na,nb,nc,.true.)
 
diff --git a/src/molecule/CMakeLists.txt b/src/molecule/CMakeLists.txt
new file mode 100644
index 00000000..c6f58777
--- /dev/null
+++ b/src/molecule/CMakeLists.txt
@@ -0,0 +1,35 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+#
+# crest is free software: you can redistribute it and/or modify it under
+# the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# crest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with crest.  If not, see <https://www.gnu.org/licenses/>.
+
+set(dir "${CMAKE_CURRENT_SOURCE_DIR}")
+
+list(APPEND srcs
+  "${dir}/parameters.f90"
+  "${dir}/io.f90"
+  "${dir}/type_components.f90" 
+  "${dir}/type_ensemble.f90"
+  "${dir}/type.f90"
+  "${dir}/strucreader.f90"
+  "${dir}/sdfio.f90"
+)
+
+set(srcs ${srcs} PARENT_SCOPE)
+
+
+
+
+
+
diff --git a/src/molecule/io.f90 b/src/molecule/io.f90
new file mode 100644
index 00000000..f5e87d82
--- /dev/null
+++ b/src/molecule/io.f90
@@ -0,0 +1,1800 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module molecule_io
+  use iso_c_binding
+  use molecule_parameters
+  use molecule_type_components
+!> simple geomerty and vector operations
+  use geo
+!> element symbols
+  use crest_cn_module,only:calculate_cn
+  implicit none
+
+! ──────────────────────────────────────────────────────────────────────────────
+!>--- private module variables and parameters
+  private
+
+!>--- private utility subroutines
+  private :: upperCase,lowerCase
+  private :: convertlable,fextension
+
+! ──────────────────────────────────────────────────────────────────────────────
+!>--- public subroutines
+  public :: i2e          !> function to convert atomic number to element symbol
+  public :: asym         !> "
+  interface asym         !> "
+    module procedure i2e !> "
+  end interface asym
+  public :: e2i          !> function to convert element symbol into atomic number
+  public :: grepenergy
+  public :: checkcoordtype
+
+  public :: rdnat       !-- procedure to read number of atoms Nat
+  public :: rdcoord     !-- read an input file, determine format automatically
+  public :: rdxmol      !-- read a file in the Xmol (.xyz) format specifically
+  public :: rdxmolselec !-- read only a certain structure in Xmol file
+  public :: rdPDB
+  public :: read_extxyz_frame
+  public :: get_at_from_ext,get_xyz_from_ext,get_grad_from_ext
+
+  !>--- write a TM coord file
+  public :: wrc0
+  interface wrc0
+    module procedure wrc0_file
+    module procedure wrc0_channel
+  end interface wrc0
+  public :: wrcoord
+  interface wrcoord
+    module procedure wrc0_file
+    module procedure wrc0_channel
+  end interface wrcoord
+
+  !>--- write a XYZ coord file
+  public :: wrxyz
+  interface wrxyz
+    module procedure wrxyz_file
+    module procedure wrxyz_file_mask
+    module procedure wrxyz_channel_energy
+    module procedure wrxyz_channel
+  end interface wrxyz
+
+  !>--- write a sdf molfile
+  public :: wrsdf
+  interface wrsdf
+    module procedure wrsdf_channel
+  end interface wrsdf
+  public :: wrsdfV2000
+  interface wrsdfV2000
+    module procedure wrsdf_channel
+  end interface wrsdfV2000
+  interface wrsdfV3000
+    module procedure wrsdfV3000_channel
+  end interface wrsdfV3000
+  public :: wrsdfV3000
+
+  public :: coordline
+  public :: sgrep
+  public :: get_atlist
+  public :: sumform
+
+! ══════════════════════════════════════════════════════════════════════════════
+contains  !> MODULE PROCEDURES START HERE
+! ══════════════════════════════════════════════════════════════════════════════
+!  ROUTINES FOR READING SINGLE STRUCTURES (COORDS)
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine checkcoordtype(fname,typint)
+!*****************************************************
+!* subroutine checkcoordtype                         *
+!* try to identify the filetype of the coord type.   *
+!* first based on file extension, if that fails by   *
+!* a keyword within the file.                        *
+!*****************************************************
+    implicit none
+    character(len=*) :: fname
+    integer,intent(out) :: typint
+    typint = coordtype%unknown
+    !-- check file extension first
+    select case (fextension(fname))
+    case ('.coord','.COORD')
+      typint = coordtype%turbomole
+    case ('.xyz','.XYZ', &
+        & '.trj','.TRJ','.sorted')
+      typint = coordtype%xyz
+      if (sgrep(fname,'Properties=',casesensitive=.false.)) then
+        typint = coordtype%extxyz
+      end if
+    case ('.extxyz','.EXTXYZ')
+      typint = coordtype%extxyz
+    case ('.sd','.sdf','.SDF','.mol','.MOL')
+      typint = coordtype%sdf
+      if (sgrep(fname,'V2000')) then
+        typint = coordtype%sdfV2000
+      end if
+      if (sgrep(fname,'V3000')) then
+        typint = coordtype%sdfV3000
+      end if
+    case ('.pdb','.PDB')
+      typint = coordtype%PDB
+    case default
+      typint = coordtype%unknown
+    end select
+
+    if (typint .ne. coordtype%unknown) return !-- file extension was recognized
+    !-- grep for keywords otherwise
+    if (sgrep(fname,'$coord')) then
+      typint = coordtype%turbomole
+    else !--no match found
+      typint = coordtype%unknown
+    end if
+    return
+  end subroutine checkcoordtype
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine rdnat(fname,nat,ftype)
+!*******************************************************************
+!* subroutine rdnat                                                *
+!* read number of atoms "nat" form file                            *
+!*                                                                 *
+!* On Input: fname  - name of the coord file                       *
+!*           ftype  - (OPTIONAL) format of the input coord file    *
+!*                    if ftype is not present, it is determined    *
+!* On Output: nat   - number of atoms                              *
+!*******************************************************************
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(out) :: nat
+    integer,optional :: ftype
+    integer :: ftypedum
+    integer :: ich,i,j,io,k
+    logical :: ex
+    character(len=256) :: atmp
+    nat = 0
+    inquire (file=fname,exist=ex)
+    if (.not.ex) then
+      write (stdout,'(a)') '**ERROR** could not find coord file '//trim(fname)
+      call exit(1)
+    end if
+    if (present(ftype)) then
+      ftypedum = ftype
+    else
+      call checkcoordtype(fname,ftypedum)
+    end if
+    open (newunit=ich,file=fname)
+    select case (ftypedum)
+
+    case (coordtype%xyz,coordtype%extxyz)  !--- *.xyz files
+      read (ich,*,iostat=io) nat
+
+    case (coordtype%turbomole)      !--- TM coord file
+      do
+        read (ich,'(a)',iostat=io) atmp
+        if (io < 0) exit
+        atmp = adjustl(atmp)
+        if (index(atmp,"$coord") .eq. 1) exit
+      end do
+      do
+        read (ich,'(a)',iostat=io) atmp
+        if (io < 0) exit
+        atmp = adjustl(atmp)
+        if (atmp(1:1) == '$') exit
+        nat = nat+1
+      end do
+
+    case (coordtype%sdfV2000)      !--- sdf V2000 (or *.mol) file
+      do i = 1,3 !-- first three comment lines
+        read (ich,'(a)',iostat=io) atmp
+        if (io < 0) exit
+      end do
+      read (ich,'(a)',iostat=io) atmp
+      if (index(atmp,'V2000') .ne. 0) then
+        read (atmp,'(i3)') nat !- first argument is nat
+      end if
+
+    case (coordtype%sdfV3000)      !--- sdf V3000 file
+      do
+        read (ich,'(a)',iostat=io) atmp
+        if (io < 0) exit
+        if ((index(atmp,'V30') .ne. 0).and. &
+        &  (index(atmp,'COUNTS') .ne. 0)) then
+          j = index(atmp,'COUNTS')+6
+          k = len_trim(atmp)
+          atmp = atmp(j:k)
+          atmp = adjustl(atmp)
+          read (atmp,*) nat
+        end if
+      end do
+
+    case (coordtype%PDB)      !--- pdb file
+      nat = 0
+      do
+        read (ich,'(a)',iostat=io) atmp
+        if (io < 0) exit
+        if ((index(atmp,'ATOM') .eq. 1).or. &
+        &  (index(atmp,'HETATM') .eq. 1)) then
+          nat = nat+1
+        end if
+      end do
+
+    case default
+      continue
+    end select
+    close (ich)
+    return
+  end subroutine rdnat
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine rdcoord(fname,nat,at,xyz,energy,ftype)
+!*****************************************************************
+!* subroutine rdcoord                                            *
+!* read in a structure. The format is determined automatically   *
+!*                                                               *
+!* On Input: fname  - name of the coord file                     *
+!*           nat    - number of atoms                            *
+!*           ftype  - coord file type (optional)                 *
+!*                                                               *
+!* On Output: at   - atom number as integer                      *
+!*            xyz  - coordinates (always in Bohr)                *
+!*            energy - (OPTIONAL) if present, try to get energy  *
+!*                      mainly from xyz files                    *
+!*****************************************************************
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: nat
+    integer,intent(inout)  :: at(nat)
+    real(wp),intent(inout) :: xyz(3,nat)
+    real(wp),optional :: energy
+    integer,intent(in),optional :: ftype
+    character(len=256) :: atmp
+    integer :: ftypedum
+    type(pdbdata) :: pdbdummy
+
+    if (present(ftype)) then
+      ftypedum = ftype
+    else
+      call checkcoordtype(fname,ftypedum)
+    end if
+
+    select case (ftypedum)
+    case (coordtype%turbomole)  !-- TM coord file, always retruns coords in Bohr
+      call rdtmcoord(fname,nat,at,xyz)
+
+    case (coordtype%xyz)     !-- XYZ file, is Angström, needs conversion
+      if (present(energy)) then
+        call rdxmol(fname,nat,at,xyz,atmp)
+        energy = grepenergy(atmp)
+      else
+        call rdxmol(fname,nat,at,xyz)
+      end if
+      xyz = xyz/bohr
+
+    case (coordtype%sdfV2000)      !-- SDF/MOL V2000 file, also Angström
+      call rdsdf(fname,nat,at,xyz)
+      xyz = xyz/bohr
+
+    case (coordtype%sdfV3000)     !-- SDF V3000 file, Angström
+      call rdsdfV3000(fname,nat,at,xyz)
+      xyz = xyz/bohr
+
+    case (coordtype%PDB)          !-- PDB file, Angström
+      call rdPDB(fname,nat,at,xyz,pdbdummy)
+      xyz = xyz/bohr
+      call pdbdummy%deallocate()
+
+    case default
+      continue
+    end select
+
+    return
+  end subroutine rdcoord
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine rdtmcoord(fname,nat,at,xyz)
+!**************************************************************
+!* subroutine rdtmcoord                                       *
+!* read a struncture in the TM coord style.                   *
+!*                                                            *
+!* On Input: fname  - name of the coord file                  *
+!*           nat    - number of atoms                         *
+!*                                                            *
+!* On Output: at   - atom number as integer                   *
+!*            xyz  - coordinates (always in Bohr)             *
+!**************************************************************
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: nat
+    integer,intent(inout)  :: at(nat)
+    real(wp),intent(inout) :: xyz(3,nat)
+    character(len=6) :: sym
+    integer :: ich,io,i
+    real(wp) :: convert
+    character(len=256) :: atmp
+    open (newunit=ich,file=fname)
+    do
+      read (ich,'(a)',iostat=io) atmp
+      if (io < 0) exit
+      atmp = adjustl(atmp)
+      if (index(atmp,"$coord") .eq. 1) exit
+    end do
+    if (index(atmp,'ang') .ne. 0) then
+      !> coord files allow explicit specification in Angström
+      convert = aatoau
+    else
+      convert = 1.0_wp
+    end if
+    do i = 1,nat
+      read (ich,'(a)',iostat=io) atmp
+      if (io < 0) exit
+      atmp = adjustl(atmp)
+      if (atmp(1:1) == '$') exit
+      call coordline(atmp,sym,xyz(1:3,i),io)
+      if (io < 0) then
+        write (*,*) 'error while reading coord line. EOF'
+        exit
+      end if
+      at(i) = e2i(sym)
+    end do
+    close (ich)
+    xyz = xyz*convert
+    return
+  end subroutine rdtmcoord
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine rdxmol(fname,nat,at,xyz,comment)
+!***************************************************************
+!* subroutine rdxmol                                           *
+!* read a struncture in the *.xyz (Xmol) style.                *
+!* The commentary (second) line is ignored                     *
+!*                                                             *
+!* On Input: fname  - name of the coord file                   *
+!*           nat    - number of atoms                          *
+!*                                                             *
+!* On Output: at   - atom number as integer                    *
+!*            xyz  - coordinates (in Angström)                 *
+!*            comment - (OPTIONAL) commentary line of the file *
+!***************************************************************
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: nat
+    integer,intent(inout)  :: at(nat)
+    real(wp),intent(inout) :: xyz(3,nat)
+    character(len=*),optional :: comment
+    character(len=6) :: sym
+    integer :: ich,io,i
+    integer :: dum
+    character(len=256) :: atmp
+    open (newunit=ich,file=fname)
+    read (ich,*,iostat=io) dum
+    if (nat .ne. dum) then
+      write (stdout,'(a)') '**ERROR** Mismatch in expected atom number for file '//trim(fname)
+      write (stdout,'(a,i0,a,i0)') '          Expected ',nat,' got ',dum
+      call exit(1)
+    end if
+    read (ich,'(a)') atmp !--commentary line
+    if (present(comment)) comment = trim(adjustl(atmp))
+    do i = 1,nat
+      read (ich,'(a)',iostat=io) atmp
+      if (io < 0) exit
+      atmp = adjustl(atmp)
+      call coordline(atmp,sym,xyz(1:3,i),io)
+      if (io < 0) then
+        write (stdout,'(a)') '**ERROR** Unexpected EOF while reading file '//trim(fname)
+        exit
+      end if
+      at(i) = e2i(sym)
+    end do
+    close (ich)
+    return
+  end subroutine rdxmol
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine rdsdf(fname,nat,at,xyz,comment)
+!***************************************************************
+!* subroutine rdsdf                                            *
+!* read a struncture in the .sdf/.mol V2000 style.             *
+!*                                                             *
+!* On Input: fname  - name of the coord file                   *
+!*           nat    - number of atoms                          *
+!*                                                             *
+!* On Output: at   - atom number as integer                    *
+!*            xyz  - coordinates (in Angström)                 *
+!*            comment - (OPTIONAL) commentary line of the file *
+!***************************************************************
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: nat
+    integer,intent(inout)  :: at(nat)
+    real(wp),intent(inout) :: xyz(3,nat)
+    character(len=*),optional :: comment
+    character(len=6) :: sym
+    integer :: ich,io,i
+    integer :: dum
+    character(len=256) :: atmp
+    open (newunit=ich,file=fname)
+    read (ich,'(a)',iostat=io) atmp
+    read (ich,'(a)',iostat=io) atmp
+    read (ich,'(a)',iostat=io) atmp
+    if (present(comment)) comment = trim(adjustl(atmp))
+    read (ich,'(i3)',iostat=io) dum
+    if (nat .ne. dum) then
+      write (stdout,'(a)') '**ERROR** Mismatch in expected atom number for file '//trim(fname)
+      write (stdout,'(a,i0,a,i0)') '          Expected ',nat,' got ',dum
+      call exit(1)
+    end if
+    do i = 1,nat
+      read (ich,'(a)',iostat=io) atmp
+      if (io < 0) exit
+      atmp = adjustl(atmp)
+      call coordline(atmp,sym,xyz(1:3,i),io)
+      if (io < 0) then
+        write (*,*) 'error while reading coord line. EOF'
+        exit
+      end if
+      at(i) = e2i(sym)
+    end do
+    close (ich)
+    return
+  end subroutine rdsdf
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine rdsdfV3000(fname,nat,at,xyz,comment)
+!***************************************************************
+!* subroutine rdsdfV3000                                       *
+!* read a struncture in the .sdf/.mol V3000 style.             *
+!*                                                             *
+!* On Input: fname  - name of the coord file                   *
+!*           nat    - number of atoms                          *
+!*                                                             *
+!* On Output: at   - atom number as integer                    *
+!*            xyz  - coordinates (in Angström)                 *
+!*            comment - (OPTIONAL) commentary line of the file *
+!***************************************************************
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: nat
+    integer,intent(inout)  :: at(nat)
+    real(wp),intent(inout) :: xyz(3,nat)
+    character(len=*),optional :: comment
+    character(len=6) :: sym
+    integer :: ich,io,i,j,k,l
+    integer :: dum
+    character(len=256) :: atmp
+    character(len=32) :: btmp
+    open (newunit=ich,file=fname)
+    read (ich,'(a)',iostat=io) atmp
+    read (ich,'(a)',iostat=io) atmp
+    read (ich,'(a)',iostat=io) atmp
+    if (present(comment)) comment = trim(adjustl(atmp))
+    do
+      read (ich,'(a)',iostat=io) atmp
+      if (io < 0) exit
+      if ((index(atmp,'V30') .ne. 0).and. &
+      &  (index(atmp,'COUNTS') .ne. 0)) then
+        j = index(atmp,'COUNTS')+6
+        k = len_trim(atmp)
+        atmp = atmp(j:k)
+        atmp = adjustl(atmp)
+        read (atmp,*) dum
+      end if
+      if ((index(atmp,'V30') .ne. 0).and. &
+      &  (index(atmp,'ATOM') .ne. 0)) then
+        exit
+      end if
+    end do
+    if (nat .ne. dum) then
+      write (stdout,'(a)') '**ERROR** Mismatch in expected atom number for file '//trim(fname)
+      write (stdout,'(a,i0,a,i0)') '          Expected ',nat,' got ',dum
+      call exit(1)
+    end if
+    do i = 1,nat
+      read (ich,'(a)',iostat=io) atmp
+      if (io < 0) exit
+      write (btmp,'(i0)') i
+      l = len_trim(btmp)+1
+      j = index(atmp,'V30')+3
+      k = len_trim(atmp)
+      atmp = atmp(j:k)
+      atmp = adjustl(atmp)
+      atmp = atmp(l:k)
+      call coordline(atmp,sym,xyz(1:3,i),io)
+      if (io < 0) then
+        write (*,*) 'error while reading coord line. EOF'
+        exit
+      end if
+      at(i) = e2i(sym)
+    end do
+    close (ich)
+    return
+  end subroutine rdsdfV3000
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine rdPDB(fname,nat,at,xyz,pdb)
+!***********************************************
+!* subroutine rdPDB                            *
+!* read a struncture in the .PDB style.        *
+!*                                             *
+!* On Input: fname  - name of the coord file   *
+!*           nat    - number of atoms          *
+!*                                             *
+!* On Output: at   - atom number as integer    *
+!*            xyz  - coordinates (in Angström) *
+!*            pdb  - pdbdata object            *
+!***********************************************
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: nat
+    integer,intent(inout)  :: at(nat)
+    real(wp),intent(inout) :: xyz(3,nat)
+    type(pdbdata) :: pdb
+    character(len=2) :: sym
+    integer :: ich,io,i,j,k
+    character(len=256) :: atmp
+    character(len=6) :: dum1
+    character(len=1) :: dum2,dum3,pdbgp
+    character(len=3) :: pdbas
+    character(len=2) :: dum4
+    character(len=4) :: pdbat
+    real(wp) :: r1,r2
+    call pdb%allocate(nat)
+    open (newunit=ich,file=fname)
+    k = 0
+    do
+      read (ich,'(a)',iostat=io) atmp
+      if (io < 0) exit
+      if ((index(atmp,'ATOM') .eq. 1).or. &
+      &  (index(atmp,'HETATM') .eq. 1)) then
+        k = k+1
+        read (atmp,'(A6,I5,1X,A4,A1,A3,1X,A1,I4,A1,3X,3F8.3,2F6.2,10X,A2,A2)') &
+        &  dum1,i,pdbat,dum2,pdbas,pdbgp,j,dum3,xyz(1:3,k),r1,r2,sym,dum4
+        at(k) = e2i(sym)
+        pdb%pdbat(k) = pdbat
+        pdb%pdbas(k) = pdbas
+        pdb%pdbgrp(k) = pdbgp
+        pdb%pdbfrag(k) = j
+        pdb%pdbocc(k) = r1
+        pdb%pdbtf(k) = r2
+      end if
+    end do
+    close (ich)
+    return
+  end subroutine rdPDB
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine rdxmolselec(fname,m,nat,at,xyz,comment)
+!*******************************************************************
+!* subroutine rdxmolselec                                          *
+!* Read a file with multiple structures in the *.xyz (Xmol) style. *
+!* Picks one structure.                                            *
+!* The commentary (second) line is ignored                         *
+!*                                                                 *
+!* On Input: fname  - name of the coord file                       *
+!*           m      - position of the desired structure            *
+!*           nat    - number of atoms                              *
+!*                                                                 *
+!* On Output: at   - atom number as integer                        *
+!*            xyz  - coordinates (in Bohr)                         *
+!*******************************************************************
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: nat,m
+    integer,intent(inout)  :: at(nat)
+    real(wp),intent(inout) :: xyz(3,nat)
+    character(len=*),optional :: comment
+    character(len=6) :: sym
+    integer :: ich,io,i,j
+    integer :: dum
+    character(len=256) :: atmp
+
+    open (newunit=ich,file=fname)
+
+    do j = 1,m
+      read (ich,*,iostat=io) dum
+      if (nat .ne. dum) then
+        write (stdout,'(a)') '**ERROR** Mismatch in expected atom number for file '//trim(fname)
+        write (stdout,'(a,i0,a,i0)') '          Expected ',nat,' got ',dum
+        call exit(1)
+      end if
+      read (ich,'(a)') atmp !--commentary line
+      if (present(comment)) comment = trim(adjustl(atmp))
+      do i = 1,nat
+        read (ich,'(a)',iostat=io) atmp
+        if (io < 0) exit
+        atmp = adjustl(atmp)
+        call coordline(atmp,sym,xyz(1:3,i),io)
+        if (io < 0) then
+          write (*,*) 'error while reading coord line. EOF'
+          exit
+        end if
+        at(i) = e2i(sym)
+      end do
+    end do
+    close (ich)
+    xyz = xyz/bohr
+    return
+  end subroutine rdxmolselec
+
+!=========================================================================================!
+!=========================================================================================!
+!  3. ROUTINES FOR WRITING STRUCTURES AND CONVERTING THEM
+!=========================================================================================!
+!=========================================================================================!
+
+!============================================================!
+! subroutine wrc0_file
+! this is the typical quick write routine for TM coord files
+! version for writing directly to a new file
+!
+! On Input: fname  - name of the coord file
+!           nat    - number of atoms
+!           at   - atom number as integer
+!           xyz  - coordinates (in Bohr)
+!
+! On Output: file written to "fname"
+!============================================================!
+  subroutine wrc0_file(fname,nat,at,xyz)
+    implicit none
+    character(len=*) :: fname
+    integer :: nat
+    integer :: at(nat)
+    real(wp) ::  xyz(3,nat)
+    integer :: i,j,k,ich,io
+    logical :: ex
+    open (newunit=ich,file=fname,status='replace')
+    write (ich,'(''$coord'')')
+    do j = 1,nat
+      write (ich,'(3F24.12,5x,a2)') xyz(1:3,j),i2e(at(j),'lc')
+    end do
+    write (ich,'(''$end'')')
+    close (ich)
+    return
+  end subroutine wrc0_file
+
+!============================================================!
+! subroutine wrc0_channel
+! this is the typical quick write routine for TM coord files
+! version for writing to a output channel
+!
+! On Input: fname  - name of the coord file
+!           nat    - number of atoms
+!           at   - atom number as integer
+!           xyz  - coordinates (in Bohr)
+!
+! On Output: file written to "fname"
+!============================================================!
+  subroutine wrc0_channel(ch,nat,at,xyz)
+    implicit none
+    integer :: ch
+    integer :: nat
+    integer :: at(nat)
+    real(wp) ::  xyz(3,nat)
+    integer :: i,j,k,ich,io
+    logical :: ex
+    write (ch,'(''$coord'')')
+    do j = 1,nat
+      write (ch,'(3F24.12,5x,a2)') xyz(1:3,j),i2e(at(j),'lc')
+    end do
+    write (ch,'(''$end'')')
+    return
+  end subroutine wrc0_channel
+
+!============================================================!
+! subroutine wrxyz_file
+! this is the typical quick write routine for TM coord files
+! version for writing directly to a new file
+!
+! On Input: fname  - name of the coord file
+!           nat    - number of atoms
+!           at   - atom number as integer
+!           xyz  - coordinates (in Angström)
+!           comment - (OPTIONAL) comment line
+!
+! On Output: file written to "fname"
+!============================================================!
+  subroutine wrxyz_file(fname,nat,at,xyz,comment)
+    implicit none
+    character(len=*) :: fname
+    integer :: nat
+    integer :: at(nat)
+    real(wp) ::  xyz(3,nat)
+    character(len=*),optional :: comment
+    integer :: i,j,k,ich,io
+    logical :: ex
+    open (newunit=ich,file=fname,status='replace')
+    write (ich,'(2x,i0)') nat
+    if (present(comment)) then
+      write (ich,'(a)') trim(comment)
+    else
+      write (ich,*)
+    end if
+    do j = 1,nat
+      write (ich,'(1x,a2,1x,3f20.10)') i2e(at(j),'nc'),xyz(1:3,j)
+    end do
+    close (ich)
+    return
+  end subroutine wrxyz_file
+
+!============================================================!
+! subroutine wrxyz_file_mask
+! this is the typical quick write routine for TM coord files
+! version for writing directly to a new file
+!
+! On Input: fname  - name of the coord file
+!           nat    - number of atoms
+!           at   - atom number as integer
+!           xyz  - coordinates (in Angström)
+!           mask - a mask to determine to write which atoms
+!           comment - (OPTIONAL) comment line
+!
+! On Output: file written to "fname"
+!============================================================!
+  subroutine wrxyz_file_mask(fname,nat,at,xyz,mask,comment)
+    implicit none
+    character(len=*) :: fname
+    integer :: nat
+    integer :: at(nat)
+    real(wp) ::  xyz(3,nat)
+    logical :: mask(nat)
+    integer :: maskednat
+    character(len=*),optional :: comment
+    integer :: i,j,k,ich,io
+    logical :: ex
+    open (newunit=ich,file=fname,status='replace')
+    maskednat = count(mask(:))
+    write (ich,'(2x,i0)') maskednat
+    if (present(comment)) then
+      write (ich,'(a)') trim(comment)
+    else
+      write (ich,*)
+    end if
+    do j = 1,nat
+      if (mask(j)) then
+        write (ich,'(1x,a2,1x,3f20.10)') i2e(at(j),'nc'),xyz(1:3,j)
+      end if
+    end do
+    close (ich)
+    return
+  end subroutine wrxyz_file_mask
+
+!============================================================!
+! subroutine wrxyz_channel
+! this is the typical quick write routine for xyz files
+! version for writing to a output channel
+!
+! On Input: fname  - name of the coord file
+!           nat    - number of atoms
+!           at   - atom number as integer
+!           xyz  - coordinates (in Angström)
+!           comment - (OPTIONAL) the comment line
+!
+! On Output: file written to "fname"
+!============================================================!
+  subroutine wrxyz_channel(ch,nat,at,xyz,comment)
+    implicit none
+    integer :: ch
+    integer :: nat
+    integer :: at(nat)
+    real(wp) ::  xyz(3,nat)
+    character(len=*),optional :: comment
+    integer :: i,j,k,ich,io
+    logical :: ex
+    write (ch,'(2x,i0)') nat
+    if (present(comment)) then
+      write (ch,'(a)') trim(comment)
+    else
+      write (ch,*)
+    end if
+    do j = 1,nat
+      write (ch,'(1x,a2,1x,3f20.10)') i2e(at(j),'nc'),xyz(1:3,j)
+    end do
+    return
+  end subroutine wrxyz_channel
+
+!============================================================!
+! subroutine wrxyz_channel
+! this is the typical quick write routine for xyz files
+! version for writing to a output channel
+!
+! On Input: fname  - name of the coord file
+!           nat    - number of atoms
+!           at   - atom number as integer
+!           xyz  - coordinates (in Angström)
+!           er   - energy
+!
+! On Output: file written to "fname"
+!============================================================!
+  subroutine wrxyz_channel_energy(ch,nat,at,xyz,er)
+    implicit none
+    integer :: ch
+    integer :: nat
+    integer :: at(nat)
+    real(wp) ::  xyz(3,nat)
+    real(wp) :: er
+    integer :: i,j,k,ich,io
+    logical :: ex
+    character(len=30) :: etmp
+    write (ch,'(2x,i0)') nat
+    write (etmp,'(f20.10)') er
+    write (ch,'(2x,a,a)') "energy=",adjustl(etmp)
+    do j = 1,nat
+      write (ch,'(1x,a2,1x,3f20.10)') i2e(at(j),'nc'),xyz(1:3,j)
+    end do
+    return
+  end subroutine wrxyz_channel_energy
+
+!============================================================!
+! subroutine wrsdf_channel
+! this is the quick write routine for sdf files
+! version for writing to a output channel
+!
+! On Input: fname  - name of the coord file
+!           nat    - number of atoms
+!           at   - atom number as integer
+!           xyz  - coordinates (in Angström)
+!           er   - energy
+!           wbo  - bond order matrix
+!
+! On Output: written to channel "ch"
+!============================================================!
+  subroutine wrsdf_channel(ch,nat,at,xyz,er,chrg,wbo,comment,icharges)
+    implicit none
+    integer,intent(in) :: ch
+    integer,intent(in) :: nat
+    integer,intent(in) :: at(nat)
+    real(wp),intent(in) ::  xyz(3,nat)
+    real(wp),intent(in) :: er
+    integer,intent(in) :: chrg
+    real(wp),intent(in) :: wbo(nat,nat)
+    character(len=*),intent(in) :: comment
+    real(wp),intent(in),optional :: icharges(nat)
+    character(len=8)  :: date
+    character(len=10) :: time
+    integer :: list12(12),nbd
+    integer,parameter :: list4(4) = 0
+    integer,parameter :: list8(8) = 0
+    character(len=*),parameter :: countsfmt = '(3i3, 8i3, 1x, a5)'
+    character(len=*),parameter :: atmfmt = '(3f10.4, 1x, a2, 12i3)'
+    character(len=*),parameter :: bndfmt = '(7i3)'
+    integer :: i,j,k,ich,io
+    logical :: ex
+
+    !>--- generate data
+    call date_and_time(date,time)
+    nbd = countbonds(nat,wbo)
+    list12 = 0
+    !>--- comment lines
+    call date_and_time(date,time)
+    write (ch,'(a)') trim(comment)
+    write (ch,'(1x,a, 3a2, a4, "3D",1x,a,f18.8,5x)') &
+    & 'crest',date(5:6),date(7:8),date(3:4),time(:4),'Energy =',er
+    write (ch,'(a)')
+    !>--- counts line
+    write (ch,countsfmt) nat,nbd,list8,999,'V2000'
+    !>--- atom block
+    do j = 1,nat
+      write (ch,atmfmt) xyz(1:3,j),i2e(at(j),'nc'),list12
+    end do
+    !>--- bonds block
+    do i = 1,nat
+      do j = i+1,nat
+        k = nint(wbo(j,i))
+        if (k > 0) then
+          write (ch,bndfmt) i,j,k,list4
+        end if
+      end do
+    end do
+    !>--- other
+    if (present(icharges)) then
+      do i = 1,nat
+        if (abs(nint(icharges(i))) /= 0) then
+          write (ch,'(a, *(i3, 1x, i3, 1x, i3))') "M  CHG",1,i,nint(icharges(i))
+        end if
+      end do
+    else if (chrg .ne. 0) then
+      write (ch,'(a, *(i3, 1x, i3, 1x, i3))') "M  CHG",1,1,chrg
+    end if
+    write (ch,'(a)') 'M  END'
+    write (ch,'(a)') '$$$$'
+    return
+  end subroutine wrsdf_channel
+
+!============================================================!
+! subroutine wrsdfV3000_channel
+! this is the quick write routine for sdf files
+! version for writing to a output channel
+!
+! On Input: fname  - name of the coord file
+!           nat    - number of atoms
+!           at   - atom number as integer
+!           xyz  - coordinates (in Angström)
+!           er   - energy
+!           wbo  - bond order matrix
+!
+! On Output: written to channel "ch"
+!============================================================!
+  subroutine wrsdfV3000_channel(ch,nat,at,xyz,er,chrg,wbo,comment)
+    implicit none
+    integer,intent(in) :: ch
+    integer,intent(in) :: nat
+    integer,intent(in) :: at(nat)
+    real(wp),intent(in) ::  xyz(3,nat)
+    real(wp),intent(in) :: er
+    real(wp),intent(in) :: chrg
+    real(wp),intent(in) :: wbo(nat,nat)
+    character(len=*),intent(in),optional :: comment
+    character(len=8)  :: date
+    character(len=10) :: time
+    integer :: list12(12),nbd,b
+    integer,parameter :: list4(4) = 0
+    character(len=*),parameter :: countsfmt = '(3i3, 8i3, 1x, a5)'
+    character(len=*),parameter :: countsfmt2 = '(a,2i3, 3i3)'
+    character(len=*),parameter :: atmfmt = '(a,1x,i0,1x, a,3f10.4, i2, 11i3)'
+    character(len=*),parameter :: bndfmt = '(a,1x,i0,1x,7i3)'
+    integer :: i,j,k,ich,io
+    logical :: ex
+
+    !>--- generate data
+    call date_and_time(date,time)
+    nbd = countbonds(nat,wbo)
+    !>--- comment lines
+    call date_and_time(date,time)
+    if (present(comment)) then
+      write (ch,'(1x,a)') comment
+    else
+      write (ch,'(1x,a)') 'structure written by crest'
+    end if
+    write (ch,'(1x,a,f18.8,5x, 3a2, a4, "3D")') &
+    & 'Energy =',er,date(5:6),date(7:8),date(3:4),time(:4)
+    write (ch,'(a)')
+    !>--- counts line
+    write (ch,countsfmt) nat,nbd,0,0,0,999,'V2000'
+    write (ch,'("M V30 BEGIN CTAB")')
+    write (ch,countsfmt2) "M V30 COUNTS",nat,nbd,0,0,0
+    !>--- atom block
+    write (ch,'("M V30 BEGIN ATOM")')
+    do j = 1,nat
+      write (ch,atmfmt) 'M V30',j, &
+      &     i2e(at(j),'nc'),xyz(1:3,j),list12
+    end do
+    write (ch,'("M V30 END ATOM")')
+    !>--- bonds block
+    write (ch,'("M V30 BEGIN BOND")')
+    b = 0
+    do i = 1,nat
+      do j = i+1,nat
+        k = nint(wbo(j,i))
+        if (k > 0) then
+          b = b+1
+          write (ch,bndfmt) "M V30",b,i,j,k,list4
+        end if
+      end do
+    end do
+    write (ch,'("M V30 END BOND")')
+    !>--- other
+    if (chrg .ne. 0) then
+      write (ch,'(a, *(i3, 1x, i3, 1x, i3))') "M V30 CHG",1,1,chrg
+    end if
+    write (ch,'(a)') 'M V30 END CTAB'
+    write (ch,'(a)') 'M  END'
+    write (ch,'(a)') '$$$$'
+    return
+  end subroutine wrsdfV3000_channel
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine read_extxyz_frame(iunit,ext_sigs,ext_props,nat,energy,lat,success, &
+  &                            energy_units,forces_units)
+    implicit none
+
+    ! Formal Arguments
+    integer,intent(in)          :: iunit
+    type(extxyz_signatures),intent(out) :: ext_sigs
+    type(extxyz_properties),intent(out) :: ext_props
+    integer,intent(out)  :: nat
+    real(wp),intent(out) :: energy
+    real(wp),intent(out),allocatable :: lat(:,:)
+    logical,intent(out)         :: success
+    character(len=32),intent(out),optional :: energy_units
+    character(len=32),intent(out),optional :: forces_units
+
+    ! Internal variables
+    integer                      :: i,ierr,total_fields
+    character(len=5000)          :: comment_line
+    character(len=2000)          :: val_str
+    logical                      :: found
+    real(wp)                     :: lattice(3,3)
+    real(wp)                     :: lat_raw(9)
+    character(len=128),allocatable :: line_fields(:)
+    character(len=2000)          :: current_line
+
+    success = .true.
+
+    ! 1. Read Number of Atoms (nat)
+    read (iunit,*,iostat=ierr) nat
+    if (ierr /= 0) then
+      success = .false.
+      return
+    end if
+
+    ! 2. Read the long comment line
+    read (iunit,'(A)',iostat=ierr) comment_line
+    if (ierr /= 0) then
+      success = .false.
+      return
+    end if
+
+    ! 3. Extract Key-Value Pairs
+    ! Extract Energy
+    call get_key_value(comment_line,"energy",val_str,found,case_sensitive=.false.)
+    if (found) read (val_str,*) energy
+
+    ! Extract optional unit specifications (defaults: eV for energy, eV/Ang for forces)
+    ! Values are stored lowercase so callers can do case-insensitive comparisons.
+    if (present(energy_units)) then
+      energy_units = 'ev'
+      call get_key_value(comment_line,"energy_units",val_str,found,case_sensitive=.false.)
+      if (found) energy_units = lowerCase(trim(adjustl(val_str)))
+    end if
+    if (present(forces_units)) then
+      forces_units = 'ev/ang'
+      call get_key_value(comment_line,"forces_units",val_str,found,case_sensitive=.false.)
+      if (found) forces_units = lowerCase(trim(adjustl(val_str)))
+    end if
+
+    ! Extract Lattice
+    call get_key_value(comment_line,"lattice",val_str,found,case_sensitive=.false.)
+    if (found) then
+      read (val_str,*) lat_raw
+      lattice = reshape(lat_raw, (/3,3/))
+      allocate (lat(3,3))
+      lat = lattice
+    end if
+
+    ! Extract and Parse Properties Signature
+    call get_extxyz_value(comment_line,"Properties",val_str,found)
+    call get_key_value(comment_line,'Properties',val_str,found,case_sensitive=.false.)
+    if (found) then
+      call parse_properties_tag(val_str,ext_sigs)
+    else
+      success = .false.
+      return
+    end if
+
+    ! 4. Allocate extxyz_properties based on signatures
+    call allocate_extxyz_properties_from_sigs(nat,ext_sigs,ext_props)
+
+    ! 5. Read Atom Data Lines
+    total_fields = ext_sigs%total_fields
+    allocate (line_fields(total_fields))
+
+    do i = 1,nat
+      read (iunit,'(A)',iostat=ierr) current_line
+      if (ierr /= 0) then
+        success = .false.
+        exit
+      end if
+
+      ! 6. Fill entries in extxyz_properties
+      call fill_atom_properties(current_line,ext_props,i)
+    end do
+  end subroutine read_extxyz_frame
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine fill_atom_properties(current_line,ext_props,i)
+    implicit none
+    character(len=*),intent(in) :: current_line
+    type(extxyz_properties),intent(inout) :: ext_props
+    integer,intent(in) :: i
+    integer :: ii,jj,kk,ierr
+    character(len=32),allocatable :: line_fields(:)
+
+    allocate (line_fields(ext_props%total_fields),source=repeat(' ',32))
+
+    read (current_line,*,iostat=ierr) line_fields
+    if (ierr /= 0) then
+      write (stdout,*) '**ERROR** unexpected line fromat in extxyz parsing for atom',i
+    end if
+
+    kk = 0
+    do ii = 1,ext_props%n_props
+      associate (prop => ext_props%props(ii))
+        do jj = 1,prop%signat%n_fields
+          kk = kk+1
+          select case (prop%signat%p_type)
+          case ('S')
+            prop%S(jj,i) = trim(line_fields(kk))
+          case ('I')
+            read (line_fields(kk),*,iostat=ierr) prop%I(jj,i)
+          case ('R')
+            read (line_fields(kk),*,iostat=ierr) prop%R(jj,i)
+          end select
+          if (ierr /= 0) then
+            write (stdout,*) '**ERROR** unexpected line fromat in extxyz parsing for element',jj,'of atom',i
+            return
+          end if
+        end do
+      end associate
+    end do
+
+  end subroutine fill_atom_properties
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine get_at_from_ext(ext_props,at)
+    implicit none
+    type(extxyz_properties) :: ext_props
+    integer,intent(out),allocatable :: at(:)
+    integer :: ii,jj,nat
+    do ii = 1,ext_props%n_props
+      associate (prop => ext_props%props(ii))
+        select case (trim(prop%signat%name))
+        case ('species')
+          nat = prop%natoms
+          allocate (at(nat),source=0)
+          do jj = 1,nat
+            at(jj) = e2i(trim(prop%S(1,jj)))
+          end do
+        end select
+      end associate
+    end do
+  end subroutine get_at_from_ext
+
+  subroutine get_xyz_from_ext(ext_props,xyz)
+    implicit none
+    type(extxyz_properties) :: ext_props
+    real(wp),intent(out),allocatable :: xyz(:,:)
+    integer :: ii,jj,nat
+    do ii = 1,ext_props%n_props
+      associate (prop => ext_props%props(ii))
+        select case (trim(prop%signat%name))
+        case ('pos')
+          nat = prop%natoms
+          allocate (xyz(3,nat),source=0.0_wp)
+          do jj = 1,nat
+            xyz(:,jj) = prop%R(:,jj)*aatoau
+          end do
+        end select
+      end associate
+    end do
+  end subroutine get_xyz_from_ext
+
+  subroutine get_grad_from_ext(ext_props,grad,forces_units)
+    implicit none
+    type(extxyz_properties) :: ext_props
+    real(wp),intent(out),allocatable :: grad(:,:)
+    character(len=32),intent(in),optional :: forces_units
+    integer :: ii,jj,nat
+    character(len=32) :: units_loc
+    units_loc = 'eV/Ang'
+    if (present(forces_units)) units_loc = forces_units
+    do ii = 1,ext_props%n_props
+      associate (prop => ext_props%props(ii))
+        select case (trim(prop%signat%name))
+        case ('forces')
+          nat = prop%natoms
+          allocate (grad(3,nat),source=0.0_wp)
+          do jj = 1,nat
+            select case (trim(units_loc))
+            case ('ha/bohr','hartree/bohr','au')
+              grad(:,jj) = prop%R(:,jj)*(-1.0_wp)  ! forces → gradient (sign flip only)
+            case default                             ! 'ev/ang' and anything unrecognised
+              grad(:,jj) = prop%R(:,jj)*(-autoaa/autoeV)
+            end select
+          end do
+        end select
+      end associate
+    end do
+  end subroutine get_grad_from_ext
+
+!=========================================================================================!
+!=========================================================================================!
+!  4. GENERAL UTILITY ROUTINES
+!=========================================================================================!
+!=========================================================================================!
+
+!============================================================!
+! read a line of coordinates and determine by itself
+! if the format is x,y,z,at or at,x,y,z
+!============================================================!
+  subroutine coordline(line,sym,xyz,io)
+    implicit none
+    character(len=*) :: line
+    character(len=*) :: sym
+    real(wp) :: xyz(3)
+    integer,intent(out) :: io
+
+    io = 0
+    read (line,*,iostat=io) xyz(1:3),sym
+    if (io .ne. 0) then
+      read (line,*,iostat=io) sym,xyz(1:3)
+    end if
+
+    return
+  end subroutine coordline
+
+!============================================================!
+! convert a string into uppercase
+!============================================================!
+  function upperCase(s)
+    implicit none
+    character(len=*),intent(in) :: s
+    character(len=:),allocatable :: sout
+    character(len=:),allocatable :: upperCase
+    integer :: ic,i
+    character(26),Parameter :: high = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+    character(26),Parameter :: low = 'abcdefghijklmnopqrstuvwxyz'
+    sout = s
+    do i = 1,LEN_TRIM(s)
+      ic = INDEX(low,s(i:i))
+      if (ic > 0) sout(i:i) = high(ic:ic)
+    end do
+    call move_alloc(sout,upperCase)
+  end function upperCase
+
+!============================================================!
+! convert a string into lowercase
+!============================================================!
+  function lowerCase(s)
+    implicit none
+    character(len=*),intent(in) :: s
+    character(len=:),allocatable :: sout
+    character(len=:),allocatable :: lowerCase
+    integer :: ic,i
+    character(26),Parameter :: high = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+    character(26),Parameter :: low = 'abcdefghijklmnopqrstuvwxyz'
+    sout = s
+    do i = 1,LEN_TRIM(s)
+      ic = INDEX(high,s(i:i))
+      if (ic > 0) sout(i:i) = low(ic:ic)
+    end do
+    call move_alloc(sout,lowerCase)
+  end function lowerCase
+
+!============================================================!
+! split element lable if some isotope indicator was given
+! and convert to uppercase
+!============================================================!
+  function convertlable(s)
+    implicit none
+    character(len=*),intent(in) :: s
+    character(len=:),allocatable :: sout
+    character(len=:),allocatable :: convertlable
+    integer :: ic,i
+    character(14),parameter :: lab = '0123456789*_+-'
+    character(26),parameter :: high = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+    character(26),parameter :: low = 'abcdefghijklmnopqrstuvwxyz'
+    sout = s
+    do i = 1,len_trim(s)
+      ic = index(lab,s(i:i))
+      if (ic > 0) sout(i:i) = ' '
+      ic = index(low,s(i:i))
+      if (ic > 0) sout(i:i) = high(ic:ic)
+    end do
+    sout = trim(adjustl(sout))
+    if (len_trim(sout) .gt. 1) then
+      sout(2:2) = lowerCase(sout(2:2))
+    else
+      sout = sout//' '
+    end if
+    call move_alloc(sout,convertlable)
+  end function convertlable
+
+!============================================================!
+! e2i is used to map the element (as a string) to integer
+!============================================================!
+  integer function e2i(cin)
+    implicit none
+    character(len=*),intent(in) :: cin
+    character(len=:),allocatable :: c
+    integer :: iout
+    integer :: i,j,k,ich,io,Z
+    logical :: ex
+    c = trim(convertlable(cin))
+    read (cin,*,iostat=io) j
+    if (io == 0) Z = j
+    if (any(PSE(:) .eq. c)) then
+      do i = 1,118
+        if (trim(PSE(i)) .eq. c) then
+          iout = i
+          exit
+        end if
+      end do
+    else if (io == 0.and.Z <= 118) then
+      iout = Z
+    else !> special cases
+      select case (trim(c))
+      case ('D'); iout = 1
+      case ('T'); iout = 1
+      case default; iout = 0
+      end select
+    end if
+    e2i = iout
+  end function e2i
+
+!============================================================!
+! i2e is used to map the element (as a integer) to a string
+!============================================================!
+  character(len=2) function i2e(iin,oformat)
+    implicit none
+    integer,intent(in) :: iin
+    character(len=:),allocatable :: c
+    character(len=*),optional :: oformat
+    if (iin <= 118) then
+      c = uppercase(PSE(iin))
+    else
+      c = 'XX'
+    end if
+    i2e = trim(c)
+    if (present(oformat)) then
+      select case (oformat)
+      case ('lc','lowercase')
+        i2e = lowerCase(trim(c))
+      case ('nc','nicecase')
+        if (len_trim(c) .gt. 1) then
+          c(2:2) = lowerCase(c(2:2))
+          i2e = trim(c)
+        end if
+      case default
+        continue
+      end select
+    end if
+  end function i2e
+
+!============================================================!
+! get the file extension
+!============================================================!
+  function fextension(s)
+    implicit none
+    character(len=*),intent(in) :: s !filename
+    character(len=:),allocatable :: sout
+    character(len=:),allocatable :: fextension !output
+    integer :: ic,i
+    sout = trim(adjustl(s))
+    i = len_trim(sout)
+    ic = index(sout,'.',.true.)
+    if (ic .ne. 0) then
+      fextension = sout(ic:i)
+    else
+      fextension = 'none'
+    end if
+    return
+  end function fextension
+
+!============================================================!
+! grep for a keyword within the file
+!============================================================!
+  function sgrep(fname,key,casesensitive)
+    implicit none
+    character(len=*),intent(in) :: fname
+    character(len=*),intent(in) :: key
+    logical,intent(in),optional :: casesensitive
+    logical :: sgrep,ex
+    logical :: convert
+    character(len=5000) :: atmp
+    character(len=:),allocatable :: kkey
+    integer :: ic,io
+    sgrep = .false.
+    convert = .false.
+    inquire (file=fname,exist=ex)
+    if (.not.ex) return
+    kkey = trim(key)
+    if (present(casesensitive)) then
+      if (.not.casesensitive)then
+        kkey = lowercase(key)
+        convert = .true.
+      endif
+    end if
+    open (newunit=ic,file=fname)
+    do
+      read (ic,'(a)',iostat=io) atmp
+      if (io < 0) exit !EOF
+      if (convert) then
+        if (index(lowercase(atmp),kkey) .ne. 0) then
+          sgrep = .true.
+          exit
+        end if
+      else
+        if (index(atmp,kkey) .ne. 0) then
+          sgrep = .true.
+          exit
+        end if
+      end if
+    end do
+    close (ic)
+    return
+  end function sgrep
+
+!============================================================!
+! grep the energy from a line of strings
+!============================================================!
+  function grepenergy(line)
+    implicit none
+    real(wp) :: grepenergy
+    character(len=*),intent(in) :: line
+    real(wp) :: energy
+    character(len=:),allocatable :: atmp
+    integer :: i,io,k
+    atmp = trim(line)
+    energy = 0.0_wp
+    if (index(atmp,'energy=') .ne. 0) then
+      k = index(atmp,'energy=')
+      atmp = atmp(k+7:)
+      read (atmp,*,iostat=io) energy
+      if (io .ne. 0) energy = 0.0_wp
+    else if (index(atmp,'energy:') .ne. 0) then
+      k = index(atmp,'energy:')
+      atmp = atmp(k+7:)
+      read (atmp,*,iostat=io) energy
+      if (io .ne. 0) energy = 0.0_wp
+    else
+      !> assumes that the first float in the line is the energy
+      do i = 1,len_trim(atmp)
+        if (len_trim(atmp) .lt. 1) exit
+        read (atmp,*,iostat=io) energy
+        if (io > 0) then
+          atmp = atmp(2:)
+          atmp = adjustl(atmp)
+          cycle
+        else
+          exit
+        end if
+      end do
+    end if
+    grepenergy = energy
+    return
+  end function grepenergy
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine get_extxyz_value(comment_line,key,value,found)
+!*************************************************************************
+!* subroutine get_extxyz_value                                           *
+!* grep a key-value-pair from the comment line of an extended XYZ file   *
+!* On input:                                                             *
+!*      comment_line - the comment line                                  *
+!*      key          - the key to look for (case INSENSITIVE)            *
+!*                                                                       *
+!* On output:                                                            *
+!*      value - the value as raw string                                  *
+!*      found - success logical, did we find the key?                    *
+!*************************************************************************
+    implicit none
+    character(len=*),intent(in)  :: comment_line
+    character(len=*),intent(in)  :: key
+    character(len=*),intent(out) :: value
+    logical,intent(out)          :: found
+
+    integer :: key_start,val_start,val_end,line_len
+    character(len=:),allocatable :: search_key
+
+    found = .false.
+    value = ""
+    line_len = len_trim(comment_line)
+
+    search_key = lowercase(key)//"="
+    key_start = index(comment_line,trim(search_key))
+
+    if (key_start > 0) then
+      val_start = key_start+len_trim(search_key)
+
+      ! --- Skip any spaces between '=' and the value
+      do while (val_start <= line_len.and.comment_line(val_start:val_start) == " ")
+        val_start = val_start+1
+      end do
+
+      ! If we hit the end of the line, the key had no value
+      if (val_start > line_len) return
+      found = .true.
+
+      ! Check for quotes
+      if (comment_line(val_start:val_start) == '"'.or. &
+          comment_line(val_start:val_start) == "'") then
+
+        val_start = val_start+1
+        val_end = val_start+index(comment_line(val_start:),comment_line(val_start-1:val_start-1))-2
+      else
+        ! Bare value: find next space
+        val_end = val_start+index(comment_line(val_start:)," ")-2
+        if (val_end < val_start) val_end = line_len
+      end if
+
+      value = comment_line(val_start:val_end)
+    end if
+  end subroutine get_extxyz_value
+
+  subroutine get_key_value(input_str,key,value,success,case_sensitive)
+    implicit none
+
+    ! Arguments
+    character(len=*),intent(in)          :: input_str     ! The full string to search
+    character(len=*),intent(in)          :: key           ! The key to look for
+    character(len=*),intent(out)         :: value         ! The extracted value
+    logical,intent(out)         :: success       ! True if found and parsed
+    logical,intent(in),optional :: case_sensitive ! Toggle case sensitivity
+
+    ! Internal variables
+    integer :: key_len,str_len,start_pos,val_start,val_end
+    character(len=len(input_str)) :: search_str,search_key
+    character(len=1) :: quote_char
+    logical :: sensitive
+
+    ! Initialize
+    success = .false.
+    value = ""
+    sensitive = .true.
+    if (present(case_sensitive)) sensitive = case_sensitive
+
+    key_len = len_trim(key)
+    str_len = len_trim(input_str)
+
+    ! Prepare strings for case-insensitive search if requested
+    if (.not.sensitive) then
+      search_str = lowercase(input_str)
+      search_key = lowercase(key)
+    else
+      search_str = input_str
+      search_key = key
+    end if
+
+    ! Find key followed immediately by '='
+    ! Note: Searching for 'key=' to satisfy the "no whitespace" requirement
+    start_pos = index(search_str,trim(search_key)//'=')
+
+    if (start_pos > 0) then
+      ! Value starts right after 'key='
+      val_start = start_pos+key_len+1
+
+      ! Check for quotes
+      quote_char = input_str(val_start:val_start)
+
+      if (quote_char == '"'.or.quote_char == "'") then
+        ! Handle quoted value
+        val_start = val_start+1
+        ! Find the closing quote starting from the next character
+        val_end = index(input_str(val_start:),quote_char)
+
+        if (val_end > 0) then
+          val_end = val_start+val_end-2
+          value = input_str(val_start:val_end)
+          success = .true.
+        end if
+      else
+        ! Handle unquoted value (extract until next space or end of string)
+        val_end = index(input_str(val_start:)," ")
+        if (val_end == 0) then
+          val_end = str_len
+        else
+          val_end = val_start+val_end-2
+        end if
+        value = input_str(val_start:val_end)
+        success = .true.
+      end if
+    end if
+  end subroutine get_key_value
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  function count_extxyz_pairs(comment_line) result(num_pairs)
+    implicit none
+    character(len=*),intent(in) :: comment_line
+    integer :: num_pairs
+    integer :: i,line_len
+    logical :: in_quotes
+    character :: quote_char
+
+    num_pairs = 0
+    in_quotes = .false.
+    line_len = len_trim(comment_line)
+    quote_char = ' '
+
+    do i = 1,line_len
+      ! Check if we are entering or leaving a quoted section
+      if (.not.in_quotes) then
+        if (comment_line(i:i) == '"'.or.comment_line(i:i) == "'") then
+          in_quotes = .true.
+          quote_char = comment_line(i:i)
+        end if
+      else
+        ! If we are in quotes, look for the matching closing quote
+        if (comment_line(i:i) == quote_char) then
+          in_quotes = .false.
+        end if
+      end if
+
+      ! If we find an '=' while NOT in quotes, it's a new key-value pair
+      if (.not.in_quotes.and.comment_line(i:i) == '=') then
+        num_pairs = num_pairs+1
+      end if
+    end do
+  end function count_extxyz_pairs
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+!============================================================!
+! count number of bonds from an wbo matrix
+!============================================================!
+  function countbonds(nat,wbo) result(nbd)
+    implicit none
+    integer,intent(in)  :: nat
+    real(wp),intent(in) :: wbo(nat,nat)
+    integer :: nbd
+    integer :: i,j,k
+    nbd = 0
+    do i = 1,nat
+      do j = 1,i-1
+        k = nint(wbo(i,j))
+        if (k > 0) nbd = nbd+1
+      end do
+    end do
+    return
+  end function countbonds
+
+!=========================================================================================!
+
+  subroutine get_atlist(nat,atlist,line,at)
+!******************************************************
+!* Analyze a string containing atom specifications.
+!* "atlist" is a array of booleans for each atom,
+!* which is set to .true. should the atom be contained
+!* in atlist.
+!******************************************************
+    implicit none
+    integer,intent(in) :: nat
+    logical,intent(out),allocatable :: atlist(:)
+    character(len=*),intent(in) :: line
+    integer,intent(in),optional :: at(nat)
+    character(len=:),allocatable :: substr(:)
+    integer :: i,j,k,l,io,ns,ll,i1,i2,io1,io2,i3,i4
+    character(len=:),allocatable :: atmp,btmp
+
+    allocate (atlist(nat),source=.false.)
+!>-- count stuff
+    ll = len_trim(line)
+    ns = 1
+    do i = 1,ll
+      if (line(i:i) .eq. ',') ns = ns+1
+    end do
+    allocate (substr(ns),source=repeat(' ',ll))
+!>-- cut stuff
+    if (ns > 1) then
+      j = 1
+      k = 1
+      do i = 1,ll
+        if (k == ns) then
+          substr(k) = lowercase(adjustl(line(j:)))
+          exit
+        end if
+        if (line(i:i) .eq. ',') then
+          substr(k) = lowercase(adjustl(line(j:i-1)))
+          k = k+1
+          j = i+1
+        end if
+      end do
+    else
+      substr(1) = trim(line)
+    end if
+!>--- analyze stuff
+    do i = 1,ns
+      atmp = trim(substr(i))
+      if (atmp .eq. 'all') then
+        atlist(:) = .true.
+        exit
+      end if
+      if (index(atmp,'.') .ne. 0) cycle !> exclude floats
+      l = index(atmp,'-')
+      if (l .eq. 0) then
+        read (atmp,*,iostat=io) i1
+        !> check if it is an element symbol
+        if (io /= 0) then
+          if (len_trim(atmp) > 2) then
+            if (index(trim(atmp),'heavy') .ne. 0) then !> all heavy atoms
+              if (present(at)) then
+                do j = 1,nat
+                  if (at(j) > 1) atlist(j) = .true.
+                end do
+              end if
+            end if
+          else !> element symbols
+            k = e2i(atmp)
+            if (present(at)) then
+              do j = 1,nat
+                if (at(j) == k) atlist(j) = .true.
+              end do
+            end if
+          end if
+        else
+          atlist(i1) = .true.
+        end if
+      else
+        btmp = atmp(:l-1)
+        read (btmp,*,iostat=io1) i1
+        btmp = atmp(l+1:)
+        read (btmp,*,iostat=io2) i2
+        if (io1 .eq. 0.and.io2 .eq. 0) then
+          i4 = max(i1,i2)
+          i3 = min(i1,i2)
+          do j = 1,nat
+            if (i3 <= j.and.j <= i4) atlist(j) = .true.
+          end do
+        end if
+      end if
+    end do
+    deallocate (substr)
+  end subroutine get_atlist
+
+!=========================================================================================!
+  function sumform(nat,at) result(sumformula)
+!************************************************
+!* get sumformula as a string from the AT array
+!************************************************
+    implicit none
+    integer,intent(in) :: nat
+    integer,intent(in) :: at(nat)
+    character(len=:),allocatable :: sumformula
+    integer :: sumat(118)
+    integer :: i
+    character(len=6) :: str
+    sumformula = ''
+    sumat = 0
+    do i = 1,nat
+      sumat(at(i)) = sumat(at(i))+1
+    end do
+    !> carbon always first
+    if (sumat(6) > 0) then
+      if (sumat(6) > 1) then
+        write (str,'(a,i0)') trim(adjustl(i2e(6,'nc'))),sumat(6)
+      else
+        str = 'C'
+      end if
+      sumformula = trim(sumformula)//trim(str)
+    end if
+    do i = 2,118
+      if (i == 6) cycle
+      if (sumat(i) .lt. 1) cycle
+      if (sumat(i) > 1) then
+        write (str,'(a,i0)') trim(adjustl(i2e(i,'nc'))),sumat(i)
+      else
+        str = trim(i2e(i,'nc'))
+      end if
+      sumformula = trim(sumformula)//trim(str)
+    end do
+    !> hydrogen always last
+    if (sumat(1) > 0) then
+      if (sumat(1) > 1) then
+        write (str,'(a,i0)') trim(adjustl(i2e(1,'nc'))),sumat(1)
+      else
+        str = 'H'
+      end if
+      sumformula = trim(sumformula)//trim(str)
+    end if
+    return
+  end function sumform
+
+! ══════════════════════════════════════════════════════════════════════════════
+! end of the module
+! ══════════════════════════════════════════════════════════════════════════════
+end module molecule_io
diff --git a/src/molecule/meson.build b/src/molecule/meson.build
new file mode 100644
index 00000000..1dda1316
--- /dev/null
+++ b/src/molecule/meson.build
@@ -0,0 +1,25 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+#
+# crest is free software: you can redistribute it and/or modify it under
+# the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# crest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with crest.  If not, see <https://www.gnu.org/licenses/>.
+
+srcs += files(
+  'parameters.f90',
+  'type.f90',
+  'io.f90',
+  'type_components.f90',
+  'type_ensemble.f90',
+  'strucreader.f90',
+  'sdfio.f90',
+)
diff --git a/src/molecule/parameters.f90 b/src/molecule/parameters.f90
new file mode 100644
index 00000000..8cb7afb0
--- /dev/null
+++ b/src/molecule/parameters.f90
@@ -0,0 +1,100 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module molecule_parameters
+  use iso_fortran_env,only:wp => real64,stdout=>output_unit
+  use iso_c_binding
+  implicit none
+
+  public :: wp,stdout  !> RE-EXPORTS
+!&<
+!>--- some constants and name mappings
+  real(wp),parameter,public :: bohr     = 0.52917726_wp
+  real(wp),parameter,public :: aatoau   = 1.0_wp/bohr
+  real(wp),parameter,public :: autoaa   = bohr
+  real(wp),parameter,public :: autokcal = 627.509541_wp
+  real(wp),parameter,public :: autoeV   = 27.211324570273_wp
+
+!>--- global extxyz output unit preference (mutable, set at runtime via TOML)
+  character(len=32),public :: extxyz_units_global = 'hartree'
+
+!>-- filetypes as integers
+  type ,private:: enum_coordtype
+    integer :: unknown    = 0
+    integer :: turbomole  = 1
+    integer :: xyz        = 2
+    integer :: extxyz     = 22
+    integer :: sdf        = 3
+    integer :: sdfV2000   = 31
+    integer :: sdfV3000   = 32
+    integer :: PDB        = 4
+  end type enum_coordtype
+  type(enum_coordtype), parameter,public :: coordtype = enum_coordtype()
+
+  !> Element symbols
+  character(len=2),parameter :: PSE(118) = [ &
+   & 'H ',                                                                                'He', &
+   & 'Li','Be',                                                  'B ','C ','N ','O ','F ','Ne', &
+   & 'Na','Mg',                                                  'Al','Si','P ','S ','Cl','Ar', &
+   & 'K ','Ca','Sc','Ti','V ','Cr','Mn','Fe','Co','Ni','Cu','Zn','Ga','Ge','As','Se','Br','Kr', &
+   & 'Rb','Sr','Y ','Zr','Nb','Mo','Tc','Ru','Rh','Pd','Ag','Cd','In','Sn','Sb','Te','I ','Xe', &
+   & 'Cs','Ba','La',                                                                            &
+   &                'Ce','Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb','Lu',      &
+   &                'Hf','Ta','W ','Re','Os','Ir','Pt','Au','Hg','Tl','Pb','Bi','Po','At','Rn', &
+   & 'Fr','Ra','Ac',                                                                            &
+   &                'Th','Pa','U ','Np','Pu','Am','Cm','Bk','Cf','Es','Fm','Md','No','Lr',      &
+   &                'Rf','Db','Sg','Bh','Hs','Mt','Ds','Rg','Cn','Nh','Fl','Mc','Lv','Ts','Og' ]
+!&>
+
+  public :: ncore
+
+! ══════════════════════════════════════════════════════════════════════════════
+contains  !> MODULE PROCEDURES START HERE
+! ══════════════════════════════════════════════════════════════════════════════
+
+  pure elemental integer function ncore(at)
+    integer,intent(in) :: at
+    if (at .le. 2) then
+      ncore = 0
+    elseif (at .le. 10) then
+      ncore = 2
+    elseif (at .le. 18) then
+      ncore = 10
+    elseif (at .le. 29) then   !zn
+      ncore = 18
+    elseif (at .le. 36) then
+      ncore = 28
+    elseif (at .le. 47) then
+      ncore = 36
+    elseif (at .le. 54) then
+      ncore = 46
+    elseif (at .le. 71) then
+      ncore = 54
+    elseif (at .le. 79) then
+      ncore = 68
+    elseif (at .le. 86) then
+      ncore = 78
+    elseif (at .le. 103) then !> Rn core
+      ncore = 86
+    elseif (at .le. 118) then !> Og core
+      ncore = 102
+    end if
+  end function ncore
+
+end module molecule_parameters
diff --git a/src/molecule/sdfio.f90 b/src/molecule/sdfio.f90
new file mode 100644
index 00000000..67617827
--- /dev/null
+++ b/src/molecule/sdfio.f90
@@ -0,0 +1,174 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2018-2025 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!---------------------------------------------------------------------------------
+! Routines for the handling of molecules in the chemoinformatical *.SDF format
+!---------------------------------------------------------------------------------
+subroutine inpsdf(env,fname)
+  use iso_fortran_env,only:wp => real64
+  use crest_data
+  use strucrd
+  implicit none
+  type(systemdata) :: env
+  character(len=*) :: fname
+  type(coord) :: mol
+  integer :: i
+  env%sdfformat = .true.
+  call checkcoordtype(fname,i)
+  if (any((/31,32/) == i)) then
+    call mol%open(fname)
+  else
+    error stop 'file not in sdf format'
+  end if
+  return
+end subroutine inpsdf
+
+!================================================================================!
+
+subroutine new_wrsdfens(env,fname,oname,conf)
+  !***********************************************************************
+  !* Write a conformer ensemble as an SDF file.
+  !* Bond orders (WBO) are obtained via a singlepoint calculation using
+  !* the calculator configured in env.
+  !*
+  !* Input:
+  !*  env  -  crest's systemdata object (provides calculator and charge)
+  !*  fname - input XYZ ensemble file
+  !*  oname - output SDF file name
+  !*  conf  - if .true., run a separate SP for each structure (loopwbo)
+  !***********************************************************************
+  use crest_parameters
+  use crest_data
+  use crest_calculator
+  use strucrd
+  implicit none
+  type(systemdata),intent(inout) :: env
+  character(len=*),intent(in) :: fname
+  character(len=*),intent(in) :: oname
+  logical,intent(in) :: conf
+  !> local
+  type(coord),allocatable :: structures(:)
+  type(calcdata) :: tmpcalc
+  real(wp),allocatable :: wbo(:,:)
+  real(wp),allocatable :: grad(:,:)
+  real(wp),allocatable :: icharges(:)
+  integer :: nall,nat,ich,io,i
+  real(wp) :: energy,er
+  logical :: loopwbo,atmchrg
+  character(len=120) :: sdfcomment
+
+  atmchrg = .false.
+  loopwbo = conf
+
+  ! ── read ensemble as array of coord objects (xyz in Bohr) ─────────────
+  call rdensemble(fname,nall,structures)
+  nat = structures(1)%nat
+
+  ! ── set up a minimal GFN0 singlepoint calculator for WBOs ─────────────
+  call tmpcalc%create('gfn0',chrg=env%chrg,uhf=env%uhf)
+  tmpcalc%calcs(1)%rdwbo = .true.
+  allocate (wbo(nat,nat),grad(3,nat),source=0.0_wp)
+  energy = 0.0_wp
+
+  ! ── for non-loopwbo: one SP on the first structure, WBO reused for all ─
+  if (.not.loopwbo) then
+    call engrad(structures(1),tmpcalc,energy,grad,io)
+    if (allocated(tmpcalc%calcs(1)%wbo)) wbo = tmpcalc%calcs(1)%wbo
+  end if
+
+  ! ── (optional) special per-atom charge handling ───────────────────────
+  if (env%properties == p_protonate) atmchrg = .true.
+  if (atmchrg) allocate (icharges(nat),source=0.0_wp)
+
+  ! ── write SDF output ──────────────────────────────────────────────────
+  open (newunit=ich,file=oname)
+  do i = 1,nall
+    write (sdfcomment,'(a,i0,a,i0)') 'structure ',i,' of ',nall
+    er = structures(i)%energy
+    if (loopwbo) then
+      ! ── per-structure SP for bond orders (protonation/tautomer modes) ─
+      wbo = 0.0_wp
+      call engrad(structures(i),tmpcalc,energy,grad,io)
+      if (allocated(tmpcalc%calcs(1)%wbo)) wbo = tmpcalc%calcs(1)%wbo
+    end if
+    if (atmchrg) then
+      if (env%properties == p_protonate) then
+        call set_prot_icharges(nat,wbo,icharges)
+      end if
+      !> wrsdf expects Angstrom: multiply Bohr coordinates by bohr (Å/bohr)
+      call wrsdf(ich,nat,structures(i)%at,structures(i)%xyz*bohr, &
+      &          er,env%chrg,wbo,sdfcomment,icharges)
+    else
+      call wrsdf(ich,nat,structures(i)%at,structures(i)%xyz*bohr, &
+      &          er,env%chrg,wbo,sdfcomment)
+    end if
+  end do
+  close (ich)
+
+  call tmpcalc%reset()
+  if (allocated(icharges)) deallocate (icharges)
+  deallocate (wbo,grad,structures)
+
+contains
+  subroutine set_prot_icharges(nat,wbo,icharges)
+    !***********************************************
+    !* For protonation mode: locate the heavy atom
+    !* bonded to the added proton (last in list)
+    !* and assign it a formal charge of +1.
+    !***********************************************
+    integer,intent(in) :: nat
+    real(wp),intent(in) :: wbo(nat,nat)
+    real(wp),intent(out) :: icharges(nat)
+    integer :: i,k
+    icharges = 0.0_wp
+    k = nat
+    do i = 1,nat
+      if (nint(wbo(i,k)) .ne. 0) then
+        icharges(i) = 1.0_wp
+      end if
+    end do
+  end subroutine set_prot_icharges
+end subroutine new_wrsdfens
+
+!================================================================================!
+
+subroutine crest_ensemble_reformat(env)
+  !***************************************************************
+  !* Reformat the conformer ensemble into requested alternative
+  !* file formats (currently SDF) after the run completes.
+  !*
+  !* Input:
+  !*  env  -  crest's systemdata object
+  !***************************************************************
+  use crest_parameters
+  use crest_data
+  implicit none
+  type(systemdata),intent(inout) :: env
+
+  ! ── SDF ensemble output ───────────────────────────────────────
+  if (env%outputsdf .or. env%sdfformat) then
+    if (any((/crest_mfmdgc,crest_imtd,crest_imtd2/) == env%crestver)) then
+      call new_wrsdfens(env,conformerfile,conformerfilebase//'.sdf',.false.)
+    end if
+    if (any((/crest_screen,crest_mdopt/) == env%crestver)) then
+      call new_wrsdfens(env,'crest_ensemble.xyz','crest_ensemble.sdf',.false.)
+    end if
+  end if
+
+end subroutine crest_ensemble_reformat
diff --git a/src/molecule/strucreader.f90 b/src/molecule/strucreader.f90
new file mode 100644
index 00000000..50a2838e
--- /dev/null
+++ b/src/molecule/strucreader.f90
@@ -0,0 +1,71 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2020-2023 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!> Exports the "coord" type and I/O
+module strucrd
+  use molecule_type
+  use molecule_type_components
+  use molecule_type_ensemble
+  use molecule_parameters, only: coordtype
+  use molecule_io
+  implicit none
+  private
+
+  !> RE-EXPORTS FROM THE ABOVE MODULES
+! ══════════════════════════════════════════════════════════════════════════════
+  public :: coord     !> coord type
+  public :: ensemble  !> ensemble type (sparsely used, better use a list of coord objects)
+  public :: mollist   !> list of coord objects
+
+! ══════════════════════════════════════════════════════════════════════════════
+  public :: i2e          !> function to convert atomic number to element symbol
+  public :: asym         !> alterinative signature for i2e
+  public :: e2i          !> function to convert element symbol into atomic number
+
+  public :: checkcoordtype !> determine input coordinate file type (mostly via extension)
+  public :: coordtype      !> Possible return types from checkcoordtype → e.g. coordtype%turbomole
+
+  public :: rdnat        !> procedure to read number of atoms Nat
+  public :: rdcoord      !> read an input file, determine format automatically
+  public :: rdxmol       !> read a file in the Xmol (.xyz) format specifically
+  public :: rdxmolselec  !> read only a certain structure in Xmol file
+
+  !> NOTE, using coord%write() is safer than the ones below
+  public :: wrc0     !> write file in turbomole format
+  public :: wrcoord  !> write file by name, type via extension
+  public :: wrxyz    !> write file in xyz format
+  public :: wrsdf    !> write file in sdf format
+
+  public :: xyz2coord
+  public :: coord2xyz
+  public :: rdensembleparam   !> read Nat and Nall for a XYZ trajectory
+  public :: rdensemble        !> read a XYZ trajectory
+  public :: wrensemble
+
+  public :: coordline
+  public :: grepenergy
+  public :: get_atlist
+  public :: sumform
+
+! ══════════════════════════════════════════════════════════════════════════════
+contains  !> MODULE PROCEDURES START HERE
+! ══════════════════════════════════════════════════════════════════════════════
+
+! ══════════════════════════════════════════════════════════════════════════════
+end module strucrd
diff --git a/src/molecule/type.f90 b/src/molecule/type.f90
new file mode 100644
index 00000000..c99c5c9b
--- /dev/null
+++ b/src/molecule/type.f90
@@ -0,0 +1,647 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module molecule_type
+  use iso_c_binding
+  use molecule_parameters
+  use molecule_io
+  use molecule_type_components
+!> simple geomerty and vector operations
+  use geo
+!> element symbols
+  use crest_cn_module,only:calculate_cn
+  implicit none
+  private
+! ══════════════════════════════════════════════════════════════════════════════
+  !> EXPORTS
+  public :: coord
+  public :: coord2xyz,xyz2coord
+! ══════════════════════════════════════════════════════════════════════════════
+
+  type :: coord
+    !> coord class. contains a single structure
+    !> by convention coordinates are in atomic units (Bohr) for a single structure!
+
+    !********************************************!
+    !> data that's typically used in coord type <!
+    !********************************************!
+    !>-- number of atoms
+    integer :: nat = 0
+    !>-- atom types as integer, dimension will be at(nat)
+    integer,allocatable  :: at(:)
+    !>-- atomic coordinates, by convention in Bohrs
+    real(wp),allocatable :: xyz(:,:)
+
+    !**************************************!
+    !> (optional) data, often not present <!
+    !**************************************!
+    !>-- energy
+    real(wp) :: energy = 0.0_wp
+    !>-- gradient
+    real(wp),allocatable :: gradient(:,:)
+    !>-- a comment line
+    character(len=:),allocatable :: comment
+    !>-- "origin" tag
+    character(len=:),allocatable :: origin
+    !>-- molecular charge
+    integer :: chrg = 0
+    !>-- multiplicity information
+    integer :: uhf = 0
+    !>-- number of bonds
+    integer :: nbd = 0
+    !>-- bond info
+    integer,allocatable :: bond(:,:)
+    !>-- lattice vectors
+    real(wp),allocatable :: lat(:,:)
+
+    !>-- atomic charges
+    real(wp),allocatable :: qat(:)
+
+    !>-- atom ids (for iRMSDs)
+    integer,allocatable :: id(:)
+
+    !>-- (optional) PDB data
+    type(pdbdata) :: pdb
+
+    !>-- extxyz signature
+    logical :: wrextxyz = .false.
+    type(extxyz_signatures),allocatable :: extxyz
+
+  contains
+    procedure :: deallocate => deallocate_coord !> clear memory space
+    procedure :: open => opencoord              !> read an coord file
+    procedure :: write => writecoord            !> write (detected from file extension)
+    procedure :: writeextxyz => write_extxyz    !> write extxyz file to a given iunit
+    procedure :: append => appendcoord          !> append
+    procedure :: get => getcoord                !> allocate & fill with data
+    procedure :: appendlog => appendcoord       !> append .log file with coordinates and energy
+    procedure :: dist => coord_getdistance      !> calculate distance between two atoms
+    procedure :: angle => coord_getangle        !> calculate angle between three atoms
+    procedure :: dihedral => coord_getdihedral  !> calculate dihedral angle between four atoms
+    procedure :: cutout => coord_getcutout      !> create a substructure
+    procedure :: get_CN => coord_get_CN         !> calculate coordination number
+    procedure :: get_z => coord_get_z           !> calculate nuclear charge
+    procedure :: cn_to_bond => coord_cn_to_bond !> generate neighbour matrix from CN
+    procedure :: swap => atswp                  !> swap two atoms coordinates and their at() entries
+    procedure :: sumform => coord_sumform       !> generate a string with the sum formula
+    procedure :: copy => coord_copy             !> deep copy from another coord object
+  end type coord
+
+! ══════════════════════════════════════════════════════════════════════════════
+contains  !> MODULE PROCEDURES START HERE
+! ══════════════════════════════════════════════════════════════════════════════
+!  ROUTINES FOR READING SINGLE STRUCTURES (COORDS)
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine deallocate_coord(self)
+!**********************************************
+!* subroutine deallocate_coord                *
+!* is used to clear memory for the coord type *
+!**********************************************
+    implicit none
+    class(coord) :: self
+    self%nat = 0
+    if (allocated(self%at)) deallocate (self%at)
+    if (allocated(self%xyz)) deallocate (self%xyz)
+    call self%pdb%deallocate()
+    return
+  end subroutine deallocate_coord
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine coord_copy(self,src)
+!*************************************************************
+!* Deep copy of a coord object from src to self.            *
+!*                                                          *
+!* On Input:  src  - source coord object                    *
+!* On Output: self - destination, populated with src data   *
+!*************************************************************
+    implicit none
+    class(coord),intent(out) :: self
+    type(coord),intent(in)   :: src
+
+    ! ── scalar fields ────────────────────────────────────────────────────────
+    self%nat      = src%nat
+    self%energy   = src%energy
+    self%chrg     = src%chrg
+    self%uhf      = src%uhf
+    self%nbd      = src%nbd
+    self%wrextxyz = src%wrextxyz
+
+    ! ── mandatory allocatable arrays ─────────────────────────────────────────
+    if (allocated(src%at))  self%at  = src%at
+    if (allocated(src%xyz)) self%xyz = src%xyz
+
+    ! ── optional allocatable arrays ──────────────────────────────────────────
+    if (allocated(src%gradient)) self%gradient = src%gradient
+    if (allocated(src%bond))     self%bond     = src%bond
+    if (allocated(src%lat))      self%lat      = src%lat
+    if (allocated(src%qat))      self%qat      = src%qat
+
+    ! ── optional character fields ─────────────────────────────────────────────
+    if (allocated(src%comment)) self%comment = src%comment
+    if (allocated(src%origin))  self%origin  = src%origin
+
+    ! ── derived-type components ───────────────────────────────────────────────
+    self%pdb = src%pdb
+    if (allocated(src%extxyz)) self%extxyz = src%extxyz
+
+    return
+  end subroutine coord_copy
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine opencoord(self,fname)
+!************************************************
+!* subroutine opencoord                         *
+!* is the open procedure for the "coord" class. *
+!************************************************
+    implicit none
+    class(coord) :: self
+    character(len=*),intent(in) :: fname
+    integer :: nat
+    integer,allocatable :: at(:)
+    real(wp),allocatable :: xyz(:,:)
+    real(wp),allocatable :: grad(:,:)
+    real(wp),allocatable :: lat(:,:)
+    integer :: ftype
+    integer :: i,j,k,ich,io,iunit
+    logical :: ex,success
+    real(wp) :: en
+    character(len=32) :: eu,fu
+    type(extxyz_signatures) :: ext_sigs
+    type(extxyz_properties) :: ext_props
+
+    inquire (file=fname,exist=ex)
+    if (.not.ex) then
+      write (stdout,'(a)') '**ERROR** could not find coord file '//trim(fname)
+      call exit(1)
+    end if
+
+    call self%deallocate()
+
+    call checkcoordtype(fname,ftype)
+    call rdnat(fname,nat,ftype=ftype)
+
+    if (nat > 0) then
+      en = 0.0_wp
+      allocate (at(nat),xyz(3,nat))
+      select case (ftype)
+      case (coordtype%PDB)
+        call rdPDB(fname,nat,at,xyz,self%pdb) ! ← need to fill self%pdb
+        xyz = xyz/bohr
+
+      case (coordtype%extxyz)
+        open (newunit=iunit,file=fname)
+        call read_extxyz_frame(iunit,ext_sigs,ext_props,nat,en,lat,success, &
+        &                      energy_units=eu,forces_units=fu)
+        close (iunit)
+        if (success) then
+          select case (trim(eu))
+          case ('hartree','ha','au')
+            ! energy already in Hartree, no conversion needed
+          case default  !> 'ev' and anything unrecognised
+            en = en/autoeV
+          end select
+          call get_at_from_ext(ext_props,at)
+          call get_xyz_from_ext(ext_props,xyz)
+          call get_grad_from_ext(ext_props,grad,forces_units=fu)
+          if (allocated(lat)) call move_alloc(lat,self%lat)
+          if (allocated(grad)) call move_alloc(grad,self%gradient)
+        end if
+
+      case default
+        call rdcoord(fname,nat,at,xyz,energy=en,ftype=ftype)
+
+      end select
+      self%nat = nat
+      self%energy = en
+      call move_alloc(at,self%at)
+      call move_alloc(xyz,self%xyz)
+    else
+      write (stdout,'(a)') '**ERROR** Format issue while reading coord file '//trim(fname)
+      write (stdout,'(a)') '          Number of atoms detected as zero!'
+      call exit(1)
+    end if
+
+    return
+  end subroutine opencoord
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+! subroutine getcoord
+! allocate "coord" class and fill with data
+  subroutine getcoord(self,convfac,nat,at,xyz)
+    implicit none
+    class(coord) :: self
+    real(wp),intent(in) :: convfac
+    integer,intent(in)  :: nat
+    integer,intent(in)  :: at(nat)
+    real(wp),intent(in) :: xyz(3,nat)
+    call self%deallocate()
+    allocate (self%at(nat))
+    allocate (self%xyz(3,nat))
+    self%nat = nat
+    self%at = at
+    self%xyz = xyz/convfac
+    return
+  end subroutine getcoord
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+! function coord_getdistance
+! calculate the distance for a given pair of atoms
+  function coord_getdistance(self,a1,a2) result(d)
+    implicit none
+    class(coord) :: self
+    integer,intent(in) :: a1,a2
+    real(wp) :: d
+    d = 0.0_wp
+    if (allocated(self%xyz)) then
+      d = (self%xyz(1,a1)-self%xyz(1,a2))**2+ &
+      &   (self%xyz(2,a1)-self%xyz(2,a2))**2+ &
+      &   (self%xyz(3,a1)-self%xyz(3,a2))**2
+      d = sqrt(d)
+    end if
+    return
+  end function coord_getdistance
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+! function coord_getangle
+! calculate the angle for a given trio of atoms in rad
+! A1-A2-A3
+  function coord_getangle(self,a1,a2,a3) result(angle)
+    implicit none
+    class(coord) :: self
+    integer,intent(in) :: a1,a2,a3
+    real(wp) :: angle,u(3),v(3),o(3)
+    real(wp) :: d2ij,d2jk,d2ik,xy,temp
+    angle = 0.0_wp
+    if (allocated(self%xyz)) then
+      u(1:3) = self%xyz(1:3,a1)-self%xyz(1:3,a2)
+      v(1:3) = self%xyz(1:3,a3)-self%xyz(1:3,a2)
+      angle = tangle(u,v)
+    end if
+    return
+  end function coord_getangle
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+! function coord_getdihedral
+! calculate the dihedral angle for a given quartet of atoms in rad
+! A1-A2-A3-A4
+  function coord_getdihedral(self,a1,a2,a3,a4) result(dihed)
+    implicit none
+    class(coord) :: self
+    integer,intent(in) :: a1,a2,a3,a4
+    real(wp) :: dihed
+    real(wp) :: u(3),v(3),w(3)
+    real(wp) :: n1(3),n2(3)
+    real(wp) :: u1(3),u2(3),u3(3)
+
+    dihed = 0.0_wp
+    if (allocated(self%xyz)) then
+
+      u(1:3) = self%xyz(1:3,a2)-self%xyz(1:3,a1)
+      v(1:3) = self%xyz(1:3,a3)-self%xyz(1:3,a2)
+      w(1:3) = self%xyz(1:3,a4)-self%xyz(1:3,a3)
+      dihed = dihedral(u,v,w)
+    end if
+    return
+  end function coord_getdihedral
+
+! ──────────────────────────────────────────────────────────────────────────────
+! function coord_getgutout
+! create a cutout mol object
+  function coord_getcutout(self,atlist) result(molout)
+    implicit none
+    class(coord) :: self
+    logical,intent(in) :: atlist(self%nat)
+    type(coord) :: molout
+    integer :: newnat,i,j,k,l
+
+    newnat = count(atlist,1)
+    if (newnat == self%nat) then
+      molout = self
+    else
+      molout%nat = newnat
+      allocate (molout%at(newnat),source=0)
+      allocate (molout%xyz(3,newnat),source=0.0_wp)
+      k = 0
+      do i = 1,self%nat
+        if (atlist(i)) then
+          k = k+1
+          molout%at(k) = self%at(i)
+          molout%xyz(1:3,k) = self%xyz(1:3,i)
+        end if
+      end do
+    end if
+    return
+  end function coord_getcutout
+
+! ──────────────────────────────────────────────────────────────────────────────
+  subroutine coord_get_CN(self,cn,cn_type,cn_thr,dcndr)
+    implicit none
+    class(coord) :: self
+    real(wp),intent(out),allocatable :: cn(:)
+    real(wp),intent(in),optional :: cn_thr
+    character(len=*),intent(in),optional :: cn_type
+    real(wp),intent(out),optional :: dcndr(3,self%nat,self%nat)
+    if (self%nat <= 0) return
+    if (.not.allocated(self%xyz).or..not.allocated(self%at)) return
+    allocate (cn(self%nat),source=0.0_wp)
+    call calculate_CN(self%nat,self%at,self%xyz,cn, &
+    & cntype=cn_type,cnthr=cn_thr,dcndr=dcndr)
+  end subroutine coord_get_CN
+
+! ──────────────────────────────────────────────────────────────────────────────
+  subroutine coord_get_z(self,z)
+    implicit none
+    class(coord) :: self
+    real(wp),intent(out),allocatable :: z(:)
+    integer :: i,j,k
+    if (self%nat <= 0) return
+    if (.not.allocated(self%xyz).or..not.allocated(self%at)) return
+    allocate (z(self%nat),source=0.0_wp)
+    do i = 1,self%nat
+      z(i) = real(self%at(i),wp)-real(ncore(self%at(i)))
+      if (self%at(i) > 57.and.self%at(i) < 72) z(i) = 3.0_wp
+    end do
+  end subroutine coord_get_z
+
+! ──────────────────────────────────────────────────────────────────────────────
+  subroutine coord_cn_to_bond(self,cn,bond,cn_type,cn_thr)
+    implicit none
+    class(coord) :: self
+    real(wp),intent(out),allocatable :: cn(:)
+    real(wp),intent(out),allocatable,optional :: bond(:,:)
+    real(wp),intent(in),optional :: cn_thr
+    character(len=*),intent(in),optional :: cn_type
+    if (self%nat <= 0) return
+    if (.not.allocated(self%xyz).or..not.allocated(self%at)) return
+    allocate (cn(self%nat),source=0.0_wp)
+    call calculate_CN(self%nat,self%at,self%xyz,cn, &
+    & cntype=cn_type,cnthr=cn_thr,bond=bond)
+  end subroutine coord_cn_to_bond
+
+! ══════════════════════════════════════════════════════════════════════════════
+!  ROUTINES FOR WRITING STRUCTURES AND CONVERTING THEM
+! ══════════════════════════════════════════════════════════════════════════════
+
+  subroutine write_extxyz(self,iunit)
+!*************************************************************************
+!* Write an extended xyz file from the coord object.                     *
+!* Output units are controlled by the module variable extxyz_units_global*
+!* (default 'Hartree'). Set to 'eV' to use eV/Ang conventions instead.  *
+!*************************************************************************
+    class(coord) :: self
+    integer,intent(in) :: iunit !> assume the unit is open for writing
+
+    character(len=200) :: atmp
+    integer :: ii
+    logical :: use_hartree
+
+    use_hartree = (trim(extxyz_units_global) .ne. 'ev')
+
+    !> print number of atoms
+    write (iunit,'(i10)') self%nat
+
+    !> construct ext comment line bit by bit
+    if (use_hartree) then
+      write (atmp,'(f20.10)') self%energy
+      write (iunit,'(a,a)',advance='no') trim('energy='//adjustl(atmp)),' '
+      write (iunit,'(a)',advance='no') 'energy_units=Hartree '
+    else
+      write (atmp,'(f20.10)') self%energy*autoeV
+      write (iunit,'(a,a)',advance='no') trim('energy='//adjustl(atmp)),' '
+      write (iunit,'(a)',advance='no') 'energy_units=eV '
+    end if
+    if (allocated(self%lat)) then
+      write (iunit,'(a)',advance='no') 'Lattice="'
+      write (iunit,'(9f15.8)',advance='no') reshape(self%lat, [9])
+      write (iunit,'(a)',advance='no') '"  pbc="T T T"  '
+    end if
+    if (allocated(self%gradient)) then
+      if (use_hartree) then
+        write (iunit,'(a)',advance='no') 'forces_units=Ha/Bohr '
+      else
+        write (iunit,'(a)',advance='no') 'forces_units=eV/Ang '
+      end if
+    end if
+    if (allocated(self%extxyz)) then
+      call assemble_properties_tag(self%extxyz,atmp)
+    else if (allocated(self%gradient)) then
+      write (atmp,'("species:S:1:pos:R:3:forces:R:3")')
+    else
+      write (atmp,'("species:S:1:pos:R:3")')
+    end if
+    write (iunit,'(a,a,a)',advance='no') 'Properties=',trim(atmp),' '
+    write (iunit,*)
+
+    !> coord block
+    if (allocated(self%extxyz)) then
+      write (stdout,*) '**ERROR** This extxyz write function is TODO'
+      call exit(1)
+    else if (allocated(self%gradient)) then
+      if (use_hartree) then
+        do ii = 1,self%nat
+          !> positions in Ang, forces in Ha/Bohr (sign flip: forces = -gradient)
+          write (iunit,'(1x,a2,1x,6f20.10)')  &
+          &  i2e(self%at(ii)),self%xyz(1:3,ii)*autoaa,self%gradient(1:3,ii)*(-1.0_wp)
+        end do
+      else
+        do ii = 1,self%nat
+          !> positions in Ang, forces in eV/Ang
+          write (iunit,'(1x,a2,1x,6f20.10)')  &
+          &  i2e(self%at(ii)),self%xyz(1:3,ii)*autoaa,self%gradient(1:3,ii)*(-autoeV/autoaa)
+        end do
+      end if
+    else
+      do ii = 1,self%nat
+        write (iunit,'(1x,a2,1x,3f20.10)') i2e(self%at(ii)),self%xyz(1:3,ii)*autoaa
+      end do
+    end if
+  end subroutine write_extxyz
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine xyz2coord(iname,oname)
+!***********************************************
+!* subroutine xyz2coord                        *
+!* simple conversion of a xyz to a coord file. *
+!*                                             *
+!* On Input: iname  - name of the xyz file     *
+!*           oname  - name of the coord file   *
+!*                                             *
+!* On Output: file written to "oname"          *
+!***********************************************
+    implicit none
+    character(len=*) :: iname
+    character(len=*) :: oname
+    type(coord) :: struc
+    call struc%open(iname)
+    call wrc0(oname,struc%nat,struc%at,struc%xyz)
+    call struc%deallocate()
+    return
+  end subroutine xyz2coord
+
+! ──────────────────────────────────────────────────────────────────────────────
+  subroutine coord2xyz(iname,oname)
+!***********************************************
+!* subroutine coord2xyz                        *
+!* simple conversion of a coord to a xyz file. *
+!*                                             *
+!* On Input: iname  - name of the coord file   *
+!*           oname  - name of the xyz file     *
+!*                                             *
+!* On Output: file written to "oname"          *
+!***********************************************
+    implicit none
+    character(len=*) :: iname
+    character(len=*) :: oname
+    type(coord) :: struc
+    call struc%open(trim(iname))
+    struc%xyz = struc%xyz*bohr !to Angström
+    call wrxyz(oname,struc%nat,struc%at,struc%xyz)
+    call struc%deallocate()
+    return
+  end subroutine coord2xyz
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine writecoord(self,fname)
+!*************************************************
+!* subroutine writecoord                         *
+!* is the write procedure for the "coord" class. *
+!*************************************************
+    implicit none
+    class(coord) :: self
+    character(len=*),intent(in) :: fname
+    character(len=80) :: comment
+    integer :: ftype,iunit
+    if (.not.allocated(self%xyz)) then
+      write (stdout,*) 'Cannot write ',trim(fname),'. No coordinates allocated'
+    end if
+    call checkcoordtype(fname,ftype)
+    open (newunit=iunit,file=trim(fname))
+    select case (ftype)
+    case (coordtype%xyz)
+      if (self%wrextxyz) then
+        call self%writeextxyz(iunit)
+      else
+        call wrxyz(iunit,self%nat,self%at,self%xyz*autoaa,self%energy)
+      end if
+
+    case (coordtype%extxyz)
+      call self%writeextxyz(iunit)
+
+    case (coordtype%sdf,coordtype%sdfV3000)
+      call wrsdfV3000(iunit,self%nat,self%at,self%xyz*autoaa, &
+        & self%energy,real(self%chrg,wp),real(self%bond,wp),' written by CREST')
+
+    case (coordtype%sdfV2000)
+      call wrsdfV2000(iunit,self%nat,self%at,self%xyz*autoaa, &
+        & self%energy,self%chrg,real(self%bond,wp),' written by CREST')
+
+    case (coordtype%PDB)
+      write (stdout,'(a)') '**ERROR** PDB file writer not implemented, TODO'
+      call exit(1)
+    case default
+      !> defaults to Turbomole coord type
+      call wrc0(iunit,self%nat,self%at,self%xyz)
+    end select
+    close (iunit)
+    return
+  end subroutine writecoord
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine appendcoord(self,iunit,energy)
+!*************************************************
+!* subroutine appendcoord                        *
+!* is the write procedure for the "coord" class. *
+!* coords will be written out in XYZ format!     *
+!*************************************************
+    implicit none
+    class(coord) :: self
+    integer,intent(in) :: iunit
+    real(wp),intent(in),optional :: energy
+    character(len=64) :: atmp
+    character(len=32) :: btmp
+    real(wp) :: etmp
+    if (.not.self%wrextxyz) then !> regular xyz append
+      self%xyz = self%xyz*bohr !to Angström
+      if (present(energy)) then
+        write (btmp,'(f22.10)') energy
+      else
+        write (btmp,'(f22.10)') self%energy
+      end if
+      write (atmp,'(a,a)') ' energy= ',adjustl(btmp)
+      if (allocated(self%comment)) then
+        call wrxyz(iunit,self%nat,self%at,self%xyz, &
+        &          trim(atmp)//' '//trim(self%comment))
+      else
+        call wrxyz(iunit,self%nat,self%at,self%xyz,trim(atmp))
+      end if
+      self%xyz = self%xyz/bohr !back
+    else
+      !> extxyz append
+      etmp = self%energy
+      if (present(energy)) self%energy = energy
+      call self%writeextxyz(iunit)
+      self%energy = etmp
+    end if
+    return
+  end subroutine appendcoord
+
+! ══════════════════════════════════════════════════════════════════════════════
+!  GENERAL UTILITY ROUTINES
+! ══════════════════════════════════════════════════════════════════════════════
+
+  subroutine atswp(self,ati,atj)
+    !********************************
+    !* swap atom ati with atj in mol
+    !********************************
+    implicit none
+    class(coord),intent(inout) :: self
+    integer,intent(in) :: ati,atj
+    real(wp) :: xyztmp(3)
+    integer :: attmp
+    xyztmp(1:3) = self%xyz(1:3,ati)
+    attmp = self%at(ati)
+    self%xyz(1:3,ati) = self%xyz(1:3,atj)
+    self%at(ati) = self%at(atj)
+    self%xyz(1:3,atj) = xyztmp(1:3)
+    self%at(atj) = attmp
+  end subroutine atswp
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  function coord_sumform(self) result(sumformula)
+    implicit none
+    class(coord) :: self
+    character(len=:),allocatable :: sumformula
+    sumformula = sumform(self%nat,self%at)
+  end function coord_sumform
+
+! ══════════════════════════════════════════════════════════════════════════════
+! end of the module
+! ══════════════════════════════════════════════════════════════════════════════
+end module molecule_type
diff --git a/src/molecule/type_components.f90 b/src/molecule/type_components.f90
new file mode 100644
index 00000000..c94a8b93
--- /dev/null
+++ b/src/molecule/type_components.f90
@@ -0,0 +1,254 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module molecule_type_components
+  use iso_c_binding
+  use molecule_parameters
+  implicit none
+  private
+! ══════════════════════════════════════════════════════════════════════════════
+
+  !coord class. contains a single structure in the PDB format.
+  !coordinates by definition are in Angstroem.
+  type :: pdbdata
+    !--- data
+    integer :: nat = 0
+    integer :: frag = 0
+    !--- arrays
+    integer,allocatable  :: athet(:) !ATOM (1) or HETATM (2)
+    character(len=4),allocatable :: pdbat(:) !PDB atom specifier
+    character(len=3),allocatable :: pdbas(:) !PDB amino acid specifier
+    integer,allocatable :: pdbfrag(:) !PDB fragment specifier
+    character(len=1),allocatable :: pdbgrp(:)  !PDB group specifier
+    real(wp),allocatable :: pdbocc(:) !PDB occupancy
+    real(wp),allocatable :: pdbtf(:)  !PDB temperature factor
+  contains
+    procedure :: deallocate => deallocate_pdb !clear memory space
+    procedure :: allocate => allocate_pdb
+  end type pdbdata
+  public :: pdbdata
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  public :: signature,extxyz_signatures,extxyz_properties
+  public :: parse_properties_tag,assemble_properties_tag
+  public :: allocate_extxyz_properties_from_sigs
+
+  ! Type representing a single property entry (e.g., pos:R:3)
+  type :: signature
+    character(len=32) :: name     ! Property name (e.g., "forces")
+    character         :: p_type   ! 'R' for Real, 'S' for String, 'I' for Int
+    integer           :: n_fields ! Number of columns (e.g., 3 for positions)
+  end type signature
+
+  ! Type representing the collection of all properties in the file
+  type :: extxyz_signatures
+    type(signature),allocatable :: signat(:)
+    integer :: n_props = 0            ! Number of unique property keys
+    integer :: total_fields = 0       ! Total sum of all n_fields (total columns)
+  end type extxyz_signatures
+
+  type :: extxyz_property
+    integer :: natoms = 0
+    type(signature) :: signat
+    character(len=32),allocatable :: S(:,:)
+    integer,allocatable           :: I(:,:)
+    real(wp),allocatable          :: R(:,:)
+  end type extxyz_property
+
+  type :: extxyz_properties
+    integer :: n_props = 0
+    integer :: total_fields = 0
+    type(extxyz_property),allocatable :: props(:)
+  end type extxyz_properties
+
+! ══════════════════════════════════════════════════════════════════════════════
+contains  !> MODULE PROCEDURES START HERE
+! ══════════════════════════════════════════════════════════════════════════════
+
+!==================================================================!
+! subroutine deallocate_pdb
+! is used to clear memory for the pdbdata type
+!==================================================================!
+  subroutine deallocate_pdb(self)
+    implicit none
+    class(pdbdata) :: self
+    self%nat = 0
+    self%frag = 0
+    if (allocated(self%athet)) deallocate (self%athet)
+    if (allocated(self%pdbat)) deallocate (self%pdbat)
+    if (allocated(self%pdbas)) deallocate (self%pdbas)
+    if (allocated(self%pdbfrag)) deallocate (self%pdbfrag)
+    if (allocated(self%pdbgrp)) deallocate (self%pdbgrp)
+    if (allocated(self%pdbocc)) deallocate (self%pdbocc)
+    if (allocated(self%pdbtf)) deallocate (self%pdbtf)
+    return
+  end subroutine deallocate_pdb
+
+!==================================================================!
+! subroutine allocate_pdb
+! is used to clear memory for the pdbdata type
+!==================================================================!
+  subroutine allocate_pdb(self,nat)
+    implicit none
+    class(pdbdata) :: self
+    integer :: nat
+    call deallocate_pdb(self)
+    self%nat = nat
+    allocate (self%athet(nat))
+    allocate (self%pdbat(nat))
+    allocate (self%pdbas(nat))
+    allocate (self%pdbfrag(nat))
+    allocate (self%pdbgrp(nat))
+    allocate (self%pdbocc(nat))
+    allocate (self%pdbtf(nat))
+    return
+  end subroutine allocate_pdb
+
+! ──────────────────────────────────────────────────────────────────────────────
+
+  subroutine parse_properties_tag(prop_str,ext_sigs)
+!*************************************************************************************
+!*   Parses the "Properties" value string from an extXYZ comment line.               *
+!*   Following the ASE (Atomic Simulation Environment) standard, it decomposes       *
+!*   the string (format: "name:type:cols:name:type:cols...") into a structured       *
+!*   array of 'signature' types.                                                     *
+!*                                                                                   *
+!* ARGUMENTS:                                                                        *
+!*   prop_str  [IN]  : The raw string value of the Properties tag.                   *
+!*                     Example: "species:S:1:pos:R:3:forces:R:3"                     *
+!*   ext_sigs [OUT] : An instance of extxyz_signatures.                             *
+!*                     - Allocates the 'props' array based on the number of triplets.*
+!*                     - Calculates 'total_fields' for buffer allocation.            *
+!*                                                                                   *
+!* DATA MAPPING:                                                                     *
+!*   - name    : String label of the property.                                       *
+!*   - p_type  : 'R' (Real), 'S' (String), 'I' (Integer).                            *
+!*   - n_fields: Integer representing the number of columns this property spans.     *
+!*                                                                                   *
+!* NOTES:                                                                            *
+!*   - This routine assumes the input string is a valid series of triplets.          *
+!*   - It handles both trailing colons and clean endings.                            *
+!*************************************************************************************
+    character(len=*),intent(in)        :: prop_str
+    type(extxyz_signatures),intent(out) :: ext_sigs
+
+    integer :: i,start_pos,end_pos,part_count,i_prop
+    character(len=len_trim(prop_str)) :: buffer
+
+    ! 1. Initial count of colons to determine array size
+    ! Format is name:type:cols -> 2 colons per property, +1 at the end of parts
+    part_count = 0
+    do i = 1,len_trim(prop_str)
+      if (prop_str(i:i) == ':') part_count = part_count+1
+    end do
+
+    ext_sigs%n_props = (part_count+1)/3
+    allocate (ext_sigs%signat(ext_sigs%n_props))
+    ext_sigs%total_fields = 0
+
+    ! 2. Parse the triplets
+    buffer = trim(prop_str)
+    start_pos = 1
+
+    do i_prop = 1,ext_sigs%n_props
+      ! Extract Name
+      end_pos = index(buffer(start_pos:),':')+start_pos-2
+      ext_sigs%signat(i_prop)%name = buffer(start_pos:end_pos)
+      start_pos = end_pos+2
+
+      ! Extract Type (R/S/I)
+      ext_sigs%signat(i_prop)%p_type = buffer(start_pos:start_pos)
+      start_pos = start_pos+2 ! Skip char and following colon
+
+      ! Extract Number of Fields
+      end_pos = index(buffer(start_pos:),':')+start_pos-2
+      if (end_pos < start_pos) end_pos = len_trim(buffer) ! Handle last element
+
+      read (buffer(start_pos:end_pos),*) ext_sigs%signat(i_prop)%n_fields
+      start_pos = end_pos+2
+
+      ! Update global counter
+      ext_sigs%total_fields = ext_sigs%total_fields+ext_sigs%signat(i_prop)%n_fields
+    end do
+  end subroutine parse_properties_tag
+
+  subroutine assemble_properties_tag(ext_sigs,prop_str)
+    implicit none
+    type(extxyz_signatures),intent(in) :: ext_sigs
+    character(len=*),intent(out)       :: prop_str
+
+    integer :: i
+    character(len=16) :: col_buffer ! Temporary buffer for integer conversion
+
+    ! Initialize the string as empty
+    prop_str = ""
+
+    do i = 1,ext_sigs%n_props
+      ! 1. Append the Name
+      prop_str = trim(prop_str)//trim(ext_sigs%signat(i)%name)//":"
+
+      ! 2. Append the Type (R/S/I)
+      prop_str = trim(prop_str)//ext_sigs%signat(i)%p_type//":"
+
+      ! 3. Append the Number of Columns
+      write (col_buffer,'(I0)') ext_sigs%signat(i)%n_fields
+      prop_str = trim(prop_str)//trim(col_buffer)
+
+      ! 4. Add a colon separator UNLESS this is the last property
+      if (i < ext_sigs%n_props) then
+        prop_str = trim(prop_str)//":"
+      end if
+    end do
+  end subroutine assemble_properties_tag
+
+! ──────────────────────────────────────────────────────────────────────────────
+  subroutine allocate_extxyz_properties_from_sigs(nat,ext_sigs,ext_props)
+    implicit none
+    integer,intent(in) :: nat
+    type(extxyz_signatures),intent(in) :: ext_sigs
+    type(extxyz_properties),intent(out) :: ext_props
+
+    integer :: ii,n_props,n_fields
+
+    n_props = ext_sigs%n_props
+    ext_props%n_props = n_props
+    ext_props%total_fields = ext_sigs%total_fields
+    allocate (ext_props%props(n_props))
+    do ii = 1,n_props
+      associate (prop => ext_props%props(ii))
+        prop%signat = ext_sigs%signat(ii)
+        prop%natoms = nat
+        n_fields = prop%signat%n_fields
+        select case (prop%signat%p_type)
+        case ('I')
+          allocate (prop%I(n_fields,nat),source=0)
+        case ('R')
+          allocate (prop%R(n_fields,nat),source=0.0_wp)
+        case ('S')
+          allocate (prop%S(n_fields,nat),source=repeat(' ',32))
+        end select
+      end associate
+    end do
+
+  end subroutine allocate_extxyz_properties_from_sigs
+
+! ══════════════════════════════════════════════════════════════════════════════
+! ══════════════════════════════════════════════════════════════════════════════
+end module molecule_type_components
diff --git a/src/molecule/type_ensemble.f90 b/src/molecule/type_ensemble.f90
new file mode 100644
index 00000000..9b7734c3
--- /dev/null
+++ b/src/molecule/type_ensemble.f90
@@ -0,0 +1,728 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+
+
+! ══════════════════════════════════════════════════════════════════════════════
+!
+! NOTE: While there are the two types "ensemble" and "mollist", the best way 
+!       to handle a list of structures is as "type(coord),allocatable :: structures(:)"
+!       which is mapped in the rdensemble_coord_type routine to rdensemble.
+!       Both of the other types wrap that, but it would be better to not use them.
+!
+! ──────────────────────────────────────────────────────────────────────────────
+
+module molecule_type_ensemble
+  use iso_c_binding
+  use molecule_parameters
+  use molecule_io
+  use molecule_type
+  use molecule_type_components
+  implicit none
+
+! ══════════════════════════════════════════════════════════════════════════════
+!>--- private module variables and parameters
+  private
+
+  public :: rdensembleparam   !-- read Nat and Nall for a XYZ trajectory
+  public :: rdensemble        !-- read a XYZ trajectory
+  interface rdensemble
+    module procedure rdensemble_conf1
+    module procedure rdensemble_conf2
+    module procedure rdensemble_conf3
+
+    module procedure rdensemble_mixed2
+
+    module procedure rdensemble_coord_type
+  end interface rdensemble
+
+  public :: wrensemble
+  interface wrensemble
+    module procedure wrensemble_conf
+    module procedure wrensemble_conf_energy
+    module procedure wrensemble_conf_energy_comment
+
+    module procedure wrensemble_coord_name
+    module procedure wrensemble_coord_channel
+  end interface wrensemble
+
+  public :: ensemble
+  public :: mollist
+
+! ──────────────────────────────────────────────────────────────────────────────
+  !> ensemble class. contains all structures of an ensemble
+  !> by convention coordinates are in Angström for an ensemble!
+  type :: ensemble
+
+    logical :: mixed = .false.   !> if all molecules were the same == .false.
+
+    !> data
+    integer :: nat = 0              !> (max) number of total atoms
+    integer :: nall = 0             !> number of structures
+
+    !> if all structures were the same molecule these are filled
+    !> mixed==.false.
+    integer,allocatable  :: at(:)      !> atom types as integer, dimension will be at(nat)
+    real(wp),allocatable :: xyz(:,:,:) !> coordinates, dimension will be xyz(3,nat,nall)
+    real(wp),allocatable :: er(:)      !> energy of each structure, dimension will be eread(nall)
+
+    !> otherwise this is filled
+    !> mixed == .true.
+    type(coord),allocatable :: structures(:)
+
+    real(wp)            :: g         !gibbs free energy
+    real(wp)            :: s         !entropy
+    real(wp),allocatable :: gt(:)    !gibbs free energy of each member
+    real(wp),allocatable :: ht(:)    !enthalpy of each member
+    real(wp),allocatable :: svib(:)  !vibrational entropy of each member
+    real(wp),allocatable :: srot(:)  !rotational entropy of each member
+    real(wp),allocatable :: stra(:)  !translational entropy of each member
+
+  contains
+    procedure :: deallocate => deallocate_ensembletype !clear memory space
+    procedure :: open => openensemble !read an ensemble file
+    procedure :: write => write_ensemble !write to file
+    procedure :: get_mol => ensemble_get_mol !extract the i-th mol from ensemble type
+  end type ensemble
+
+!==========================================================================================!
+  type :: mollist
+    integer :: nall = 0
+    type(coord),allocatable :: structure(:)
+  end type mollist
+
+! ══════════════════════════════════════════════════════════════════════════════
+contains  !> MODULE PROCEDURES START HERE
+! ══════════════════════════════════════════════════════════════════════════════
+!  1. ROUTINES FOR READING ENTIRE ENSEMBLES (OR TRAJECTORIES)
+! ──────────────────────────────────────────────────────────────────────────────
+
+!==================================================================!
+! subroutine rdensembleparam
+! read a ensemble file and get some information from
+! it:
+! On Input: fname - name of the file, should be in
+!                   the Xmol (*.xyz) format.
+!
+! On Output: nat  - number of atoms
+!                   (if different sized structures are present,
+!                    nat is the largest)
+!            nall - number of structures
+!            conform - (optional) do all structures
+!                      have the same number of atoms?
+!=================================================================!
+  subroutine rdensembleparam(fname,nat,nall,conform)
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(out) :: nat
+    integer,intent(out) :: nall
+    logical,intent(out),optional :: conform
+    logical :: conformdum
+    integer :: dum,iosum
+    integer :: natref
+    real(wp) :: x,y,z
+    integer :: i,j,k,ich,io
+    logical :: ex
+    character(len=10) :: str
+    conformdum = .true.
+    nat = 0
+    nall = 0
+    natref = 0
+    inquire (file=fname,exist=ex)
+    if (.not.ex) return
+    open (newunit=ich,file=fname)
+    do
+      read (ich,*,iostat=io) dum
+      if (io < 0) exit
+      if (io > 0) cycle
+      if (nat == 0) natref = dum
+      read (ich,*,iostat=io)
+      if (io < 0) exit
+      iosum = 0
+      do i = 1,dum
+        read (ich,*,iostat=io) str,x,y,z
+        if (io < 0) exit
+        iosum = iosum+io
+      end do
+      if (iosum > 0) cycle
+      nat = max(dum,nat)
+      if (dum .ne. natref) conformdum = .false.
+      nall = nall+1
+    end do
+    close (ich)
+    if (present(conform)) conform = conformdum
+    return
+  end subroutine rdensembleparam
+
+!==================================================================!
+! subroutine rdensemble_conf1
+! read a conformer ensemble/a MD trajectory, i.e.,
+! all structures have the same number and order of atoms.
+! version 1 also reads the energy
+!=================================================================!
+  subroutine rdensemble_conf1(fname,nat,nall,at,xyz,eread)
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(inout) :: nat
+    integer,intent(inout) :: nall
+    integer,intent(inout),allocatable :: at(:)
+    real(wp),intent(inout),allocatable :: xyz(:,:,:)
+    real(wp),intent(inout),allocatable :: eread(:)
+    integer :: i,j,k,ich,io
+    logical :: ex
+    integer :: dum
+    character(len=512) :: line
+    character(len=6) :: sym
+    if (.not.allocated(xyz).or..not.allocated(at)) then
+      call rdensembleparam(fname,nat,nall)
+    end if
+    if (.not.allocated(xyz)) allocate (xyz(3,nat,nall))
+    if (.not.allocated(at)) allocate (at(nat))
+    if (.not.allocated(eread)) allocate (eread(nall))
+
+    eread = 0.0_wp
+    xyz = 0.0_wp
+    open (newunit=ich,file=fname)
+    do i = 1,nall
+      read (ich,*,iostat=io) dum
+      if (io < 0) exit
+      if (io > 0) cycle
+      if (dum .ne. nat) then
+        call ensemble_strucskip(ich,nat,io)
+        if (io < 0) exit
+      end if
+      read (ich,'(a)',iostat=io) line
+      if (io < 0) exit
+      eread(i) = grepenergy(line)
+      do j = 1,dum
+        read (ich,'(a)',iostat=io) line
+        if (io < 0) exit
+        call coordline(line,sym,xyz(1:3,j,i),io)
+        if (io .ne. 0) then
+          backspace (ich)
+          exit
+        end if
+        at(j) = e2i(sym)
+      end do
+    end do
+    close (ich)
+
+    if (io < 0) then
+      error stop 'error while reading ensemble file.'
+    end if
+
+    return
+  end subroutine rdensemble_conf1
+
+!==================================================================!
+! subroutine rdensemble_conf2
+! read a conformer ensemble/a MD trajectory, i.e.,
+! all structures have the same number and order of atoms.
+! version 2 does not read the energy
+!=================================================================!
+  subroutine rdensemble_conf2(fname,nat,nall,at,xyz)
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(inout) :: nat
+    integer,intent(inout) :: nall
+    integer,intent(inout),allocatable :: at(:)
+    real(wp),intent(inout),allocatable :: xyz(:,:,:)
+    integer :: i,j,k,ich,io
+    logical :: ex
+    integer :: dum,nallnew
+    character(len=512) :: line
+    character(len=6) :: sym
+    if (.not.allocated(xyz).or..not.allocated(at)) then
+      call rdensembleparam(fname,nat,nall)
+    end if
+    if (.not.allocated(xyz)) allocate (xyz(3,nat,nall))
+    if (.not.allocated(at)) allocate (at(nat))
+    io = 0
+    xyz = 0.0_wp
+    open (newunit=ich,file=fname)
+    do i = 1,nall
+      read (ich,*,iostat=io) dum
+      if (io < 0) exit
+      if (io > 0) cycle
+      if (dum .ne. nat) then
+        call ensemble_strucskip(ich,nat,io)
+        if (io < 0) exit
+      end if
+      read (ich,'(a)',iostat=io) line
+      if (io < 0) exit
+      do j = 1,dum
+        read (ich,'(a)',iostat=io) line
+        if (io < 0) exit
+        call coordline(line,sym,xyz(1:3,j,i),io)
+        if (io .ne. 0) then
+          backspace (ich)
+          exit
+        end if
+        at(j) = e2i(sym)
+      end do
+    end do
+    close (ich)
+
+    if (io < 0) then
+      error stop 'error while reading ensemble file.'
+    end if
+
+    return
+  end subroutine rdensemble_conf2
+
+!==================================================================!
+! subroutine rdensemble_conf3
+! read a conformer ensemble/a MD trajectory, i.e.,
+! all structures have the same number and order of atoms.
+! version 3 saves the comment line for each structure
+!=================================================================!
+  subroutine rdensemble_conf3(fname,nat,nall,at,xyz,comments)
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(inout) :: nat
+    integer,intent(inout) :: nall
+    integer :: at(nat)
+    integer,allocatable :: atdum(:)
+    real(wp) :: xyz(3,nat,nall)
+    character(len=*) :: comments(nall)
+    integer :: i,j,k,ich,io
+    logical :: ex
+    integer :: dum,nallnew
+    character(len=512) :: line
+    character(len=6) :: sym
+    io = 0
+    xyz = 0.0_wp
+    k = 0
+    open (newunit=ich,file=fname)
+    do i = 1,nall
+      read (ich,*,iostat=io) dum
+      if (io < 0) exit
+      if (io > 0) cycle
+      if (dum .ne. nat) then
+        call ensemble_strucskip(ich,nat,io)
+        if (io < 0) exit
+      end if
+      read (ich,'(a)',iostat=io) line
+      if (io < 0) exit
+      comments(i) = trim(line)
+      do j = 1,dum
+        k = k+1
+        read (ich,'(a)',iostat=io) line
+        if (io < 0) exit
+        call coordline(line,sym,xyz(1:3,j,i),io)
+        if (io .ne. 0) then
+          backspace (ich)
+          exit
+        end if
+        at(j) = e2i(sym)
+      end do
+    end do
+    close (ich)
+
+    if (io < 0) then
+      error stop 'error while reading ensemble file.'
+    end if
+
+    return
+  end subroutine rdensemble_conf3
+
+  subroutine ensemble_strucskip(ich,nat,io)
+    implicit none
+    integer,intent(in) :: ich
+    integer,intent(in) :: nat
+    integer,intent(out) :: io
+    integer :: io2,dum,k
+    io = 0
+    dum = 0
+    k = 0
+    do while (dum .ne. nat)
+      read (ich,*,iostat=io) dum
+      if (io < 0) exit
+      k = k+1
+      if (io > 0) cycle
+    end do
+  end subroutine ensemble_strucskip
+
+!==================================================================!
+! subroutine rdensemble_mixed2
+! read an ensemble of mixed strcutres, i.e., all stuctures
+! can have a diferent number and order of atoms.
+! version 2 does not read energies
+!=================================================================!
+  subroutine rdensemble_mixed2(fname,natmax,nall,nats,ats,xyz,comments)
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: natmax
+    integer,intent(in) :: nall
+    integer  :: nats(nall)
+    integer  :: ats(natmax,nall)
+    real(wp) :: xyz(3,natmax,nall)
+    character(len=*) :: comments(nall)
+    integer :: i,j,k,ich,io
+    logical :: ex
+    integer :: dum
+    character(len=512) :: line
+    character(len=6) :: sym
+    open (newunit=ich,file=fname)
+    do i = 1,nall
+      read (ich,*,iostat=io) dum
+      if (io < 0) exit
+      if (io > 0) cycle
+      nats(i) = dum
+      read (ich,'(a)',iostat=io) line
+      if (io < 0) exit
+      comments(i) = trim(line)
+      do j = 1,dum
+        read (ich,'(a)',iostat=io) line
+        if (io < 0) exit
+        call coordline(line,sym,xyz(1:3,j,i),io)
+        if (io < 0) exit
+        ats(j,i) = e2i(sym)
+      end do
+    end do
+    close (ich)
+
+    if (io < 0) then
+      error stop 'error while reading ensemble file.'
+    end if
+
+    return
+  end subroutine rdensemble_mixed2
+
+! ══════════════════════════════════════════════════════════════════════════════
+!> most important routine in this module: read into a list of coord objects!
+! ══════════════════════════════════════════════════════════════════════════════
+  subroutine rdensemble_coord_type(fname,nall,structures)
+!**********************************************************
+!* subroutine rdensemble_coord_type                       *
+!* A variant of the rdensemble routine that automatically *
+!* produces an array of coord containers                  *
+!**********************************************************
+    implicit none
+    character(len=*),intent(in) :: fname !> name of the ensemble file
+    integer,intent(out) :: nall  !> number of structures in ensemble
+    type(coord),intent(out),allocatable :: structures(:)
+
+    real(wp),allocatable :: xyz(:,:,:)
+    integer :: nat
+    integer,allocatable :: nats(:)
+    integer,allocatable :: at(:)
+    integer,allocatable :: ats(:,:)
+    real(wp),allocatable :: eread(:)
+    character(len=512),allocatable :: comments(:)
+    integer :: i,j,k,ich,io,nat_i,iunit,ii
+    logical :: ex,multiple_sizes,is_extxyz,success
+
+    type(extxyz_signatures) :: ext_sigs
+    type(extxyz_properties) :: ext_props
+    real(wp),allocatable :: exyz(:,:),egrd(:,:),lat(:,:)
+    integer,allocatable :: eat(:)
+    real(wp) :: energy
+    character(len=32) :: eu,fu
+
+    is_extxyz = sgrep(fname,'Properties=',casesensitive=.false.)
+
+    call rdensembleparam(fname,nat,nall,multiple_sizes)
+
+    !>--- multiple sizes possible
+    allocate (structures(nall))
+
+    if (is_extxyz) then
+      !>-- extended xyz case
+      open (newunit=iunit,file=trim(fname))
+      do ii = 1,nall
+        call read_extxyz_frame(iunit,ext_sigs,ext_props,nat,energy,lat,success, &
+        &                      energy_units=eu,forces_units=fu)
+        if (success) then
+          select case (trim(eu))
+          case ('hartree','ha','au')
+            ! energy already in Hartree, no conversion needed
+          case default  !> 'ev' and anything unrecognised
+            energy = energy/autoeV
+          end select
+          call get_at_from_ext(ext_props,eat)
+          call get_xyz_from_ext(ext_props,exyz)
+          call get_grad_from_ext(ext_props,egrd,forces_units=fu)
+          if (allocated(eat)) call move_alloc(eat,structures(ii)%at)
+          if(allocated(exyz)) call move_alloc(exyz,structures(ii)%xyz)
+          if (allocated(lat)) call move_alloc(lat,structures(ii)%lat)
+          if (allocated(egrd)) call move_alloc(egrd,structures(ii)%gradient)
+          structures(ii)%energy = energy
+          structures(ii)%wrextxyz = .true.
+          structures(ii)%nat = nat
+        end if
+      end do
+      close (iunit)
+    else
+      !>-- regular xyz case
+      allocate (xyz(3,nat,nall),ats(nat,nall),nats(nall),eread(nall))
+      allocate (comments(nall))
+      call rdensemble_mixed2(fname,nat,nall,nats,ats,xyz,comments)
+      !>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<!
+      !>--- Important: coord types must be in Bohrs
+      xyz = xyz/bohr
+      !>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<!
+      do i = 1,nall
+        nat_i = nats(i)
+        structures(i)%nat = nats(i)
+        allocate (structures(i)%at(nat_i))
+        structures(i)%at(:) = ats(1:nat_i,i)
+        allocate (structures(i)%xyz(3,nat_i))
+        structures(i)%xyz(:,:) = xyz(1:3,1:nat_i,i)
+        eread(i) = grepenergy(comments(i))
+        structures(i)%energy = eread(i)
+        structures(i)%comment = trim(comments(i))
+      end do
+      deallocate (comments,eread,nats,ats,xyz)
+    end if
+  end subroutine rdensemble_coord_type
+
+!=================================================================!
+! subroutine wrensemble_conf
+! write a ensemble file/a trajectory from memory.
+!=================================================================!
+  subroutine wrensemble_conf(fname,nat,nall,at,xyz)
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: nat
+    integer,intent(in) :: nall
+    integer :: at(nat)
+    real(wp) :: xyz(3,nat,nall)
+    integer :: i,j,k,ich,io
+    logical :: ex
+    open (newunit=ich,file=fname,status='replace')
+    do i = 1,nall
+      call wrxyz(ich,nat,at,xyz(:,:,i))
+    end do
+    close (ich)
+    return
+  end subroutine wrensemble_conf
+
+!=================================================================!
+! subroutine wrensemble_conf_energy
+! write a ensemble file/a trajectory from memory.
+!=================================================================!
+  subroutine wrensemble_conf_energy(fname,nat,nall,at,xyz,er)
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: nat
+    integer,intent(in) :: nall
+    integer :: at(nat)
+    real(wp) :: xyz(3,nat,nall)
+    real(wp) :: er(nall)
+    integer :: i,j,k,ich,io
+    logical :: ex
+
+    open (newunit=ich,file=fname,status='replace')
+    do i = 1,nall
+      call wrxyz(ich,nat,at,xyz(:,:,i),er(i))
+    end do
+    close (ich)
+
+    return
+  end subroutine wrensemble_conf_energy
+
+!=================================================================!
+! subroutine wrensemble_conf_energy_comment
+! write a ensemble file/a trajectory from memory.
+!=================================================================!
+  subroutine wrensemble_conf_energy_comment(fname,nat,nall,at,xyz,er,comments)
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: nat
+    integer,intent(in) :: nall
+    integer :: at(nat)
+    real(wp) :: xyz(3,nat,nall)
+    real(wp) :: er(nall)
+    character(len=*) :: comments(nall)
+    character(len=512) :: line
+    integer :: i,j,k,ich,io
+    logical :: ex
+
+    open (newunit=ich,file=fname,status='replace')
+    do i = 1,nall
+      write (line,'(2x,f18.8,2x,a)') er(i),trim(comments(i))
+      call wrxyz(ich,nat,at,xyz(:,:,i),trim(line))
+    end do
+    close (ich)
+
+    return
+  end subroutine wrensemble_conf_energy_comment
+
+!==================================================================!
+! subroutine write_ensemble
+! wrapper to write an ensemble from the "ensemble" class
+!==================================================================!
+  subroutine write_ensemble(self,fname)
+    implicit none
+    class(ensemble) :: self
+    character(len=*),intent(in) :: fname
+    if (.not.self%mixed) then
+      call wrensemble_conf_energy(fname,self%nat,self%nall,self%at,self%xyz,self%er)
+    else
+      self%structures(:)%energy = self%er(:)
+      call wrensemble_coord_name(fname,self%nall,self%structures)
+    end if
+    return
+  end subroutine write_ensemble
+
+  subroutine wrensemble_coord_name(fname,nall,structures)
+    implicit none
+    character(len=*),intent(in) :: fname
+    integer,intent(in) :: nall
+    type(coord) :: structures(nall)
+    integer :: ich,i
+    open (newunit=ich,file=fname,status='replace')
+    do i = 1,nall
+      call structures(i)%append(ich)
+    end do
+    close (ich)
+    return
+  end subroutine wrensemble_coord_name
+
+  subroutine wrensemble_coord_channel(ich,nall,structures)
+    implicit none
+    integer,intent(in) :: ich
+    integer,intent(in) :: nall
+    type(coord) :: structures(nall)
+    integer :: i
+    do i = 1,nall
+      call structures(i)%append(ich)
+    end do
+    return
+  end subroutine wrensemble_coord_channel
+
+!==================================================================!
+! subroutine deallocate_ensembletype
+! is used to clear memory for the ensemble type
+!==================================================================!
+  subroutine deallocate_ensembletype(self)
+    implicit none
+    class(ensemble) :: self
+
+    self%mixed = .false.
+    self%nat = 0
+    self%nall = 0
+    if (allocated(self%at)) deallocate (self%at)
+    if (allocated(self%xyz)) deallocate (self%xyz)
+    if (allocated(self%er)) deallocate (self%er)
+
+    if (allocated(self%structures)) deallocate (self%structures)
+
+    if (allocated(self%gt)) deallocate (self%gt)
+    if (allocated(self%ht)) deallocate (self%ht)
+    if (allocated(self%svib)) deallocate (self%svib)
+    if (allocated(self%srot)) deallocate (self%srot)
+    if (allocated(self%stra)) deallocate (self%stra)
+    return
+  end subroutine deallocate_ensembletype
+
+!==================================================================!
+! subroutine openensemble
+! is the open procedure for the "ensemble" class.
+! a ensemble (trajectory) fname is read into a new ensemble object
+!==================================================================!
+  subroutine openensemble(self,fname)
+    implicit none
+    class(ensemble) :: self
+    character(len=*),intent(in) :: fname
+    integer :: nat
+    integer,allocatable :: at(:)
+    real(wp),allocatable :: xyz(:,:,:)
+    real(wp),allocatable :: eread(:)
+    integer :: nall
+    integer :: i,j,k,ich,io
+    logical :: ex,conform
+    type(coord),allocatable :: structures(:)
+
+    inquire (file=fname,exist=ex)
+    if (.not.ex) then
+      error stop 'ensemble file does not exist.'
+    end if
+
+    !> we check if all the structures in the file
+    !> are actually the same length (nat), if not we need to
+    !> take care of this and read into self%structures instead
+    call rdensembleparam(fname,nat,nall,conform)
+    self%mixed = .not.conform
+
+    if (conform) then
+      if (nat > 0.and.nall > 0) then
+        call self%deallocate()
+        allocate (at(nat),xyz(3,nat,nall),eread(nall))
+        call rdensemble(fname,nat,nall,at,xyz,eread)
+
+        self%nat = nat
+        self%nall = nall
+        call move_alloc(at,self%at)
+        call move_alloc(xyz,self%xyz)
+        call move_alloc(eread,self%er)
+      else
+        error stop 'format error while reading ensemble file.'
+      end if
+    else
+      call rdensemble_coord_type(fname,self%nall,self%structures)
+      allocate (self%er(nall),source=0.0_wp)
+      self%er(:) = self%structures(:)%energy
+    end if
+
+    return
+  end subroutine openensemble
+
+  subroutine ensemble_get_mol(self,i,mol)
+    class(ensemble) :: self
+    integer,intent(in) :: i
+    class(coord),intent(inout) :: mol
+    integer :: n
+    logical :: reinitialize
+    if (i > self%nall) error stop 'can´t get molecule from ensemble. i>nall'
+    if (i < 1) error stop 'can´t get molecule from ensemble. i<1'
+    if (.not.self%mixed) then
+      n = self%nat
+      reinitialize = .not. (mol%nat == n)
+      if (reinitialize) then
+        mol%nat = n
+        if (allocated(mol%at)) deallocate (mol%at)
+        allocate (mol%at(n),source=0)
+        if (allocated(mol%xyz)) deallocate (mol%xyz)
+        allocate (mol%xyz(3,n),source=0.0_wp)
+      end if
+      mol%energy = self%er(i)
+      mol%at(:) = self%at(:)
+      !> Important, ens is in Angström, mol is in Bohrs
+      mol%xyz(1:3,1:n) = self%xyz(1:3,1:n,i)*aatoau
+    else !> self%mixed == .true.
+      n = self%structures(i)%nat
+      reinitialize = .not. (mol%nat == n)
+      if (reinitialize) then
+        if (allocated(mol%at)) deallocate (mol%at)
+        allocate (mol%at(n),source=0)
+        if (allocated(mol%xyz)) deallocate (mol%xyz)
+        allocate (mol%xyz(3,n),source=0.0_wp)
+      end if
+      mol%nat = self%structures(i)%nat
+      mol%at(:) = self%structures(i)%at(:)
+      mol%xyz(:,:) = self%structures(i)%xyz(:,:)
+      mol%energy = self%structures(i)%energy
+    end if
+  end subroutine ensemble_get_mol
+
+! ══════════════════════════════════════════════════════════════════════════════
+! ══════════════════════════════════════════════════════════════════════════════
+end module molecule_type_ensemble
diff --git a/src/msreact/msmod.f90 b/src/msreact/msmod.f90
index 055640ed..3a44183f 100644
--- a/src/msreact/msmod.f90
+++ b/src/msreact/msmod.f90
@@ -774,7 +774,7 @@ subroutine write_fragments(env,mso,estart,nisomers,nfragpairs,fname,lprint)
     character(len=80) :: comment
     logical :: ex
     logical :: lprint
-    character(len=40) :: sumform,sumformula
+    character(len=40) :: sumformula
     real(wp) :: mass,erel
 
     nat = mso%pl%mol(1)%nat
diff --git a/src/optimize/CMakeLists.txt b/src/optimize/CMakeLists.txt
index 1fd034a2..3675888e 100644
--- a/src/optimize/CMakeLists.txt
+++ b/src/optimize/CMakeLists.txt
@@ -20,8 +20,11 @@ list(APPEND srcs
   "${dir}/ancopt.f90"
   "${dir}/gd.f90"
   "${dir}/rfo.f90"
+  "${dir}/lbfgs.f90"
+  "${dir}/newton_raphson.f90"
   "${dir}/hessupdate.f90"
   "${dir}/modelhessian.f90"
+  "${dir}/coordtrafo.f90"
   "${dir}/optimize_maths.f90"
   "${dir}/optimize_module.f90"
   "${dir}/optimize_type.f90"
diff --git a/src/optimize/ancopt.f90 b/src/optimize/ancopt.f90
index 287f46b5..7a140078 100644
--- a/src/optimize/ancopt.f90
+++ b/src/optimize/ancopt.f90
@@ -1,7 +1,7 @@
 !================================================================================!
 ! This file is part of crest.
 !
-! Copyright (C) 2021 - 2022 Philipp Pracht
+! Copyright (C) 2021 - 2026 Philipp Pracht
 !
 ! crest is free software: you can redistribute it and/or modify it under
 ! the terms of the GNU Lesser General Public License as published by
@@ -23,7 +23,7 @@
 !> This module implements the ANCOPT algorithm
 
 module ancopt_module
-  use iso_fortran_env, only: wp=>real64, sp=>real32
+  use iso_fortran_env,only:wp => real64,sp => real32
   !use crest_parameters
   use crest_calculator
   use axis_module
@@ -35,6 +35,7 @@ module ancopt_module
   use modelhessian_module
   use hessupdate_module
   use optimize_utils
+  use hessian_reconstruct
   implicit none
   private
 
@@ -46,7 +47,7 @@ module ancopt_module
 !========================================================================================!
 !========================================================================================!
 
-  subroutine ancopt(mol,calc,etot,grd,pr,wr,iostatus)
+  subroutine ancopt(mol,calc,etot,grd,pr,wr,iostatus,logfile)
 !*************************************************************************
 !> subroutine ancopt
 !> Implementation of the Aproximate Normal Coordinate (ANC) optimizer
@@ -61,9 +62,10 @@ subroutine ancopt(mol,calc,etot,grd,pr,wr,iostatus)
 !>             on output final energy
 !>      grd  - Cartesian gradient
 !>       pr  - printout bool
-!>       wr  - logfile (crestopt.log) bool
+!>       wr  - logfile bool (name given by logfile, default crestopt.log.xyz)
 !>  iostatus - return status of the routine
 !>             (success=0, error<0, not converged>0)
+!>   logfile - name of the trajectory logfile to write when wr is set
 !!***********************************************************************
     implicit none
     !> INPUT/OUTPUT
@@ -74,6 +76,7 @@ subroutine ancopt(mol,calc,etot,grd,pr,wr,iostatus)
     logical,intent(in) :: pr
     logical,intent(in) :: wr
     integer,intent(out) :: iostatus
+    character(len=*),intent(in) :: logfile
     !> LOCAL
     integer  :: tight
     real(wp) :: eel
@@ -88,7 +91,7 @@ subroutine ancopt(mol,calc,etot,grd,pr,wr,iostatus)
     real(wp) :: step,amu2au,au2cm,dumi,dumj,damp,hlow,edum,s6,thr
     real(wp) :: maxdispl,gthr,ethr,hmax,energy,rij(3),t1,t0,w1,w0
     real(wp) :: rot(3),gnorm
-    integer :: n3,i,j,k,l,jjj,ic,jc,ia,ja,ii,jj,info,nat3
+    integer :: n3,i,j,k,l,jjj,ic,jc,ia,ja,ii,jj,info,nat3,info2
     integer :: nvar,iter,nread,maxcycle,maxmicro,itry,maxopt,iupdat,iii
     integer :: id,ihess,error
     integer :: ilog
@@ -119,8 +122,9 @@ subroutine ancopt(mol,calc,etot,grd,pr,wr,iostatus)
     iupdat = calc%iupdat
     hlow = calc%hlow_opt !> 0.01 in ancopt, 0.002 too small
     hmax = calc%hmax_opt
-    maxdispl = calc%maxdispl_opt 
+    maxdispl = calc%maxdispl_opt
     s6 = mhset%s6 !> slightly better than 30 for various proteins
+    mhset%model = calc%mh_type
 
 !> initial number of steps in relax() routine before
 !> new ANC are made by model Hessian
@@ -154,7 +158,6 @@ subroutine ancopt(mol,calc,etot,grd,pr,wr,iostatus)
       &                       ethr,gthr,linear,wr)
     end if
 
-
 !>--- initialize OPT object
     !$omp critical
     allocate (h(nat3,nat3),hess(nat3*(nat3+1)/2),eig(nat3))
@@ -166,12 +169,13 @@ subroutine ancopt(mol,calc,etot,grd,pr,wr,iostatus)
     molopt%nat = mol%nat
     molopt%at = mol%at
     molopt%xyz = mol%xyz
+    molopt%wrextxyz = calc%logextxyz
     estart = etot
 
 !>--- initialize .log file, if desired
     ilog = 942
     if (wr) then
-      open (newunit=ilog,file='crestopt.log')
+      open (newunit=ilog,file=logfile)
     end if
 
 !>--- The ANCOPT iteration loop. "iter" is updated in relax() subroutine
@@ -184,7 +188,7 @@ subroutine ancopt(mol,calc,etot,grd,pr,wr,iostatus)
       write (*,'(5x,"change ΔE",e18.7,1x,"Eh")') 0.0_wp
       write (*,'(3x,"gradient norm :",f14.7,1x,"Eh/a0")',advance='no') gnorm
       write (*,'(2x,"predicted",e18.7)',advance='no') 0.0_wp
-      write (*,'(1x,"("f7.2"%)")')-0.0_wp
+      write (*,'(1x,"(",f7.2,"%)")')-0.0_wp
     end if
 
 !>======================================================================
@@ -221,7 +225,7 @@ subroutine ancopt(mol,calc,etot,grd,pr,wr,iostatus)
       esave = etot !> save energy before relaxation
 !>--- call the actual relaxation routine
 !>    this routine will perform [maxmicro] relaxation steps
-      if(iter+maxmicro >= maxcycle) maxmicro = maxcycle - iter
+      if (iter+maxmicro >= maxcycle) maxmicro = maxcycle-iter
 !>    [maxmicro] need to be adapted to not overshoot maxcycle
       call relax(molopt,calc,OPT,iter,maxmicro,etot,grd,  &
             &      ethr,gthr,converged,                  &
@@ -343,22 +347,26 @@ subroutine relax(mol,calc,OPT,iter,maxmicro,etot,grd,  &
     logical :: lowered
     integer :: i,j,ii,jj,jjj,iii,k,lwork,info,m,idum,imax(3)
     real(wp) :: energy,dsnrm,maxdispl,t0,w0,t1,w1
-    real(wp) :: lambda,gnorm,dnorm,ddot,eold,xdum,estart,acc,e_in
-    real(wp) :: depred,echng,dummy,maxd,alp,gchng,gnold
+    real(wp) :: lambda,gnorm,dnorm,eold,xdum,estart,acc,e_in
+    real(wp) :: depred,echng,dummy,maxd,alp,alpold,gchng,gnold
     real(wp),allocatable :: gold(:)
-    real(wp),allocatable :: displ(:),gint(:)
-    real(sp),allocatable :: eaug(:)
-    real(sp),allocatable :: Uaug(:,:)
-    real(sp),allocatable :: Aaug(:)
-    real(sp),parameter :: r4dum = 1.e-8
+    real(wp),allocatable :: displ(:),gint(:),dxold(:)
+    real(wp),allocatable :: eaug(:)
+    real(wp),allocatable :: Uaug(:,:)
+    real(wp),allocatable :: Aaug(:)
+    real(wp),parameter :: r4dum = 1.e-8
+    real(wp),allocatable :: test_hess(:,:)
     !> LAPACK & BLAS
     external :: dgemv
-    real(sp),external :: sdot
+    real(wp),external :: ddot
+    integer :: q,r,s,nat3 !> ONLY for testing!
+    nat3 = 3*mol%nat
+    allocate (test_hess(nat3,nat3))
 
     iostatus = 0
 
     !$omp critical
-    allocate (gold(OPT%nvar),displ(OPT%nvar),gint(OPT%nvar),source=0.0_wp)
+    allocate (gold(OPT%nvar),displ(OPT%nvar),gint(OPT%nvar),dxold(OPT%nvar),source=0.0_wp)
 
     gnorm = 0.0_wp
     depred = 0.0_wp
@@ -368,6 +376,7 @@ subroutine relax(mol,calc,OPT,iter,maxmicro,etot,grd,  &
     energy = etot
     e_in = etot
     alp = 1.0_wp
+    alpold = 1.0_wp
     converged = .false.
     exact = calc%exact_rf
     iupdat = calc%iupdat
@@ -375,7 +384,7 @@ subroutine relax(mol,calc,OPT,iter,maxmicro,etot,grd,  &
     nvar1 = OPT%nvar+1             !> dimension of RF calculation
     npvar = OPT%nvar*(nvar1)/2   !> packed size of Hessian (note the abuse of nvar1!)
     npvar1 = nvar1*(nvar1+1)/2 !> packed size of augmented Hessian
-    allocate (Uaug(nvar1,1),eaug(nvar1),Aaug(npvar1), source=0.0_sp)
+    allocate (Uaug(nvar1,1),eaug(nvar1),Aaug(npvar1),source=0.0_wp)
     !$omp end critical
 
 !! ========================================================================
@@ -387,8 +396,11 @@ subroutine relax(mol,calc,OPT,iter,maxmicro,etot,grd,  &
       gnold = gnorm
       eold = energy
 !>--- calc predicted energy change based on E = E0 + delta * G + delta^2 * H
+      alpold = alp
+      dxold = displ*alpold
+
       if (ii > 1) then
-        call prdechng(OPT%nvar,gold,displ,OPT%hess,depred)
+        call prdechng(OPT%nvar,gold,dxold,OPT%hess,depred)
       end if
 
 !>------------------------------------------------------------------------
@@ -420,18 +432,6 @@ subroutine relax(mol,calc,OPT,iter,maxmicro,etot,grd,  &
         exit main_loop
       end if
 
-      !if (present(avconv)) then
-      !  call avconv%set_eg_log(energy,gnorm)
-      !  energy = avconv%get_averaged_energy()
-      !  gnorm = avconv%get_averaged_gradient()
-      !  if (pr) then
-      !    write (*,'("av. E:",1x,f14.7,1x,"->",1x,f14.7)') &
-      !      avconv%elog(avconv%nlog),energy
-      !    write (*,'("av. G:",1x,f14.7,1x,"->",1x,f14.7)') &
-      !      avconv%glog(avconv%nlog),gnorm
-      !  end if
-      !end if
-
 !>--- check for convergence
       gchng = gnorm-gnold
       echng = energy-eold
@@ -448,25 +448,28 @@ subroutine relax(mol,calc,OPT,iter,maxmicro,etot,grd,  &
         if (ii > 1) then
           dummy = (depred-echng)/echng*100.0_wp
           if (abs(dummy) < 1000.0_wp) then
-            write (*,'(1x,"("f7.2"%)")') dummy
+            write (*,'(1x,"("f7.2,"%)")') dummy
           else
             write (*,'(1x,"(*******%)")')
           end if
         else
-          write (*,'(1x,"("f7.2"%)")')-100.0_wp
+          write (*,'(1x,"(",f7.2,"%)")')-100.0_wp
         end if
       end if
 
-      alp = 1.0d0 
-      if (gnorm .lt. 0.002) then ! 0.002
-        alp = 1.5d0 ! 1.5
-      endif
-      if (gnorm .lt. 0.0006) then
-        alp = 2.0d0 ! 2
-      endif
-      if (gnorm .lt. 0.0003) then
-        alp = 3.0d0 ! 3
-      end if
+      alp = 1.0d0
+      !if (gnorm .lt. 0.002) then ! 0.002
+      !  alp = 1.5d0 ! 1.5
+      !end if
+      !if (gnorm .lt. 0.0006) then
+      !  alp = 2.0d0 ! 2
+      !end if
+      !if (gnorm .lt. 0.0003) then
+      !  alp = 3.0d0 ! 3
+      !end if
+
+      !alp = alp_generate(gnorm)
+      !write(stdout,*) alp
 
 !>------------------------------------------------------------------------
 !> Update the Hessian
@@ -475,15 +478,15 @@ subroutine relax(mol,calc,OPT,iter,maxmicro,etot,grd,  &
 !>--- Hessian update, but only after first iteration (ii > 1)
         select case (iupdat)
         case (0)
-          call bfgs(OPT%nvar,gnorm,gint,gold,displ,OPT%hess)
+          call bfgs(OPT%nvar,gnorm,gint,gold,dxold,OPT%hess)
         case (1)
-          call powell(OPT%nvar,gnorm,gint,gold,displ,OPT%hess)
+          call powell(OPT%nvar,gnorm,gint,gold,dxold,OPT%hess)
         case (2)
-          call sr1(OPT%nvar,gnorm,gint,gold,displ,OPT%hess)
+          call sr1(OPT%nvar,gnorm,gint,gold,dxold,OPT%hess)
         case (3)
-          call bofill(OPT%nvar,gnorm,gint,gold,displ,OPT%hess)
+          call bofill(OPT%nvar,gnorm,gint,gold,dxold,OPT%hess)
         case (4)
-          call schlegel(OPT%nvar,gnorm,gint,gold,displ,OPT%hess)
+          call schlegel(OPT%nvar,gnorm,gint,gold,dxold,OPT%hess)
         case default
           write (*,*) 'invalid hessian update selection'
           stop
@@ -501,24 +504,24 @@ subroutine relax(mol,calc,OPT,iter,maxmicro,etot,grd,  &
 !>     Aaug    Uaug       Uaug
 
 !>--- first, augment Hessian by gradient, everything packed, no blowup
-      Aaug(1:npvar) = real(OPT%hess(1:npvar),sp)
-      Aaug(npvar+1:npvar1-1) = real(gint(1:OPT%nvar),sp)
-      Aaug(npvar1) = 0.0_sp
+      Aaug(1:npvar) = OPT%hess(1:npvar)
+      Aaug(npvar+1:npvar1-1) = gint(1:OPT%nvar)
+      Aaug(npvar1) = 0.0_wp
 
-!>--- choose solver
+!>--- choose solver for the RF eigenvalue problem
       if (exact.or.nvar1 .lt. 50) then
-        call solver_sspevx(nvar1,r4dum,Aaug,Uaug,eaug,fail)
+        call solver_dspevx(nvar1,r4dum,Aaug,Uaug,eaug,fail)
       else
         !>--- steepest decent guess for displacement
         if (ii .eq. 1) then
-          Uaug(:,1) = [-real(gint(1:OPT%nvar),sp),1.0_sp]
-          dsnrm = sqrt(sdot(nvar1,Uaug,1,Uaug,1))
-          Uaug = Uaug/real(dsnrm,sp)
+          Uaug(:,1) = [-gint(1:OPT%nvar),1.0_wp]
+          dsnrm = sqrt(ddot(nvar1,Uaug,1,Uaug,1))
+          Uaug = Uaug/dsnrm
         end if
-        call solver_sdavidson(nvar1,r4dum,Aaug,Uaug,eaug,fail,.false.)
+        call solver_ddavidson(nvar1,r4dum,Aaug,Uaug,eaug,fail,.false.)
         !>--- if that failed, retry with better solver
         if (fail) then
-          call solver_sspevx(nvar1,r4dum,Aaug,Uaug,eaug,fail)
+          call solver_dspevx(nvar1,r4dum,Aaug,Uaug,eaug,fail)
         end if
       end if
 
@@ -553,7 +556,7 @@ subroutine relax(mol,calc,OPT,iter,maxmicro,etot,grd,  &
         write (*,'(6x,"in ANC''s ",3("#",i0,", "),"...")') imax
         !call prdispl(OPT%nvar,displ)
       end if
-!>------------------------------------------------------------------------
+!>---------------------------------------------------------------------------
 
 !>--- 2nd: exit and redo hessian (internal restart)
       if (ii .gt. 2.and.dsnrm .gt. 2.0) then
@@ -628,5 +631,21 @@ subroutine trfp2xyz(nvar,nat3,p,xyz0,h,dspl)
   end subroutine trfp2xyz
 
 !========================================================================================!
+
+  function alp_generate(gnorm) result(alp)
+!****************************************************
+!* Computes stepsize scaling factor
+!****************************************************
+    real(wp),intent(in) :: gnorm
+    real(wp) :: alp,shift,l,k
+
+    l = 2.0_wp
+    k = 2000.0
+    shift = 0.0005
+
+    alp = L/(1+euler**(k*(gnorm-shift)))+1
+
+  end function alp_generate
+
 !========================================================================================!
 end module ancopt_module
diff --git a/src/optimize/coordtrafo.f90 b/src/optimize/coordtrafo.f90
new file mode 100644
index 00000000..7c778dc6
--- /dev/null
+++ b/src/optimize/coordtrafo.f90
@@ -0,0 +1,232 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2025 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module coordinate_transform_module
+!***********************************************************************
+!* Module: coordinate_transform_module
+!*
+!* This module provides transformation routines for converting between
+!* different coordinate representations. In particular, it includes routines
+!* to transform 3D Cartesian coordinates (stored in a 'coord' type from the
+!* strucrd module) into a 1D vector representation and vice versa. It also
+!* provides routines to transform gradients between a 3D representation (as a
+!* 2D array with dimensions 3 x nat) and a 1D vector. These routines are useful
+!* in optimization contexts where a flattened variable representation is required.
+!***********************************************************************
+  use crest_parameters
+  use strucrd
+  implicit none
+  private
+
+  public :: compute_nvar,transform_mol,transform_grd
+
+!========================================================================================!
+!========================================================================================!
+contains !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  function compute_nvar(mol) result(nvar)
+    !***********************************************************************
+    !* Function compute_nvar
+    !* Computes the number of variables for a system with nat atoms.
+    !* nvar is defined as 3 * nat.
+    !***********************************************************************
+    implicit none
+    type(coord),intent(in) :: mol
+    integer :: nvar
+
+    nvar = 3*mol%nat
+  end function compute_nvar
+
+!========================================================================================!
+
+  subroutine transform_mol(transformation_type,mol,nvar,vec)
+    !***********************************************************************
+    !* Subroutine transform_mol
+    !* Wrapper routine for coordinate transformations on a molecule.
+    !* Supported transformation types:
+    !*   "cart2v" - Transforms mol%xyz (3D Cartesian coordinates) into a 1D vector.
+    !*   "v2cart" - Transforms a 1D vector into mol%xyz.
+    !*
+    !* @param transformation_type  Character string specifying the transformation.
+    !* @param mol                  Type(coord) variable containing Cartesian coordinates.
+    !* @param vec                  1D real(wp) vector (input for "v2cart", output for "cart2v").
+    !* @param nvar                 Integer, number of variables (nvar = 3*mol%nat).
+    !***********************************************************************
+    implicit none
+    character(len=*),intent(in) :: transformation_type
+    type(coord),intent(inout) :: mol
+    real(wp),intent(inout) :: vec(nvar)
+    integer,intent(in) :: nvar
+
+    select case (trim(transformation_type))
+    case ("cart2v")
+      call cartesian_to_vector(mol,vec,nvar)
+    case ("v2cart")
+      call vector_to_cartesian(vec,nvar,mol)
+    case default
+      write(*,*)"Error: Transformation type not recognized in transform_mol."
+      stop
+    end select
+  end subroutine transform_mol
+
+!========================================================================================!
+
+  subroutine transform_grd(transformation_type,mol,grd,nvar,vec)
+    !***********************************************************************
+    !* Subroutine transform_grd
+    !* Wrapper routine for gradient transformations.
+    !* Supported transformation types:
+    !*   "grd2v" - Transforms a 3D gradient array grd(3, nat) into a 1D vector.
+    !*   "v2grd" - Transforms a 1D gradient vector into a 3D array grd(3, nat).
+    !*
+    !* @param transformation_type  Character string specifying the transformation.
+    !* @param grd                  3D gradient array (3 x nat); input for "grd2v"
+    !*                             and output for "v2grd".
+    !* @param vec                  1D real(wp) vector (output for "grd2v", input for "v2grd").
+    !* @param nvar                 Integer, number of variables (nvar = 3*nat).
+    !***********************************************************************
+    implicit none
+    character(len=*),intent(in) :: transformation_type
+    type(coord),intent(inout) :: mol
+    real(wp),intent(inout) :: grd(3,mol%nat)
+    real(wp),intent(inout) :: vec(nvar)
+    integer,intent(inout) :: nvar
+    integer :: nat
+
+    nat = mol%nat
+    select case (trim(transformation_type))
+    case ("cart2v")
+      call gradient_to_vector(grd,nat,vec,nvar)
+    case ("v2cart")
+      call vector_to_gradient(vec,nvar,grd,nat)
+    case default
+      write(*,*)"Error: Transformation type not recognized in transform_grd."
+      stop
+    end select
+  end subroutine transform_grd
+
+!========================================================================================!
+
+  subroutine cartesian_to_vector(mol,x,nvar)
+    !***********************************************************************
+    ! Subroutine cartesian_to_vector
+    ! Transforms 3D Cartesian coordinates from mol%xyz into a 1D vector x.
+    ! The number of variables is computed as nvar = 3 * mol%nat.
+    !***********************************************************************
+    implicit none
+    type(coord),intent(in) :: mol
+    real(wp),intent(out) :: x(nvar)
+    integer,intent(in) :: nvar
+    integer :: i,j,idx
+
+    x = reshape(mol%xyz, [nvar])
+    !idx = 0
+    !do j = 1,mol%nat
+    !  do i = 1,3
+    !    idx = idx+1
+    !    x(idx) = mol%xyz(i,j)
+    !  end do
+    !end do
+  end subroutine cartesian_to_vector
+
+  subroutine vector_to_cartesian(x,nvar,mol)
+    !***********************************************************************
+    ! Subroutine vector_to_cartesian
+    ! Transforms a 1D vector x into 3D Cartesian coordinates stored in mol%xyz.
+    ! It computes the number of atoms as nat = nvar / 3 and allocates mol%xyz.
+    !***********************************************************************
+    implicit none
+    integer,intent(in) :: nvar
+    real(wp),intent(in) :: x(nvar)
+    type(coord),intent(inout) :: mol
+    integer :: nat,i,j,idx
+
+    if (mod(nvar,3) /= 0) then
+      write(*,*)"Error: nvar must be a multiple of 3."
+      stop
+    end if
+
+    mol%xyz = reshape(x,[3,mol%nat])
+!    nat = mol%nat
+!    idx = 0
+!    do j = 1,nat
+!      do i = 1,3
+!        idx = idx+1
+!        mol%xyz(i,j) = x(idx)
+!      end do
+!    end do
+  end subroutine vector_to_cartesian
+
+!========================================================================================!
+
+  subroutine gradient_to_vector(grd,nat,g,nvar)
+    !***********************************************************************
+    !* Subroutine gradient_to_vector
+    !* Transforms a 3D gradient array grd(3, nat) into a 1D vector g.
+    !* The number of variables is computed as nvar = 3 * nat.
+    !***********************************************************************
+    implicit none
+    integer,intent(in) :: nat,nvar
+    real(wp),intent(in) :: grd(3,nat)
+    real(wp),intent(out) :: g(nvar)
+    integer :: i,j,idx
+
+    g = reshape(grd, [nvar])
+    !idx = 0
+    !do j = 1,nat
+    !  do i = 1,3
+    !    idx = idx+1
+    !    g(idx) = grd(i,j)
+    !  end do
+    !end do
+  end subroutine gradient_to_vector
+
+  subroutine vector_to_gradient(g,nvar,grd,nat)
+    !***********************************************************************
+    !* Subroutine vector_to_gradient
+    !* Transforms a 1D gradient vector g into a 3D gradient array grd(3, nat).
+    !* It computes the number of atoms as nat = nvar / 3 and allocates grd.
+    !***********************************************************************
+    implicit none
+    integer,intent(in) :: nvar,nat
+    real(wp),intent(in) :: g(nvar)
+    real(wp),intent(out) :: grd(3,nat)
+    integer :: i,j,idx
+
+    if (mod(nvar,3) /= 0) then
+      write(*,*)"Error: nvar must be a multiple of 3."
+      stop
+    end if
+
+    grd = reshape(g, [3,nat])  
+    !idx = 0
+    !do j = 1,nat
+    !  do i = 1,3
+    !    idx = idx+1
+    !    grd(i,j) = g(idx)
+    !  end do
+    !end do
+  end subroutine vector_to_gradient
+
+!========================================================================================!
+!========================================================================================!
+end module coordinate_transform_module
+
diff --git a/src/optimize/gd.f90 b/src/optimize/gd.f90
index 00c57bfe..f176f11a 100644
--- a/src/optimize/gd.f90
+++ b/src/optimize/gd.f90
@@ -42,7 +42,7 @@ module gradientdescent_module
 !========================================================================================!
 !========================================================================================!
 
-  subroutine gradientdescent(mol,calc,etot,grd,pr,wr,iostatus)
+  subroutine gradientdescent(mol,calc,etot,grd,pr,wr,iostatus,logfile)
 !*************************************************************************
 !> subroutine gradientdescent
 !> Implementation of a simple gradient descent algorithm
@@ -57,9 +57,10 @@ subroutine gradientdescent(mol,calc,etot,grd,pr,wr,iostatus)
 !>             on output final energy
 !>      grd  - Cartesian gradient
 !>       pr  - printout bool
-!>       wr  - logfile (crestopt.log) bool
+!>       wr  - logfile bool (name given by logfile, default crestopt.log.xyz)
 !>  iostatus - return status of the routine
 !>             (success=0, error<0, not converged>0)
+!>   logfile - name of the trajectory logfile to write when wr is set
 !!***********************************************************************
     implicit none
     !> INPUT/OUTPUT
@@ -70,6 +71,7 @@ subroutine gradientdescent(mol,calc,etot,grd,pr,wr,iostatus)
     logical,intent(in) :: pr
     logical,intent(in) :: wr
     integer,intent(out) :: iostatus
+    character(len=*),intent(in) :: logfile
     !> LOCAL
     integer  :: tight
     real(wp) :: eel
@@ -153,6 +155,7 @@ subroutine gradientdescent(mol,calc,etot,grd,pr,wr,iostatus)
     molopt%nat = mol%nat
     molopt%at = mol%at
     molopt%xyz = mol%xyz
+    molopt%wrextxyz = calc%logextxyz
     estart = etot
     gnorm = 0.0_wp
     depred = 0.0_wp
@@ -164,7 +167,7 @@ subroutine gradientdescent(mol,calc,etot,grd,pr,wr,iostatus)
 !>--- initialize .log file, if desired
     ilog = 942
     if (wr) then
-      open (newunit=ilog,file='crestopt.log')
+      open (newunit=ilog,file=logfile)
     end if
 
 !>--- The gradient descent iteration loop. "iter"
diff --git a/src/optimize/hessupdate.f90 b/src/optimize/hessupdate.f90
index 5d9fcefe..57b55549 100644
--- a/src/optimize/hessupdate.f90
+++ b/src/optimize/hessupdate.f90
@@ -72,6 +72,7 @@ subroutine bfgs(nat3,gnorm,grad,grado,dx,hess)
     real(wp) :: dgdx,idgdx,dgdgdx
     real(wp),parameter :: thrs = 1.d-12
     real(wp),parameter :: thr = 1d-2
+    integer :: unit
     !> BLAS:
     external :: dspmv
     real(wp),external :: ddot
diff --git a/src/optimize/lbfgs.f90 b/src/optimize/lbfgs.f90
new file mode 100644
index 00000000..f338a02a
--- /dev/null
+++ b/src/optimize/lbfgs.f90
@@ -0,0 +1,317 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2025 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!> This module implemnts a simple L-BFGS with different coordinate choices
+
+module lbfgs_module
+  use,intrinsic :: iso_fortran_env,only:wp => real64
+  use crest_calculator
+  use strucrd
+  use optimize_type  !> This module provides the 'optimizer' type.
+  use optimize_utils
+  use coordinate_transform_module
+  implicit none
+  private
+
+  public :: lbfgs_optimize
+
+!========================================================================================!
+!========================================================================================!
+contains !>  MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  function lbfgs_direction(nvar,g,k,OPT,gamm) result(d)
+    !*******************************************************************************
+    !* Two-loop recursion routine to compute the search direction.
+    !*
+    !* This function uses the stored correction pairs (S and Y) and
+    !* corresponding scaling factors (rho) to approximate the product
+    !* H*g, where H is the inverse Hessian approximation.
+    !*
+    !* The algorithm proceeds in two loops:
+    !* 1. The first (backward) loop computes the coefficients "alpha" and
+    !*    subtracts corrections from the gradient.
+    !* 2. The second (forward) loop applies the corrections in the reverse order.
+    !* Finally, the result is negated to obtain the descent direction.
+    !* Note, this routine is NOT called for the very first iteration (k == 0)
+    !*
+    !* @param nvar   Dimension of the variable space.
+    !* @param k      Number of stored correction pairs (k ≤ m).
+    !* @param g      Current gradient vector.
+    !* @param OPT    optimizer type that stores the following variables
+    !*     => S      Matrix containing the s-vectors (x_{k+1} - x_k),
+    !*               of size(nvar, m).
+    !*     => Y      Matrix containing the y-vectors (g_{k+1} - g_k),
+    !*               of size(nvar, m).
+    !*     => rho    Array of stored values 1/(y^T*s) for each correction.
+    !*     => alpha  coefficients (get computed in this function)
+    !*     => q      temporary workspace
+    !* @param gamm  Scaling factor for the initial Hessian approximation.
+    !*
+    !* @return d     Computed search direction (negative approximate inverse
+    !*               Hessian times g).
+    !********************************************************************************
+    !> INPUT
+    integer,intent(in) :: nvar,k
+    type(optimizer),intent(inout) :: OPT
+    real(wp),intent(in) :: g(nvar)
+    real(wp),intent(in) :: gamm
+    !> OUTPUT
+    real(wp) :: d(nvar)
+    !> LOCAL
+    integer :: i
+
+    associate (S => OPT%S,Y => OPT%Y,alpha => OPT%alpha,rho => OPT%rho,q => OPT%q)
+
+      !write(*,*) k
+      !write(*,*) S(:,k)
+      !write(*,*) Y(:,k)
+      !> Initialize q with the current gradient.
+      q = g
+
+      !---------------------------------------------------------
+      !> First loop (backward pass): for i = k downto 1,
+      !> compute the coefficient alpha(i) and update q.
+      !---------------------------------------------------------
+      do i = k,1,-1
+        alpha(i) = rho(i)*dot_product(S(1:nvar,i),q)
+        q = q-alpha(i)*Y(1:nvar,i)
+      end do
+
+      !---------------------------------------------------------
+      !> Apply the initial Hessian approximation.
+      !> We use a scaled identity matrix H0 = gamm * I.
+      !---------------------------------------------------------
+      d = gamm*q
+
+      !---------------------------------------------------------
+      !> Second loop (forward pass): for i = 1 to k,
+      !> compute the correction and update d.
+      !---------------------------------------------------------
+      do i = 1,k
+        d = d+S(1:nvar,i)*(alpha(i)-rho(i)*dot_product(Y(1:nvar,i),d))
+      end do
+
+      !> The final search direction is the negative of d.
+      d = -d
+
+    end associate
+  end function lbfgs_direction
+
+!========================================================================================!
+
+  subroutine lbfgs_optimize(mol,calc,etot,grd,pr,io,logfile)
+    !**************************************************************************
+    !* L-BFGS Optimization Routine
+    !*
+    !* Performs optimization using the Limited-memory BFGS (L-BFGS) algorithm.
+    !* The routine updates the coordinate vector x to approach a local minimum of the
+    !* objective function. It integrates with an optimizer type (OPT) to manage the
+    !* correction pairs (s and y) and related internal data using associate constructs.
+    !*
+    !* The main steps include:
+    !*  1. Evaluating the objective function and gradient at the current x.
+    !*  2. Computing the search direction via the two-loop recursion (lbfgs_direction).
+    !*  3. Updating x using a fixed step (with the option to incorporate a line search).
+    !*  4. Updating the correction pairs: s = x_new - x and y = g_new - g, while managing
+    !*     the history using a shifting strategy when full.
+    !*
+    !* @param io       Integer. Output status variable (0 indicates success).
+    !* @param logfile  name of the trajectory logfile (default crestopt.log.xyz).
+    !**************************************************************************
+    implicit none
+    !> INPUT
+    type(coord),intent(inout) :: mol
+    type(calcdata),intent(in) :: calc
+    real(wp),intent(inout) :: etot
+    real(wp),intent(inout) :: grd(3,mol%nat)
+    logical,intent(in)     :: pr
+    character(len=*),intent(in) :: logfile
+    !> OUTPUT
+    integer,intent(out)    :: io
+    !> LOCAL
+    type(optimizer) :: OPT
+    integer :: iter,k,nvar,m
+    integer :: tight,max_iter
+    real(wp) :: gnorm,deltaE,energy
+    real(wp) :: ethr,gthr,maxerise
+    logical :: econverged,gconverged,converged,Erise
+    real(wp),allocatable :: x(:),g(:),d(:),g_new(:),x_new(:),gtmp(:,:)
+    real(wp) :: f,f_new,gamm,step
+    integer :: ilog
+
+    !> Prepare settings
+    io = 0
+    nvar = compute_nvar(mol)
+    m = calc%lbfgs_histsize
+    gnorm = norm2(grd)
+    deltaE = huge(deltaE)
+    tight = calc%optlev
+    call get_optthr(mol%nat,tight,calc,ethr,gthr)
+    max_iter = calc%maxcycle !> automatic setting in get_optthr or by user
+    maxerise = calc%maxerise
+    econverged = .false.
+    gconverged = .false.
+    converged = .false.
+    mol%wrextxyz = calc%logextxyz
+
+    open (newunit=ilog,file=logfile)
+    if(calc%logextxyz)then
+      mol%gradient = grd
+    endif
+    call mol%appendlog(ilog,etot)
+
+    !$omp critical
+    !> Allocate the vectors for position, gradient, and search direction.
+    allocate (x(nvar),g(nvar),d(nvar),g_new(nvar),x_new(nvar),gtmp(3,mol%nat))
+    !> Allocate matrices to store up to m correction pairs (columns correspond to each stored pair).
+    call OPT%allocatelbfgs(nvar,m)
+    !$omp end critical
+
+    associate (S => OPT%S,Y => OPT%Y,rho => OPT%rho,alpha => OPT%alpha)
+      S = 0.0_wp
+      Y = 0.0_wp
+      rho = 0.0_wp
+      k = 0  ! Initially, no correction pairs are stored.
+
+      !> First trafo
+      call transform_mol('cart2v',mol,nvar,x)
+      call transform_grd('cart2v',mol,grd,nvar,g)
+
+      iter = 0
+      if (pr) then
+        call print_optiter(iter)
+        write (*,'(" * total energy  :",f14.7,1x,"Eh")',advance='no') etot
+        write (*,'(5x,"change ΔE",e18.7,1x,"Eh")') 0.0_wp
+        write (*,'(3x,"gradient norm :",f14.7,1x,"Eh/a0")') gnorm
+      end if
+
+      LBFGS_iter: do while (.not.converged.and.iter < max_iter)
+        iter = iter+1
+        if (pr) call print_optiter(iter)
+
+        if (iter == 1) then
+          !> First iteration: use the steepest descent direction.
+          d = -g
+        else
+          !---------------------------------------------------------
+          !> Determine the scaling factor gamm for the initial Hessian.
+          !  Here we use the most recent correction pair.
+          !---------------------------------------------------------
+          if (k > 0) then
+            gamm = dot_product(S(1:nvar,k),Y(1:nvar,k))/ &
+                   dot_product(Y(1:nvar,k),Y(1:nvar,k))
+          else
+            gamm = 1.0_wp
+          end if
+
+          !> Compute the search direction using the two-loop recursion.
+          d = lbfgs_direction(nvar,g,k,OPT,gamm)
+        end if
+
+        !---------------------------------------------------------
+        !> A fixed step size could be used here for simplicity.
+        !  In a full implementation, a line search could be used.
+        !  If the energy rises, we reduce the stepsize iteratively
+        !---------------------------------------------------------
+        step = 0.2_wp
+
+        Erise = .true.
+        do while (Erise)
+          !> Update the position: x_new = x + step * d.
+          x_new = x+step*d
+
+          !====================================================================!
+          !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+          !> Evaluate the objective and gradient at the new position.
+          call transform_mol('v2cart',mol,nvar,x_new)
+          grd = 0.0_wp
+          call engrad(mol,calc,energy,gtmp,io)
+          call mol%appendlog(ilog,energy)
+          !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+          !====================================================================!
+          if (io /= 0) exit
+
+          call transform_grd('cart2v',mol,gtmp,nvar,g_new)
+          gnorm = norm2(gtmp)
+          deltaE = energy-etot
+
+          Erise = (deltaE > maxerise)
+          if (Erise) then
+            step = step*0.25_wp
+            if (pr) then
+              write (*,'(" * energy rise detected, decreasing stepsize")')
+            end if
+          end if
+        end do
+        econverged = abs(deltaE) .lt. ethr
+        gconverged = gnorm .lt. gthr
+
+        !---------------------------------------------------------
+        !> Compute the correction pair:
+        !   s = x_new - x and y = g_new - g.
+        !---------------------------------------------------------
+        if (k < m) then
+          !> If there is still room in the history, simply add the new pair.
+          k = k+1
+          S(1:nvar,k) = x_new-x
+          Y(1:nvar,k) = g_new-g
+        else
+          !> When the history is full, shift the stored corrections and
+          !> insert the new pair at the end.
+          S(1:nvar,1:m-1) = S(1:nvar,2:m)
+          Y(1:nvar,1:m-1) = Y(1:nvar,2:m)
+          S(1:nvar,m) = x_new-x
+          Y(1:nvar,m) = g_new-g
+        end if
+
+        !> Update the scaling factor for the new correction pair.
+        rho(k) = 1.0_wp/dot_product(Y(1:nvar,k),S(1:nvar,k))
+
+        !> Update the current position, gradient, and function value.
+        x = x_new
+        g = g_new
+        etot = energy
+
+        !> Optional: print iteration information.
+        if (pr) then
+          write (*,'(" * total energy  :",f14.7,1x,"Eh")',advance='no') etot
+          write (*,'(5x,"change ΔE",e18.7,1x,"Eh")') deltaE
+          write (*,'(3x,"gradient norm :",f14.7,1x,"Eh/a0")',advance='no') gnorm
+          call print_convd(econverged,gconverged)
+        end if
+        converged = econverged.and.gconverged
+      end do LBFGS_iter
+
+      !> stop associating
+    end associate
+
+    !> Final trafo
+    call transform_mol('v2cart',mol,nvar,x_new)
+    call transform_grd('v2cart',mol,grd,nvar,g_new)
+
+    !> Deallocate all temporary arrays.
+    deallocate (x_new,g_new,d,g,x)
+  end subroutine lbfgs_optimize
+
+!========================================================================================!
+!========================================================================================!
+end module lbfgs_module
+
diff --git a/src/optimize/meson.build b/src/optimize/meson.build
index ad786316..1955147a 100644
--- a/src/optimize/meson.build
+++ b/src/optimize/meson.build
@@ -18,6 +18,9 @@ srcs += files(
   'ancopt.f90',
   'gd.f90',
   'rfo.f90',
+  'lbfgs.f90',
+  'newton_raphson.f90',
+  'coordtrafo.f90',
   'hessupdate.f90',
   'modelhessian.f90',
   'optimize_maths.f90',
diff --git a/src/optimize/modelhessian.f90 b/src/optimize/modelhessian.f90
index 4bd9b522..300e0ac9 100644
--- a/src/optimize/modelhessian.f90
+++ b/src/optimize/modelhessian.f90
@@ -20,102 +20,33 @@
 ! under the Open-source software LGPL-3.0 Licencse.
 !================================================================================!
 module modelhessian_module
-  use iso_fortran_env,only:wp => real64
+  use iso_fortran_env,only:wp => real64,stdout => output_unit
   use crest_calculator,only:calcdata,constrhess
+  use modelhessian_core
   implicit none
 
-!> a modelhessian type to save settings
-  type :: mhparam
-    integer :: model = 0       !> model hessian selection
-    real(wp) :: s6 = 20.0_wp   !> dispersion scaling
-    real(wp) :: rcut = 70.0_wp !> cutoff parameter
-    !> force constants
-    real(wp) :: kr = 0.4000_wp
-    real(wp) :: kf = 0.1300_wp
-    real(wp) :: kt = 0.0075_wp
-    real(wp) :: ko = 0.0000_wp
-    real(wp) :: kd = 0.0000_wp
-    real(wp) :: kq = 0.0000_wp
-  end type mhparam
-
-!> Parameters & constants
-  real(wp),parameter :: bohr = 0.52917726_wp
-  real(wp),parameter :: pi = 3.141592653589793_wp
-  real(wp),parameter :: Zero = 0.0_wp
-  real(wp),parameter :: One = 1.0_wp
-  real(wp),parameter :: Two = 2.0_wp
-  real(wp),parameter :: Three = 3.0_wp
-  real(wp),parameter :: Four = 4.0_wp
-  real(wp),parameter :: Five = 5.0_wp
-  real(wp),parameter :: Six = 6.0_wp
-  real(wp),parameter :: Seven = 7.0_wp
-  real(wp),parameter :: Eight = 8.0_wp
-  real(wp),parameter :: RNine = 9.0_wp
-  real(wp),parameter :: Ten = 10.0_wp
-  real(wp),parameter :: Half = 0.5_wp
-  real(wp),parameter :: SqrtP2 = 0.8862269254527579_wp
-  real(wp),parameter :: TwoP34 = 0.2519794355383808_wp
-  real(wp),parameter :: TwoP54 = 5.914967172795612_wp
-  real(wp),parameter :: One2C2 = 0.2662567690426443D-04
-
-  !>  van-der-Waals radii used in the D2 model (NOTE: here not in a.u.)
-  real(wp),parameter :: vander(86) = (/ &
-  & 0.91_wp,0.92_wp, & ! H, He
-  & 0.75_wp,1.28_wp,1.35_wp,1.32_wp,1.27_wp,1.22_wp,1.17_wp,1.13_wp, & ! Li-Ne
-  & 1.04_wp,1.24_wp,1.49_wp,1.56_wp,1.55_wp,1.53_wp,1.49_wp,1.45_wp, & ! Na-Ar
-  & 1.35_wp,1.34_wp, & ! K, Ca
-  & 1.42_wp,1.42_wp,1.42_wp,1.42_wp,1.42_wp, & ! Sc-Zn
-  & 1.42_wp,1.42_wp,1.42_wp,1.42_wp,1.42_wp, &
-  & 1.50_wp,1.57_wp,1.60_wp,1.61_wp,1.59_wp,1.57_wp, & ! Ga-Kr
-  & 1.48_wp,1.46_wp, & ! Rb, Sr
-  & 1.49_wp,1.49_wp,1.49_wp,1.49_wp,1.49_wp, & ! Y-Cd
-  & 1.49_wp,1.49_wp,1.49_wp,1.49_wp,1.49_wp, &
-  & 1.52_wp,1.64_wp,1.71_wp,1.72_wp,1.72_wp,1.71_wp, & ! In-Xe
-  & 2.00_wp,2.00_wp, &
-  & 2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp, & ! La-Yb
-  & 2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp, &
-  & 2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp, & ! Lu-Hg
-  & 2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp, &
-  & 2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp,2.00_wp/) ! Tl-Rn
-  !>  C6 coefficients used in the D2 model
-  real(wp),parameter :: c6(86) = (/ &
-  & 0.14_wp,0.08_wp, & ! H,He
-  & 1.61_wp,1.61_wp,3.13_wp,1.75_wp,1.23_wp,0.70_wp,0.75_wp,0.63_wp, &
-  & 5.71_wp,5.71_wp,10.79_wp,9.23_wp,7.84_wp,5.57_wp,5.07_wp,4.61_wp, &
-  & 10.80_wp,10.80_wp, & ! K,Ca
-  & 10.80_wp,10.80_wp,10.80_wp,10.80_wp,10.80_wp, & ! Sc-Zn
-  & 10.80_wp,10.80_wp,10.80_wp,10.80_wp,10.80_wp, &
-  & 16.99_wp,17.10_wp,16.37_wp,12.64_wp,12.47_wp,12.01_wp, & ! Ga-Kr
-  & 24.67_wp,24.67_wp, & ! Rb,Sr
-  & 24.67_wp,24.67_wp,24.67_wp,24.67_wp,24.67_wp, & ! Y-Cd
-  & 24.67_wp,24.67_wp,24.67_wp,24.67_wp,24.67_wp, &
-  & 37.32_wp,38.71_wp,38.44_wp,31.74_wp,31.50_wp,29.99_wp, & ! In-Xe
-  & 50.00_wp,50.00_wp, & ! Cs,Ba
-  & 50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp, & ! La-Yb
-  & 50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp, &
-  & 50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp, & ! Lu-Hg
-  & 50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp, &
-  & 50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp,50.00_wp/) ! Tl-Rn
-
   public :: modhes
 
-contains
-!========================================================================================!
-!> subroutine modhes
-!> create a model Hessian for a given molecule
-!>
-!> Input:
-!>     natoms - number of atoms
-!>       xyz  - Cartesian coordinates
-!>        at  - atom types as integers
-!>      modh  - model Hessian settings (see above)
-!>      calc  - calculation settings (for constraints)
-!>        pr  - printout selection
-!>
-!> Output:
-!>      Hess  - the (packed) model Hessian
-!>--------------------------------------------------------
+!==============================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!==============================================================================!
+!
   subroutine modhes(calc,modh,natoms,xyz,at,Hess,pr)
+!**********************************************************
+!* subroutine modhes
+!* create a model Hessian for a given molecule
+!*
+!* Input:
+!*     natoms - number of atoms
+!*       xyz  - Cartesian coordinates
+!*        at  - atom types as integers
+!*      modh  - model Hessian settings (see above)
+!*      calc  - calculation settings (for constraints)
+!*        pr  - printout selection
+!*
+!* Output:
+!*      Hess  - the (packed) model Hessian
+!**********************************************************
     implicit none
     type(calcdata),intent(in) :: calc
     type(mhparam),intent(in) :: modh
@@ -124,27 +55,27 @@ subroutine modhes(calc,modh,natoms,xyz,at,Hess,pr)
     integer :: nhess
     integer,intent(in) :: natoms
     real(wp),intent(in) :: xyz(3,natoms)
-    real(wp),intent(out) :: hess((natoms * 3) * ((natoms * 3) + 1) / 2)
+    real(wp),intent(out) :: hess((natoms*3)*((natoms*3)+1)/2)
     integer,intent(in) :: at(natoms)
 
 !>  initialize
-    nhess = 3 * natoms
+    nhess = 3*natoms
     Hess = 0.0_wp
 
     select case (modh%model)
-    case default  !case (p_modh_old)
-      if (pr) write (*,'(a)') "Using Lindh-Hessian (1995)"
+    case (0)
+      if (pr) write (stdout,'(a)') "Using Lindh-Hessian (1995)"
       call ddvopt(xyz,natoms,Hess,at,modh)
-!> other model hessians currently not implemented
-      !case (p_modh_lindh_d2)
-      !  if (pr) write (*,'(a)') "Using Lindh-Hessian"
-      !  call mh_lindh_d2(xyz,natoms,Hess,at,modh)
-      !case (p_modh_lindh)
-      !  if (pr) write (*,'(a)') "Using Lindh-Hessian (2007)"
-      !  call mh_lindh(xyz,natoms,Hess,at,modh)
-      !case (p_modh_swart)
-      !  if (pr) write (*,'(a)') "Using Swart-Hessian"
-      !  call mh_swart(xyz,natoms,Hess,at,modh)
+!> other model hessians currently not tested
+    case (1)
+      if (pr) write (stdout,'(a)') "Using Lindh-Hessian"
+      call mh_lindh_d2(xyz,natoms,Hess,at,modh)
+    case (2)
+      if (pr) write (stdout,'(a)') "Using Lindh-Hessian (2007)"
+      call mh_lindh(xyz,natoms,Hess,at,modh)
+    case (3)
+      if (pr) write (stdout,'(a)') "Using Swart-Hessian"
+      call mh_swart(xyz,natoms,Hess,at,modh)
     end select
 
 !> add user-set constraint contributions to modelhessian
@@ -154,1140 +85,6 @@ subroutine modhes(calc,modh,natoms,xyz,at,Hess,pr)
   end subroutine modhes
 
 !========================================================================================!
-!> subroutine ddvopt
-!> generates a Lindh Model Hessian
-!> Chem. Phys. Let. 241(1995) 423-428
-!>
-!> Input:
-!>     Cart  - cartesian coordinates
-!>    nAtoms - number of atoms
-!>     iANr  - atom types as integers
-!>    mhset  - model Hessian parameters
-!>
-!> Output:
-!>     Hess  - the (packed) model Hessian
-!>------------------------------------------------------
-  subroutine ddvopt(Cart,nAtoms,Hess,iANr,mhset)
-    Implicit Integer(i - n)
-    Implicit Real(wp) (a - h,o - z)
-    type(mhparam) :: mhset
-
-    real(wp) :: s6
-    real(wp) :: rcut
-
-    Real(wp) :: Cart(3,nAtoms),rij(3),rjk(3),rkl(3), &
-   &       Hess((3 * nAtoms) * (3 * nAtoms + 1) / 2),si(3),sj(3),sk(3), &
-   &       sl(3),sm(3),x(2),y(2),z(2), &
-   &       xyz(3,4),C(3,4),Dum(3,4,3,4)
-    Integer iANr(nAtoms)
-
-! include  "common/ddvdt.inc" (molpro 2002.6)
-    Real(wp) :: rAV(3,3),aAV(3,3), &
-   &       B_Str(6),A_Bend(2),A_Trsn(2),A_StrH(2), &
-   &       rkr,rkf,A_Str,RF_Const, &
-   &       wthr
-
-    Data rAv/1.3500d+00,2.1000d+00,2.5300d+00, &
-   &         2.1000d+00,2.8700d+00,3.4000d+00, &
-   &         2.5300d+00,3.4000d+00,3.4000d+00/
-    Data aAv/1.0000d+00,0.3949d+00,0.3949d+00, &
-   &         0.3949d+00,0.2800d+00,0.2800d+00, &
-   &         0.3949d+00,0.2800d+00,0.2800d+00/
-!org  Data rkr,rkf,rkt/0.4500D+00,0.1500D+00,0.5000D-02/
-    Data rkr,rkf,rkt/0.4000D+00,0.1300D+00,0.7500D-02/
-    Data A_Str/1.734d0/
-    Data B_Str/-.244d0,0.352d0,1.085d0,0.660d0,1.522d0,2.068d0/
-    Data A_Bend/0.160d0,0.250d0/
-    Data A_Trsn/0.0023d0,0.07d0/
-    Data A_StrH/0.3601d0,1.944d0/
-    Data RF_Const/1.0D-2/
-    Data wthr/0.2/
-
-!cc VDWx-Parameters (Grimme) used for vdw-correction of model hessian
-    real(wp) :: alphavdw,damp,c6k,c6l,c66,vdw(3,3),dr(3)
-    integer :: kxyz,lxyz
-!cc End: VDWx ccccccccccccccccc
-
-    !> BLAS
-    external :: dcopy
-
-    s6 = mhset%s6
-    rcut = mhset%rcut
-
-!
-!------- Statement functions
-!
-!      ixyz(i,iAtom) = (iAtom-1)*3 + i
-!      Jnd(i,j) = i*(i-1)/2 +j
-!      Ind(i,iAtom,j,jAtom)=Jnd(Max(ixyz(i,iAtom),ixyz(j,jAtom)), &
-!     &                         Min(ixyz(i,iAtom),ixyz(j,jAtom)))
-!end
-
-    Fact = One
-!hjw threshold reduced
-    rZero = 1.0d-10
-    n3 = 3 * nAtoms
-    Hess = 0.0d0
-
-!
-!     Hessian for tension
-!
-    Do kAtom = 1,nAtoms
-      kr = iTabRow(iANr(kAtom))
-!        If (kr.eq.0) Go To 5
-
-      Do lAtom = 1,kAtom - 1
-        lr = iTabRow(iANr(lAtom))
-!           If (lr.eq.0) Go To 10
-        xkl = Cart(1,kAtom) - Cart(1,lAtom)
-        ykl = Cart(2,kAtom) - Cart(2,lAtom)
-        zkl = Cart(3,kAtom) - Cart(3,lAtom)
-        rkl2 = xkl**2 + ykl**2 + zkl**2
-        r0 = rAv(kr,lr)
-        alpha = aAv(kr,lr)
-
-!cccccc VDWx ccccccccccccccccccccccccccccccccc
-        c6k = c6(iANr(katom))
-        c6l = c6(iANr(latom))
-        c66 = sqrt(c6k * c6l)
-        Rv = (vander(iANr(katom)) + vander(iANr(latom))) / bohr
-
-        call getvdwxx(xkl,ykl,zkl,c66,s6,Rv,vdw(1,1))
-        call getvdwxy(xkl,ykl,zkl,c66,s6,Rv,vdw(1,2))
-        call getvdwxy(xkl,zkl,ykl,c66,s6,Rv,vdw(1,3))
-        call getvdwxx(ykl,xkl,zkl,c66,s6,Rv,vdw(2,2))
-        call getvdwxy(ykl,zkl,xkl,c66,s6,Rv,vdw(2,3))
-        call getvdwxx(zkl,xkl,ykl,c66,s6,Rv,vdw(3,3))
-!cccccc Ende VDWx ccccccccccccccccccccccccccccccc
-
-        gamma = rkr * Exp(alpha * r0**2)
-! not better: *sqrt(abs(wb(kAtom,lAtom)))
-        gmm = gamma * Exp(-alpha * rkl2)
-        Hxx = gmm * xkl * xkl / rkl2 - vdw(1,1)
-        Hxy = gmm * xkl * ykl / rkl2 - vdw(1,2)
-        Hxz = gmm * xkl * zkl / rkl2 - vdw(1,3)
-        Hyy = gmm * ykl * ykl / rkl2 - vdw(2,2)
-        Hyz = gmm * ykl * zkl / rkl2 - vdw(2,3)
-        Hzz = gmm * zkl * zkl / rkl2 - vdw(3,3)
-
-!
-        Hess(Ind(1,kAtom,1,kAtom)) = Hess(Ind(1,kAtom,1,kAtom)) + Hxx
-        Hess(Ind(2,kAtom,1,kAtom)) = Hess(Ind(2,kAtom,1,kAtom)) + Hxy
-        Hess(Ind(2,kAtom,2,kAtom)) = Hess(Ind(2,kAtom,2,kAtom)) + Hyy
-        Hess(Ind(3,kAtom,1,kAtom)) = Hess(Ind(3,kAtom,1,kAtom)) + Hxz
-        Hess(Ind(3,kAtom,2,kAtom)) = Hess(Ind(3,kAtom,2,kAtom)) + Hyz
-        Hess(Ind(3,kAtom,3,kAtom)) = Hess(Ind(3,kAtom,3,kAtom)) + Hzz
-!
-        Hess(Ind(1,kAtom,1,lAtom)) = Hess(Ind(1,kAtom,1,lAtom)) - Hxx
-        Hess(Ind(1,kAtom,2,lAtom)) = Hess(Ind(1,kAtom,2,lAtom)) - Hxy
-        Hess(Ind(1,kAtom,3,lAtom)) = Hess(Ind(1,kAtom,3,lAtom)) - Hxz
-        Hess(Ind(2,kAtom,1,lAtom)) = Hess(Ind(2,kAtom,1,lAtom)) - Hxy
-        Hess(Ind(2,kAtom,2,lAtom)) = Hess(Ind(2,kAtom,2,lAtom)) - Hyy
-        Hess(Ind(2,kAtom,3,lAtom)) = Hess(Ind(2,kAtom,3,lAtom)) - Hyz
-        Hess(Ind(3,kAtom,1,lAtom)) = Hess(Ind(3,kAtom,1,lAtom)) - Hxz
-        Hess(Ind(3,kAtom,2,lAtom)) = Hess(Ind(3,kAtom,2,lAtom)) - Hyz
-        Hess(Ind(3,kAtom,3,lAtom)) = Hess(Ind(3,kAtom,3,lAtom)) - Hzz
-!
-        Hess(Ind(1,lAtom,1,lAtom)) = Hess(Ind(1,lAtom,1,lAtom)) + Hxx
-        Hess(Ind(2,lAtom,1,lAtom)) = Hess(Ind(2,lAtom,1,lAtom)) + Hxy
-        Hess(Ind(2,lAtom,2,lAtom)) = Hess(Ind(2,lAtom,2,lAtom)) + Hyy
-        Hess(Ind(3,lAtom,1,lAtom)) = Hess(Ind(3,lAtom,1,lAtom)) + Hxz
-        Hess(Ind(3,lAtom,2,lAtom)) = Hess(Ind(3,lAtom,2,lAtom)) + Hyz
-        Hess(Ind(3,lAtom,3,lAtom)) = Hess(Ind(3,lAtom,3,lAtom)) + Hzz
-!
-10      Continue
-      End Do
-
-5     Continue
-    End Do
-
-!
-!     Hessian for bending
-!
-    Do mAtom = 1,nAtoms
-      mr = iTabRow(iANr(mAtom))
-!        If (mr.eq.0) Go To 20
-      Do iAtom = 1,nAtoms
-        If (iAtom .eq. mAtom) Go To 30
-        ir = iTabRow(iANr(iAtom))
-!          If (ir.eq.0) Go To 30
-        if (rcutoff(cart,iatom,matom,rcut)) cycle
-!          if(wb(iatom,matom).lt.wthr) cycle
-        Do jAtom = 1,iAtom - 1
-          If (jAtom .eq. mAtom) Go To 40
-          jr = iTabRow(iANr(jAtom))
-!           If (jr.eq.0) Go To 40
-          if (rcutoff(cart,jatom,iatom,rcut)) cycle
-          if (rcutoff(cart,jatom,matom,rcut)) cycle
-!           if(wb(jatom,iatom).lt.wthr) cycle
-!           if(wb(jatom,matom).lt.wthr) cycle
-
-          xmi = (Cart(1,iAtom) - Cart(1,mAtom))
-          ymi = (Cart(2,iAtom) - Cart(2,mAtom))
-          zmi = (Cart(3,iAtom) - Cart(3,mAtom))
-          rmi2 = xmi**2 + ymi**2 + zmi**2
-          rmi = sqrt(rmi2)
-          r0mi = rAv(mr,ir)
-          ami = aAv(mr,ir)
-!
-          xmj = (Cart(1,jAtom) - Cart(1,mAtom))
-          ymj = (Cart(2,jAtom) - Cart(2,mAtom))
-          zmj = (Cart(3,jAtom) - Cart(3,mAtom))
-          rmj2 = xmj**2 + ymj**2 + zmj**2
-          rmj = sqrt(rmj2)
-          r0mj = rAv(mr,jr)
-          amj = aAv(mr,jr)
-!
-!---------- Test if zero angle
-!
-          Test = xmi * xmj + ymi * ymj + zmi * zmj
-          Test = Test / (rmi * rmj)
-          If (Test .eq. One) Go To 40
-!
-          xij = (Cart(1,jAtom) - Cart(1,iAtom))
-          yij = (Cart(2,jAtom) - Cart(2,iAtom))
-          zij = (Cart(3,jAtom) - Cart(3,iAtom))
-          rij2 = xij**2 + yij**2 + zij**2
-          rrij = sqrt(rij2)
-!
-          alpha = rkf * exp((ami * r0mi**2 + amj * r0mj**2))
-!
-          r = sqrt(rmj2 + rmi2)
-          gij = alpha * exp(-(ami * rmi2 + amj * rmj2))
-!           Write (*,*) ' gij=',gij
-          rL2 = (ymi * zmj - zmi * ymj)**2 + (zmi * xmj - xmi * zmj)**2 + &
-   &         (xmi * ymj - ymi * xmj)**2
-!hjw modified
-          if (rL2 .lt. 1.d-14) then
-            rL = 0
-          else
-            rL = sqrt(rL2)
-          end if
-!
-          if ((rmj .gt. rZero) .and. (rmi .gt. rZero) .and. &
-   &                                (rrij .gt. rZero)) Then
-            SinPhi = rL / (rmj * rmi)
-            rmidotrmj = xmi * xmj + ymi * ymj + zmi * zmj
-            CosPhi = rmidotrmj / (rmj * rmi)
-!
-!-------------None linear case
-!
-            If (SinPhi .gt. rZero) Then
-!               Write (*,*) ' None linear case'
-              si(1) = (xmi / rmi * cosphi - xmj / rmj) / (rmi * sinphi)
-              si(2) = (ymi / rmi * cosphi - ymj / rmj) / (rmi * sinphi)
-              si(3) = (zmi / rmi * cosphi - zmj / rmj) / (rmi * sinphi)
-              sj(1) = (cosphi * xmj / rmj - xmi / rmi) / (rmj * sinphi)
-              sj(2) = (cosphi * ymj / rmj - ymi / rmi) / (rmj * sinphi)
-              sj(3) = (cosphi * zmj / rmj - zmi / rmi) / (rmj * sinphi)
-              sm(1) = -si(1) - sj(1)
-              sm(2) = -si(2) - sj(2)
-              sm(3) = -si(3) - sj(3)
-              Do icoor = 1,3
-                Do jCoor = 1,3
-                  If (mAtom .gt. iAtom) Then
-                    Hess(Ind(icoor,mAtom,jcoor,iAtom)) = &
-  &                        Hess(Ind(icoor,mAtom,jcoor,iAtom)) &
-  &                        + gij * sm(icoor) * si(jcoor)
-                  else
-                    Hess(Ind(icoor,iAtom,jcoor,mAtom)) = &
-   &                        Hess(Ind(icoor,iAtom,jcoor,mAtom)) &
-   &                        + gij * si(icoor) * sm(jcoor)
-                  End If
-                  If (mAtom .gt. jAtom) Then
-                    Hess(Ind(icoor,mAtom,jcoor,jAtom)) = &
- &                        Hess(Ind(icoor,mAtom,jcoor,jAtom)) &
- &                        + gij * sm(icoor) * sj(jcoor)
-                  else
-                    Hess(Ind(icoor,jAtom,jcoor,mAtom)) = &
-   &                        Hess(Ind(icoor,jAtom,jcoor,mAtom)) &
-   &                        + gij * sj(icoor) * sm(jcoor)
-                  End If
-                  If (iAtom .gt. jAtom) Then
-                    Hess(Ind(icoor,iAtom,jcoor,jAtom)) = &
- &                        Hess(Ind(icoor,iAtom,jcoor,jAtom)) &
- &                        + gij * si(icoor) * sj(jcoor)
-                  else
-                    Hess(Ind(icoor,jAtom,jcoor,iAtom)) = &
- &                        Hess(Ind(icoor,jAtom,jcoor,iAtom)) &
- &                        + gij * sj(icoor) * si(jcoor)
-                  End If
-                End Do
-              End Do
-              Do icoor = 1,3
-                Do jCoor = 1,icoor
-                  Hess(Ind(icoor,iAtom,jcoor,iAtom)) = &
-   &                        Hess(Ind(icoor,iAtom,jcoor,iAtom)) &
-   &                        + gij * si(icoor) * si(jcoor)
-                  Hess(Ind(icoor,mAtom,jcoor,mAtom)) = &
-   &                        Hess(Ind(icoor,mAtom,jcoor,mAtom)) &
-   &                        + gij * sm(icoor) * sm(jcoor)
-                  Hess(Ind(icoor,jAtom,jcoor,jAtom)) = &
-   &                        Hess(Ind(icoor,jAtom,jcoor,jAtom)) &
-   &                        + gij * sj(icoor) * sj(jcoor)
-
-!
-                End Do
-              End Do
-            Else
-!
-!----------------Linear case
-!
-              if ((abs(ymi) .gt. rZero) .or. &
-&                 (abs(xmi) .gt. rZero)) Then
-                x(1) = -ymi
-                y(1) = xmi
-                z(1) = Zero
-                x(2) = -xmi * zmi
-                y(2) = -ymi * zmi
-                z(2) = xmi * xmi + ymi * ymi
-              Else
-                x(1) = One
-                y(1) = Zero
-                z(1) = Zero
-                x(2) = Zero
-                y(2) = One
-                z(2) = Zero
-              End If
-              Do i = 1,2
-                r1 = sqrt(x(i)**2 + y(i)**2 + z(i)**2)
-                cosThetax = x(i) / r1
-                cosThetay = y(i) / r1
-                cosThetaz = z(i) / r1
-                si(1) = -cosThetax / rmi
-                si(2) = -cosThetay / rmi
-                si(3) = -cosThetaz / rmi
-                sj(1) = -cosThetax / rmj
-                sj(2) = -cosThetay / rmj
-                sj(3) = -cosThetaz / rmj
-                sm(1) = -(si(1) + sj(1))
-                sm(2) = -(si(2) + sj(2))
-                sm(3) = -(si(3) + sj(3))
-!
-                Do icoor = 1,3
-                  Do jCoor = 1,3
-                    If (mAtom .gt. iAtom) Then
-                      Hess(Ind(icoor,mAtom,jcoor,iAtom)) = &
- &                        Hess(Ind(icoor,mAtom,jcoor,iAtom)) &
- &                         + gij * sm(icoor) * si(jcoor)
-                    else
-                      Hess(Ind(icoor,iAtom,jcoor,mAtom)) = &
-&                        Hess(Ind(icoor,iAtom,jcoor,mAtom)) &
-&                         + gij * si(icoor) * sm(jcoor)
-                    End If
-                    If (mAtom .gt. jAtom) Then
-                      Hess(Ind(icoor,mAtom,jcoor,jAtom)) = &
- &                        Hess(Ind(icoor,mAtom,jcoor,jAtom)) &
- &                         + gij * sm(icoor) * sj(jcoor)
-                    else
-                      Hess(Ind(icoor,jAtom,jcoor,mAtom)) = &
- &                        Hess(Ind(icoor,jAtom,jcoor,mAtom)) &
- &                         + gij * sj(icoor) * sm(jcoor)
-                    End If
-                    If (iAtom .gt. jAtom) Then
-                      Hess(Ind(icoor,iAtom,jcoor,jAtom)) = &
-&                        Hess(Ind(icoor,iAtom,jcoor,jAtom)) &
-&                         + gij * si(icoor) * sj(jcoor)
-                    else
-                      Hess(Ind(icoor,jAtom,jcoor,iAtom)) = &
-&                        Hess(Ind(icoor,jAtom,jcoor,iAtom)) &
-&                         + gij * sj(icoor) * si(jcoor)
-                    End If
-                  End Do
-                End Do
-                Do icoor = 1,3
-                  Do jCoor = 1,icoor
-                    Hess(Ind(icoor,iAtom,jcoor,iAtom)) = &
-&                        Hess(Ind(icoor,iAtom,jcoor,iAtom)) &
-&                         + gij * si(icoor) * si(jcoor)
-                    Hess(Ind(icoor,mAtom,jcoor,mAtom)) = &
-&                        Hess(Ind(icoor,mAtom,jcoor,mAtom)) &
-&                         + gij * sm(icoor) * sm(jcoor)
-                    Hess(Ind(icoor,jAtom,jcoor,jAtom)) = &
-&                         Hess(Ind(icoor,jAtom,jcoor,jAtom)) &
-&                         + gij * sj(icoor) * sj(jcoor)
-                  End Do
-                End Do
-              End Do
-            End If
-          End If
-!
-40        Continue
-        End Do
-30      Continue
-      End Do
-20    Continue
-    End Do
-!
-!     Hessian for torsion
-!
-    Do jAtom = 1,nAtoms
-      jr = iTabRow(iANr(jAtom))
-!       If (jr.eq.0) Go To 444
-!
-      Call DCopy(3,Cart(1,jAtom),1,xyz(1,2),1)
-!
-      Do kAtom = 1,nAtoms
-        If (kAtom .eq. jAtom) Go To 111
-        kr = iTabRow(iANr(kAtom))
-!          If (kr.eq.0) Go To 111
-
-        if (rcutoff(cart,katom,jatom,rcut)) cycle
-!          if(wb(katom,jatom).lt.wthr) cycle
-!
-        Call DCopy(3,Cart(1,kAtom),1,xyz(1,3),1)
-!
-        Do iAtom = 1,nAtoms
-          ij_ = nAtoms * (jAtom - 1) + iAtom
-          If (iAtom .eq. jAtom) Go To 333
-          If (iAtom .eq. kAtom) Go To 333
-          ir = iTabRow(iANr(iAtom))
-!             If (ir.eq.0) Go To 333
-!
-          if (rcutoff(cart,iatom,katom,rcut)) cycle
-          if (rcutoff(cart,iatom,jatom,rcut)) cycle
-!             if(wb(iatom,katom).lt.wthr) cycle
-!             if(wb(iatom,jatom).lt.wthr) cycle
-
-          Call DCopy(3,Cart(1,iAtom),1,xyz(1,1),1)
-!
-          Do lAtom = 1,nAtoms
-            lk_ = nAtoms * (kAtom - 1) + lAtom
-            If (ij_ .le. lk_) Go To 222
-            If (lAtom .eq. iAtom) Go To 222
-            If (lAtom .eq. jAtom) Go To 222
-            If (lAtom .eq. kAtom) Go To 222
-            lr = iTabRow(iANr(lAtom))
-!                If (lr.eq.0) Go To 222
-!
-            if (rcutoff(cart,latom,iatom,rcut)) cycle
-            if (rcutoff(cart,latom,katom,rcut)) cycle
-            if (rcutoff(cart,latom,jatom,rcut)) cycle
-!                if(wb(latom,iatom).lt.wthr) cycle
-!                if(wb(latom,katom).lt.wthr) cycle
-!                if(wb(latom,jatom).lt.wthr) cycle
-
-            Call DCopy(3,Cart(1,lAtom),1,xyz(1,4),1)
-!
-            rij(1) = Cart(1,iAtom) - Cart(1,jAtom)
-            rij(2) = Cart(2,iAtom) - Cart(2,jAtom)
-            rij(3) = Cart(3,iAtom) - Cart(3,jAtom)
-            rij0 = rAv(ir,jr)**2
-            aij = aAv(ir,jr)
-!
-            rjk(1) = Cart(1,jAtom) - Cart(1,kAtom)
-            rjk(2) = Cart(2,jAtom) - Cart(2,kAtom)
-            rjk(3) = Cart(3,jAtom) - Cart(3,kAtom)
-            rjk0 = rAv(jr,kr)**2
-            ajk = aAv(jr,kr)
-!
-            rkl(1) = Cart(1,kAtom) - Cart(1,lAtom)
-            rkl(2) = Cart(2,kAtom) - Cart(2,lAtom)
-            rkl(3) = Cart(3,kAtom) - Cart(3,lAtom)
-            rkl0 = rAv(kr,lr)**2
-            akl = aAv(kr,lr)
-!
-            rij2 = rij(1)**2 + rij(2)**2 + rij(3)**2
-            rjk2 = rjk(1)**2 + rjk(2)**2 + rjk(3)**2
-            rkl2 = rkl(1)**2 + rkl(2)**2 + rkl(3)**2
-!              Allow only angles in the range of 35-145
-            A35 = (35.0D0 / 180.D0) * Pi
-            CosFi_Max = Cos(A35)
-            CosFi2 = (rij(1) * rjk(1) + rij(2) * rjk(2) + rij(3) * rjk(3)) &
-  &               / Sqrt(rij2 * rjk2)
-            If (Abs(CosFi2) .gt. CosFi_Max) Go To 222
-            CosFi3 = (rkl(1) * rjk(1) + rkl(2) * rjk(2) + rkl(3) * rjk(3)) &
-  &               / Sqrt(rkl2 * rjk2)
-            If (Abs(CosFi3) .gt. CosFi_Max) Go To 222
-
-            beta = rkt * &
-  &                       exp((aij * rij0 + ajk * rjk0 + akl * rkl0))
-            tij = beta * exp(-(aij * rij2 + ajk * rjk2 + akl * rkl2))
-
-            Call Trsn(xyz,4,Tau,C,.False.,.False.,'        ', &
-  &                  Dum,.False.)
-            Call DCopy(3,C(1,1),1,si,1)
-            Call DCopy(3,C(1,2),1,sj,1)
-            Call DCopy(3,C(1,3),1,sk,1)
-            Call DCopy(3,C(1,4),1,sl,1)
-!
-!-------------Off diagonal block
-!
-            Do icoor = 1,3
-              Do jCoor = 1,3
-                Hess(Ind(icoor,iAtom,jcoor,jAtom)) = &
-    &           Hess(Ind(icoor,iAtom,jcoor,jAtom)) &
-    &            + tij * si(icoor) * sj(jcoor)
-                Hess(Ind(icoor,iAtom,jcoor,kAtom)) = &
-    &           Hess(Ind(icoor,iAtom,jcoor,kAtom)) &
-    &            + tij * si(icoor) * sk(jcoor)
-                Hess(Ind(icoor,iAtom,jcoor,lAtom)) = &
-    &           Hess(Ind(icoor,iAtom,jcoor,lAtom)) &
-    &            + tij * si(icoor) * sl(jcoor)
-                Hess(Ind(icoor,jAtom,jcoor,kAtom)) = &
-    &           Hess(Ind(icoor,jAtom,jcoor,kAtom)) &
-    &            + tij * sj(icoor) * sk(jcoor)
-                Hess(Ind(icoor,jAtom,jcoor,lAtom)) = &
-    &           Hess(Ind(icoor,jAtom,jcoor,lAtom)) &
-    &            + tij * sj(icoor) * sl(jcoor)
-                Hess(Ind(icoor,kAtom,jcoor,lAtom)) = &
-    &           Hess(Ind(icoor,kAtom,jcoor,lAtom)) &
-    &            + tij * sk(icoor) * sl(jcoor)
-
-              End Do
-            End Do
-!
-!-------------Diagonal block
-!
-            Do icoor = 1,3
-              Do jCoor = 1,icoor
-                Hess(Ind(icoor,iAtom,jcoor,iAtom)) = &
-    &           Hess(Ind(icoor,iAtom,jcoor,iAtom)) &
-    &            + tij * si(icoor) * si(jcoor)
-                Hess(Ind(icoor,jAtom,jcoor,jAtom)) = &
-    &           Hess(Ind(icoor,jAtom,jcoor,jAtom)) &
-    &            + tij * sj(icoor) * sj(jcoor)
-                Hess(Ind(icoor,kAtom,jcoor,kAtom)) = &
-    &           Hess(Ind(icoor,kAtom,jcoor,kAtom)) &
-    &            + tij * sk(icoor) * sk(jcoor)
-                Hess(Ind(icoor,lAtom,jcoor,lAtom)) = &
-    &           Hess(Ind(icoor,lAtom,jcoor,lAtom)) &
-    &            + tij * sl(icoor) * sl(jcoor)
-
-!
-              End Do
-            End Do
-222         Continue
-          End Do        ! lAtom
-333       Continue
-        End Do          ! iAtom
-111     Continue
-      End Do             ! kAtom
-444   Continue
-    End Do               ! jAtom
-    Return
-
-  contains
-    function ixyz(i,iatom)
-      integer :: ixyz
-      integer,intent(in) :: i,iatom
-      ixyz = (iatom - 1) * 3 + i
-    end function ixyz
-    function jnd(i,j)
-      integer :: jnd
-      integer,intent(in) :: i,j
-      jnd = i * (i - 1) / 2 + j
-    end function jnd
-    function ind(i,iatom,j,jatom)
-      integer :: ind
-      integer,intent(in) :: i,iatom,j,jatom
-      ind = jnd(max(ixyz(i,iatom),ixyz(j,jatom)),min(ixyz(i,iatom),ixyz(j,jatom)))
-    end function ind
-  end subroutine ddvopt
-
-!========================================================================================!
-  logical function rcutoff(cart,katom,latom,rcut)
-    implicit none
-    Real(wp) :: Cart(3,*),xkl,ykl,zkl,rkl2
-    real(wp) :: rcut
-    integer :: katom,latom
-    rcutoff = .false.
-    xkl = Cart(1,kAtom) - Cart(1,lAtom)
-    ykl = Cart(2,kAtom) - Cart(2,lAtom)
-    zkl = Cart(3,kAtom) - Cart(3,lAtom)
-    rkl2 = xkl**2 + ykl**2 + zkl**2
-    if (rkl2 .gt. rcut) rcutoff = .true.
-  end function
-
-  function itabrow(i)
-    integer :: itabrow
-    integer,intent(in) :: i
-
-    itabrow = 0
-    if (i .gt. 0 .and. i .le. 2) then
-      itabrow = 1
-    else if (i .gt. 2 .and. i .le. 10) then
-      itabrow = 2
-    else if (i .gt. 10 .and. i .le. 18) then
-      itabrow = 3
-    else if (i .gt. 18 .and. i .le. 36) then
-      itabrow = 3
-    else if (i .gt. 36 .and. i .le. 54) then
-      itabrow = 3
-    else if (i .gt. 54 .and. i .le. 86) then
-      itabrow = 3
-    else if (i .gt. 86) then
-      itabrow = 3
-    end if
-
-    return
-  end function itabrow
-
-  subroutine getvdwxy(rx,ry,rz,c66,s6,r0,vdw)
-    !cc Ableitung nach rx und ry
-    Implicit Real * 8(a - h,o - z)
-    integer k,l
-    !    write(*,*) 's6:', s6
-    avdw = 20.0
-    t1 = s6 * C66
-    t2 = rx**2
-    t3 = ry**2
-    t4 = rz**2
-    t5 = t2 + t3 + t4
-    t6 = t5**2
-    t7 = t6**2
-    t11 = sqrt(t5)
-    t12 = 0.1D1 / r0
-    t16 = exp(-avdw * (t11 * t12 - 0.1D1))
-    t17 = 0.1D1 + t16
-    t25 = t17**2
-    t26 = 0.1D1 / t25
-    t35 = 0.1D1 / t7
-    t40 = avdw**2
-    t41 = r0**2
-    t43 = t40 / t41
-    t44 = t16**2
-    t56 = -0.48D2 * t1 / t7 / t5 / t17 * rx * ry + 0.13D2 * t1 / t11 /&
-       & t7 * t26 * rx * avdw * t12 * ry * t16 - 0.2D1 * t1 * t35 / t25 /&
-       &t17 * t43 * rx * t44 * ry + t1 * t35 * t26 * t43 * rx * ry * t16
-    vdw = t56
-    return
-  end subroutine getvdwxy
-
-  subroutine getvdwxx(rx,ry,rz,c66,s6,r0,vdw)
-    !cc Ableitung nach rx und rx
-    Implicit Real * 8(a - h,o - z)
-    avdw = 20.0
-    !      write(*,*) 's6:', s6
-    t1 = s6 * C66
-    t2 = rx**2
-    t3 = ry**2
-    t4 = rz**2
-    t5 = t2 + t3 + t4
-    t6 = t5**2
-    t7 = t6**2
-    t10 = sqrt(t5)
-    t11 = 0.1D1 / r0
-    t15 = exp(-avdw * (t10 * t11 - 0.1D1))
-    t16 = 0.1D1 + t15
-    t17 = 0.1D1 / t16
-    t24 = t16**2
-    t25 = 0.1D1 / t24
-    t29 = t11 * t15
-    t33 = 0.1D1 / t7
-    t41 = avdw**2
-    t42 = r0**2
-    t44 = t41 / t42
-    t45 = t15**2
-    t62 = -0.48D2 * t1 / t7 / t5 * t17 * t2 + 0.13D2 * t1 / t10 / t7 *&
-       & t25 * t2 * avdw * t29 + 0.6D1 * t1 * t33 * t17 - 0.2D1 * t1 * t33&
-       & / t24 / t16 * t44 * t2 * t45 - t1 / t10 / t6 / t5 * t25 * avdw *&
-       &t29 + t1 * t33 * t25 * t44 * t2 * t15
-    vdw = t62
-  end subroutine getvdwxx
-
-  pure subroutine trsn2(xyz,tau,bt)
-    implicit none
-    real(wp),intent(out) :: bt(3,4)
-    real(wp),intent(out) :: tau
-    real(wp),intent(in)  :: xyz(3,4)
-    real(wp) :: rij(3),rij1,brij(3,2)
-    real(wp) :: rjk(3),rjk1,brjk(3,2)
-    real(wp) :: rkl(3),rkl1,brkl(3,2)
-    real(wp) :: bf2(3,3),fi2,sinfi2,cosfi2
-    real(wp) :: bf3(3,3),fi3,sinfi3,cosfi3
-    real(wp) :: costau,sintau
-    integer  :: ix,iy,iz
-    call strtch2(xyz(1,1),rij1,brij)
-    call strtch2(xyz(1,2),rjk1,brjk)
-    call strtch2(xyz(1,3),rkl1,brkl)
-    call bend2(xyz(1,1),fi2,bf2)
-    sinfi2 = sin(fi2)
-    cosfi2 = cos(fi2)
-    call bend2(xyz(1,2),fi3,bf3)
-    sinfi3 = sin(fi3)
-    cosfi3 = cos(fi3)
-    costau = ((brij(2,1) * brjk(3,2) - brij(3,1) * brjk(2,2)) * &
-              (brjk(2,1) * brkl(3,2) - brjk(3,1) * brkl(2,2)) + &
-              (brij(3,1) * brjk(1,2) - brij(1,1) * brjk(3,2)) * &
-              (brjk(3,1) * brkl(1,2) - brjk(1,1) * brkl(3,2)) + &
-              (brij(1,1) * brjk(2,2) - brij(2,1) * brjk(1,2)) * &
-              (brjk(1,1) * brkl(2,2) - brjk(2,1) * brkl(1,2))) &
-             / (sinfi2 * sinfi3)
-    sintau = (brij(1,2) * (brjk(2,1) * brkl(3,2) - brjk(3,1) * brkl(2,2)) &
-              + brij(2,2) * (brjk(3,1) * brkl(1,2) - brjk(1,1) * brkl(3,2)) &
-              + brij(3,2) * (brjk(1,1) * brkl(2,2) - brjk(2,1) * brkl(1,2))) &
-             / (sinfi2 * sinfi3)
-    tau = atan2(sintau,costau)
-    if (abs(tau) .eq. pi) tau = pi
-    do ix = 1,3
-      iy = ix + 1
-      if (iy .gt. 3) iy = iy - 3
-      iz = iy + 1
-      if (iz .gt. 3) iz = iz - 3
-      bt(ix,1) = (brij(iy,2) * brjk(iz,2) - brij(iz,2) * brjk(iy,2)) &
-         &           / (rij1 * sinfi2**2)
-      bt(ix,4) = (brkl(iy,1) * brjk(iz,1) - brkl(iz,1) * brjk(iy,1)) &
-         &           / (rkl1 * sinfi3**2)
-      bt(ix,2) = -((rjk1 - rij1 * cosfi2) * bt(ix,1) &
-         &             + rkl1 * cosfi3 * bt(ix,4)) / rjk1
-      bt(ix,3) = -(bt(ix,1) + bt(ix,2) + bt(ix,4))
-    end do
-  contains
-    pure subroutine strtch2(xyz,avst,b)
-      implicit none
-      real(wp),intent(out) :: b(3,2)
-      real(wp),intent(in)  :: xyz(3,2)
-      real(wp) :: r(3)
-      real(wp) :: rr
-      real(wp),intent(out) :: avst
-      r = xyz(:,2) - xyz(:,1)
-      rr = norm2(r)
-      avst = rr
-      b(:,1) = -r / rr
-      b(:,2) = -b(:,1)
-    end subroutine strtch2
-    pure subroutine bend2(xyz,fir,bf)
-      implicit none
-      real(wp),intent(out) :: bf(3,3)
-      real(wp),intent(in)  :: xyz(3,3)
-      real(wp) :: brij(3,2)
-      real(wp) :: brjk(3,2)
-      real(wp) :: co,crap
-      real(wp),intent(out) :: fir
-      real(wp) :: si
-      real(wp) :: rij1,rjk1
-      integer  :: i
-      call strtch2(xyz(1,1),rij1,brij)
-      call strtch2(xyz(1,2),rjk1,brjk)
-      co = 0.0_wp
-      crap = 0.0_wp
-      do i = 1,3
-        co = co + brij(i,1) * brjk(i,2)
-        crap = crap + (brjk(i,2) + brij(i,1))**2
-      end do
-      if (sqrt(crap) .lt. 1.0d-6) then
-        fir = pi - asin(sqrt(crap))
-        si = sqrt(crap)
-      else
-        fir = acos(co)
-        si = sqrt(1.0_wp - co**2)
-      end if
-      if (abs(fir - pi) .lt. 1.0d-13) then
-        fir = pi
-        return
-      end if
-      do i = 1,3
-        bf(i,1) = (co * brij(i,1) - brjk(i,2)) / (si * rij1)
-        bf(i,3) = (co * brjk(i,2) - brij(i,1)) / (si * rjk1)
-        bf(i,2) = -(bf(i,1) + bf(i,3))
-      end do
-    end subroutine bend2
-  end subroutine trsn2
-
-  Subroutine Trsn(xyz,nCent,Tau,Bt,lWrite,lWarn,Label,dBt,ldB)
-    !***********************************************************************
-    !                                                                      *
-    ! Reference: Molecular Vibrations, E. Bright Wilson, Jr, J. C. Decicius*
-    !             nd Paul C. Cross, Sec. 4-1, Eq. 20-24                    *
-    !                                                                      *
-    ! R.Lindh May-June '96                                                 *
-    !***********************************************************************
-    Implicit Real(wp) (a - h,o - z)
-
-    integer :: nCent,mCent,i,j,ix,iy,iz,jx,jy,jz
-    Real(wp) Bt(3,nCent),xyz(3,nCent),Rij(3),Eij(3),Rjk(3),Ejk(3),&
-       &       Rkl(3),Ekl(3),Rijk(3),Eijk(3),dBt(3,nCent,3,nCent),&
-       &       BRij(3,2),dBRij(3,2,3,2),BRjk(3,2),dBRjk(3,2,3,2),&
-       &       BRkl(3,2),dBRkl(3,2,3,2),Bf2(3,3),dum(3,4,3,4),&
-       &       Bf3(3,3)
-    Logical :: lWrite,lWarn,ldB
-    Character(len=8) :: Label
-    !
-    !     Call qEnter('Trsn')
-    mCent = 2
-    Call Strtch(xyz(1,1),mCent,Rij1,BRij,.False.,Label,dBRij,ldB)
-    Call Strtch(xyz(1,2),mCent,Rjk1,BRjk,.False.,Label,dBRjk,ldB)
-    Call Strtch(xyz(1,3),mCent,Rkl1,BRkl,.False.,Label,dBRkl,ldB)
-    mCent = 3
-    Call Bend(xyz(1,1),mCent,Fi2,Bf2,.False.,.False.,Label,Dum,&
-       &          .False.)
-    SinFi2 = Sin(Fi2)
-    CosFi2 = Cos(Fi2)
-    Call Bend(xyz(1,2),mCent,Fi3,Bf3,.False.,.False.,Label,Dum,&
-       &          .False.)
-    SinFi3 = Sin(Fi3)
-    CosFi3 = Cos(Fi3)
-    !
-    !     Get the angle between the two planes, i.e. the
-    !     angle between the normal vectors.
-    !
-    !     r123 * r234 = CosTau
-    !
-    CosTau = ((BRij(2,1) * BRjk(3,2) - BRij(3,1) * BRjk(2,2)) *&
-       &           (BRjk(2,1) * BRkl(3,2) - BRjk(3,1) * BRkl(2,2)) +&
-       &           (BRij(3,1) * BRjk(1,2) - BRij(1,1) * BRjk(3,2)) *&
-       &           (BRjk(3,1) * BRkl(1,2) - BRjk(1,1) * BRkl(3,2)) +&
-       &           (BRij(1,1) * BRjk(2,2) - BRij(2,1) * BRjk(1,2)) *&
-       &           (BRjk(1,1) * BRkl(2,2) - BRjk(2,1) * BRkl(1,2)))&
-       &         / (SinFi2 * SinFi3)
-    !
-    !     For the vector product of the two vectors. This
-    !     will give a vector parallell to e23. The direction
-    !     relative to e23 defines the sign.
-    !
-    !     e123 X e234 = SinTau * e23
-    !
-    SinTau = (BRij(1,2) * (BRjk(2,1) * BRkl(3,2) - BRjk(3,1) * BRkl(2,2))&
-       &         + BRij(2,2) * (BRjk(3,1) * BRkl(1,2) - BRjk(1,1) * BRkl(3,2))&
-       &         + BRij(3,2) * (BRjk(1,1) * BRkl(2,2) - BRjk(2,1) * BRkl(1,2)))&
-       &         / (SinFi2 * SinFi3)
-    !
-    !     (-Pi < Tau <= Pi)
-    !
-    Tau = ATan2(SinTau,CosTau)
-    If (Abs(Tau) .eq. Pi) Tau = Pi
-    !
-    dTau = 180.0D+00 * Tau / Pi
-    dFi2 = 180.0D+00 * Fi2 / Pi
-    dFi3 = 180.0D+00 * Fi3 / Pi
-    If (lWarn) Then
-      If (dTau .gt. 177.5 .or. dTau .lt. -177.5) Then
-        Write (*,*) ' Warning: dihedral angle close to'&
-           &         //' end of range'
-      End If
-      If (dFi2 .gt. 177.5 .or. dFi2 .lt. 2.5) Then
-        Write (*,*) ' Warning: bond angle close to'&
-           &         //' end of range'
-      End If
-      If (dFi3 .gt. 177.5 .or. dFi3 .lt. 2.5) Then
-        Write (*,*) ' Warning: bond angle close to'&
-           &         //' end of range'
-      End If
-    End If
-    If (LWRITE) Write (*,1) Label,dTau,Tau
-1   FORMAT(1X,A,' : Dihedral Angle=',F10.4,&
-       & '/degree,',F10.4,'/rad')
-    !
-    !---- Compute the WDC matrix.
-    !
-    Do ix = 1,3
-      iy = ix + 1
-      If (iy .gt. 3) iy = iy - 3
-      iz = iy + 1
-      If (iz .gt. 3) iz = iz - 3
-      Bt(ix,1) = (BRij(iy,2) * BRjk(iz,2) - BRij(iz,2) * BRjk(iy,2))&
-         &           / (Rij1 * SinFi2**2)
-      Bt(ix,4) = (BRkl(iy,1) * BRjk(iz,1) - BRkl(iz,1) * BRjk(iy,1))&
-         &           / (Rkl1 * SinFi3**2)
-      Bt(ix,2) = -((Rjk1 - Rij1 * CosFi2) * Bt(ix,1)&
-         &             + Rkl1 * CosFi3 * Bt(ix,4)) / Rjk1
-      Bt(ix,3) = -(Bt(ix,1) + Bt(ix,2) + Bt(ix,4))
-    End Do
-    !
-    If (ldB) Then
-      !
-      !------- Compute the derivative of the WDC matrix.
-      !
-      Do ix = 1,3
-        iy = ix + 1
-        If (iy .gt. 3) iy = iy - 3
-        iz = iy + 1
-        If (iz .gt. 3) iz = iz - 3
-        Do jx = 1,ix
-          jy = jx + 1
-          If (jy .gt. 3) jy = jy - 3
-          jz = jy + 1
-          If (jz .gt. 3) jz = jz - 3
-          !
-          dBt(ix,1,jx,1) = (dBRij(ix,1,jy,2) * BRjk(jz,2)&
-             &                       - dBRij(ix,1,jz,2) * BRjk(jy,2)&
-             &                       - Bt(jx,1) * (BRij(ix,1) * SinFi2**2&
-             &                       + Rij1 * Two * SinFi2 * CosFi2 * Bf2(ix,1)))&
-             &                       / (Rij1 * SinFi2**2)
-          dBt(ix,1,jx,2) = -((-BRij(ix,1) * CosFi2&
-             &                         + Rij1 * SinFi2 * Bf2(ix,1)) * Bt(jx,1)&
-             &                         + (Rjk1 - Rij1 * CosFi2) * dBt(ix,1,jx,1))&
-             &                       / Rjk1
-          dBt(jx,2,ix,1) = dBt(ix,1,jx,2)
-          dBt(ix,1,jx,4) = Zero
-          dBt(jx,4,ix,1) = dBt(ix,1,jx,4)
-          dBt(ix,1,jx,3) = -(dBt(ix,1,jx,1) + dBt(ix,1,jx,2))
-          dBt(jx,3,ix,1) = dBt(ix,1,jx,3)
-          dBt(ix,4,jx,4) = (dBRkl(ix,2,jy,1) * BRjk(jz,1)&
-             &                       - dBRkl(ix,2,jz,1) * BRjk(jy,1)&
-             &                       - Bt(jx,4) * (BRkl(ix,2) * SinFi3**2&
-             &                       + Rkl1 * Two * SinFi3 * CosFi3 * Bf3(ix,3)))&
-             &                       / (Rkl1 * SinFi3**2)
-          dBt(ix,4,jx,3) = -((-BRkl(ix,2) * CosFi3&
-             &                         + Rkl1 * SinFi3 * Bf3(ix,3)) * Bt(jx,4)&
-             &                         + (Rjk1 - Rkl1 * CosFi3) * dBt(ix,4,jx,4))&
-             &                       / Rjk1
-          dBt(jx,3,ix,4) = dBt(ix,4,jx,3)
-          dBt(ix,4,jx,2) = -(dBt(ix,4,jx,4) + dBt(ix,4,jx,3))
-          dBt(jx,2,ix,4) = dBt(ix,4,jx,2)
-          If (ix .ne. jx) Then
-            dBt(jx,1,ix,1) = dBt(ix,1,jx,1)
-            dBt(ix,4,jx,1) = Zero
-            dBt(jx,4,ix,4) = dBt(ix,4,jx,4)
-            dBt(jx,1,ix,4) = dBt(ix,4,jx,1)
-            dBt(jx,1,ix,2) = -((-BRij(jx,1) * CosFi2&
-               &                            + Rij1 * SinFi2 * Bf2(jx,1)) * Bt(ix,1)&
-               &                            + (Rjk1 - Rij1 * CosFi2) * dBt(jx,1,ix,1))&
-               &                          / Rjk1
-            dBt(ix,2,jx,1) = dBt(jx,1,ix,2)
-            dBt(ix,3,jx,1) = -(dBt(ix,1,jx,1) + dBt(ix,2,jx,1)&
-               &                          + dBt(ix,4,jx,1))
-            dBt(jx,1,ix,3) = dBt(ix,3,jx,1)
-            dBt(jx,4,ix,3) = -((-BRkl(jx,2) * CosFi3&
-               &                            + Rkl1 * SinFi3 * Bf3(jx,3)) * Bt(ix,4)&
-               &                            + (Rjk1 - Rkl1 * CosFi3) * dBt(jx,4,ix,4))&
-               &                          / Rjk1
-            dBt(ix,3,jx,4) = dBt(jx,4,ix,3)
-            dBt(ix,2,jx,4) = -(dBt(ix,4,jx,4) + dBt(ix,3,jx,4))
-            dBt(jx,4,ix,2) = dBt(ix,2,jx,4)
-          End If
-          dBt(ix,2,jx,3) = -((BRjk(ix,1)&
-             &                           + Rkl1 * SinFi3 * Bf3(ix,1)) * Bt(jx,4)&
-             &                         + (Rjk1 - Rkl1 * CosFi3) * dBt(ix,2,jx,4)&
-             &                         + (BRij(ix,2) * CosFi2&
-             &                           - Rij1 * SinFi2 * Bf2(ix,2)) * Bt(jx,1)&
-             &                         + Rij1 * CosFi2 * dBt(ix,2,jx,1)&
-             &                         + Bt(jx,3) * BRjk(ix,1)) / Rjk1
-          dBt(jx,3,ix,2) = dBt(ix,2,jx,3)
-          dBt(ix,2,jx,2) = -(dBt(ix,2,jx,1) + dBt(ix,2,jx,4)&
-             &                         + dBt(ix,2,jx,3))
-          dBt(ix,3,jx,3) = -(dBt(ix,2,jx,3) + dBt(ix,1,jx,3)&
-             &                         + dBt(ix,4,jx,3))
-          If (ix .ne. jx) Then
-            dBt(ix,3,jx,2) = -(dBt(ix,2,jx,2) + dBt(ix,1,jx,2)&
-               &                            + dBt(ix,4,jx,2))
-            dBt(jx,2,ix,3) = dBt(ix,3,jx,2)
-            dBt(jx,2,ix,2) = dBt(ix,2,jx,2)
-            dBt(jx,3,ix,3) = dBt(ix,3,jx,3)
-          End If
-          !
-        End Do
-      End Do
-      !
-    End If
-    !     Call qExit('Trsn')
-    Return
-  contains
-    Subroutine Strtch(xyz,nCent,Avst,B,lWrite,Label,dB,ldB)
-      Implicit Real(wp) (a - h,o - z)
-      !      include "common/real.inc"
-      !comdeck real.inc $Revision: 2002.3 $
-      Real(wp) :: Zero,One,Two,Three,Four,Five,Six,Seven,&
-         &       Eight,RNine,Ten,Half,Pi,SqrtP2,TwoP34,&
-         &       TwoP54,One2C2
-      Parameter(Zero=0.0D0,One=1.0D0,Two=2.0D0,Three=3.0D0,&
-         &          Four=4.0D0,Five=5.0D0,Six=6.0D0,Seven=7.0D0,&
-         &          Eight=8.0D0,rNine=9.0D0,Ten=1.0D1,Half=0.5D0,&
-         &          Pi=3.141592653589793D0,&
-         &          SqrtP2=0.8862269254527579D0,&
-         &          TwoP34=0.2519794355383808D0,&
-         &          TwoP54=5.914967172795612D0,&
-         &          One2C2=0.2662567690426443D-04)
-
-      integer :: nCent
-      Real(wp) :: B(3,nCent),xyz(3,nCent),dB(3,nCent,3,nCent),R(3)
-      Logical :: lWrite,ldB
-      Character(len=8) :: Label
-      !      include "common/angstr.inc"
-      !comdeck angstr.inc $Revision: 2002.3 $
-      !
-      !     Conversion factor angstrom to bohr from the IUPAC
-      !     publication
-      !     .529177249(24) angstrom / bohr
-      !     "Quantities, Units and Symbols in Physical Chemistry"
-      !     I. Mills, T. Cvitas, K. Homann, N. Kallay and
-      !     K. Kuchitsu, Blackwell Scientific Publications,
-      !     Oxford, 1988.
-      !
-      Data Angstr/0.529177249D+00/
-      !
-      R(1) = xyz(1,2) - xyz(1,1)
-      R(2) = xyz(2,2) - xyz(2,1)
-      R(3) = xyz(3,2) - xyz(3,1)
-      R2 = R(1)**2 + R(2)**2 + R(3)**2
-      RR = Sqrt(R2)
-      Avst = RR
-      !
-      aRR = RR * Angstr
-      If (lWrite) Write (*,'(1X,A,A,2(F10.6,A))') Label,&
-         &      ' : Bond Length=',aRR,' / Angstrom',RR,' / bohr'
-      !
-      !---- Compute the WDC B-matrix.
-      !
-      B(1,1) = -R(1) / RR
-      B(2,1) = -R(2) / RR
-      B(3,1) = -R(3) / RR
-      !.... Utilize translational invariance.
-      B(1,2) = -B(1,1)
-      B(2,2) = -B(2,1)
-      B(3,2) = -B(3,1)
-      !
-      !---- Compute the cartesian derivative of the B-matrix.
-      !
-      If (ldB) Then
-        !
-        Do i = 1,3
-          Do j = 1,i
-            If (i .eq. j) Then
-              dB(i,1,j,1) = (One - B(j,1) * B(i,1)) / RR
-            Else
-              dB(i,1,j,1) = (-B(j,1) * B(i,1)) / RR
-            End If
-            dB(j,1,i,1) = dB(i,1,j,1)
-            !
-            dB(i,2,j,1) = -dB(i,1,j,1)
-            dB(j,1,i,2) = dB(i,2,j,1)
-            !
-            dB(i,1,j,2) = -dB(i,1,j,1)
-            dB(j,2,i,1) = dB(i,1,j,2)
-            !
-            dB(i,2,j,2) = -dB(i,2,j,1)
-            dB(j,2,i,2) = dB(i,2,j,2)
-          End Do
-        End Do
-        !
-      End If
-      !     Call qExit('Strtch')
-      !     Call GetMem('Exit Strtch','Chec','Real',ipMass,2*msAtom)
-      Return
-    End subroutine strtch
-    Subroutine Bend(xyz,nCent,Fir,Bf,lWrite,lWarn,Label,dBf,ldB)
-      Implicit Real(wp) (a - h,o - z)
-
-      integer :: nCent
-      !Real(wp) ::   Bf(3,nCent),xyz(3,nCent),dBf(3,nCent,3,nCent),&
-      Real(wp) ::   Bf(3,3),xyz(3,nCent),dBf(3,nCent,3,nCent),&
-         &        BRij(3,2),dBRij(3,2,3,2),&
-         &        BRjk(3,2),dBRjk(3,2,3,2)
-      Logical lWrite,ldB,lWarn
-      Character(len=8) :: Label
-      !
-      !     Call QEnter('Bend')
-      !
-      mCent = 2
-      Call Strtch(xyz(1,1),mCent,Rij1,BRij,.False.,Label,dBRij,ldB)
-      Call Strtch(xyz(1,2),mCent,Rjk1,BRjk,.False.,Label,dBRjk,ldB)
-      Co = Zero
-      Crap = Zero
-      Do i = 1,3
-        Co = Co + BRij(i,1) * BRjk(i,2)
-        Crap = Crap + (BRjk(i,2) + BRij(i,1))**2
-      End Do
-      !
-      !.... Special care for cases close to linearity
-      !
-      If (Sqrt(Crap) .lt. 1.0D-6) Then
-        Fir = Pi - ArSin(Sqrt(Crap))
-        Si = Sqrt(Crap)
-      Else
-        Fir = ArCos(Co)
-        Si = Sqrt(One - Co**2)
-      End If
-      !
-      If (Abs(Fir - Pi) .lt. 1.0d-13) Then
-        Fir = Pi
-        Return
-      End If
-      dFir = 180.0D0 * Fir / Pi
-      If ((Abs(dFir) .gt. 177.5 .or. Abs(dFir) .lt. 2.5) .and. lWarn)&
-         &   Write (*,*) ' Valence angle close to end in '//&
-         &               'range of definition'
-      If (lWrite) Write (*,'(1X,A,A,F10.4,A,F10.6,A)') Label,&
-         &            ' : Angle=',dFir,'/degree, ',Fir,'/rad'
-      !
-      !---- Compute the WDC B-matrix
-      !
-      !     Bf=-11.1111
-      Do i = 1,3
-        Bf(i,1) = (Co * BRij(i,1) - BRjk(i,2)) / (Si * Rij1)
-        Bf(i,3) = (Co * BRjk(i,2) - BRij(i,1)) / (Si * Rjk1)
-        !....... Utilize translational invariance.
-        Bf(i,2) = -(Bf(i,1) + Bf(i,3))
-      End Do
-      !     Call RecPrt('Bf',' ',Bf,9,1)
-      !
-      !---- Compute the cartesian derivative of the B-Matrix.
-      !
-      If (ldB) Then
-        !
-        !        dBf=-11.11111
-        Do i = 1,3
-          Do j = 1,i
-            dBf(i,1,j,1) = (-Si * Bf(i,1) * BRij(j,1)&
-               &                        + Co * dBRij(i,1,j,1)&
-               &                        - Bf(j,1) * (Co * Bf(i,1) * Rij1&
-               &                        + Si * BRij(i,1))) / (Si * Rij1)
-            dBf(i,1,j,3) = (-Si * Bf(i,1) * BRjk(j,2)&
-               &                       + dBRij(i,1,j,2)&
-               &                       - Bf(j,3) * Co * Bf(i,1) * Rjk1)&
-               &                       / (Si * Rjk1)
-            !              Write (*,*) '13',dBf(i,1,j,3), i, j
-            dBf(i,3,j,1) = (-Si * Bf(i,3) * BRij(j,1)&
-               &                       + dBRjk(i,2,j,1)&
-               &                       - Bf(j,1) * Co * Bf(i,3) * Rij1)&
-               &                       / (Si * Rij1)
-            dBf(i,3,j,3) = (-Si * Bf(i,3) * BRjk(j,2)&
-               &                        + Co * dBRjk(i,2,j,2)&
-               &                        - Bf(j,3) * (Co * Bf(i,3) * Rjk1&
-               &                        + Si * BRjk(i,2))) / (Si * Rjk1)
-            !
-            dBf(j,1,i,1) = dBf(i,1,j,1)
-            dBf(j,3,i,1) = dBf(i,1,j,3)
-            dBf(j,1,i,3) = dBf(i,3,j,1)
-            dBf(j,3,i,3) = dBf(i,3,j,3)
-            !
-            dBf(i,1,j,2) = -(dBf(i,1,j,1) + dBf(i,1,j,3))
-            dBf(j,2,i,1) = dBf(i,1,j,2)
-            dBf(j,1,i,2) = -(dBf(j,1,i,1) + dBf(j,1,i,3))
-            dBf(i,2,j,1) = dBf(j,1,i,2)
-            dBf(i,3,j,2) = -(dBf(i,3,j,1) + dBf(i,3,j,3))
-            dBf(j,2,i,3) = dBf(i,3,j,2)
-            dBf(j,3,i,2) = -(dBf(j,3,i,1) + dBf(j,3,i,3))
-            dBf(i,2,j,3) = dBf(j,3,i,2)
-            !
-            dBf(i,2,j,2) = -(dBf(i,2,j,1) + dBf(i,2,j,3))
-            dBf(j,2,i,2) = dBf(i,2,j,2)
-            !
-          End Do
-        End Do
-        !        Call RecPrt('dBf','(9F9.1)',dBf,9,9)
-        !
-      End If
-      !
-      !     Call QExit('Bend')
-      Return
-    End subroutine bend
-    Function arSin(Arg)
-      Implicit Real * 8(a - h,o - z)
-      Real * 8 ArSin
-
-      A = Arg
-      IF (ABS(A) .GT. One) Then
-        PRINT 3,A
-3       FORMAT(1X,'Warning argument of aSin= ',1F21.18)
-        A = Sign(One,A)
-      End If
-      !
-      ArSin = ASin(A)
-      Return
-    End function arSin
-    Function arCos(Arg)
-      Implicit Real(wp) (a - h,o - z)
-      Real(wp) :: ArCos
-      A = Arg
-      IF (ABS(A) .GT. One) Then
-        A = Sign(One,A)
-      End If
-      ArCos = ACos(A)
-      Return
-    End function arCos
-  End subroutine trsn
-
+!########################################################################################!
 !========================================================================================!
 end module modelhessian_module
diff --git a/src/optimize/newton_raphson.f90 b/src/optimize/newton_raphson.f90
new file mode 100644
index 00000000..2130bcc5
--- /dev/null
+++ b/src/optimize/newton_raphson.f90
@@ -0,0 +1,469 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2026 Lukas Rindt
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!
+! Routines were adapted from the xtb code (github.com/grimme-lab/xtb)
+! under the Open-source software LGPL-3.0 Licencse.
+!================================================================================!
+
+!> This module implements a standard NR algorithm (in Cart. coords)
+
+module newton_raphson_module
+  use iso_fortran_env,only:wp => real64,sp => real32
+  use crest_calculator
+  use axis_module
+  use strucrd
+  use ls_rmsd
+
+  use optimize_type
+  use optimize_maths
+  use modelhessian_module
+  use hessupdate_module
+  use optimize_utils
+  use hessian_reconstruct
+  use hr_utils
+  implicit none
+  private
+
+  public :: newton_raphson
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  subroutine newton_raphson(mol,calc,etot,grd,pr,wr,iostatus,logfile)
+!*************************************************************************
+!> subroutine rfopt
+!> Implementation of the standard rational function optimizer (RFO)
+!>
+!> Input/Output:
+!>      mol  - object containing the molecule,
+!>             Cartesian coordinates in Bohrs.
+!>             will be overwritten on output
+!>     calc  - object containing calculation settings
+!>             and optimization thresholds (look for calc% )
+!>     etot  - on input initial energy (do a singlepoint before ancopt)
+!>             on output final energy
+!>      grd  - Cartesian gradient
+!>       pr  - printout bool
+!>       wr  - logfile bool (name given by logfile, default crestopt.log.xyz)
+!>  iostatus - return status of the routine
+!>             (success=0, error<0, not converged>0)
+!>   logfile - name of the trajectory logfile to write when wr is set
+!!***********************************************************************
+    implicit none
+    !> INPUT/OUTPUT
+    type(coord),intent(inout) :: mol
+    type(calcdata),intent(inout) :: calc
+    real(wp),intent(inout) :: etot
+    real(wp),intent(inout) :: grd(3,mol%nat)
+    logical,intent(in) :: pr
+    logical,intent(in) :: wr
+    integer,intent(out) :: iostatus
+    character(len=*),intent(in) :: logfile
+    !> LOCAL
+    integer  :: tight
+    real(wp) :: eel
+    real(wp) :: et
+    real(wp) :: egap
+    logical :: fail
+    !> Local objects
+    type(coord)   :: molopt
+    type(optimizer)  :: OPT
+    type(mhparam) :: mhset
+
+    real(wp) :: step,amu2au,au2cm,dumi,dumj,damp,hlow,edum,s6,thr
+    real(wp) :: maxdispl,gthr,ethr,hmax,energy,rij(3),t1,t0,w1,w0
+    real(wp) :: rot(3),gnorm
+    integer :: n3,i,j,k,l,jjj,ic,jc,ia,ja,ii,jj,info,nat3
+    integer :: nvar,iter,nread,maxcycle,maxmicro,itry,maxopt,iupdat,iii
+    integer :: id,ihess,error
+    integer :: ilog,imax(3)
+    real(wp) :: depred,echng,alp,alpold,gnold,eold,gchng,dummy,dsnrm,maxd
+    real(wp),allocatable :: h(:,:)
+    real(wp),allocatable :: b(:,:)
+    real(wp),allocatable :: fc(:)
+    real(wp),allocatable :: eig(:)
+    real(wp),allocatable :: aux(:)
+    real(wp),allocatable :: hess(:)
+    integer,allocatable :: iwork(:)
+    integer,allocatable :: totsym(:)
+    real(wp),allocatable :: pmode(:,:)
+    real(wp),allocatable :: grmsd(:,:)
+    real(wp),allocatable :: grd1(:)
+    real(wp),allocatable :: gold(:)
+    real(wp),allocatable :: displ(:)
+    integer :: nvar1,npvar,npvar1
+    real(wp), allocatable :: int_hess(:), c(:)
+    integer, allocatable :: IPIV(:)
+    integer :: info2,info3
+    type(convergence_log),allocatable :: avconv
+    real(wp) :: U(3,3),x_center(3),y_center(3),rmsdval
+    integer :: modef
+    logical :: ex,converged,linear,exact
+    logical :: econverged,gconverged,lowered
+    real(wp) :: estart,esave
+    real(wp),parameter :: r4dum = 1.e-8
+    integer :: unit
+    real(wp), allocatable :: dx_test(:)
+    !> LAPACK & BLAS
+    external :: dgemv
+    external :: dppsv
+    external :: dspsv
+    real(wp), external :: ddot
+    !real(sp),external :: sdot
+
+    iostatus = 0
+    fail = .false.
+    converged = .false.
+    if (mol%nat .eq. 1) return
+!>  defaults
+    tight = calc%optlev
+    modef = 0
+    call get_optthr(mol%nat,tight,calc,ethr,gthr)
+    iupdat = calc%iupdat
+    hlow = calc%hlow_opt !> 0.01 in ancopt, 0.002 too small
+    hmax = calc%hmax_opt
+    maxdispl = calc%maxdispl_opt
+    gnorm = 0.0_wp
+    depred = 0.0_wp
+    echng = 0.0_wp
+    alp = 1.0_wp
+    alpold = 1.0_wp
+    exact = calc%exact_rf .or. tight>0
+
+    maxmicro = 100
+    maxcycle = calc%maxcycle
+    if (maxcycle .lt. maxmicro) maxmicro = maxcycle
+
+    !> check if the molecule is linear
+    call axis(mol%nat,mol%at,mol%xyz,rot,dumi)
+    linear = (rot(3) .lt. 1.d-10).or.(mol%nat == 2)
+
+    !> set degrees of freedom
+    nat3 = 3*mol%nat
+    nvar = nat3-6
+    if (linear) then
+      nvar = nat3-5
+    end if
+    if (calc%nfreeze .gt. 0) then ! exact fixing
+      nvar = nat3-3*calc%nfreeze-3
+      if (nvar .le. 0) nvar = 1
+    end if
+
+    !$omp critical
+    allocate (pmode(nat3,1),grmsd(3,mol%nat)) ! dummy allocated
+    !$omp end critical
+
+!>--- print a summary of settings, if desired
+    if (pr) then
+      call print_optsummary(calc,tight,nvar,maxcycle,maxmicro, &
+      &                       ethr,gthr,linear,wr)
+    end if
+
+!>--- initialize OPT object
+    !$omp critical
+    allocate (h(nat3,nat3),hess(nat3*(nat3+1)/2),eig(nat3))
+    call OPT%allocate2(mol%nat) !> NOTE: OPT%nvar will be nat*3 !!!
+    allocate (molopt%at(mol%nat),molopt%xyz(3,mol%nat))
+    nvar1 = OPT%nvar+1         
+    npvar = OPT%nvar*(nvar1)/2 !> packed size of Hessian (note the abuse of nvar1!)
+    allocate (gold(OPT%nvar),displ(OPT%nvar),grd1(OPT%nvar),source=0.0_wp)
+    allocate(int_hess(size(OPT%hess)))
+    allocate(c(nat3))
+    allocate(IPIV(nat3))
+    !$omp end critical
+
+!>------------------------------------------------------------------------
+!>--- put the Hessian guess into the type
+!>------------------------------------------------------------------------
+    !k = 0
+    !do i = 1,nat3
+    !  do j = 1,i
+    !    k = k+1
+    !    if (i /= j) then
+    !      OPT%hess(k) = 0.0_wp
+    !    else
+    !      OPT%hess(k) = calc%hguess
+    !    end if
+    !  end do
+    !end do
+
+    call initialize_hessian(calc,calc%hess_init,mol%xyz,mol%nat,mol%at,OPT%hess,calc%hguess,pr)
+
+!>--- backup coordinates, and starting energy
+    molopt%nat = mol%nat
+    molopt%at = mol%at
+    molopt%xyz = mol%xyz
+    molopt%wrextxyz = calc%logextxyz
+    estart = etot
+
+!>--- initialize .log file, if desired
+    ilog = 942
+    if (wr) then
+      open (newunit=ilog,file=logfile)
+    end if
+
+    iter = 0
+
+!>--- start with a printout of the preceeding single point
+    if (pr) call print_optiter(iter)
+    gnorm = norm2(grd)
+    if (pr) then
+      write (*,'(" * total energy  :",f14.7,1x,"Eh")',advance='no') etot
+      write (*,'(5x,"change ΔE",e18.7,1x,"Eh")') 0.0_wp
+      write (*,'(3x,"gradient norm :",f14.7,1x,"Eh/a0")',advance='no') gnorm
+      write (*,'(2x,"predicted",e18.7)',advance='no') 0.0_wp
+      write (*,'(1x,"("f7.2"%)")')-0.0_wp
+    end if
+
+!>======================================================================
+    NR_iter: do while (iter < maxcycle.and..not.converged)
+!>======================================================================
+!>--- count the step and print out
+      iter = iter+1
+      if (pr) call print_optiter(iter)
+      gold = reshape(grd, [nat3])
+      gnold = gnorm
+      eold = energy
+
+!>--- calc predicted energy change based on E = E0 + delta * G + delta^2 * H
+      if (iter > 1) then
+        call prdechng(OPT%nvar,gold,displ,OPT%hess,depred)
+      end if
+
+!>------------------------------------------------------------------------
+!>--- SINGLEPOINT CALCULATION
+!>------------------------------------------------------------------------
+      grd = 0.0_wp
+      call engrad(molopt,calc,energy,grd,iostatus)
+      if (iostatus .ne. 0) then
+        fail = .true.
+        exit NR_iter
+      end if
+      gnorm = norm2(grd)
+      grd1 = reshape(grd, [nat3])
+
+!>--- dump to .log file
+      if (wr) then
+        call molopt%appendlog(ilog,energy)
+      end if
+
+      if (gnorm .gt. 500.0_wp) then
+        if (pr) write (*,*) '|grad| > 500, something is totally wrong!'
+        fail = .true.
+        iostatus = -1
+        exit NR_iter
+      end if
+
+!>--- check for convergence
+      gchng = gnorm-gnold
+      echng = energy-eold
+      econverged = abs(echng) .lt. ethr
+      gconverged = gnorm .lt. gthr
+      lowered = echng .lt. 0.0_wp
+
+!>--- optimization step printout
+      if (pr) then
+        write (*,'(" * total energy  :",f14.7,1x,"Eh")',advance='no') energy
+        write (*,'(5x,"change ΔE",e18.7,1x,"Eh")') echng
+        write (*,'(3x,"gradient norm :",f14.7,1x,"Eh/a0")',advance='no') gnorm
+        write (*,'(2x,"predicted",e18.7)',advance='no') depred
+        if (iter > 1) then
+          dummy = (depred-echng)/echng*100.0_wp
+          if (abs(dummy) < 1000.0_wp) then
+            write (*,'(1x,"("f7.2"%)")') dummy
+          else
+            write (*,'(1x,"(*******%)")')
+          end if
+        else
+          write (*,'(1x,"("f7.2"%)")')-100.0_wp
+        end if
+      end if
+
+!>--- dynamic scaling in dependence of grad norm
+!>--- if we are close to convergence we can take larger steps
+      alpold = alp
+
+      !alp = 1.0d-0
+      !if (gnorm .lt. 0.002) then ! 0.002
+      !  alp = 1.5d-0 ! 1.5
+      !end if
+      !if (gnorm .lt. 0.0006) then
+      !  alp = 2.0d-0 ! 2
+      !end if
+      !if (gnorm .lt. 0.0003) then
+      !  alp = 3.0d-1 ! 3
+      !end if
+
+      
+      !alp = alp_generate(gnorm, calc%optlev,calc%opt_engine, calc%hess_init)
+      alp = 1.0_wp
+      !write(stdout,*) alp
+
+!>------------------------------------------------------------------------
+!> Update the Hessian
+!>------------------------------------------------------------------------
+      if (iter .gt. 1) then
+!>--- Hessian update, but only after first iteration (iter > 1)
+        select case (iupdat)
+        case (0)
+          call bfgs(OPT%nvar,gnorm,grd1,gold,displ*alpold,OPT%hess)
+        case (1)
+          call powell(OPT%nvar,gnorm,grd1,gold,displ*alpold,OPT%hess)
+        case (2)
+          call sr1(OPT%nvar,gnorm,grd1,gold,displ*alpold,OPT%hess)
+        case (3)
+          call bofill(OPT%nvar,gnorm,grd1,gold,displ*alpold,OPT%hess)
+        case (4)
+          call schlegel(OPT%nvar,gnorm,grd1,gold,displ*alpold,OPT%hess)
+        case default
+          write (*,*) 'invalid hessian update selection'
+          stop
+        end select
+      end if
+
+      !allocate(calc%chess%H(nat3,nat3))
+      if (calc%full_HR) then
+        call dhtosq(nat3,calc%chess%H(:,:),OPT%hess(:))
+      end if
+!>------------------------------------------------------------------------
+!>  Newton Raphson (NR) method
+!>------------------------------------------------------------------------
+
+!> Solve linear system H*dx = -g
+    int_hess = OPT%hess
+    c = -grd1 !> This will become the update step after system is solved
+    call dppsv('U', nat3, 1, int_hess, c, nat3, info2) 
+    if (info2 /= 0) then !> dppsv assumes matrix to be positive definite, fallback dspsv
+        int_hess = OPT%hess
+        c = -grd1
+        call dspsv('U', nat3, 1, int_hess, IPIV, c, nat3, info3)
+        displ = c  
+    else
+        displ = c
+    endif
+    
+!>--- rescale displacement if necessary
+      maxd = alp*sqrt(ddot(OPT%nvar,displ,1,displ,1))
+      if (maxd > maxdispl) then
+        if (pr) write (*,'(" * rescaling step by",f14.7)') maxdispl/maxd
+        displ = maxdispl*displ/maxd
+      end if
+
+!>--- now some output
+      dsnrm = sqrt(ddot(OPT%nvar,displ,1,displ,1))
+      if (pr) then
+        !> this array is currently not used and will be overwritten in next step
+        gold = abs(displ)
+        imax(1) = maxloc(gold,1); gold(imax(1)) = 0.0_wp
+        imax(2) = maxloc(gold,1); gold(imax(2)) = 0.0_wp
+        imax(3) = maxloc(gold,1)
+        write (*,'(3x,"displ. norm   :",f14.7,1x,"a.u.")',advance='no') &
+          dsnrm*alp
+        !write (*,'(6x,"lambda   ",e18.7)') eaug(1)
+        write (*,'(3x,"maximum displ.:",f14.7,1x,"a.u.")',advance='no') &
+          abs(displ(imax(1)))*alp
+        write (*,'(6x,"in coords ",3("#",i0,", "),"...")') imax
+      end if
+
+!>------------------------------------------------------------------------
+!>--- new coordinates
+!>------------------------------------------------------------------------
+      molopt%xyz = molopt%xyz+reshape(displ, [3,molopt%nat])*alp
+
+!>--- converged ?
+      econverged = abs(echng) .lt. ethr
+      gconverged = gnorm .lt. gthr
+      lowered = echng .lt. 0.0_wp
+      converged = econverged.and.gconverged.and.lowered
+      if (pr) then
+        call print_convd(econverged,gconverged)
+      end if
+      if (converged) then
+        converged = .true.
+        etot = energy
+        exit NR_iter
+      end if
+
+!>======================================================================
+    end do NR_iter
+!>======================================================================
+
+!>--- close .log file
+    if (wr) then
+      close (ilog)
+    end if
+
+    if (converged) then
+!>--- if the relaxation converged properly do this
+      iostatus = 0
+      if (pr) then
+        call rmsd(mol%nat,mol%xyz,molopt%xyz,1,U,x_center,y_center,rmsdval,.false.,grmsd)
+        write (*,'(/,3x,"***",1x,a,1x,i0,1x,a,1x,"***",/)') &
+          "GEOMETRY OPTIMIZATION CONVERGED AFTER",iter,"ITERATIONS"
+        write (*,'(72("-"))')
+        write (*,'(1x,"total energy gain   :",F18.7,1x,"Eh",F14.4,1x,"kcal/mol")') &
+          etot-estart, (etot-estart)*autokcal
+        write (*,'(1x,"total RMSD          :",F18.7,1x,"a0",F14.4,1x,"Å")') &
+          rmsdval,rmsdval*autoaa
+        write (*,'(72("-"))')
+      end if
+    else if (iostatus .ne. 0) then
+!>--- if iostatus =/= 0, something went wrong in the relaxation
+      if (pr) then
+        write (*,'(/,3x,"***",1x,a,1x,"***",/)') &
+          "GEOMETRY RELAXATION FAILED"
+      end if
+    else
+!>--- not converging in the given cycles is considered a FAILURE
+      !> some iostatus>0 is selected to signal this
+      iostatus = iter
+      if (pr) then
+        write (*,'(/,3x,"***",1x,a,1x,i0,1x,a,1x,"***",/)') &
+          "FAILED TO CONVERGE GEOMETRY OPTIMIZATION IN",iter,"ITERATIONS"
+      end if
+    end if
+
+!>--- overwrite input structure with optimized one
+    mol%nat = molopt%nat
+    mol%at = molopt%at
+    mol%xyz = molopt%xyz
+
+!> deallocate data
+    !$omp critical
+    if (allocated(gold)) deallocate (gold)
+    if (allocated(displ)) deallocate (displ)
+    if (allocated(grd1)) deallocate (grd1)
+    if (allocated(grmsd)) deallocate (grmsd)
+    if (allocated(pmode)) deallocate (pmode)
+    if (allocated(h)) deallocate (h)
+    if (allocated(hess)) deallocate (hess)
+    if (allocated(molopt%at)) deallocate (molopt%at)
+    if (allocated(molopt%xyz)) deallocate (molopt%xyz)
+    call OPT%deallocate
+    !$omp end critical
+
+    return
+  end subroutine newton_raphson
+
+
+!========================================================================================!
+!========================================================================================!
+end module newton_raphson_module
diff --git a/src/optimize/optimize_maths.f90 b/src/optimize/optimize_maths.f90
index b46a223c..58f5a78f 100644
--- a/src/optimize/optimize_maths.f90
+++ b/src/optimize/optimize_maths.f90
@@ -33,8 +33,12 @@ module optimize_maths
   end interface
   public :: detrotra8
   public :: solver_sdavidson
+  public :: solver_ddavidson
   public :: solver_sspevx
+  public :: solver_dspevx
   public :: solver_ssyevx
+  public :: dsqtoh
+  public :: dhtosq
 
 !========================================================================================!
 !========================================================================================!
@@ -113,8 +117,8 @@ recursive subroutine detrotra_qsort(a,first,last,ind)
         i = i+1
         j = j-1
       end do
-      if (first < i-1) call qsort(a,first,i-1,ind)
-      if (j+1 < last) call qsort(a,j+1,last,ind)
+      if (first < i-1) call detrotra_qsort(a,first,i-1,ind)
+      if (j+1 < last) call detrotra_qsort(a,j+1,last,ind)
     end subroutine detrotra_qsort
   end subroutine detrotra8
 
@@ -212,7 +216,9 @@ subroutine gtrprojm(natoms,nat3,xyzucm,hess,ldebug,nmode,mode,ndim)
     nprj = 6
     if (nmode .gt. 0) nprj = nprj+nmode
     !if (nmode .lt. 0) nprj = nprj + fixset%n * 3
+    !$omp critical
     allocate (fmat(nat3,nprj))
+    !$omp end critical
     fmat(:,:) = 0.0_wp
 
     if (nmode .ge. 0) then
@@ -252,8 +258,10 @@ subroutine gtrprojm(natoms,nat3,xyzucm,hess,ldebug,nmode,mode,ndim)
 
     !> do projection
     call dsyprj(nat3,nprj,fmat,nat3,hess)
-
+    
+    !$omp critical
     deallocate (fmat)
+    !$omp end critical
     return
   end subroutine gtrprojm
 
@@ -458,8 +466,9 @@ subroutine dsyprj(nbdim,m,bmat,n,asym)
     external :: dsymm
     external :: dgemm
 !-----------------------------------------------------------------
+   !$omp critical
     allocate (scrb(n,m),scra(n,n))
-
+    !$omp end critical
 !> Expand trigonal matrix asym to full matrix on scra
     call dhtosq(n,scra,asym)
 !> Calculate scrb = asym*bmat (BLAS)
@@ -487,8 +496,9 @@ subroutine dsyprj(nbdim,m,bmat,n,asym)
         asym(ij) = asym(ij)+scra(i,j)
       end do
     end do
-
+    !$omp critical
     deallocate (scra,scrb)
+    !$omp end critical
     return
   end subroutine dsyprj
 
@@ -535,7 +545,9 @@ subroutine dblckmgs(m,n,ndim,darray)
 !-----------------------------------------------------------------
 ! Allocate overlap matrix
 !-----------------------------------------------------------------
+    !$omp critical
     allocate (smat(ibsize,ibsize))
+    !$omp end critical
 
 !-----------------------------------------------------------------
 ! Calculate the number of blocks
@@ -599,7 +611,9 @@ subroutine dblckmgs(m,n,ndim,darray)
     end do
 
 !> Clean up and return
+    !$omp critical
     deallocate (smat)
+    !$omp end critical
     return
   end subroutine dblckmgs
 
@@ -814,6 +828,217 @@ subroutine smread(n,iwo,v,irec)
     end subroutine smread
   end subroutine solver_sdavidson
 
+!========================================================================================!
+
+  subroutine solver_ddavidson(n,crite,Hp,C,e,fail,pr) !> This one now in double precision!!
+!*****************************************************************
+!* subroutine solver_sdavidson
+!*
+!* Davidson method to iteratively diagonalize
+!* a subspace of a matrix to provide its first
+!* few lowest (or highest) eigenvalues.
+!* In this version it is hard-coded to the lowest eigenvalue.
+!*
+!* Input:
+!*      n -  dimension of the matrix to be diagonalized
+!*  crite - eigenvalue convergence threshold
+!*     Hp - the matrix to be diagonalized in packed form
+!*      C - eigenvevtor(s)
+!*     pr - print statement
+!* Output:
+!*      e - eigenvalues
+!*   fail - exit status boolean
+!*
+!* Note the DOUBLE PRECISION!
+!*****************************************************************
+    implicit none
+    logical,intent(in) :: pr
+    logical,parameter :: ini = .false.
+    integer :: n       ! dimension
+    integer,parameter :: nr = 1
+    real(wp) :: crite   ! eigenvalue convergence threshold
+    real(wp) :: Hp(n*(n+1)/2)  ! matrix to be diagonalized
+    real(wp) :: C(n,nr) ! eigenvectors
+    real(wp) :: e(nr)   ! eigenvalues
+    logical,intent(out) :: fail
+    !> Local
+    integer,parameter :: maxiter = 100        ! maximum # of iterations
+    integer :: iter,ineue(1),janf!,lun1,lun2
+    integer :: iideks(maxiter),idum,j,jalt,ilauf,jneu
+    integer :: l1,l2,k,LWORK,LIWORK,INFO,i,ien,ialt,memlun2
+    integer,allocatable :: iwork(:)
+    logical :: lconf
+    real(wp),allocatable :: lun1(:,:),lun2(:,:)
+    integer,parameter :: initial_dyn_array_size = 10
+    real(wp) :: valn(1),uim,s,denerg
+    real(wp),allocatable :: adiag(:),vecf1(:),vecf2(:),w(:)
+    real(wp),allocatable :: Uaug(:,:),d(:),aux(:)
+    real(wp),allocatable :: AB(:,:),av(:),tmpav(:,:)
+    !> LAPACK & BLAS
+    external :: dspmv
+    real(wp),external :: ddot
+    external :: dsyevd
+    external :: daxpy
+
+    fail = .true.
+
+    if (pr) then
+      write (*,'(/,10x,''******************************************'')')
+      write (*,'(10x,''*            multi-root davidson (R4)    *'')')
+      write (*,'(10x,''******************************************'',/)')
+      write (*,*) 'dim ',n,' # roots ',1
+    end if
+
+    allocate (adiag(n),vecf1(n),vecf2(n),w(n),av(maxiter*(maxiter+1)/2))
+
+    allocate (lun1(n,initial_dyn_array_size),lun2(n,initial_dyn_array_size), &
+       &     source=0.0_wp)
+
+    !> H * C for initialization
+    call dmwrite(n,lun1,C(:,1),1)
+    call dspmv('u',n,1.0_wp,Hp,C(:,1),1,0.0_wp,vecf2,1)
+    call dmwrite(n,lun2,vecf2,1)
+
+    !> make array iideks
+    iideks(1) = 1
+    do idum = 2,maxiter
+      iideks(idum) = iideks(idum-1)+idum
+    end do
+    valn = 0
+    lconf = .false.
+    e = 0
+    do i = 1,n
+      adiag(i) = HP(i*(i+1)/2)
+    end do
+    av(1) = ddot(n,C(:,1),1,vecf2,1)
+
+!>--------------------------------
+!> Davidson algo loop
+!>--------------------------------
+    j = 1
+    DAVIDSON: do iter = 1,maxiter-1
+      lwork = 1+6*j+2*j**2
+      liwork = 8*j
+      allocate (Uaug(j,j),d(j),iwork(liwork),aux(lwork))
+      k = 0
+      do l1 = 1,j
+        do l2 = 1,l1
+          k = k+1
+          Uaug(l2,l1) = av(k)
+          Uaug(l1,l2) = av(k)
+        end do
+      end do
+      call dsyevd('V','U',j,Uaug,j,d,aux,LWORK,IWORK,LIWORK,INFO)
+      valn(1:1) = d(1:1)
+
+      !> create and save vectors on vecf1
+      vecf1 = 0.0_wp
+      do i = 1,j
+        call dmread(n,lun1,w,i)
+        uim = Uaug(i,1)
+        call daxpy(n,uim,w,1,vecf1,1)
+      end do
+
+      !> calculate E*bi
+      vecf2 = -valn(1)*vecf1
+      !> calculate h*bi-e*bi (overwrites vecf2)
+      do i = 1,j
+        call dmread(n,lun2,w,i)
+        memlun2 = i
+        uim = Uaug(i,1)
+        call daxpy(n,uim,w,1,vecf2,1)
+      end do
+      deallocate (aux,iwork,d,Uaug)
+      C(1:n,1) = vecf1
+
+      !> calculate (h*bi - e*bi)/(e - haa); (saved as vecf2)
+      vecf1 = vecf2/(valn(1)-adiag)
+
+      !> check for convergence of Davidson algo
+      denerg = abs(valn(1)-e(1))
+      lconf = denerg .lt. crite
+      if (pr) write (*,*) iter,lconf,denerg,valn(1:1)
+      if (lconf) then
+        if (pr) write (*,*) 'all roots converged'
+        fail = .false.
+        exit DAVIDSON
+      end if
+
+      if (j .gt. 0) then
+        ialt = j
+        !> orthogonalize
+        do jalt = 1,ialt
+          call dmread(n,lun1,w,jalt)
+          s = -ddot(n,w,1,vecf1,1)
+          call daxpy(n,s,w,1,vecf1,1)
+        end do
+        !> normalize remaining
+        s = ddot(n,vecf1,1,vecf1,1)
+        if (s .gt. 0.00000001) then
+          s = 1.0_wp/sqrt(s)
+          vecf1 = vecf1*s
+          ialt = ialt+1
+          call dmwrite(n,lun1,vecf1,jalt)
+        else
+          fail = .false.
+          exit DAVIDSON
+        end if
+      end if
+
+      !> H * C
+      call dspmv('u',n,1.0_wp,Hp,vecf1,1,0.0_wp,vecf2,1)
+      call dmwrite(n,lun2,vecf2,memlun2+1)
+
+      !> calculate matrix elements for next iteration
+      do jalt = 1,j
+        call dmread(n,lun1,w,jalt)
+        ilauf = iideks(j)+jalt
+        av(ilauf) = ddot(n,w,1,vecf2,1)
+        ilauf = ilauf+1+j
+      end do
+      av(iideks(j+1)) = ddot(n,vecf2,1,vecf1,1)
+      !> increase expansion space and iterate further
+      e = valn
+      j = j+1
+    end do DAVIDSON
+!>--------------------------------
+!> end algo loop
+!>--------------------------------
+    if (pr.and.fail) write (*,*) 'Warning: davidson not properly converged'
+
+    deallocate (adiag,vecf1,vecf2,w,av,lun1,lun2)
+    return
+  contains
+    !> write array v onto iwo
+    subroutine dmwrite(n,iwo,v,irec)
+      implicit none
+      real(wp),intent(inout),allocatable :: iwo(:,:)
+      real(wp),intent(in)  :: v(n)
+      integer,intent(in)  :: n,irec
+      real(wp),allocatable :: tmp(:,:)
+      integer :: d2,dn
+      d2 = size(iwo,2)
+      if (irec > d2) then
+        dn = d2+d2/2+1
+        allocate (tmp(n,dn))
+        tmp(:,:d2) = iwo
+        deallocate (iwo)
+        call move_alloc(tmp,iwo)
+      end if
+      iwo(:,irec) = v
+      return
+    end subroutine dmwrite
+    !> read array v from iwo
+    subroutine dmread(n,iwo,v,irec)
+      implicit none
+      real(wp),intent(out) :: v(n)
+      real(wp),intent(in)  :: iwo(:,:)
+      integer,intent(in)  :: n,irec
+      v = iwo(:,irec)
+      return
+    end subroutine dmread
+  end subroutine solver_ddavidson
+
 !========================================================================================!
 
   subroutine solver_ssyevx(n,thr,A,U,e,fail)
@@ -881,6 +1106,57 @@ subroutine solver_sspevx(n,thr,A,U,e,fail)
     deallocate (iwork,work,ifail)
   end subroutine solver_sspevx
 
+  subroutine solver_dspevx(n,thr,A,U,e,fail)
+!*********************************************************
+!* subroutine solver_dspevx
+!* wrapper for LAPACK's dspevx routine:
+!* DSPEVX computes all eigenvalues and eigenvectors of a
+!* real symmetric matrix A in packed storage using a
+!* divide and conquer algorithm.
+!*********************************************************
+    implicit none
+    integer,intent(in) :: n
+    real(wp),intent(in) :: thr
+    real(wp),intent(inout) :: A(:)
+    real(wp),intent(inout) :: U(:,:)
+    real(wp),intent(inout) :: e(:)
+    logical,intent(out) :: fail
+    integer :: i,j,k
+    integer :: info
+    real(wp),allocatable :: work(:)
+    integer,allocatable :: iwork(:)
+    integer,allocatable :: ifail(:)
+    real(wp) :: dum
+    !> LAPACK
+    external :: dspevx
+    fail = .false.
+    allocate (iwork(5*n),work(8*n),ifail(n))
+    j = 1
+    call dspevx('V','I','U',n,A,dum,dum,j,j,thr,i,e,U,n,work,iwork,ifail,info)
+    if (info .ne. 0) fail = .true.
+    deallocate (iwork,work,ifail)
+  end subroutine solver_dspevx
+
+  subroutine dsqtoh(n,a,b)
+!****************************************************
+!* converts upper triangle of a matrix into a vector
+!****************************************************
+    implicit none
+    integer,intent(in)  :: n
+    real(wp),intent(in) :: a(n,n)
+    real(wp),intent(out)  :: b(n*(n+1)/2)
+    integer :: i,j,k
+
+    k = 0
+    do i = 1,n
+      do j = 1,i
+        k = k+1
+        b(k) = a(i,j)
+      end do
+    end do
+
+  end subroutine dsqtoh
+
 !========================================================================================!
 !========================================================================================!
 end module optimize_maths
diff --git a/src/optimize/optimize_module.f90 b/src/optimize/optimize_module.f90
index 42fbe67f..dbb3ad05 100644
--- a/src/optimize/optimize_module.f90
+++ b/src/optimize/optimize_module.f90
@@ -20,7 +20,7 @@
 ! under the Open-source software LGPL-3.0 Licencse.
 !================================================================================!
 
-!> This module wrapps the different optimization algorithms, 
+!> This module wrapps the different optimization algorithms,
 !> i.e., this is what can be called for geometry opt.
 
 module optimize_module
@@ -31,7 +31,12 @@ module optimize_module
   use ancopt_module
   use gradientdescent_module
   use rfo_module
+  use lbfgs_module
   use optimize_utils
+  use thermochem_module
+  use hessian_reconstruct
+  use newton_raphson_module
+  use hr_utils
   implicit none
   private
 
@@ -44,18 +49,41 @@ module optimize_module
 !========================================================================================!
 !========================================================================================!
 
-  subroutine optimize_geometry(mol,molnew,calc,etot,grd,pr,wr,iostatus)
+  subroutine optimize_geometry(mol,molnew,calc,etot,grd,pr,wr,iostatus,logfile)
+    !**********************************************************************
+    !* Driver that dispatches to the selected geometry optimizer engine.
+    !*
+    !* logfile - optional name for the step-by-step trajectory logfile;
+    !*           defaults to 'crestopt.log.xyz' when absent. Only written
+    !*           when the engine's wr flag is set.
+    !**********************************************************************
     implicit none
     !> Input
     type(coord)    :: mol
     type(calcdata) :: calc
     logical,intent(in)        :: pr
     logical,intent(in)        :: wr
+    character(len=*),intent(in),optional :: logfile
     !> Output
     type(coord)   :: molnew
     integer,intent(out)       :: iostatus
     real(wp),intent(inout)    :: etot
     real(wp),intent(inout)    :: grd(3,mol%nat)
+    real(wp),allocatable :: H_init(:,:),freq(:)
+    integer :: nat3,io,idx,nrt
+    real(wp),allocatable :: hess(:),g_hess(:), g_hess_full(:,:), int_temps(:)
+    logical :: pr2
+    character(len=:),allocatable :: logfile_l
+
+
+    !write(stdout,*) "RUNNING AN OPT"
+
+    !> resolve the logfile name (default if not provided)
+    if (present(logfile)) then
+      logfile_l = logfile
+    else
+      logfile_l = 'crestopt.log.xyz'
+    end if
 
     iostatus = -1
     !> do NOT overwrite original geometry
@@ -63,63 +91,158 @@ subroutine optimize_geometry(mol,molnew,calc,etot,grd,pr,wr,iostatus)
     molnew%at = mol%at
     molnew%xyz = mol%xyz
     molnew%nat = mol%nat
+    molnew%wrextxyz = .true.
     !$omp end critical
+    nat3 = 3*mol%nat
 
     !> Check for optimization-individual calculation setup
-    if(calc%optnewinit)then
+    if (calc%optnewinit) then
       !$omp critical
       call calc%dealloc_params()
       !$omp end critical
-    endif
+    end if
+
+    !> Check if Hessian Reconstruct is called and initialize the type
+    if (calc%do_HR .or. calc%deform_opt_hess) then
+      allocate (calc%chess)
+      allocate (H_init(nat3,nat3))
+      call calc%chess%alloc(mol%nat,calc%hu_steps,calc%chess_id_guess,calc%initialize_hr_type, calc%hr_hu_type)
+    end if
 
     !> initial singlepoint
+    if (calc%do_HR .or. calc%deform_opt_hess) calc%chess%track_step = .false. !this is not tracked to avoid duplicate
     call engrad(molnew,calc,etot,grd,iostatus)
-
+    if (calc%do_HR .or. calc%deform_opt_hess) calc%chess%track_step = .true.
     !> optimization
     select case (calc%opt_engine)
-    case ( 0)
-       call ancopt(molnew,calc,etot,grd,pr,wr,iostatus)
-    case ( 1)
-       !> l-bfgs goes here
-      write(stdout,'(a)') 'L-BFGS currently not implemented'
-      stop
-    case ( 2)
-       !> rfo goes here
-       call rfopt(molnew,calc,etot,grd,pr,wr,iostatus)
+    case (0)
+      call ancopt(molnew,calc,etot,grd,pr,wr,iostatus,logfile_l)
+    case (1)
+      !> l-bfgs goes here
+      !write(stdout,'(a)') 'L-BFGS currently not implemented'
+      !stop
+      call lbfgs_optimize(molnew,calc,etot,grd,pr,iostatus,logfile_l)
+    case (2)
+      !> rfo goes here
+      call rfopt(molnew,calc,etot,grd,pr,wr,iostatus,logfile_l)
+    case (3)
+      !> newton-raphson step goes here, this is a newton step with updated hessians, i.e. quasi Newton
+      call newton_raphson(molnew,calc,etot,grd,pr,wr,iostatus,logfile_l)
     case (-1)
-      call gradientdescent(molnew,calc,etot,grd,pr,wr,iostatus)
+      call gradientdescent(molnew,calc,etot,grd,pr,wr,iostatus,logfile_l)
     case default
-      write(stdout,'(a)') 'Unknown optimization engine!'
+      write (stdout,'(a)') 'Unknown optimization engine!'
       stop
     end select
-    molnew%energy = etot   
+    molnew%energy = etot
+
+    if (calc%do_HR  .and. iostatus .eq. 0) then !> Hessian reconstruction and post-processing happen here, only do it if geometry relaxation successful
+      if (calc%full_HR) then
+
+        write (stdout,*)
+        write (stdout,*) "THERMO FROM BFGS" !> This is here for full hessian reconstruct
+        write (stdout,*)
+
+        call calc_thermo_from_hess(molnew,calc%chess%H,pr, &
+        & calc%nt,calc%temperatures,calc%ithr,calc%fscal,calc%sthr,calc%et, &
+        & calc%ht,calc%gt,calc%stot,etot)
+
+      else
+        
+        idx = minloc(calc%chess%order,1)
+        if (minval(calc%chess%order) .eq. 0) idx = 1
+        
+        call initialize_hessian(calc,calc%chess%initialize_type,calc%chess%coords(idx,:,:),molnew%nat,molnew%at,calc%chess%hess(:),calc%chess%hguess,pr)
+        call dhtosq(nat3,H_init,calc%chess%hess) 
+        write(stdout,*)                                                                              
+        write(stdout,*)"THERMO FROM INITIALIZED HESSIAN:"
+        write(stdout,*) 
+        call calc_thermo_from_hess(molnew,H_init,pr, &
+        & calc%nt,calc%temperatures,calc%ithr,calc%fscal,calc%sthr,calc%et, &
+        & calc%ht,calc%gt,calc%stot,etot)
+
+        call calc%chess%construct_hessian()
+
+        write (stdout,*)
+        write (stdout,*) "THERMO FROM RECONSTRUCTED HESSIAN:" 
+        write (stdout,*)
+
+        call calc_thermo_from_hess(molnew,calc%chess%H(:,:),pr, &
+        & calc%nt,calc%temperatures,calc%ithr,calc%fscal,calc%sthr,calc%et, &
+        & calc%ht,calc%gt,calc%stot,etot)
+      end if
+
+      call calc%chess%dealloc()
+      deallocate (calc%chess)
+    end if
+
+    !write(stdout,*) calc%g_sampling
+    if (calc%g_sampling) then 
+      pr2 = .false.
+      !write(stdout,*) "Running gs"
+      !write(stdout,*) "Energy pre correction", etot
+      !$omp critical
+      allocate(g_hess(nat3*(nat3+1)/2),g_hess_full(nat3,nat3))
+      !$omp end critical
+      call initialize_hessian(calc,calc%gs_hess_type,molnew%xyz,molnew%nat,molnew%at,g_hess,calc%chess%hguess,pr2)
+      !write(*,*) "Hess Initialized"
+      call dhtosq(nat3,g_hess_full,g_hess)
+      !write(*,*) "Hess diagonalized"
+      call calc_thermo_from_hess(molnew,g_hess_full,pr2, &
+      & calc%nt,calc%temperatures,calc%ithr,calc%fscal,calc%sthr,calc%et, &
+      & calc%ht,calc%gt,calc%stot,etot)
+      !write(*,*) "Thermo calculated"
+
+      !$omp critical
+      allocate (int_temps(calc%nt))
+      !$omp end critical
+
+      int_temps = abs(calc%temperatures-298.15_wp)
+      nrt = minloc(int_temps(:),1)
+      etot = etot+calc%gt(nrt)
+      !write(stdout,*) "Energy post correction", etot
+    endif
+
     return
   end subroutine optimize_geometry
 
 !========================================================================================!
 
-  subroutine print_opt_data(calc,ich)
+  subroutine print_opt_data(calc,ich,natoms,tag)
     implicit none
     type(calcdata) :: calc
     integer,intent(in) :: ich
-    integer :: tight
+    integer,intent(in),optional :: natoms
+    character(len=*),intent(in),optional :: tag
+    integer :: tight,nat
     real(wp) :: ethr,gthr
+    character(len=:),allocatable :: ttag
+    if (present(tag)) then
+      ttag = tag
+    else
+      ttag = ' '
+    end if
+    if (present(natoms)) then
+      nat = natoms
+    else
+      nat = 0
+    end if
 
-    write (ich,'(1x,a)',advance='no') 'Optimization engine: '
+    write (ich,'(a,a)',advance='no') ttag,'Optimization engine: '
     select case (calc%opt_engine)
-    case ( 0)
+    case (0)
       write (ich,'(a)') 'ANCOPT'
-    case ( 1)
+    case (1)
       write (ich,'(a)') 'L-BFGS'
-    case ( 2)
+    case (2)
       write (ich,'(a)') 'RFO'
     case (-1)
       write (ich,'(a)') 'Gradient Descent'
     case default
-      write(ich,'(a)') 'Unknown'
+      write (ich,'(a)') 'Unknown'
     end select
     if (calc%opt_engine >= 0) then
-      write (ich,'(1x,a)',advance='no') 'Hessian update type: '
+      write (ich,'(a,a)',advance='no') ttag,'Hessian update type: '
       select case (calc%iupdat)
       case (0)
         write (ich,'(a)') 'BFGS'
@@ -135,12 +258,11 @@ subroutine print_opt_data(calc,ich)
     end if
 
     tight = calc%optlev
-    call get_optthr(0,tight,calc,ethr,gthr)
-    write (ich,'(1x,a,e10.3,a,e10.3,a)') 'E/G convergence criteria: ',&
+    call get_optthr(nat,tight,calc,ethr,gthr)
+    write (ich,'(a,a,e10.3,a,e10.3,a)') ttag,'E/G convergence criteria: ',&
     & ethr,' Eh,',gthr,' Eh/a0'
 
-    write (ich,'(1x,a,i0)') 'maximum optimization steps: ',calc%maxcycle
-     
+    write (ich,'(a,a,i0)') ttag,'maximum optimization steps: ',calc%maxcycle
   end subroutine print_opt_data
 
 !========================================================================================!
diff --git a/src/optimize/optimize_type.f90 b/src/optimize/optimize_type.f90
index 1ced8342..6a659773 100644
--- a/src/optimize/optimize_type.f90
+++ b/src/optimize/optimize_type.f90
@@ -21,34 +21,46 @@
 ! under the Open-source software LGPL-3.0 Licencse.
 !================================================================================!
 module optimize_type
-   use iso_fortran_env, only: wp=>real64
-   use optimize_maths, only: detrotra8
-   implicit none
-
-   public :: optimizer
-   public :: convergence_log
-   private
-
-   type optimizer
-      integer  :: n    !< number of atoms
-      integer  :: n3   !< dimension of hessian
-      integer  :: nvar !< actual dimension
-      real(wp) :: hlow
-      real(wp) :: hmax
-      real(wp),allocatable :: hess(:)
-      real(wp),allocatable :: B(:,:)
-      real(wp),allocatable :: eigv(:)
-      real(wp),allocatable :: coord(:)
-      real(wp),allocatable :: xyz(:,:)
-   contains
-   procedure :: allocate => allocate_anc
-   procedure :: allocate2 => allocate_opt
-   procedure :: deallocate => deallocate_anc
-   procedure :: write => write_anc
-   procedure :: new => generate_anc_blowup
-   procedure :: get_cartesian
-   end type optimizer
-
+  use iso_fortran_env,only:wp => real64
+  use optimize_maths,only:detrotra8
+  implicit none
+
+  public :: optimizer
+  public :: convergence_log
+  private
+
+  type optimizer
+    !******************************************************
+    !* Storage type for optimizations
+    !*
+    !* Depending on the chosen optimization algorithm
+    !* different variables in this will be used/allocated
+    !******************************************************
+    integer  :: n    !< number of atoms
+    integer  :: n3   !< dimension of hessian
+    integer  :: nvar !< actual dimension
+    real(wp) :: hlow
+    real(wp) :: hmax
+    real(wp),allocatable :: hess(:)
+    real(wp),allocatable :: B(:,:)
+    real(wp),allocatable :: eigv(:)
+    real(wp),allocatable :: coord(:)
+    real(wp),allocatable :: xyz(:,:)
+    !> L-BFGS block
+    integer :: m !> history size
+    real(wp),allocatable :: S(:,:),Y(:,:)
+    real(wp),allocatable :: rho(:)
+    real(wp),allocatable :: alpha(:)
+    real(wp),allocatable :: q(:)
+  contains
+    procedure :: allocate => allocate_anc
+    procedure :: allocate2 => allocate_opt
+    procedure :: allocatelbfgs => allocate_lbfgs
+    procedure :: deallocate => deallocate_anc
+    procedure :: write => write_anc
+    procedure :: new => generate_anc_blowup
+    procedure :: get_cartesian
+  end type optimizer
 
   type :: convergence_log
     integer :: nlog
@@ -62,7 +74,6 @@ module optimize_type
   interface convergence_log
     module procedure new_convergence_log
   end interface convergence_log
-  
 
 !========================================================================================!
 !========================================================================================!
@@ -70,362 +81,372 @@ module optimize_type
 !========================================================================================!
 !========================================================================================!
 
-subroutine allocate_anc(self,n,nvar,hlow,hmax)
-   implicit none
-   class(optimizer),intent(inout)  :: self
-   integer,      intent(in)     :: n
-   integer,      intent(in)     :: nvar
-   integer                      :: n3
-   real(wp),intent(in),optional :: hlow
-   real(wp),intent(in),optional :: hmax
-   n3 = 3*n
-   call self%deallocate
-   self%n    = n
-   self%n3   = 3*n
-   self%nvar = nvar
-   if (present(hlow)) self%hlow = hlow
-   if (present(hmax)) self%hmax = hmax
-   allocate( self%hess(nvar*(nvar+1)/2), source = 0.0_wp )
-   allocate( self%B(n3,n3),              source = 0.0_wp )
-   allocate( self%eigv(n3),              source = 0.0_wp )
-   allocate( self%coord(nvar),           source = 0.0_wp )
-   allocate( self%xyz(3,n),              source = 0.0_wp )
-end subroutine allocate_anc
-
-
-subroutine allocate_opt(self,n)!,nvar)
-   implicit none
-   class(optimizer),intent(inout)  :: self
-   integer,      intent(in)     :: n
-   !integer,      intent(in)     :: nvar
-   integer :: nvar
-   integer                      :: n3
-   !real(wp),intent(in),optional :: hlow
-   !real(wp),intent(in),optional :: hmax
-   n3 = 3*n
-   call self%deallocate
-   self%n    = n
-   self%n3   = 3*n
-   nvar = 3*n
-   self%nvar = nvar
-   allocate( self%hess(nvar*(nvar+1)/2), source = 0.0_wp )
-   !allocate( self%B(n3,n3),              source = 0.0_wp )
-   allocate( self%eigv(n3),              source = 0.0_wp )
-   !allocate( self%coord(nvar),           source = 0.0_wp )
-   !allocate( self%xyz(3,n),              source = 0.0_wp )
-end subroutine allocate_opt
-
-
+  subroutine allocate_anc(self,n,nvar,hlow,hmax)
+    implicit none
+    class(optimizer),intent(inout)  :: self
+    integer,intent(in)           :: n
+    integer,intent(in)           :: nvar
+    integer                      :: n3
+    real(wp),intent(in),optional :: hlow
+    real(wp),intent(in),optional :: hmax
+    n3 = 3*n
+    call self%deallocate
+    self%n = n
+    self%n3 = 3*n
+    self%nvar = nvar
+    if (present(hlow)) self%hlow = hlow
+    if (present(hmax)) self%hmax = hmax
+    allocate (self%hess(nvar*(nvar+1)/2),source=0.0_wp)
+    allocate (self%B(n3,n3),source=0.0_wp)
+    allocate (self%eigv(n3),source=0.0_wp)
+    allocate (self%coord(nvar),source=0.0_wp)
+    allocate (self%xyz(3,n),source=0.0_wp)
+  end subroutine allocate_anc
+
+  subroutine allocate_opt(self,n)
+    implicit none
+    class(optimizer),intent(inout)  :: self
+    integer,intent(in) :: n
+    integer            :: nvar
+    integer            :: n3
+    n3 = 3*n
+    call self%deallocate
+    self%n = n
+    self%n3 = 3*n
+    nvar = 3*n
+    self%nvar = nvar
+    allocate (self%hess(nvar*(nvar+1)/2),source=0.0_wp)
+    allocate (self%eigv(n3),source=0.0_wp)
+  end subroutine allocate_opt
+
+  subroutine allocate_lbfgs(self,nvar,mem)
+    implicit none
+    class(optimizer),intent(inout)  :: self
+    integer,intent(in) :: nvar,mem
+    call self%deallocate
+    self%m = mem
+    self%nvar = nvar
+    allocate(self%S(nvar,mem))
+    allocate(self%Y(nvar,mem))
+    allocate(self%rho(mem))
+    allocate(self%alpha(mem))
+    allocate(self%q(nvar))
+  end subroutine allocate_lbfgs
 
 !========================================================================================!
 
-subroutine deallocate_anc(self)
-   implicit none
-   class(optimizer),intent(inout) :: self
-   self%n    = 0
-   self%n3   = 0
-   self%nvar = 0
-   if (allocated(self%hess )) deallocate( self%hess  )
-   if (allocated(self%B    )) deallocate( self%B     )
-   if (allocated(self%eigv )) deallocate( self%eigv  )
-   if (allocated(self%coord)) deallocate( self%coord )
-   if (allocated(self%xyz  )) deallocate( self%xyz   )
-end subroutine deallocate_anc
+  subroutine deallocate_anc(self)
+    implicit none
+    class(optimizer),intent(inout) :: self
+    self%n = 0
+    self%n3 = 0
+    self%nvar = 0
+    if (allocated(self%hess)) deallocate (self%hess)
+    if (allocated(self%B)) deallocate (self%B)
+    if (allocated(self%eigv)) deallocate (self%eigv)
+    if (allocated(self%coord)) deallocate (self%coord)
+    if (allocated(self%xyz)) deallocate (self%xyz)
+    if (allocated(self%S)) deallocate (self%S)
+    if (allocated(self%Y)) deallocate (self%Y)
+    if (allocated(self%rho)) deallocate (self%rho)
+    if (allocated(self%alpha)) deallocate (self%alpha)
+    if (allocated(self%q)) deallocate(self%q)
+  end subroutine deallocate_anc
 
 !========================================================================================!
 !> @brief print information about current approximate normal coordinates to unit
-subroutine write_anc(self,iunit,comment)
-   implicit none
-   class(optimizer),   intent(in) :: self    !< approximate normal coordinates
-   integer,         intent(in) :: iunit   !< file handle
-   character(len=*),intent(in) :: comment !< name of the variable
-   character(len=*),parameter  :: dfmt = '(1x,a,1x,"=",1x,g0)'
-
-   write(iunit,'(72(">"))')
-   write(iunit,'(1x,"*",1x,a)') "Writing 'optimizer' class"
-   write(iunit,'(  "->",1x,a)') comment
-   write(iunit,'(72("-"))')
-   write(iunit,'(1x,"*",1x,a)') "status of the fields"
-   write(iunit,dfmt) "integer :: n           ",self%n
-   write(iunit,dfmt) "integer :: n3          ",self%n3
-   write(iunit,dfmt) "integer :: nvar        ",self%nvar
-   write(iunit,dfmt) "real    :: hlow        ",self%hlow
-   write(iunit,dfmt) "real    :: hmax        ",self%hmax
-   write(iunit,'(72("-"))')
-   write(iunit,'(1x,"*",1x,a)') "allocation status"
-   write(iunit,dfmt) "allocated? hess(:)     ",allocated(self%hess)
-   write(iunit,dfmt) "allocated? B(:)        ",allocated(self%B)
-   write(iunit,dfmt) "allocated? eigv(:)     ",allocated(self%eigv)
-   write(iunit,dfmt) "allocated? coord(:)    ",allocated(self%coord)
-   write(iunit,dfmt) "allocated? xyz(:,:)    ",allocated(self%xyz)
-   write(iunit,'(72("-"))')
-   write(iunit,'(1x,"*",1x,a)') "size of memory allocation"
-   if (allocated(self%hess)) then
-   write(iunit,dfmt) "size(1) :: hess(*)     ",size(self%hess,1)
-   endif
-   if (allocated(self%B)) then
-   write(iunit,dfmt) "size(1) :: B(*,:)      ",size(self%B,1)
-   write(iunit,dfmt) "size(2) :: B(:,*)      ",size(self%B,2)
-   endif
-   if (allocated(self%eigv)) then
-   write(iunit,dfmt) "size(1) :: eigv(*)     ",size(self%eigv,1)
-   endif
-   if (allocated(self%coord)) then
-   write(iunit,dfmt) "size(1) :: coord(*)    ",size(self%coord,1)
-   endif
-   if (allocated(self%xyz)) then
-   write(iunit,dfmt) "size(1) :: xyz(*,:)    ",size(self%xyz,1)
-   write(iunit,dfmt) "size(2) :: xyz(:,*)    ",size(self%xyz,2)
-   endif
-   write(iunit,'(72("<"))')
-end subroutine write_anc
+  subroutine write_anc(self,iunit,comment)
+    implicit none
+    class(optimizer),intent(in) :: self    !< approximate normal coordinates
+    integer,intent(in) :: iunit   !< file handle
+    character(len=*),intent(in) :: comment !< name of the variable
+    character(len=*),parameter  :: dfmt = '(1x,a,1x,"=",1x,g0)'
+
+    write (iunit,'(72(">"))')
+    write (iunit,'(1x,"*",1x,a)') "Writing 'optimizer' class"
+    write (iunit,'(  "->",1x,a)') comment
+    write (iunit,'(72("-"))')
+    write (iunit,'(1x,"*",1x,a)') "status of the fields"
+    write (iunit,dfmt) "integer :: n           ",self%n
+    write (iunit,dfmt) "integer :: n3          ",self%n3
+    write (iunit,dfmt) "integer :: nvar        ",self%nvar
+    write (iunit,dfmt) "real    :: hlow        ",self%hlow
+    write (iunit,dfmt) "real    :: hmax        ",self%hmax
+    write (iunit,'(72("-"))')
+    write (iunit,'(1x,"*",1x,a)') "allocation status"
+    write (iunit,dfmt) "allocated? hess(:)     ",allocated(self%hess)
+    write (iunit,dfmt) "allocated? B(:)        ",allocated(self%B)
+    write (iunit,dfmt) "allocated? eigv(:)     ",allocated(self%eigv)
+    write (iunit,dfmt) "allocated? coord(:)    ",allocated(self%coord)
+    write (iunit,dfmt) "allocated? xyz(:,:)    ",allocated(self%xyz)
+    write (iunit,'(72("-"))')
+    write (iunit,'(1x,"*",1x,a)') "size of memory allocation"
+    if (allocated(self%hess)) then
+      write (iunit,dfmt) "size(1) :: hess(*)     ",size(self%hess,1)
+    end if
+    if (allocated(self%B)) then
+      write (iunit,dfmt) "size(1) :: B(*,:)      ",size(self%B,1)
+      write (iunit,dfmt) "size(2) :: B(:,*)      ",size(self%B,2)
+    end if
+    if (allocated(self%eigv)) then
+      write (iunit,dfmt) "size(1) :: eigv(*)     ",size(self%eigv,1)
+    end if
+    if (allocated(self%coord)) then
+      write (iunit,dfmt) "size(1) :: coord(*)    ",size(self%coord,1)
+    end if
+    if (allocated(self%xyz)) then
+      write (iunit,dfmt) "size(1) :: xyz(*,:)    ",size(self%xyz,1)
+      write (iunit,dfmt) "size(2) :: xyz(:,*)    ",size(self%xyz,2)
+    end if
+    write (iunit,'(72("<"))')
+  end subroutine write_anc
 
 !========================================================================================!
 
-subroutine generate_anc_blowup(self,xyz,hess,pr,linear,fail)
-   implicit none
-   class(optimizer),intent(inout) :: self
-   real(wp),     intent(in)    :: xyz(3,self%n)
-   real(wp),     intent(inout) :: hess(self%n3,self%n3)
-   logical,      intent(in)    :: pr
-   logical,      intent(in)    :: linear
-   logical,      intent(out)   :: fail
+  subroutine generate_anc_blowup(self,xyz,hess,pr,linear,fail)
+    implicit none
+    class(optimizer),intent(inout) :: self
+    real(wp),intent(in)    :: xyz(3,self%n)
+    real(wp),intent(inout) :: hess(self%n3,self%n3)
+    logical,intent(in)    :: pr
+    logical,intent(in)    :: linear
+    logical,intent(out)   :: fail
 
-   real(wp),parameter   :: thr1 = 1.0e-10_wp
-   real(wp),parameter   :: thr2 = 1.0e-11_wp
-   integer, parameter   :: maxtry = 4
-   integer  :: i,itry
-   integer  :: nvar
-   integer  :: info
-   integer  :: lwork
-   integer  :: liwork
-   integer, allocatable :: iwork(:)
-   real(wp) :: elow,damp,thr
-   real(wp),allocatable :: aux(:)
+    real(wp),parameter   :: thr1 = 1.0e-10_wp
+    real(wp),parameter   :: thr2 = 1.0e-11_wp
+    integer,parameter   :: maxtry = 4
+    integer  :: i,itry
+    integer  :: nvar
+    integer  :: info
+    integer  :: lwork
+    integer  :: liwork
+    integer,allocatable :: iwork(:)
+    real(wp) :: elow,damp,thr
+    real(wp),allocatable :: aux(:)
 
-   !> LAPACK
-   external :: dsyevd
+    !> LAPACK
+    external :: dsyevd
 
-   fail = .false.
-   self%xyz = xyz
+    fail = .false.
+    self%xyz = xyz
 
-   thr = thr2
-   lwork  = 1 + 6*self%n3 + 2*self%n3**2
-   liwork = 8 * self%n3
+    thr = thr2
+    lwork = 1+6*self%n3+2*self%n3**2
+    liwork = 8*self%n3
 
-   allocate(iwork(liwork), source = 0 )
-   allocate(aux(lwork), source = 0.0_wp )
+    allocate (iwork(liwork),source=0)
+    allocate (aux(lwork),source=0.0_wp)
 
-   call dsyevd('V','U',self%n3,hess,self%n3,self%eigv, &
-      &        aux,lwork,iwork,liwork,info)
+    call dsyevd('V','U',self%n3,hess,self%n3,self%eigv, &
+       &        aux,lwork,iwork,liwork,info)
 
-   deallocate(aux,iwork)
+    deallocate (aux,iwork)
 
-   call detrotra8(linear,self%n,self%xyz,hess,self%eigv) 
+    call detrotra8(linear,self%n,self%xyz,hess,self%eigv)
 
-   elow = minval(self%eigv,mask=(abs(self%eigv) > thr1))
+    elow = minval(self%eigv,mask=(abs(self%eigv) > thr1))
 
-   damp = max(self%hlow - elow,0.0_wp)
-   where(abs(self%eigv) > thr2) self%eigv = self%eigv + damp
+    damp = max(self%hlow-elow,0.0_wp)
+    where (abs(self%eigv) > thr2) self%eigv = self%eigv+damp
 !   do i = 1, self%n3
 !      if (abs(self%eigv(i)) > thr2 ) self%eigv(i) = self%eigv(i) + damp
 !   enddo
 
-   if(pr)then
-      write(*,*) 'Shifting diagonal of input Hessian by ', damp
-      write(*,*) 'Lowest  eigenvalues of input Hessian'
-      write(*,'(6F12.6)')(self%eigv(i),i=1,min(18,self%n3))
-      write(*,*) 'Highest eigenvalues'
-      write(*,'(6F12.6)')(self%eigv(i),i=self%n3-5,self%n3)
-      write(*,*)
-   endif
-
-   fail = .true.
-   get_anc: do itry = 1, maxtry
+    if (pr) then
+      write (*,*) 'Shifting diagonal of input Hessian by ',damp
+      write (*,*) 'Lowest  eigenvalues of input Hessian'
+      write (*,'(6F12.6)') (self%eigv(i),i=1,min(18,self%n3))
+      write (*,*) 'Highest eigenvalues'
+      write (*,'(6F12.6)') (self%eigv(i),i=self%n3-5,self%n3)
+      write (*,*)
+    end if
+
+    fail = .true.
+    get_anc: do itry = 1,maxtry
       self%B = 0.0_wp
       self%hess = 0.0_wp
       nvar = 0
       ! take largest (positive) first
-      do i = self%n3, 1, -1
-         if (abs(self%eigv(i)) > thr .and. nvar < self%nvar) then
-            nvar = nvar+1
-            self%B(:,nvar) = hess(:,i)
-            self%hess(nvar+nvar*(nvar-1)/2) = &
-               min(max(self%eigv(i),self%hlow),self%hmax)
-         endif
-      enddo
-
-      if (nvar.ne.self%nvar) then
-         thr = thr * 0.1_wp
-         cycle get_anc
-      endif
+      do i = self%n3,1,-1
+        if (abs(self%eigv(i)) > thr.and.nvar < self%nvar) then
+          nvar = nvar+1
+          self%B(:,nvar) = hess(:,i)
+          self%hess(nvar+nvar*(nvar-1)/2) = &
+            min(max(self%eigv(i),self%hlow),self%hmax)
+        end if
+      end do
+
+      if (nvar .ne. self%nvar) then
+        thr = thr*0.1_wp
+        cycle get_anc
+      end if
 
       fail = .false.
       exit get_anc
-   enddo get_anc
+    end do get_anc
 
-   if (fail) then
-      if(pr) write(*,*) 'nvar, self%nvar',nvar,self%nvar
+    if (fail) then
+      if (pr) write (*,*) 'nvar, self%nvar',nvar,self%nvar
       return
-   end if
+    end if
 
-   call sort(self%n3,self%nvar,self%hess,self%B)
+    call sort(self%n3,self%nvar,self%hess,self%B)
 
-   self%coord = 0.0_wp
-   return
-end subroutine generate_anc_blowup
+    self%coord = 0.0_wp
+    return
+  end subroutine generate_anc_blowup
 
 !========================================================================================!
 
-subroutine generate_anc_packed(self,xyz,hess,pr,fail)
-   implicit none
-   class(optimizer),intent(inout) :: self
-   real(wp),     intent(in)    :: xyz(3,self%n)
-   real(wp),     intent(inout) :: hess(self%n3*(self%n3+1)/2)
-   logical,      intent(in)    :: pr
-   logical,      intent(out)   :: fail
-
-   real(wp),parameter   :: thr1 = 1.0e-10_wp
-   real(wp),parameter   :: thr2 = 1.0e-11_wp
-   integer, parameter   :: maxtry = 4
-   integer  :: i,itry
-   integer  :: nvar
-   integer  :: info
-   integer  :: lwork
-   integer  :: liwork
-   integer, allocatable :: iwork(:)
-   real(wp) :: elow,damp,thr
-   real(wp),allocatable :: aux(:)
-   real(wp),allocatable :: u(:,:)
-
-   !> LAPACK
-   external :: dspevd
-
-   self%xyz = xyz
-
-   thr = thr2
-   lwork  = 1 + 6*self%n3 + 2*self%n3**2
-   liwork = 8 * self%n3
-
-   allocate(iwork(liwork), source = 0 )
-   allocate(aux(lwork), source = 0.0_wp )
-   allocate(u(self%n3,self%n3), source = 0.0_wp )
-
-   call dspevd('V','U',self%n3,hess,self%eigv,u,self%n3, &
-      &        aux,lwork,iwork,liwork,info)
-
-   !elow = 1.0e+99_wp
-   elow = minval(self%eigv,mask=(abs(self%eigv) > thr1))
-   !do i = 1, self%n3
-   !   if (abs(self%eigv(i)) > thr1 ) elow = min(elow,self%eigv(i))
-   !enddo
-
-   damp = max(self%hlow - elow,0.0_wp)
-   where(abs(self%eigv) > thr2) self%eigv = self%eigv + damp
+  subroutine generate_anc_packed(self,xyz,hess,pr,fail)
+    implicit none
+    class(optimizer),intent(inout) :: self
+    real(wp),intent(in)    :: xyz(3,self%n)
+    real(wp),intent(inout) :: hess(self%n3*(self%n3+1)/2)
+    logical,intent(in)    :: pr
+    logical,intent(out)   :: fail
+
+    real(wp),parameter   :: thr1 = 1.0e-10_wp
+    real(wp),parameter   :: thr2 = 1.0e-11_wp
+    integer,parameter   :: maxtry = 4
+    integer  :: i,itry
+    integer  :: nvar
+    integer  :: info
+    integer  :: lwork
+    integer  :: liwork
+    integer,allocatable :: iwork(:)
+    real(wp) :: elow,damp,thr
+    real(wp),allocatable :: aux(:)
+    real(wp),allocatable :: u(:,:)
+
+    !> LAPACK
+    external :: dspevd
+
+    self%xyz = xyz
+
+    thr = thr2
+    lwork = 1+6*self%n3+2*self%n3**2
+    liwork = 8*self%n3
+
+    allocate (iwork(liwork),source=0)
+    allocate (aux(lwork),source=0.0_wp)
+    allocate (u(self%n3,self%n3),source=0.0_wp)
+
+    call dspevd('V','U',self%n3,hess,self%eigv,u,self%n3, &
+       &        aux,lwork,iwork,liwork,info)
+
+    !elow = 1.0e+99_wp
+    elow = minval(self%eigv,mask=(abs(self%eigv) > thr1))
+    !do i = 1, self%n3
+    !   if (abs(self%eigv(i)) > thr1 ) elow = min(elow,self%eigv(i))
+    !enddo
+
+    damp = max(self%hlow-elow,0.0_wp)
+    where (abs(self%eigv) > thr2) self%eigv = self%eigv+damp
 !   do i = 1, self%n3
 !      if (abs(self%eigv(i)) > thr2 ) self%eigv(i) = self%eigv(i) + damp
 !   enddo
 
-   if(pr)then
-      write(*,*) 'Shifting diagonal of input Hessian by ', damp
-      write(*,*) 'Lowest  eigenvalues of input Hessian'
-      write(*,'(6F12.6)')(self%eigv(i),i=1,min(18,self%n3))
-      write(*,*) 'Highest eigenvalues'
-      write(*,'(6F12.6)')(self%eigv(i),i=self%n3-5,self%n3)
-      write(*,*)
-   endif
-
-   fail = .true.
-   get_anc: do itry = 1, maxtry
+    if (pr) then
+      write (*,*) 'Shifting diagonal of input Hessian by ',damp
+      write (*,*) 'Lowest  eigenvalues of input Hessian'
+      write (*,'(6F12.6)') (self%eigv(i),i=1,min(18,self%n3))
+      write (*,*) 'Highest eigenvalues'
+      write (*,'(6F12.6)') (self%eigv(i),i=self%n3-5,self%n3)
+      write (*,*)
+    end if
+
+    fail = .true.
+    get_anc: do itry = 1,maxtry
       self%B = 0.0_wp
       self%hess = 0.0_wp
       nvar = 0
       ! take largest (positive) first
-      do i = self%n3, 1, -1
-         if (abs(self%eigv(i)) > thr .and. nvar < self%nvar) then
-            nvar = nvar+1
-            self%B(:,nvar) = u(:,i)
-            self%hess(nvar+nvar*(nvar-1)/2) = &
-               min(max(self%eigv(i),self%hlow),self%hmax)
-         endif
-      enddo
-
-      if (nvar.ne.self%nvar) then
-         thr = thr * 0.1_wp
-         cycle get_anc
-      endif
+      do i = self%n3,1,-1
+        if (abs(self%eigv(i)) > thr.and.nvar < self%nvar) then
+          nvar = nvar+1
+          self%B(:,nvar) = u(:,i)
+          self%hess(nvar+nvar*(nvar-1)/2) = &
+            min(max(self%eigv(i),self%hlow),self%hmax)
+        end if
+      end do
+
+      if (nvar .ne. self%nvar) then
+        thr = thr*0.1_wp
+        cycle get_anc
+      end if
 
       fail = .false.
       exit get_anc
 
-   enddo get_anc
+    end do get_anc
 
-  if (fail) then
-      if(pr) write(*,*) 'nvar, selv%nvar',nvar,self%nvar
+    if (fail) then
+      if (pr) write (*,*) 'nvar, selv%nvar',nvar,self%nvar
       return
-   end if
+    end if
 
-   call sort(self%n3,self%nvar,self%hess,self%B)
+    call sort(self%n3,self%nvar,self%hess,self%B)
 
-   self%coord = 0.0_wp
-   return
-end subroutine generate_anc_packed
+    self%coord = 0.0_wp
+    return
+  end subroutine generate_anc_packed
 
 !========================================================================================!
 
-pure subroutine sort(nat3,nvar,hess,b)
-   implicit none
-   integer :: ii,k,j,m,i
-   integer, intent(in)    :: nat3,nvar
-   real(wp),intent(inout) :: hess(nvar*(nvar+1)/2)
-   real(wp),intent(inout) :: b(nat3,nat3)
-   real(wp) :: pp,sc1
-   real(wp),allocatable   :: edum(:)
-   allocate( edum(nvar), source = 0.0_wp )
-
-   do k=1,nvar
-      edum(k)=hess(k+k*(k-1)/2)
-   enddo
+  pure subroutine sort(nat3,nvar,hess,b)
+    implicit none
+    integer :: ii,k,j,m,i
+    integer,intent(in)    :: nat3,nvar
+    real(wp),intent(inout) :: hess(nvar*(nvar+1)/2)
+    real(wp),intent(inout) :: b(nat3,nat3)
+    real(wp) :: pp,sc1
+    real(wp),allocatable   :: edum(:)
+    allocate (edum(nvar),source=0.0_wp)
+
+    do k = 1,nvar
+      edum(k) = hess(k+k*(k-1)/2)
+    end do
 !  sort
-   do ii = 2, nvar
-      i = ii - 1
+    do ii = 2,nvar
+      i = ii-1
       k = i
-      pp= edum(i)
-      do j = ii, nvar
-         if (edum(j) .gt. pp) cycle
-         k = j
-         pp= edum(j)
-      enddo
+      pp = edum(i)
+      do j = ii,nvar
+        if (edum(j) .gt. pp) cycle
+        k = j
+        pp = edum(j)
+      end do
       if (k .eq. i) cycle
       edum(k) = edum(i)
       edum(i) = pp
-      do m=1,nat3
-         sc1=b(m,i)
-         b(m,i)=b(m,k)
-         b(m,k)=sc1
-      enddo
-   enddo
-
-   do k=1,nvar
-      hess(k+k*(k-1)/2)=edum(k)
-   enddo
-   return
-end subroutine sort
+      do m = 1,nat3
+        sc1 = b(m,i)
+        b(m,i) = b(m,k)
+        b(m,k) = sc1
+      end do
+    end do
+
+    do k = 1,nvar
+      hess(k+k*(k-1)/2) = edum(k)
+    end do
+    return
+  end subroutine sort
 
 !========================================================================================!
 
-subroutine get_cartesian(self,xyz)
-   implicit none
-   class(optimizer),intent(in) :: self
-   integer :: m,i,j,k
-   real(wp),intent(out) :: xyz (3,self%n)
-   real(wp) :: dum
+  subroutine get_cartesian(self,xyz)
+    implicit none
+    class(optimizer),intent(in) :: self
+    integer :: m,i,j,k
+    real(wp),intent(out) :: xyz(3,self%n)
+    real(wp) :: dum
     external :: dgemv
 !>  generate cartesian displacement vector
-   xyz = self%xyz
-   call dgemv('n',self%n3,self%nvar,1.0_wp,self%B,self%n3,self%coord,1,1.0_wp,xyz,1)
-   return
-end subroutine get_cartesian
+    xyz = self%xyz
+    call dgemv('n',self%n3,self%nvar,1.0_wp,self%B,self%n3,self%coord,1,1.0_wp,xyz,1)
+    return
+  end subroutine get_cartesian
 
 !========================================================================================!
 
@@ -445,17 +466,17 @@ pure function get_averaged_energy(self) result(val)
 
     ! only apply it if sufficient number of points i.e. a "tail" can exist
     ! with the censo blockl = 8 default, this can first be effective in the second
-    if (self%nlog .lt. 3 * nav) then
+    if (self%nlog .lt. 3*nav) then
       val = self%elog(self%nlog)
     else
-      low = max(1,self%nlog - nav + 1)
+      low = max(1,self%nlog-nav+1)
       j = 0
       eav = 0
       do i = self%nlog,low,-1
-        j = j + 1
-        eav = eav + self%elog(i)
+        j = j+1
+        eav = eav+self%elog(i)
       end do
-      val = eav / float(j)
+      val = eav/float(j)
     end if
 
   end function get_averaged_energy
@@ -468,20 +489,20 @@ pure function get_averaged_gradient(self) result(deriv)
 
     ! only apply it if sufficient number of points i.e. a "tail" can exist
     ! with the censo blockl = 8 default, this can first be effective in the second
-    if (self%nlog .lt. 3 * nav) then
+    if (self%nlog .lt. 3*nav) then
       deriv = self%glog(self%nlog)
     else
-      low = max(1,self%nlog - nav + 1)
+      low = max(1,self%nlog-nav+1)
       j = 0
       gav = 0
       do i = self%nlog,low,-1
-        j = j + 1
-        gav = gav + self%glog(i)
+        j = j+1
+        gav = gav+self%glog(i)
       end do
       ! adjust the gradient norm to xtb "conventions" because e.g. a noisy
       ! DCOSMO-RS gradient for large cases can never (even on average)
       ! become lower than the "-opt normal" thresholds
-      deriv = gav / float(j) / 2.d0
+      deriv = gav/float(j)/2.d0
     end if
 
   end function get_averaged_gradient
@@ -493,7 +514,7 @@ pure subroutine set_eg_log(self,e,g)
     integer :: k,k2
     k = size(self%elog)
     if (self%nlog >= k) then
-      k2 = k + 1
+      k2 = k+1
       allocate (dum(k2))
       dum(1:k) = self%elog(1:k)
       call move_alloc(dum,self%elog)
@@ -501,12 +522,11 @@ pure subroutine set_eg_log(self,e,g)
       dum(1:k) = self%glog(1:k)
       call move_alloc(dum,self%glog)
     end if
-    self%nlog = self%nlog + 1
+    self%nlog = self%nlog+1
     self%elog(self%nlog) = e
     self%glog(self%nlog) = g
   end subroutine set_eg_log
 
-
 !========================================================================================!
 !========================================================================================!
 end module optimize_type
diff --git a/src/optimize/optutils.f90 b/src/optimize/optutils.f90
index ee943152..e9195874 100644
--- a/src/optimize/optutils.f90
+++ b/src/optimize/optutils.f90
@@ -334,7 +334,8 @@ subroutine print_optsummary(calc,tight,nvar,maxcycle,maxmicro, &
                                   '(10x,"│",3x,a,i18,      10x,"│")'
     character(len=*),parameter :: chrfmt = &
                                   '(10x,"│",3x,a,a18,      10x,"│")'
-
+    character(len=*),parameter :: chrfmt2 = &                          
+                                  '(10x,"│",3x,a,a14,      t63,"│")'  
 !>--- set params
     engine = calc%opt_engine
     iupdat = calc%iupdat
@@ -354,6 +355,8 @@ subroutine print_optsummary(calc,tight,nvar,maxcycle,maxmicro, &
       write (*,chrfmt) "algorithm         ","          L-BFGS"
     case (2)
       write (*,chrfmt) "algorithm         ","Rational Function"
+    case (3)
+      write (*,chrfmt) "algorithm         ","Quasi Newton"
     case (-1)
       write (*,chrfmt) "algorithm         ","Gradient Descent"
     end select
@@ -410,7 +413,7 @@ subroutine print_optsummary(calc,tight,nvar,maxcycle,maxmicro, &
         write (*,chrfmt) "Hessian update    ","schlegel"
       end select
     end if
-    write (*,chrfmt) "write crestopt.log",bool2string(wr)
+    write (*,chrfmt2) "write crestopt.log.xyz",bool2string(wr)
     if (linear) then
       write (*,chrfmt) "linear (good luck)",bool2string(linear)
     else
diff --git a/src/optimize/rfo.f90 b/src/optimize/rfo.f90
index fc97b5c6..a978999a 100644
--- a/src/optimize/rfo.f90
+++ b/src/optimize/rfo.f90
@@ -23,7 +23,7 @@
 !> This module implements a standard RFO algorithm (in Cart. coords)
 
 module rfo_module
-  use iso_fortran_env, only: wp=>real64, sp=>real32
+  use iso_fortran_env,only:wp => real64,sp => real32
   use crest_calculator
   use axis_module
   use strucrd
@@ -34,6 +34,8 @@ module rfo_module
   use modelhessian_module
   use hessupdate_module
   use optimize_utils
+  use hessian_reconstruct
+  use hr_utils
   implicit none
   private
 
@@ -45,7 +47,7 @@ module rfo_module
 !========================================================================================!
 !========================================================================================!
 
-  subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus)
+  subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus,logfile)
 !*************************************************************************
 !> subroutine rfopt
 !> Implementation of the standard rational function optimizer (RFO)
@@ -60,19 +62,21 @@ subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus)
 !>             on output final energy
 !>      grd  - Cartesian gradient
 !>       pr  - printout bool
-!>       wr  - logfile (crestopt.log) bool
+!>       wr  - logfile bool (name given by logfile, default crestopt.log.xyz)
 !>  iostatus - return status of the routine
 !>             (success=0, error<0, not converged>0)
+!>   logfile - name of the trajectory logfile to write when wr is set
 !!***********************************************************************
     implicit none
     !> INPUT/OUTPUT
     type(coord),intent(inout) :: mol
-    type(calcdata),intent(in) :: calc
+    type(calcdata),intent(inout) :: calc
     real(wp),intent(inout) :: etot
     real(wp),intent(inout) :: grd(3,mol%nat)
     logical,intent(in) :: pr
     logical,intent(in) :: wr
     integer,intent(out) :: iostatus
+    character(len=*),intent(in) :: logfile
     !> LOCAL
     integer  :: tight
     real(wp) :: eel
@@ -91,7 +95,7 @@ subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus)
     integer :: nvar,iter,nread,maxcycle,maxmicro,itry,maxopt,iupdat,iii
     integer :: id,ihess,error
     integer :: ilog,imax(3)
-    real(wp) :: depred,echng,alp,gnold,eold,gchng,dummy,dsnrm,maxd
+    real(wp) :: depred,echng,alp,alpold,gnold,eold,gchng,dummy,dsnrm,maxd
     real(wp),allocatable :: h(:,:)
     real(wp),allocatable :: b(:,:)
     real(wp),allocatable :: fc(:)
@@ -106,21 +110,30 @@ subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus)
     real(wp),allocatable :: gold(:)
     real(wp),allocatable :: displ(:)
     integer :: nvar1,npvar,npvar1
-    real(sp),allocatable :: eaug(:)
-    real(sp),allocatable :: Uaug(:,:)
-    real(sp),allocatable :: Aaug(:)
+    real(wp),allocatable :: eaug(:)
+    real(wp),allocatable :: Uaug(:,:)
+    real(wp),allocatable :: Aaug(:)
     type(convergence_log),allocatable :: avconv
     real(wp) :: U(3,3),x_center(3),y_center(3),rmsdval
     integer :: modef
     logical :: ex,converged,linear,exact
     logical :: econverged,gconverged,lowered
     real(wp) :: estart,esave
-    real(sp),parameter :: r4dum = 1.e-8
+    real(wp),parameter :: r4dum = 1.e-8
+    integer :: unit
+    real(wp), allocatable :: dx_test(:)
     !> LAPACK & BLAS
     external :: dgemv
     real(wp),external :: ddot
-    real(sp),external :: sdot
-
+    !real(sp),external :: sdot
+    real(wp),allocatable :: test_hess(:) !> only for testing
+    integer :: q,r,s !>only for testing
+    !>These are for spectral projection
+    real(wp), allocatable :: eigvec(:,:), eigval(:)
+    real(wp), allocatable :: work(:)
+    integer, allocatable :: iwork_spec(:)
+    integer :: lwork, liwork, info_spec
+    real(wp) :: elow, damp_spec, scale
 
     iostatus = 0
     fail = .false.
@@ -133,12 +146,13 @@ subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus)
     iupdat = calc%iupdat
     hlow = calc%hlow_opt !> 0.01 in ancopt, 0.002 too small
     hmax = calc%hmax_opt
-    maxdispl = calc%maxdispl_opt 
+    maxdispl = calc%maxdispl_opt
     gnorm = 0.0_wp
     depred = 0.0_wp
     echng = 0.0_wp
     alp = 1.0_wp
-    exact = calc%exact_rf
+    alpold = 1.0_wp
+    exact = calc%exact_rf .or. tight>0
 
 !> initial number of steps in relax() routine before
 !> new ANC are made by model Hessian
@@ -181,34 +195,38 @@ subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus)
     npvar = OPT%nvar*(nvar1)/2 !> packed size of Hessian (note the abuse of nvar1!)
     npvar1 = nvar1*(nvar1+1)/2 !> packed size of augmented Hessian
     allocate (Uaug(nvar1,1),eaug(nvar1),Aaug(npvar1))
-    allocate ( gold(OPT%nvar),displ(OPT%nvar),grd1(OPT%nvar),source=0.0_wp)
+    allocate (gold(OPT%nvar),displ(OPT%nvar),grd1(OPT%nvar),source=0.0_wp)
     !$omp end critical
 
 !>------------------------------------------------------------------------
 !>--- put the Hessian guess into the type
 !>------------------------------------------------------------------------
-   k = 0
-   do i = 1,nat3
-     do j = 1,i
-       k = k+1
-       if( i /= j )then
-         OPT%hess(k) = 0.0_wp
-       else
-         OPT%hess(k) = calc%hguess
-       endif
-     end do
-   end do
+    !k = 0
+    !do i = 1,nat3
+    !  do j = 1,i
+    !    k = k+1
+    !    if (i /= j) then
+    !      OPT%hess(k) = 0.0_wp
+    !    else
+    !      OPT%hess(k) = calc%hguess
+    !    end if
+    !  end do
+    !end do
+
+    call initialize_hessian(calc,calc%hess_init,mol%xyz,mol%nat,mol%at,OPT%hess(:),calc%hguess,pr) !>Need to add printout about how hessian is initialized!
 
 !>--- backup coordinates, and starting energy
     molopt%nat = mol%nat
     molopt%at = mol%at
     molopt%xyz = mol%xyz
+    molopt%wrextxyz = calc%logextxyz
     estart = etot
+    energy = etot
 
 !>--- initialize .log file, if desired
     ilog = 942
     if (wr) then
-      open (newunit=ilog,file='crestopt.log')
+      open (newunit=ilog,file=logfile)
     end if
 
 !>--- The ANCOPT iteration loop. "iter" is updated in relax() subroutine
@@ -299,16 +317,24 @@ subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus)
 
 !>--- dynamic scaling in dependence of grad norm
 !>--- if we are close to convergence we can take larger steps
-      alp = 1.0d-1
-      if (gnorm .lt. 0.002) then ! 0.002
-        alp = 1.5d-1 ! 1.5
-      endif
-      if (gnorm .lt. 0.0006) then
-        alp = 2.0d-1 ! 2
-      endif
-      if (gnorm .lt. 0.0003) then
-        alp = 3.0d-1 ! 3
-      endif
+      alpold = alp
+
+      !alp = 1.0d0
+      !if (gnorm .lt. 0.002) then ! 0.002
+      !  alp = 1.5d0 ! 1.5
+      !end if
+      !if (gnorm .lt. 0.0006) then
+      !  alp = 2.0d0 ! 2
+      !end if
+      !if (gnorm .lt. 0.0003) then
+      !  alp = 3.0d0 ! 3
+      !end if
+
+      
+      !alp = alp_generate(gnorm, calc%optlev,calc%opt_engine, calc%hess_init)
+      !write(stdout,*) alp
+      alp = 1.0_wp !The whole thing should be removed before merging!! Same for NR!
+      
 
 !>------------------------------------------------------------------------
 !> Update the Hessian
@@ -317,21 +343,28 @@ subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus)
 !>--- Hessian update, but only after first iteration (iter > 1)
         select case (iupdat)
         case (0)
-          call bfgs(OPT%nvar,gnorm,grd1,gold,displ,OPT%hess)
+          call bfgs(OPT%nvar,gnorm,grd1,gold,displ*alpold,OPT%hess)
         case (1)
-          call powell(OPT%nvar,gnorm,grd1,gold,displ,OPT%hess)
+          call powell(OPT%nvar,gnorm,grd1,gold,displ*alpold,OPT%hess)
         case (2)
-          call sr1(OPT%nvar,gnorm,grd1,gold,displ,OPT%hess)
+          call sr1(OPT%nvar,gnorm,grd1,gold,displ*alpold,OPT%hess)
         case (3)
-          call bofill(OPT%nvar,gnorm,grd1,gold,displ,OPT%hess)
+          call bofill(OPT%nvar,gnorm,grd1,gold,displ*alpold,OPT%hess)
         case (4)
-          call schlegel(OPT%nvar,gnorm,grd1,gold,displ,OPT%hess)
+          call schlegel(OPT%nvar,gnorm,grd1,gold,displ*alpold,OPT%hess)
         case default
           write (*,*) 'invalid hessian update selection'
           stop
         end select
       end if
 
+      !allocate(dx_test(size(displ)))
+      dx_test = displ*alpold
+
+      !allocate(calc%chess%H(nat3,nat3))
+      if (calc%full_HR) then
+        call dhtosq(nat3,calc%chess%H(:,:),OPT%hess(:))
+      end if
 !>------------------------------------------------------------------------
 !>  rational function (RF) method
 !>------------------------------------------------------------------------
@@ -343,24 +376,30 @@ subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus)
 !>     Aaug    Uaug       Uaug
 
 !>--- first, augment Hessian by gradient, everything packed, no blowup
-      Aaug(1:npvar) = real(OPT%hess(1:npvar),sp)
-      Aaug(npvar+1:npvar1-1) = real(grd1(1:OPT%nvar),sp)
-      Aaug(npvar1) = 0.0_sp
+      Aaug(1:npvar) = OPT%hess(1:npvar)
+      Aaug(npvar+1:npvar1-1) = grd1(1:OPT%nvar)
+      Aaug(npvar1) = 0.0_wp
 
 !>--- choose solver for the RF eigenvalue problem
       if (exact.or.nvar1 .lt. 50) then
-        call solver_sspevx(nvar1,r4dum,Aaug,Uaug,eaug,fail)
+        !if (iter .eq. 1) Uaug(:,1) = 0.0_wp
+        !  Uaug(:,1) = [-grd1(1:OPT%nvar),1.0_wp]
+        !  dsnrm = sqrt(ddot(nvar1,Uaug,1,Uaug,1))
+        !  Uaug = Uaug/dsnrm
+        !else
+          call solver_dspevx(nvar1,r4dum,Aaug,Uaug,eaug,fail)
+        !endif
       else
         !>--- steepest decent guess for displacement
         if (iter .eq. 1) then
-          Uaug(:,1) = [-real(grd1(1:OPT%nvar),sp),1.0_sp]
-          dsnrm = sqrt(sdot(nvar1,Uaug,1,Uaug,1))
-          Uaug = Uaug/real(dsnrm,sp)
+          Uaug(:,1) = [-grd1(1:OPT%nvar),1.0_wp]
+          dsnrm = sqrt(ddot(nvar1,Uaug,1,Uaug,1))
+          Uaug = Uaug/dsnrm
         end if
-        call solver_sdavidson(nvar1,r4dum,Aaug,Uaug,eaug,fail,.false.)
+        call solver_ddavidson(nvar1,r4dum,Aaug,Uaug,eaug,fail,.false.)
         !>--- if that failed, retry with better solver
         if (fail) then
-          call solver_sspevx(nvar1,r4dum,Aaug,Uaug,eaug,fail)
+          call solver_dspevx(nvar1,r4dum,Aaug,Uaug,eaug,fail)
         end if
       end if
 
@@ -372,7 +411,7 @@ subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus)
       end if
       displ(1:OPT%nvar) = Uaug(1:OPT%nvar,1)/Uaug(nvar1,1)
 
-!>--- rescale displacementaif necessary
+!>--- rescale displacement if necessary
       maxd = alp*sqrt(ddot(OPT%nvar,displ,1,displ,1))
       if (maxd > maxdispl) then
         if (pr) write (*,'(" * rescaling step by",f14.7)') maxdispl/maxd
@@ -460,9 +499,9 @@ subroutine rfopt(mol,calc,etot,grd,pr,wr,iostatus)
 
 !> deallocate data
     !$omp critical
-    if (allocated(gold)) deallocate(gold)
-    if (allocated(displ)) deallocate(displ)
-    if (allocated(grd1)) deallocate(grd1)
+    if (allocated(gold)) deallocate (gold)
+    if (allocated(displ)) deallocate (displ)
+    if (allocated(grd1)) deallocate (grd1)
     if (allocated(Uaug)) deallocate (Uaug)
     if (allocated(eaug)) deallocate (eaug)
     if (allocated(Aaug)) deallocate (Aaug)
diff --git a/src/parsing/CMakeLists.txt b/src/parsing/CMakeLists.txt
index 1b52b129..e5fd6286 100644
--- a/src/parsing/CMakeLists.txt
+++ b/src/parsing/CMakeLists.txt
@@ -18,6 +18,7 @@ set(dir "${CMAKE_CURRENT_SOURCE_DIR}")
 
 list(APPEND srcs
    "${dir}/confparse2.f90"
+   "${dir}/parse_hybrid.f90"
    "${dir}/constraining.f90"
    "${dir}/parse_block.f90"
    "${dir}/parse_calcdata.f90"
diff --git a/src/parsing/confparse2.f90 b/src/parsing/confparse2.f90
index 9eb8a4e7..dabe7602 100644
--- a/src/parsing/confparse2.f90
+++ b/src/parsing/confparse2.f90
@@ -42,6 +42,7 @@ subroutine parseinputfile(env,fname)
   use crest_data
   use crest_calculator,only:calcdata
   use dynamics_module,only:mddata
+  use bh_module,only:bh_class
 
   !> modules used for parsing the root_object
   use parse_keyvalue,only:keyvalue
@@ -50,7 +51,7 @@ subroutine parseinputfile(env,fname)
   use parse_maindata
   use parse_inputfile,only:parse_input
   use parse_calcdata,only:parse_calculation_data, &
-  &                         parse_dynamics_data
+  &                       parse_dynamics_data,parse_basinhopping_data
   !> Declarations
   implicit none
   type(systemdata),intent(inout) :: env
@@ -60,6 +61,7 @@ subroutine parseinputfile(env,fname)
   type(datablock) :: blk
   type(calcdata) :: newcalc
   type(mddata) :: mddat
+  type(bh_class) :: bh
   logical :: ex,l1,l2
   integer :: i,j,k,l
   integer :: readstatus
@@ -78,7 +80,7 @@ subroutine parseinputfile(env,fname)
   call dict%print2()
 
 !>--- sanity check for input files
-  readstatus = 0  !> has to remain 0, or something went wrong 
+  readstatus = 0  !> has to remain 0, or something went wrong
 
 !>--- parse all root-level key-value pairs
   do i = 1,dict%nkv
@@ -112,11 +114,17 @@ subroutine parseinputfile(env,fname)
     call env_mddat_specialcases(env)
   end if
 
+!>--- check for any basinhopping/MC setup
+  call parse_basinhopping_data(env,bh,dict,l1,readstatus)
+  if (l1) then
+    env%bh_ref = bh
+  end if
+
 !>--- terminate if there were any unrecognized keywords
-  if(readstatus /= 0)then
-    write(stdout, '(i0,a)') readstatus,' error(s) while reading input file'
+  if (readstatus /= 0) then
+    write (stdout,'(i0,a)') readstatus,' error(s) while reading input file'
     call creststop(status_config)
-  endif  
+  end if
 
 !>--- check for lwONIOM setup (will be read at end of confparse)
   do i = 1,dict%nblk
@@ -193,8 +201,7 @@ subroutine env_calcdat_specialcases(env)
   integer :: refine_lvl
 
   !> if this return is triggered, the program will fall back to GFN2 at some point
-  if(env%calc%ncalculations .lt. 1) return
-   
+  if (env%calc%ncalculations .lt. 1) return
 
   !> special case for GFN-FF calculations
   if (any(env%calc%calcs(:)%id == jobtype%gfnff)) then
@@ -209,13 +216,27 @@ subroutine env_calcdat_specialcases(env)
     do i = 1,env%calc%ncalculations
       refine_lvl = env%calc%calcs(i)%refine_lvl
       if (refine_lvl <= 0) cycle
-      if(allocated(env%refine_queue))then
+      if (refine_lvl >= refine%post_opt) cycle  !> post-search calcs handled via pqueue
+      if (allocated(env%refine_queue)) then
         if (any(env%refine_queue(:) == refine_lvl)) cycle
-      endif
+      end if
       call env%addrefine(refine_lvl)
     end do
   end if
 
+
+
+
+
+
+
+
+
+
+
+
+
+
 end subroutine env_calcdat_specialcases
 
 !========================================================================================!
@@ -235,15 +256,15 @@ subroutine env_mddat_specialcases(env)
   integer :: nac,ii,iac
 
 !>--- Check for MD-active only levels
-  if(allocated(env%mddat%active_potentials))then
+  if (allocated(env%mddat%active_potentials)) then
     nac = size(env%mddat%active_potentials)
-    do ii=1,nac
-    !>--- deactivate by default (the MD routine will set them to active automatically)  
-     iac = env%mddat%active_potentials(ii)
-     if(iac <= env%calc%ncalculations)then
-       env%calc%calcs(iac)%active = .false.
-     endif
-    enddo
-  endif
+    do ii = 1,nac
+      !>--- deactivate by default (the MD routine will set them to active automatically)
+      iac = env%mddat%active_potentials(ii)
+      if (iac <= env%calc%ncalculations) then
+        env%calc%calcs(iac)%active = .false.
+      end if
+    end do
+  end if
 
 end subroutine env_mddat_specialcases
diff --git a/src/parsing/constraining.f90 b/src/parsing/constraining.f90
index 43c62ce7..278fb835 100644
--- a/src/parsing/constraining.f90
+++ b/src/parsing/constraining.f90
@@ -326,7 +326,7 @@ end subroutine rdcoord_reduced
 subroutine sort_constraints(cts)
   use crest_data
   implicit none
-  type(constra) :: cts
+  type(legacy_constraints) :: cts
 
   character(len=128) :: atmp,btmp
   integer :: i,j
@@ -376,7 +376,7 @@ end subroutine sort_constraints
 subroutine read_constrainbuffer(fname,cts)
   use crest_data
   implicit none
-  type(constra) :: cts
+  type(legacy_constraints) :: cts
   character(len=*) :: fname
 
   character(len=128) :: atmp
@@ -418,7 +418,7 @@ end subroutine read_constrainbuffer
 subroutine write_cts(ich,cts)
   use crest_data
   implicit none
-  type(constra) :: cts
+  type(legacy_constraints) :: cts
   integer :: ich
   integer :: i
 !--- not really a "constraint", but convenient for the implementation:
@@ -455,7 +455,7 @@ end subroutine write_cts
 subroutine write_cts_NCI(ich,cts)
   use crest_data
   implicit none
-  type(constra) :: cts
+  type(legacy_constraints) :: cts
   integer :: ich
   integer :: i
 !---- do it only if constaints are given
@@ -476,7 +476,7 @@ end subroutine write_cts_NCI
 subroutine write_cts_NCI_pr(ich,cts)
   use crest_data
   implicit none
-  type(constra) :: cts
+  type(legacy_constraints) :: cts
   integer :: ich
   integer :: i
 !---- do it only if constaints are given
@@ -497,7 +497,7 @@ subroutine write_cts_biasext(ich,cts)
   use crest_data
   use iomod
   implicit none
-  type(constra) :: cts
+  type(legacy_constraints) :: cts
   integer :: ich
 !---- do it only if constaints are given
   if (cts%usermsdpot) then
@@ -758,7 +758,7 @@ end subroutine rdrcontrol
 subroutine write_cts_rcontrol(ich,cts)
   use crest_data
   implicit none
-  type(constra) :: cts
+  type(legacy_constraints) :: cts
   integer :: ich,i
   if (cts%ureactor) then
     do i = 1,cts%nrctrl
@@ -806,7 +806,7 @@ end subroutine rd_cbonds
 subroutine write_cts_CBONDS(ich,cts)
   use crest_data
   implicit none
-  type(constra) :: cts
+  type(legacy_constraints) :: cts
   integer :: ich
   integer :: i
 !---- do it only if constaints are given
@@ -826,7 +826,7 @@ end subroutine write_cts_CBONDS
 subroutine write_cts_DISP(ich,cts)
   use crest_data
   implicit none
-  type(constra) :: cts
+  type(legacy_constraints) :: cts
   integer :: ich
   character(len=40) :: dum
 !---- apply dispersion scaling factor (> xtb 6.4.0)
diff --git a/src/parsing/meson.build b/src/parsing/meson.build
index 54f932ca..f999512f 100644
--- a/src/parsing/meson.build
+++ b/src/parsing/meson.build
@@ -16,6 +16,7 @@
 
 srcs += files(
   'confparse2.f90',
+  'parse_hybrid.f90',
   'constraining.f90',
   'parse_block.f90',
   'parse_calcdata.f90',
diff --git a/src/parsing/parse_calcdata.f90 b/src/parsing/parse_calcdata.f90
index 00768671..e080517b 100644
--- a/src/parsing/parse_calcdata.f90
+++ b/src/parsing/parse_calcdata.f90
@@ -28,8 +28,9 @@ module parse_calcdata
   use crest_data
   use crest_calculator,only:calcdata,calculation_settings,jobtype,constraint,scantype
   use dynamics_module
+  use bh_module
   use gradreader_module,only:gradtype,conv2gradfmt
-  use tblite_api,only:xtblvl
+  use tblite_api,only:xtblvl,have_gxtb
   use strucrd,only:get_atlist,coord
   use axis_module
 
@@ -62,6 +63,7 @@ module parse_calcdata
 
   public :: parse_calculation_data
   public :: parse_dynamics_data
+  public :: parse_basinhopping_data
 
   character(len=*),parameter,private :: fmturk = '("unrecognized KEYWORD in ",a," : ",a)'
   character(len=*),parameter,private :: fmtura = '("unrecognized ARGUMENT : ",a)'
@@ -173,12 +175,14 @@ subroutine parse_setting_auto(env,job,kv,rd)
     type(keyvalue) :: kv
     logical,intent(out) :: rd
     logical :: ex
+    integer :: n
     rd = .true.
     select case (kv%key)
 
 !>--- floats
     case ('etemp')
       job%etemp = kv%value_f
+      job%etemp_user_set = .true.
     case ('accuracy')
       job%accuracy = kv%value_f
     case ('weight')
@@ -189,10 +193,22 @@ subroutine parse_setting_auto(env,job,kv,rd)
       job%proberad = kv%value_f
     case ('radscal','pvol_radscal')
       job%pvradscal = kv%value_f
+    case ('efield')
+      n = size(kv%value_fa,1)
+      if (n .ne. 3) then
+        !>--- keyword was recognized, but invalid argument supplied
+        write (stdout,fmtura) trim(kv%rawvalue)
+        call creststop(status_config)
+      end if
+      allocate (job%efield(3),source=0.0_wp)
+      job%efield(:) = kv%value_fa(:)
 
 !>--- integers
-    case ('uhf','multiplicity')
+    case ('uhf')
       job%uhf = kv%value_i
+      call job%sync_multiplicity()
+    case ('multiplicity','mult')
+      call job%set_multiplicity(kv%value_i)
     case ('chrg','charge')
       job%chrg = kv%value_i
     case ('id')
@@ -203,6 +219,10 @@ subroutine parse_setting_auto(env,job,kv,rd)
       job%ngrid = kv%value_i
     case ('vdwset','pvol_vdwset')
       job%vdwset = kv%value_i
+    case ('mlip_port','mlip_base_port')
+      job%MPAR%BASE_PORT = kv%value_i
+    case ('mlip_timeout','mlip_timeout_sec')
+      job%MPAR%TIMEOUT_SEC = kv%value_i
     case ('config')
       call job%addconfig(kv%value_ia)
 
@@ -241,15 +261,39 @@ subroutine parse_setting_auto(env,job,kv,rd)
         job%id = jobtype%gfnff
       case ('pvol','libpvol','pv')
         job%id = jobtype%libpvol
-      case ('gxtb_dev')  
-        job%id = jobtype%turbomole 
-        job%rdgrad = .true.       
-        job%binary = 'gxtb' 
-        job%other ='-grad'
+      case ('gxtb','g-xtb','gxtb-xtb')
+        if (have_gxtb) then
+          job%id = jobtype%tblite
+          job%tblitelvl = xtblvl%gxtb
+        else
+          job%id = jobtype%xtbsys
+          job%other = '--gxtb'
+        end if
+      case ('gxtb_dev')
+        if (have_gxtb) then
+          call gxtb_dev_warning()
+        else
+          job%id = jobtype%xtbsys
+          job%other = '--gxtb'
+        end if
       case ('none')
         job%id = jobtype%unknown
       case ('lj','lennard-jones')
         job%id = jobtype%lj
+      case ('modh')
+        job%id = jobtype%approxg
+      case ('rmsdbias','penalty')
+        job%id = jobtype%penalty
+        nullify (job%penalty%biaslist)
+      case ('mlip','fmlip_relay')
+        job%id = jobtype%mlip
+      case ('solvation','solvator')
+        job%id = jobtype%solvation
+        if (.not.allocated(job%solv)) allocate (job%solv)
+      case ('eeq','eeqbc','electrostatic')
+        job%id = jobtype%electrostatic
+        if (.not.allocated(job%eeq)) allocate (job%eeq)
+        if (kv%value_c /= 'electrostatic') job%eeq%charge_model = kv%value_c
       case default
         job%id = jobtype%unknown
         !>--- keyword was recognized, but invalid argument supplied
@@ -317,17 +361,37 @@ subroutine parse_setting_auto(env,job,kv,rd)
       case ('eeq','d4eeq')
         job%tblitelvl = xtblvl%eeq
         job%rdgrad = .false.
+      case ('gxtb','g-xtb')
+        job%tblitelvl = xtblvl%gxtb
       case default
         job%tblitelvl = xtblvl%unknown
         !>--- keyword was recognized, but invalid argument supplied
         write (stdout,fmtura) kv%value_c
         call creststop(status_config)
-
       end select
+
     case ('tblite_param')
       job%tbliteparam = kv%value_c
       job%tblitelvl = xtblvl%param
 
+    case ('mlip_backend')
+      job%MPAR%backend = kv%value_c
+
+    case ('mlip_modelpath')
+      job%MPAR%modelpath = kv%value_c
+
+    case ('mlip_modelsize','mlip_modelname')
+      job%MPAR%modelsize = kv%value_c
+
+    case ('mlip_device')
+      job%MPAR%device = kv%value_c
+
+    case ('mlip_uma_model','mlip_umamodel')
+      job%MPAR%umamodel = kv%value_c
+
+    case ('mlip_uma_task','mlip_umatask')
+      job%MPAR%umatask = kv%value_c
+
     case ('orca_cmd')
       job%id = jobtype%orca
       job%ORCA%cmd = kv%value_c
@@ -336,10 +400,29 @@ subroutine parse_setting_auto(env,job,kv,rd)
       job%id = jobtype%orca
       call job%ORCA%read(kv%value_c)
 
-    case ('gbsa','alpb','cpcm')
+    case ('gbsa','alpb','cpcm','cosmo','pcm')
       job%solvmodel = kv%key
       job%solvent = kv%value_c
 
+!>--- composite solvation calculator (method = "solvation") settings
+    case ('solvent')
+      if (.not.allocated(job%solv)) allocate (job%solv)
+      job%solv%solvent = kv%value_c
+    case ('solv_model')
+      if (.not.allocated(job%solv)) allocate (job%solv)
+      job%solv%smodel = kv%value_c
+    case ('solv_charges')
+      if (.not.allocated(job%solv)) allocate (job%solv)
+      job%solv%charge_model = kv%value_c
+    case ('solv_hbond')
+      if (.not.allocated(job%solv)) allocate (job%solv)
+      job%solv%do_hbond = kv%value_b
+
+!>--- charge-equilibration electrostatics calculator settings
+    case ('eeq_model','charge_model')
+      if (.not.allocated(job%eeq)) allocate (job%eeq)
+      job%eeq%charge_model = kv%value_c
+
     case ('refine','refinement')
       select case (kv%value_c)
       case ('sp','singlepoint')
@@ -348,6 +431,8 @@ subroutine parse_setting_auto(env,job,kv,rd)
         job%refine_lvl = refine%correction
       case ('opt','optimization')
         job%refine_lvl = refine%geoopt
+      case ('freq','frequencies','deltag')
+        job%refine_lvl = refine%deltaG
       case default
         job%refine_lvl = refine%non
         !>--- keyword was recognized, but invalid argument supplied
@@ -375,6 +460,21 @@ subroutine parse_setting_auto(env,job,kv,rd)
         call creststop(status_input)
       end if
 
+    case ('biasfile')
+      inquire (file=kv%value_c,exist=ex)
+      if (ex) then
+        job%penalty%biasfile = kv%value_c
+      else
+        write (stderr,'(a,a,a)') 'specified bias file ',kv%value_c,' does not exist'
+        call creststop(status_input)
+      end if
+
+    case ('penalty_kpush')
+      job%penalty%kpush = kv%value_f
+
+    case ('penalty_alpha')
+      job%penalty%alpha = kv%value_f
+
     case ('parametrisation')
       inquire (file=kv%value_c,exist=ex)
       if (ex) then
@@ -450,6 +550,10 @@ subroutine parse_setting_auto(env,job,kv,rd)
       job%apiclean = kv%value_b
     case ('lmo','lmocent')
       job%getlmocent = kv%value_b
+    case ('ceh_guess')
+      job%ceh_guess = kv%value_b
+    case ('spin_polarized')
+      job%spin_polarized = kv%value_b
 
     case default
       !>--- keyword not correctly read/found
@@ -510,10 +614,31 @@ subroutine parse_calc_auto(env,calc,kv,rd)
     case ('hguess')
       calc%hguess = kv%value_f  !> guess for the initial hessian
 
+    case ('opt_lval')
+      calc%L = kv%value_f !> Parameters for smooth function for stepsize control within optimizer
+
+    case ('opt_k')
+      calc%k = kv%value_f
+
+    case ('opt_shift')
+      calc%shift = kv%value_f
+
+    case ('scaling')
+      calc%scaling = kv%value_f
+
+    case ('doh_stepsize')
+      calc%doh_stepsize = kv%value_f
+
+    case ('chess_id_guess')
+      calc%chess_id_guess = kv%value_f
+
 !>--- integers
     case ('maxcycle')
       calc%maxcycle = kv%value_i  !> optimization max cycles
 
+    case ('chess_steps')
+      calc%hu_steps = kv%value_i
+
 !>--- strings
     case ('id','type')
       !> (OLD setting) calculation type
@@ -559,6 +684,8 @@ subroutine parse_calc_auto(env,calc,kv,rd)
         calc%opt_engine = 1
       case ('rfo','rfo-cart')
         calc%opt_engine = 2
+      case ('newton','nr')
+        calc%opt_engine = 3
       case ('gd','gradient descent')
         calc%opt_engine = -1
       case default
@@ -567,6 +694,98 @@ subroutine parse_calc_auto(env,calc,kv,rd)
         call creststop(status_config)
       end select
 
+    case ('hr_init','hr_initialization') !> here we set how the matrix for hessian reconstruction is initialized
+      select case (kv%value_c)
+      case ('identity')
+        calc%initialize_hr_type = 0
+      case ('gfnff','gfn-ff')
+        calc%initialize_hr_type = 1
+      case ('gfn0')
+        calc%initialize_hr_type = 2
+      case ('gfn1')
+        calc%initialize_hr_type = 3
+      case ('gfn2')
+        calc%initialize_hr_type = 4
+      case ('modhess')
+        calc%initialize_hr_type = 5
+      case default
+        !>--- keyword was recognized, but invalid argument supplied
+        write (stdout,fmtura) kv%value_c
+        call creststop(status_config)
+      end select
+
+    case ('gs_hess_type')
+      select case (kv%value_c)
+      case ('gfnff','gfn-ff')
+        calc%gs_hess_type = 1
+      case ('gfn0')
+        calc%gs_hess_type = 2
+      case ('gfn1')
+        calc%gs_hess_type = 3
+      case ('gfn2')
+        calc%gs_hess_type = 4
+      case ('modhess')
+        calc%gs_hess_type = 5
+      case default
+        !>--- keyword was recognized, but
+        write (stdout,fmtura) kv%value_c
+        call creststop(status_config)
+      end select
+
+    case ('modhess_type','mh_type') !> here we set how the matrix for hessian reconstruction is initialized
+      select case (kv%value_c)      !>maybe need to add another keywort for crosstesting hr and geopt -> No,
+      case ('lindh95')
+        calc%mh_type = 0
+      case ('lindh')
+        calc%mh_type = 1
+      case ('lindh07')
+        calc%mh_type = 2
+      case ('swart')
+        calc%mh_type = 3
+      case default
+        !>--- keyword was recognized, but invalid argument supplied
+        write (stdout,fmtura) kv%value_c
+        call creststop(status_config)
+      end select
+
+    case ('hess_init','hess_initialization') !> here we set how the hessian for optimization
+      select case (kv%value_c)
+      case ('identity')
+        calc%hess_init = 0
+      case ('gfnff','gfn-ff')
+        calc%hess_init = 1
+      case ('gfn0')
+        calc%hess_init = 2
+      case ('gfn1')
+        calc%hess_init = 3
+      case ('gfn2')
+        calc%hess_init = 4
+      case ('modhess')
+        calc%hess_init = 5
+      case default
+        !>--- keyword was recognized, but invalid argument supplied
+        write (stdout,fmtura) kv%value_c
+        call creststop(status_config)
+      end select
+
+    case ('hr_hess_update','hr_hu_update')
+      select case (kv%value_c) !> Hessian updates in hessian reconstruction
+      case ('bfgs')
+        calc%hr_hu_type = 0
+      case ('powell')
+        calc%hr_hu_type = 1
+      case ('sr1')
+        calc%hr_hu_type = 2
+      case ('bofill')
+        calc%hr_hu_type = 3
+      case ('schlegel')
+        calc%hr_hu_type = 4
+      case default
+        !>--- keyword was recognized, but invalid argument supplied
+        write (stdout,fmtura) kv%value_c
+        call creststop(status_config)
+      end select
+
     case ('freeze')
       call get_atlist(env%ref%nat,atlist,kv%value_c,env%ref%at)
       calc%nfreeze = count(atlist)
@@ -579,6 +798,18 @@ subroutine parse_calc_auto(env,calc,kv,rd)
     case ('exact_rf')
       calc%exact_rf = kv%value_b
 
+    case ('chess')
+      calc%do_HR = kv%value_b
+
+    case ('full_chess') !> Do Hessian Reconstruct with all optimization steps
+      calc%full_HR = kv%value_b
+
+    case ('deform_opt_hess')
+      calc%deform_opt_hess = kv%value_b
+
+    case ("g_sampling") !> Do sampling on free energy surface as approximated by lindh95 hessian
+      calc%g_sampling = kv%value_b
+
     case default
       rd = .false.
     end select
@@ -983,7 +1214,7 @@ subroutine parse_dynamics_data(env,mddat,dict,included,istat)
         included = .true.
         call parse_mddat(env,blk,mddat,istat)
       else if (blk%header == 'dynamics.meta') then
-        call parse_metadyn(blk,mddat,istat)
+        call parse_metadyn(env,blk,mddat,istat)
         included = .true.
       end if
     end do
@@ -1031,13 +1262,15 @@ subroutine parse_md_auto(env,mddat,kv,rd)
       mddat%active_potentials = kv%value_ia
 
     case ('includermsd','atlist+')
+      nat = env%ref%nat
       call get_atlist(nat,atlist,kv%rawvalue,env%ref%at)
-      if (.not.allocated(env%includeRMSD)) allocate (env%includeRMSD(nat),source=1)
+      if (.not.allocated(env%includeRMSD)) allocate (env%includeRMSD(nat),source=0)
       do j = 1,nat
         if (atlist(j)) env%includeRMSD(j) = 1
       end do
 
     case ('excludermsd','atlist-')
+      nat = env%ref%nat
       call get_atlist(nat,atlist,kv%rawvalue,env%ref%at)
       if (.not.allocated(env%includeRMSD)) allocate (env%includeRMSD(nat),source=1)
       do j = 1,nat
@@ -1046,6 +1279,7 @@ subroutine parse_md_auto(env,mddat,kv,rd)
 
     case ('length','length_ps')
       mddat%length_ps = kv%value_f
+      env%user_mdtime = .true.
     case ('dump')
       mddat%dumpstep = kv%value_f
     case ('hmass')
@@ -1056,6 +1290,20 @@ subroutine parse_md_auto(env,mddat,kv,rd)
       mddat%tsoll = kv%value_f
       mddat%thermostat = .true.
 
+    case ('thermostat')
+      select case (kv%value_c)
+      case ('off','nve')
+        mddat%thermotype = 'none'
+      case ('berendsen','langevin','bbk')
+        mddat%thermotype = trim(kv%value_c)
+      case ('bussi','bussi-donaido-parinello','bussi-parinello','csvr')
+        mddat%thermotype = 'bussi'
+      case default
+        write (stdout,fmtura) kv%value_c
+        call creststop(status_config)
+      end select
+      mddat%thermostat = .true.
+
     case ('shake')
       select case (kv%id)
       case (valuetypes%int)
@@ -1090,13 +1338,14 @@ end subroutine parse_md_auto
 
 !========================================================================================!
 
-  subroutine parse_metadyn(blk,mddat,istat)
+  subroutine parse_metadyn(env,blk,mddat,istat)
 !**************************************************
 !* The following routines are used to
 !* read information into the "metadynamics" object
 !* and add it to a mol.dynamics data object
 !***************************************************
     implicit none
+    type(systemdata),intent(inout) :: env
     type(datablock),intent(in) :: blk
     type(mddata),intent(inout) :: mddat
     integer,intent(inout) :: istat
@@ -1108,7 +1357,7 @@ subroutine parse_metadyn(blk,mddat,istat)
     success = .false.
     if (blk%header .ne. 'dynamics.meta') return
     do i = 1,blk%nkv
-      call parse_metadyn_auto(mtd,blk%kv_list(i),success,rd)
+      call parse_metadyn_auto(env,mtd,blk%kv_list(i),success,rd)
       if (.not.rd) then
         istat = istat+1
         write (stdout,fmturk) '[['//blk%header//']]-block',blk%kv_list(i)%key
@@ -1117,12 +1366,15 @@ subroutine parse_metadyn(blk,mddat,istat)
     if (success) call mddat%add(mtd)
     return
   end subroutine parse_metadyn
-  subroutine parse_metadyn_auto(mtd,kv,success,rd)
+  subroutine parse_metadyn_auto(env,mtd,kv,success,rd)
     implicit none
+    type(systemdata),intent(inout) :: env
     type(keyvalue) :: kv
     type(mtdpot) :: mtd
     logical,intent(inout) :: success
     logical,intent(out) :: rd
+    integer :: j,nat
+    logical,allocatable :: atlist(:)
     rd = .true.
 
     select case (kv%key)
@@ -1156,6 +1408,22 @@ subroutine parse_metadyn_auto(mtd,kv,success,rd)
       mtd%mtdtype = cv_rmsd_static
       mtd%biasfile = kv%value_c
 
+    case ('includermsd','atlist+')
+      nat = env%ref%nat
+      call get_atlist(nat,atlist,kv%rawvalue,env%ref%at)
+      if (.not.allocated(mtd%atinclude)) allocate (mtd%atinclude(nat),source=.false.)
+      do j = 1,nat
+        if (atlist(j)) mtd%atinclude(j) = .true.
+      end do
+
+    case ('excludermsd','atlist-')
+      nat = env%ref%nat
+      call get_atlist(nat,atlist,kv%rawvalue,env%ref%at)
+      if (.not.allocated(mtd%atinclude)) allocate (mtd%atinclude(nat),source=.true.)
+      do j = 1,nat
+        if (atlist(j)) mtd%atinclude(j) = .false.
+      end do
+
     case default
       rd = .false.
       return
@@ -1163,6 +1431,123 @@ subroutine parse_metadyn_auto(mtd,kv,success,rd)
 
   end subroutine parse_metadyn_auto
 
+!========================================================================================!
+
+  subroutine parse_basinhopping_data(env,bh,dict,included,istat)
+!**********************************************
+!* The following routines are used to
+!* read information into the "bh_class" object
+!**********************************************
+    implicit none
+    type(systemdata) :: env
+    type(bh_class) :: bh
+    type(root_object) :: dict
+    type(datablock) :: blk
+    type(calculation_settings) :: newjob
+    type(constraint) :: newcstr
+    integer :: i,j,k,l
+    logical,intent(out) :: included
+    integer,intent(inout) :: istat
+
+    included = .false.
+
+    do i = 1,dict%nblk
+      call blk%deallocate()
+      blk = dict%blk_list(i)
+      if (blk%header == 'basinhopping') then
+        included = .true.
+        call parse_bh_class(env,blk,bh,istat)
+      end if
+    end do
+    return
+  end subroutine parse_basinhopping_data
+  subroutine parse_bh_class(env,blk,bh,istat)
+    implicit none
+    type(systemdata),intent(inout) :: env
+    type(datablock),intent(in) :: blk
+    type(bh_class),intent(inout) :: bh
+    integer,intent(inout) :: istat
+    integer :: i,j,nat
+    logical :: rd
+    if (blk%header .ne. 'basinhopping') return
+
+    do i = 1,blk%nkv
+      call parse_bh_auto(env,bh,blk%kv_list(i),rd)
+      if (.not.rd) then
+        istat = istat+1
+        write (stdout,fmturk) '['//blk%header//']-block',blk%kv_list(i)%key
+      end if
+    end do
+    return
+  end subroutine parse_bh_class
+  subroutine parse_bh_auto(env,bh,kv,rd)
+    implicit none
+    type(systemdata),intent(inout) :: env
+    type(bh_class) :: bh
+    type(keyvalue) :: kv
+    logical,intent(out) :: rd
+    logical,allocatable :: atlist(:)
+    integer :: n,j
+    logical :: ex
+    rd = .true.
+
+    select case (kv%key)
+    case ('maxiter') !> these are NOT the BH steps!
+      bh%maxiter = max(1,kv%value_i)
+
+    case ('maxsave')
+      bh%maxsave = kv%value_i
+
+    case ('seed')
+      if (.not.allocated(bh%seed)) allocate (bh%seed)
+      bh%seed = kv%value_i
+
+    case ('step','stepsize')
+      select case (kv%id)
+      case (valuetypes%int)
+        bh%stepsize(1) = real(kv%value_i)
+      case (valuetypes%float)
+        bh%stepsize(1) = kv%value_f
+      case (valuetypes%float_array)
+        n = min(size(kv%value_fa,1),3)
+        bh%stepsize(1:n) = kv%value_fa(1:n)
+      case default
+        !>--- keyword was recognized, but invalid argument supplied
+        write (stdout,fmtura) kv%rawvalue
+        call creststop(status_config)
+      end select
+
+    case ('steps','maxsteps')  !> these are the BH steps
+      bh%maxsteps = kv%value_i
+
+    case ('steptype')
+      select case (kv%value_c)
+      case ('cartesian')
+        bh%steptype = 0
+      case ('internal')
+        bh%steptype = 1
+      case ('dihedral')
+        bh%steptype = 2
+      case ('intermol')
+        bh%steptype = 3
+      case default
+        write (stdout,fmtura) trim(kv%value_c)
+        call creststop(status_config)
+      end select
+
+    case ('temp','T')
+      bh%temp = kv%value_f
+
+    case ('parallel')
+      bh%parallel = kv%value_b
+
+    case default
+      rd = .false.
+      return
+    end select
+
+  end subroutine parse_bh_auto
+
 !========================================================================================!
 !========================================================================================!
 end module parse_calcdata
diff --git a/src/parsing/parse_hybrid.f90 b/src/parsing/parse_hybrid.f90
new file mode 100644
index 00000000..5a22b3b4
--- /dev/null
+++ b/src/parsing/parse_hybrid.f90
@@ -0,0 +1,191 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2024 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!> Routines for parsing and setting up hybrid two-level method combinations
+!> expressed as CLI arguments of the form A@B, A//B, A/sp/B, A/opt/B.
+
+module parse_hybrid
+  use crest_parameters
+  use crest_data
+  use crest_calculator,only:calcdata,calculation_settings
+  use iomod,only:lowercase
+  implicit none
+  private
+
+  public :: parse_hybrid_argument
+  public :: is_valid_method
+  public :: setup_hybrid_calc
+
+contains
+
+!========================================================================================!
+
+  subroutine parse_hybrid_argument(str,quality,workhorse,mode,iostat)
+  !***************************************************************
+  !* Parse a composite method argument of the form:
+  !*   A@B     → quality=A, workhorse=B, mode='at'  (post-search opt)
+  !*   A//B    → quality=A, workhorse=B, mode='sp'  (inline SP refine)
+  !*   A/sp/B  → quality=A, workhorse=B, mode='sp'
+  !*   A/opt/B → quality=A, workhorse=B, mode='opt' (inline geo-opt refine)
+  !* Returns iostat=0 on success, non-zero if not recognised.
+  !*
+  !* Input:
+  !*   str  - argument string (without leading dash)
+  !* Output:
+  !*   quality   - the higher-level method token (left of separator)
+  !*   workhorse - the fast workhorse method token (right of separator)
+  !*   mode      - 'at', 'sp', or 'opt'
+  !*   iostat    - 0 on success
+  !***************************************************************
+    implicit none
+    character(len=*),intent(in) :: str
+    character(len=:),intent(out),allocatable :: quality,workhorse
+    character(len=4),intent(out) :: mode
+    integer,intent(out) :: iostat
+    integer :: k
+    character(len=:),allocatable :: s
+
+    iostat = 1
+    quality = ''
+    workhorse = ''
+    mode = ''
+    s = lowercase(trim(str))
+
+  ! ── try each separator in order of specificity ────────────────
+    k = index(s,'/opt/')
+    if (k > 0) then
+      quality   = s(1:k-1)
+      workhorse = s(k+5:)
+      mode = 'opt'
+    end if
+    if (mode == '') then
+      k = index(s,'/sp/')
+      if (k > 0) then
+        quality   = s(1:k-1)
+        workhorse = s(k+4:)
+        mode = 'sp'
+      end if
+    end if
+    if (mode == '') then
+      k = index(s,'//')
+      if (k > 0) then
+        quality   = s(1:k-1)
+        workhorse = s(k+2:)
+        mode = 'sp'
+      end if
+    end if
+    if (mode == '') then
+      k = index(s,'@')
+      if (k > 0) then
+        quality   = s(1:k-1)
+        workhorse = s(k+1:)
+        mode = 'at'
+      end if
+    end if
+
+    if (mode == '') return
+
+    if (.not.is_valid_method(quality)) return
+    if (.not.is_valid_method(workhorse)) return
+    iostat = 0
+  end subroutine parse_hybrid_argument
+
+!========================================================================================!
+
+  logical function is_valid_method(token)
+  !*************************************************
+  !* Returns .true. if token names a supported method.
+  !*************************************************
+    implicit none
+    character(len=*),intent(in) :: token
+    select case (lowercase(trim(token)))
+    case ('gfn0','gfn1','gfn2','gxtb','gfnff','gff')
+      is_valid_method = .true.
+    case default
+      is_valid_method = .false.
+    end select
+  end function is_valid_method
+
+!========================================================================================!
+
+  subroutine setup_hybrid_calc(env,workhorse_str,quality_str,mode)
+  !*******************************************************************
+  !* Set up a two-level calcdata from a hybrid method pair.
+  !*  workhorse → primary calc (refine_lvl=0, runs during iMTD-GC)
+  !*  quality   → secondary calc:
+  !*               mode='sp'  → refine_lvl=singlepoint (inline SP)
+  !*               mode='opt' → refine_lvl=geoopt      (inline opt)
+  !*               mode='at'  → refine_lvl=post_opt    (post-search + pqueue 51)
+  !*
+  !* Input:
+  !*   workhorse_str - method string for the fast workhorse (e.g. 'gfnff')
+  !*   quality_str   - method string for the quality level  (e.g. 'gfn2')
+  !*   mode          - 'sp', 'opt', or 'at'
+  !*******************************************************************
+    implicit none
+    type(systemdata),intent(inout) :: env
+    character(len=*),intent(in) :: workhorse_str,quality_str,mode
+    type(calculation_settings) :: cal_work,cal_qual
+    integer :: rlvl
+
+    select case (trim(mode))
+    case ('sp');  rlvl = refine%singlepoint
+    case ('opt'); rlvl = refine%geoopt
+    case ('at');  rlvl = refine%post_opt
+    case default; rlvl = refine%singlepoint
+    end select
+
+  ! ── workhorse (active during normal search) ────────────────────
+    call cal_work%create(workhorse_str)
+    cal_work%chrg = env%chrg
+    cal_work%uhf  = env%uhf
+    cal_work%refine_lvl = 0
+    call cal_work%autocomplete(1)
+    call env%calc%add(cal_work)
+
+  ! ── quality level ──────────────────────────────────────────────
+    call cal_qual%create(quality_str)
+    cal_qual%chrg = env%chrg
+    cal_qual%uhf  = env%uhf
+    cal_qual%refine_lvl = rlvl
+    call cal_qual%autocomplete(2)
+    call env%calc%add(cal_qual)
+
+  ! ── register refine_queue / pqueue ────────────────────────────
+    if (trim(mode) == 'at') then
+      call env%addjob(51)
+      call env%checkhy()
+      write(stdout,'(2x,a,"@",a,a)') trim(quality_str),trim(workhorse_str), &
+        & ' : post-search re-optimization of conformer ensemble'
+    else
+  !   Mirror what env2calc does for --refine: populate refine_queue now
+  !   so the inline refine path is active even without a TOML input file.
+      call env%addrefine(rlvl)
+      if (trim(mode) == 'opt') then
+        write(stdout,'(2x,a,"/opt/",a,a)') trim(quality_str),trim(workhorse_str), &
+          & ' : inline geometry refinement'
+      else
+        write(stdout,'(2x,a,"//",a,a)') trim(quality_str),trim(workhorse_str), &
+          & ' : inline singlepoint re-ranking'
+      end if
+    end if
+  end subroutine setup_hybrid_calc
+
+!========================================================================================!
+end module parse_hybrid
diff --git a/src/parsing/parse_maindata.f90 b/src/parsing/parse_maindata.f90
index a192a973..0284ff3f 100644
--- a/src/parsing/parse_maindata.f90
+++ b/src/parsing/parse_maindata.f90
@@ -26,10 +26,9 @@ module parse_maindata
   use crest_parameters
   !> modules for data storage in crest
   use crest_data
-  use crest_restartlog
   use strucrd,only:coord
+  use molecule_parameters,only:extxyz_units_global
   !> modules used for parsing the root_object
-  !>
   use parse_keyvalue,only:keyvalue,valuetypes
   use parse_block,only:datablock
   use parse_datastruct,only:root_object
@@ -72,6 +71,15 @@ subroutine parse_main_auto(env,kv,istat)
       select case (kv%key)
       case ('optlev','ancopt_level')
         env%optlev = optlevnum(kv%rawvalue)
+
+      case ('split')
+        if (kv%id .ne. valuetypes%int_array.or. &
+          & kv%na < 3) then
+          write (stdout,'(a)') '**ERROR** "split" must be a list of at least 3 integers'
+          call creststop(status_config)
+        end if
+        call env%addsplitqueue(kv%value_ia)
+
       case default
         istat = istat+1
       end select
@@ -175,17 +183,48 @@ subroutine parse_main_c(env,key,val,rd)
         env%preopt = .false.
         env%crestver = crest_mecp
         env%runver = crest_mecp
-      case ('imtd-gc')
+      case ('imtd-gc','mtd_search')
         env%preopt = .true.
         env%crestver = crest_imtd
         env%runver = 1
-      case ('nci-mtd','nci')
+      case ('mtd_search_quick')
+        env%preopt = .true.
+        env%crestver = crest_imtd
+        env%quick = .true.
+        env%runver = 2
+        env%ewin = 5.0d0
+        env%optlev = 1.0d0    !> optlev tight for quick run
+      case ('mtd_search_mquick')
+        env%preopt = .true.
+        env%crestver = crest_imtd
+        env%rotamermds = .false.      !> no NORMMD
+        env%performCross = .false.    !> no GC
+        env%quick = .true.            !> MTD settings from the quick-mode
+        env%superquick = .true.       !> use user-set opt level in Multilevel opt.
+        env%Maxrestart = 1            !> only one MTD iteration
+        env%runver = 6
+        env%optlev = 0.0d0  !> user-set opt level
+        env%ewin = 2.5d0              !> smaller energy window
+      case ('mtd_search_squick')
+        env%preopt = .true.
+        env%crestver = crest_imtd
+        env%rotamermds = .false.      !> no NORMMD
+        env%performCross = .false.    !> no GC
+        env%quick = .true.            !> MTD settings from the quick-mode
+        env%superquick = .true.       !> use user-set opt level in Multilevel opt.
+        env%runver = 5
+        env%optlev = 0.0d0            !> user-set opt level
+        env%ewin = 5.0d0              !> smaller energy window
+      case ('nci-mtd','nci','nci_search')
         env%NCI = .true.
         env%runver = 4
         env%autozsort = .false.
         env%performCross = .false.
         env%rotamermds = .false.
-      case ('entropy','imtd-smtd')
+        env%crestver = crest_imtd
+      case ('bh','gmin')
+        env%crestver = crest_bh
+      case ('entropy','imtd-smtd','entropy_search')
         env%crestver = crest_imtd  !> the entropy mode acts as subtype of the crest_imtd algo
         env%properties = abs(p_CREentropy)
         env%autozsort = .false.     !> turn off zsort (since we are not going to GC anyways)
@@ -219,6 +258,20 @@ subroutine parse_main_c(env,key,val,rd)
         env%properties = p_tautomerize
         env%crestver = crest_tautomerize
 
+      case ('thermo')
+        env%properties = p_thermo
+        env%crestver = crest_none
+        env%preopt = .false.
+
+      case ('cregen','sort')
+        env%preopt    = .false.
+        env%crestver  = crest_sorting
+        env%autozsort = .false.
+        if (val .eq. 'cregen') then
+          env%sortmode = 'cregen'
+          env%confgo   = .true.
+        end if
+
       case default
         !>--- keyword was recognized, but invalid argument supplied
         write (stdout,fmtura) val
@@ -241,6 +294,8 @@ subroutine parse_main_c(env,key,val,rd)
     case ('watlist','wat')
       env%potatlist = val
       env%wallsetup = .true.
+    case ('extxyz_units')
+      extxyz_units_global = trim(val)
     case default
       rd = .false.
     end select
@@ -262,10 +317,6 @@ subroutine parse_main_bool(env,key,val,rd)
       env%checktopo = val
     case ('notopo')
       env%checktopo = .not.val
-    case ('restart')
-      if (val) then
-        call read_restart(env)
-      end if
     case ('multilevelopt')
       env%multilevelopt = val
     case ('refine_presort')
@@ -293,8 +344,6 @@ subroutine parse_main_blk(env,blk,istat)
     select case (blk%header)
     case ('cregen')
       call parse_cregen(env,blk,istat)
-    case ('confsolv')
-      call parse_confsolv(env,blk,istat)
     case ('thermo')
       call parse_thermo(env,blk,istat)
     case ('protonation')
@@ -335,57 +384,6 @@ subroutine parse_cregen(env,blk,istat)
     end do
   end subroutine parse_cregen
 
-!========================================================================================!
-  subroutine parse_confsolv(env,blk,istat)
-    use ConfSolv_module
-    implicit none
-    type(systemdata) :: env
-    type(datablock) :: blk
-    type(keyvalue) :: kv
-    integer,intent(inout) :: istat
-    integer :: i
-!>--- add ConfSolv as refinement level to give a ΔΔGsoln
-    call env%addrefine(refine%ConfSolv)
-    env%ewin = 100.0_wp
-
-!>--- parse the arguments
-    do i = 1,blk%nkv
-      kv = blk%kv_list(i)
-      select case (kv%key)
-      case ('pid')
-        if (.not.allocated(cs_pid)) allocate (cs_pid)
-        cs_pid = kv%value_i
-      case ('bin')
-        cs_bin = trim(kv%value_c)
-      case ('port')
-        if (.not.allocated(cs_port)) allocate (cs_port)
-        cs_port = kv%value_i
-      case ('solvent')
-        !> to define a single solvent like: solvent = ['water','O']
-        if (kv%na == 2) then
-          cs_solvent = trim(kv%value_rawa(1))
-          cs_smiles = trim(kv%value_rawa(2))
-        else if (index(kv%value_c,'.csv') .ne. 0) then
-          cs_solvfile = kv%value_c
-        else
-          cs_solvent = kv%value_c
-        end if
-      case ('solvent_csv','solvfile')
-        cs_solvfile = kv%value_c
-      case ('solvent_name')
-        cs_solvent = kv%value_c
-      case ('solvent_smiles')
-        cs_smiles = kv%value_c
-      case ('model_path','param','checkpoint')
-        cs_param = kv%value_c
-      case default
-        !>--- unrecognized keyword
-        istat = istat+1
-        write (stdout,fmturk) '[confsolv]-block',kv%key
-      end select
-    end do
-  end subroutine parse_confsolv
-
 !========================================================================================!
 
   subroutine parse_thermo(env,blk,istat)
@@ -425,6 +423,19 @@ subroutine parse_thermo(env,blk,istat)
       case ('freq_input','vibs','hessian')
         env%thermo%vibfile = kv%value_c
         if (allocated(env%thermo%coords)) env%properties = p_thermo
+
+      case ('entropy_model','svib_model')
+        select case (kv%value_c)
+        case ('grimme')
+          env%thermo%emodel = kv%value_c
+        case ('truhlar') 
+          env%thermo%emodel = kv%value_c 
+          env%thermo%sthr = 100.0_wp
+        case default
+          write (stdout,fmtura) trim(kv%rawvalue)
+          call creststop(status_config)
+        end select
+
       case default
         !>--- unrecognized keyword
         istat = istat+1
diff --git a/src/parsing/parse_xtbinput.f90 b/src/parsing/parse_xtbinput.f90
index 197dafef..aa69f34a 100644
--- a/src/parsing/parse_xtbinput.f90
+++ b/src/parsing/parse_xtbinput.f90
@@ -1,7 +1,7 @@
 !================================================================================!
 ! This file is part of crest.
 !
-! Copyright (C) 2023 Philipp Pracht
+! Copyright (C) 2023-2025 Philipp Pracht
 !
 ! crest is free software: you can redistribute it and/or modify it under
 ! the terms of the GNU Lesser General Public License as published by
@@ -27,6 +27,7 @@
 module parse_xtbinput
   use crest_parameters
   use crest_data
+  use crest_calculator,only:calcdata
   use parse_datastruct
   use parse_keyvalue
   use parse_block
@@ -47,6 +48,8 @@ module parse_xtbinput
     module procedure :: parse_xtb_input_fallback
   end interface parse_xtbinputfile
 
+  public :: parse_constraints_from_cts
+
 !========================================================================================!
 !========================================================================================!
 contains  !> MODULE PROCEDURES START HERE
@@ -59,22 +62,26 @@ subroutine parse_xtb_inputfile(env,fname)
 !* and storing information in env
 !*********************************************
     implicit none
-    type(systemdata) :: env
-    character(len=*) :: fname
+    type(systemdata),intent(inout) :: env
+    character(len=*),intent(in)    :: fname
 
     type(root_object),allocatable,target :: dict
     type(datablock),pointer :: blk
     logical :: ex
     character(len=:),allocatable :: hdr
     integer :: i,j,k,l
+    type(coord) :: mol
 
     inquire (file=fname,exist=ex)
     if (.not.ex) return
 
-    allocate(dict)
+    allocate (dict)
     call parse_xtb_input_fallback(fname,dict)
     !call dict%print()
 
+    !> get the ref structure
+    call env%ref%to(mol)
+
     write (stdout,'(a,a,a)') 'Parsing xtb-type input file ',trim(fname), &
     & ' to set up calculators ...'
     !> iterate through the blocks and save the necessary information
@@ -83,13 +90,14 @@ subroutine parse_xtb_inputfile(env,fname)
       hdr = trim(blk%header)
       select case (hdr)
       case ('constrain')
-        call get_xtb_constraint_block(env,blk)
+        call get_xtb_constraint_block(env%calc,mol,blk)
       case ('wall')
-        call get_xtb_wall_block(env,blk)
+        call get_xtb_wall_block(env%calc,mol,env%potscal,blk)
       case ('fix')
-        call get_xtb_fix_block(env,blk)
+        call get_xtb_fix_block(env%calc,mol,blk)
       case ('metadyn')
-        call get_xtb_metadyn_block(env,blk)
+        call get_xtb_metadyn_block(env%calc,mol,env%mtd_kscal, &
+        & env%includeRMSD,env%rednat,blk)
       case default
         write (stdout,'(a,a,a)') 'xtb-style input block: "$',trim(hdr),'" not defined for CREST'
       end select
@@ -100,19 +108,20 @@ end subroutine parse_xtb_inputfile
 
 !========================================================================================!
 
-  subroutine get_xtb_constraint_block(env,blk)
+  subroutine get_xtb_constraint_block(calc,mol,blk)
 !********************************************************************
 !* This is the fallback reader for xtb input files to set up a dict
 !********************************************************************
     implicit none
-    type(systemdata),intent(inout) :: env
-    type(filetype) :: file
+    !> IN/OUTPUT
+    type(calcdata),intent(inout) :: calc
+    type(coord),intent(in) :: mol
+    type(datablock),intent(in),target :: blk
+    !> LOCAL
     integer :: i,j,k,io
     type(keyvalue),pointer :: kv
-    type(datablock),intent(in),target :: blk
     real(wp) :: force_constant,dist,angl
     real(wp) :: rdum
-    type(coord) :: mol
     type(coord) :: molref
     logical :: useref
     logical,allocatable :: pairwise(:)
@@ -138,7 +147,6 @@ subroutine get_xtb_constraint_block(env,blk)
 
       case ('reference')
         !> a reference geometry (must be the same molecule as the input)
-        call env%ref%to(mol)
         call molref%open(kv%rawvalue)
         if (any(mol%at(:) .ne. molref%at(:))) then
           write (stdout,'(a,/,a)') '**ERROR** while reading xtb-style input:',&
@@ -151,9 +159,6 @@ subroutine get_xtb_constraint_block(env,blk)
       end select
     end do
 
-!>--- get reference input geometry
-    call env%ref%to(mol)
-
 !>--- then the common constraints: distance, angle, dihedral
     do i = 1,blk%nkv
       kv => blk%kv_list(i)
@@ -163,7 +168,7 @@ subroutine get_xtb_constraint_block(env,blk)
         !> already read above
 
       case ('distance','bond')
-        if (kv%na .eq. 3 .or. kv%na .eq. 4) then
+        if (kv%na .eq. 3.or.kv%na .eq. 4) then
           read (kv%value_rawa(1),*,iostat=io) i1
           if (io == 0) read (kv%value_rawa(2),*,iostat=io) i2
           if (io == 0) then
@@ -180,12 +185,12 @@ subroutine get_xtb_constraint_block(env,blk)
             !if(io == 0 .and. kv%na == 4)then
             !  read (kv%value_rawa(3),*,iostat=io) rdum
             !endif
-            if(io == 0)then
+            if (io == 0) then
               call cons%deallocate()
               call cons%bondconstraint(i1,i2,dist,force_constant)
               if (debug) call cons%print(stdout)
-              call env%calc%add(cons)
-            endif
+              call calc%add(cons)
+            end if
           end if
         end if
 
@@ -207,7 +212,7 @@ subroutine get_xtb_constraint_block(env,blk)
             call cons%deallocate()
             call cons%angleconstraint(i1,i2,i3,angl,force_constant)
             if (debug) call cons%print(stdout)
-            call env%calc%add(cons)
+            call calc%add(cons)
           end if
         end if
 
@@ -230,7 +235,7 @@ subroutine get_xtb_constraint_block(env,blk)
             call cons%deallocate()
             call cons%dihedralconstraint(i1,i2,i3,i4,angl,force_constant)
             if (debug) call cons%print(stdout)
-            call env%calc%add(cons)
+            call calc%add(cons)
           end if
         end if
 
@@ -238,29 +243,30 @@ subroutine get_xtb_constraint_block(env,blk)
         read (kv%value_rawa(1),*,iostat=io) atm1
         if (io == 0) read (kv%value_rawa(2),*,iostat=io) atm2
         if (io == 0) read (kv%value_rawa(3),*,iostat=io) dum1
-        if(io==0)then
-        dum1 = dum1*aatoau
-        dum1 = max(0.0_wp,dum1) !> can't be negative
-        select case (kv%na)
-        case (3)
-          dum2 = huge(dum2)/3.0_wp !> some huge value
-          call cons%bondrangeconstraint(atm1,atm2,dum1,dum2)
-        case (4)
-          if (io == 0) read (kv%value_rawa(4),*,iostat=io) dum2
-          dum2 = dum2*aatoau
-          call cons%bondrangeconstraint(atm1,atm2,dum1,dum2)
-        case (5)
-          if (io == 0) read (kv%value_rawa(5),*,iostat=io) dum3
-          call cons%bondrangeconstraint(atm1,atm2,dum1,dum2,beta=dum3)
-        case (6)
-          if (io == 0) read (kv%value_rawa(6),*,iostat=io) dum4 
-          call cons%bondrangeconstraint(atm1,atm2,dum1,dum2,beta=dum3,T=dum4)
-        case default
-          error stop '**ERROR** wrong number of arguments in bondrange constraint'
-        end select
-        call env%calc%add(cons) 
-        if (debug) call cons%print(stdout)
-        endif
+        if (io == 0) then
+          dum1 = dum1*aatoau
+          dum1 = max(0.0_wp,dum1) !> can't be negative
+          select case (kv%na)
+          case (3)
+            dum2 = huge(dum2)/3.0_wp !> some huge value
+            call cons%bondrangeconstraint(atm1,atm2,dum1,dum2)
+          case (4)
+            if (io == 0) read (kv%value_rawa(4),*,iostat=io) dum2
+            dum2 = dum2*aatoau
+            call cons%bondrangeconstraint(atm1,atm2,dum1,dum2)
+          case (5)
+            if (io == 0) read (kv%value_rawa(5),*,iostat=io) dum3
+            call cons%bondrangeconstraint(atm1,atm2,dum1,dum2,beta=dum3)
+          case (6)
+            if (io == 0) read (kv%value_rawa(6),*,iostat=io) dum4
+            call cons%bondrangeconstraint(atm1,atm2,dum1,dum2,beta=dum3,T=dum4)
+          case default
+            error stop '**ERROR** wrong number of arguments in bondrange constraint'
+          end select
+          call calc%add(cons)
+          if (debug) call cons%print(stdout)
+        end if
+
       case ('atoms')
         if (.not.allocated(pairwise)) allocate (pairwise(mol%nat),source=.false.)
         call get_atlist(mol%nat,atlist,kv%rawvalue,mol%at)
@@ -296,10 +302,10 @@ subroutine get_xtb_constraint_block(env,blk)
       k = 0
       do i = 1,mol%nat
         do j = 1,i-1
-          if (pairwise(i).and.pairwise(j)) k = k +1
-        enddo
-      enddo
-      allocate(conslist(k))
+          if (pairwise(i).and.pairwise(j)) k = k+1
+        end do
+      end do
+      allocate (conslist(k))
       k = 0
       do i = 1,mol%nat
         do j = 1,i-1
@@ -309,42 +315,41 @@ subroutine get_xtb_constraint_block(env,blk)
             else
               dist = mol%dist(j,i)
             end if
-            k = k + 1
+            k = k+1
             !call cons%deallocate()
             call conslist(k)%bondconstraint(j,i,dist,force_constant)
             if (debug) call conslist(k)%print(stdout)
-            !call env%calc%add(cons)
           end if
         end do
       end do
-      call env%calc%add(k,conslist)
-      deallocate (conslist) 
+      call calc%add(k,conslist)
+      deallocate (conslist)
       deallocate (pairwise)
     end if
-
   end subroutine get_xtb_constraint_block
 
-  subroutine get_xtb_wall_block(env,blk)
+  subroutine get_xtb_wall_block(calc,mol,potscal,blk)
 !**************************************
 !* This is a reader for the $wall block
 !***************************************
     implicit none
-    type(systemdata),intent(inout) :: env
-    type(filetype) :: file
+    !> IN/OUTPUT
+    type(calcdata),intent(inout) :: calc
+    type(coord),intent(in) :: mol
+    real(wp),intent(inout) :: potscal
+    type(datablock),intent(in),target :: blk
+    !> LOCAL
     integer :: i,j,k,io
     type(keyvalue),pointer :: kv
-    type(datablock),intent(in),target :: blk
     real(wp) :: force_constant,dist,angl
     real(wp) :: T,alpha,beta
     real(wp) :: rdum,rabc(3),r1,r2,r3
-    type(coord) :: mol
-    logical,allocatable :: pairwise(:)
     logical,allocatable :: atlist(:)
     integer :: i1,i2,i3,i4
     integer :: pot
     type(constraint) :: cons
 
-    if(debug) write(*,*) 'parsing $wall block'
+    if (debug) write (*,*) 'parsing $wall block'
 
 !>--- asome defaults
     force_constant = 1.0_wp
@@ -353,9 +358,6 @@ subroutine get_xtb_wall_block(env,blk)
     T = 300.0_wp
     pot = 1 !> 1= polynomial, 2= logfermi
 
-!>--- get reference input geometry
-    call env%ref%to(mol)
-
 !>--- get the parameters first
     do i = 1,blk%nkv
       kv => blk%kv_list(i)
@@ -401,7 +403,7 @@ subroutine get_xtb_wall_block(env,blk)
         if (kv%na > 0) then
           if (trim(kv%value_rawa(1)) .eq. 'auto') then
             !> determine sphere
-            call wallpot_core(mol,rabc,potscal=env%potscal)
+            call wallpot_core(mol,rabc,potscal=potscal)
             rdum = maxval(rabc(:))
             rabc(:) = rdum
           else
@@ -417,15 +419,15 @@ subroutine get_xtb_wall_block(env,blk)
             call cons%ellipsoid(mol%nat,atlist,rabc,T,beta,.true.)
           end select
           if (debug) call cons%print(stdout)
-          call env%calc%add(cons)
+          call calc%add(cons)
         end if
 
       case ('ellipsoid')
-        if(debug) write(*,*) 'parsing ellipsoid',kv%na
+        if (debug) write (*,*) 'parsing ellipsoid',kv%na
         if (kv%na > 0) then
           if (trim(kv%value_rawa(1)) .eq. 'auto') then
             !> determine ellipsoid
-            call wallpot_core(mol,rabc,potscal=env%potscal)
+            call wallpot_core(mol,rabc,potscal=potscal)
           else
             read (kv%value_rawa(1),*,iostat=io) r1
             if (io == 0) read (kv%value_rawa(2),*,iostat=io) r2
@@ -445,7 +447,7 @@ subroutine get_xtb_wall_block(env,blk)
             call cons%ellipsoid(mol%nat,atlist,rabc,T,beta,.true.)
           end select
           if (debug) call cons%print(stdout)
-          call env%calc%add(cons)
+          call calc%add(cons)
         end if
 
       case default
@@ -453,31 +455,28 @@ subroutine get_xtb_wall_block(env,blk)
 
       end select
     end do
-
   end subroutine get_xtb_wall_block
 
-  subroutine get_xtb_fix_block(env,blk)
+  subroutine get_xtb_fix_block(calc,mol,blk)
 !**************************************
 !* This is a reader for the $fix block
 !***************************************
     implicit none
-    type(systemdata),intent(inout) :: env
-    type(filetype) :: file
+    !> IN/OUTPUT
+    type(calcdata),intent(inout) :: calc
+    type(coord),intent(in) :: mol
+    type(datablock),intent(in),target :: blk
+    !> LOCAL
     integer :: i,j,k,io
     type(keyvalue),pointer :: kv
-    type(datablock),intent(in),target :: blk
     real(wp) :: force_constant,dist,angl
     real(wp) :: T,alpha,beta
     real(wp) :: rdum,rabc(3),r1,r2,r3
-    type(coord) :: mol
     logical,allocatable :: pairwise(:)
     logical,allocatable :: atlist(:)
     integer :: i1,i2,i3,i4
     integer :: pot
 
-!>--- get reference input geometry
-    call env%ref%to(mol)
-
 !>--- get the parameters first
     do i = 1,blk%nkv
       kv => blk%kv_list(i)
@@ -517,7 +516,7 @@ subroutine get_xtb_fix_block(env,blk)
 
     if (allocated(pairwise)) then
       i1 = count(pairwise)
-      env%calc%nfreeze = i1
+      calc%nfreeze = i1
       if (debug) then
         write (stdout,'("> ",a)') 'Frozen atoms:'
         do i = 1,mol%nat
@@ -525,35 +524,33 @@ subroutine get_xtb_fix_block(env,blk)
         end do
         write (stdout,*)
       end if
-      call move_alloc(pairwise,env%calc%freezelist)
+      call move_alloc(pairwise,calc%freezelist)
     end if
-
   end subroutine get_xtb_fix_block
 
-
-
-  subroutine get_xtb_metadyn_block(env,blk)
+  subroutine get_xtb_metadyn_block(calc,mol,mtd_kscal,includeRMSD,rednat,blk)
 !**************************************
 !* This is a reader for the $metadyn block
 !***************************************
     implicit none
-    type(systemdata),intent(inout) :: env
-    type(filetype) :: file
+    !> IN/OUTPUT
+    type(calcdata),intent(inout) :: calc
+    type(coord),intent(in) :: mol
+    real(wp),intent(inout) :: mtd_kscal
+    integer,allocatable,intent(inout) :: includeRMSD(:)
+    integer,intent(inout) :: rednat
+    type(datablock),intent(in),target :: blk
+    !> LOCAL
     integer :: i,j,k,io
     type(keyvalue),pointer :: kv
-    type(datablock),intent(in),target :: blk
     real(wp) :: force_constant,dist,angl
     real(wp) :: T,alpha,beta
     real(wp) :: rdum,rabc(3),r1,r2,r3
-    type(coord) :: mol
     logical,allocatable :: pairwise(:)
     logical,allocatable :: atlist(:)
     integer :: i1,i2,i3,i4
     integer :: pot
 
-!>--- get reference input geometry
-    call env%ref%to(mol)
-
 !>--- get the parameters first
     do i = 1,blk%nkv
       kv => blk%kv_list(i)
@@ -584,12 +581,11 @@ subroutine get_xtb_metadyn_block(env,blk)
             if (i1 == mol%at(j)) pairwise(j) = .true.
           end do
         end if
-  
+
       case ('kscal')
         !> define a global metadynamics k-push scaling factor
-        read(kv%rawvalue,*) r1
-        env%mtd_kscal = r1
-
+        read (kv%rawvalue,*) r1
+        mtd_kscal = r1
 
       case default
         write (stdout,'(a,a,a)') 'xtb-style input key: "',kv%key,'" not defined for CREST'
@@ -606,17 +602,16 @@ subroutine get_xtb_metadyn_block(env,blk)
         end do
         write (stdout,*)
       end if
-      if(.not.allocated(env%includeRMSD)) allocate(env%includeRMSD(mol%nat), source=0)
-      do i=1,mol%nat
-         if(pairwise(i)) env%includeRMSD(i) = 1
-      enddo
-      env%rednat = i1
+      if (.not.allocated(includeRMSD)) allocate (includeRMSD(mol%nat),source=0)
+      do i = 1,mol%nat
+        if (pairwise(i)) includeRMSD(i) = 1
+      end do
+      rednat = i1
     end if
 
     call mol%deallocate()
   end subroutine get_xtb_metadyn_block
 
-
 !========================================================================================!
 
   subroutine parse_xtb_input_fallback(fname,dict)
@@ -737,7 +732,7 @@ subroutine get_xtb_keyvalue(kv,str,io)
     call kv%deallocate()
     io = 0
     tmpstr = adjustl(lowercase(str))
-    tmpstr_rc=adjustl(trim(str))
+    tmpstr_rc = adjustl(trim(str))
 
     !> key-value conditions
     l(1) = index(tmpstr,'=')
@@ -792,7 +787,6 @@ subroutine get_xtb_keyvalue(kv,str,io)
     end if
   end subroutine get_xtb_keyvalue
 
-
   subroutine get_xtb_rawa(kv,str,io)
     implicit none
     class(keyvalue),intent(inout) :: kv
@@ -803,7 +797,8 @@ subroutine get_xtb_rawa(kv,str,io)
     integer :: i,j,k,na,plast
     integer :: l(3)
 
-    if(allocated(kv%value_rawa)) deallocate(kv%value_rawa)
+    io = 0
+    if (allocated(kv%value_rawa)) deallocate (kv%value_rawa)
 
     vtmp = trim(adjustl(str))
 
@@ -910,5 +905,151 @@ subroutine clearxtbheader(hdr)
     return
   end subroutine clearxtbheader
 
+!============================================================================!
+
+  subroutine parse_constraints_from_cts(calc,mol,cts)
+!*********************************************
+!* Routine for parsing cts objects into calcdata
+!*********************************************
+    implicit none
+    !> IN/OUTPUT
+    type(calcdata),intent(inout) :: calc
+    class(coord),intent(inout) :: mol   !> polymorphic class(!) to use in qcg
+    type(legacy_constraints),intent(in) :: cts
+    !> LOCAL
+    type(root_object),allocatable,target :: dict
+    type(datablock),pointer :: blk
+    logical :: ex
+    character(len=:),allocatable :: hdr
+    integer :: i,j,k,l
+    !> some defaults/fallbacks
+    real(wp) :: potscal = 1.0_wp
+    integer :: rednat
+    integer,allocatable :: includeRMSD(:)
+    real(wp) :: mtd_kscal
+
+    allocate (dict)
+    !call parse_xtb_input_fallback(fname,dict)
+    call parse_cts_internal(cts,dict)
+    !call dict%print()
+
+    !write (stdout,'(a,a,a)') 'Parsing xtb-type constraints from internal backup to set up calculators ...'
+    !> iterate through the blocks and save the necessary information
+    do i = 1,dict%nblk
+      blk => dict%blk_list(i)
+      hdr = trim(blk%header)
+      select case (hdr)
+      case ('constrain')
+        call get_xtb_constraint_block(calc,mol,blk)
+      case ('wall')
+        call get_xtb_wall_block(calc,mol,potscal,blk)
+      case ('fix')
+        call get_xtb_fix_block(calc,mol,blk)
+      case ('metadyn')
+        call get_xtb_metadyn_block(calc,mol,mtd_kscal, &
+        & includeRMSD,rednat,blk)
+      case default
+        write (stdout,'(a,a,a)') 'xtb-style input block: "$',trim(hdr),'" not defined for CREST'
+      end select
+    end do
+
+    if (debug) stop
+  end subroutine parse_constraints_from_cts
+
+  subroutine parse_cts_internal(cts,dict)
+!********************************************************************
+!* This is the fallback reader for xtb constraints from cts to set up a dict
+!********************************************************************
+    implicit none
+    !> IN/OUTPUT
+    type(legacy_constraints),intent(in) :: cts
+    type(root_object),intent(out) :: dict
+    !> LOCAL
+    type(filetype) :: file
+    integer :: i,j,k,io,b
+    logical :: get_root_kv
+    type(keyvalue) :: kvdum
+    type(datablock) :: blkdum
+    character(len=:),allocatable :: dummy
+
+    call dict%new()
+!>--- parse cts into a "file" --> internal storage
+    k = 0
+    if (cts%used) then
+      do i = 1,cts%ndim
+        if (trim(cts%sett(i)) .ne. '') k = k+1
+      end do
+    end if
+    if (cts%NCI.and.allocated(cts%pots)) then
+      do i = 1,10
+        if (trim(cts%pots(i)) .ne. '') k = k+1
+      end do
+    end if
+    if (allocated(cts%cbonds)) then
+      do i = 1,cts%n_cbonds
+        if (trim(cts%cbonds(i)) .ne. '') k = k+1
+      end do
+    end if
+    b = 128
+    file%lwidth = b
+    dummy = repeat(' ',b+5)
+    file%nlines = k
+    file%current_line = 1
+    allocate (file%f(k),source=dummy)
+    k=0
+    if (cts%used) then
+      do i = 1,cts%ndim
+        if (trim(cts%sett(i)) .ne. '')then
+          k = k+1
+          file%f(k) = trim(cts%sett(i))
+        endif
+      end do
+    end if
+    if (cts%NCI.and.allocated(cts%pots)) then
+      do i = 1,10
+        if (trim(cts%pots(i)) .ne. '')then
+          k = k+1
+          file%f(k) = trim(cts%pots(i))
+        endif
+      end do
+    end if
+    if (allocated(cts%cbonds)) then
+      do i = 1,cts%n_cbonds
+        if (trim(cts%cbonds(i)) .ne. '')then
+          k = k+1
+          file%f(k) = trim(cts%cbonds(i))
+        endif
+      end do
+    end if
+
+    dict%filename = "internal cts"
+    call remove_comments(file)
+
+!>--- all valid key-values must be in $-blocks, no root-level ones
+    get_root_kv = .false.
+!>--- the loop where the input file is read
+    do i = 1,file%nlines
+      if (file%current_line > i) cycle
+      !> key-value pairs of the root dict (ignored for xtb)
+      if (get_root_kv) then
+        call get_keyvalue(kvdum,file%line(i),io)
+        if (io == 0) then
+          call dict%addkv(kvdum) !> add to dict
+        end if
+      end if
+
+      !> the $-blocks
+      if (isxtbheader(file%line(i))) then
+        get_root_kv = .false.
+        call read_xtbdatablock(file,i,blkdum)
+        call dict%addblk(blkdum) !> add to dict
+      end if
+    end do
+
+    call file%close()
+
+    return
+  end subroutine parse_cts_internal
+
 !========================================================================================!
 end module parse_xtbinput
diff --git a/src/printouts.f90 b/src/printouts.f90
index f34ceada..d9e8db25 100644
--- a/src/printouts.f90
+++ b/src/printouts.f90
@@ -60,8 +60,8 @@ subroutine confscript_head(vers)
   write (*,'(4x,a)') ' P.Pracht, S.Grimme, Universität Bonn, MCTC'
   write (*,'(3x,a)') 'with help from (alphabetical order):'
   write (*,'(4x,a)') ' C.Bannwarth, F.Bohle, S.Ehlert, G.Feldmann, J.Gorges,'
-  write (*,'(4x,a)') ' S.Grimme, C.Plett, P.Pracht, S.Spicher, P.Steinbach,'
-  write (*,'(4x,a)') ' P.Wesolowski, F.Zeller'
+  write (*,'(4x,a)') ' S.Grimme, C.Plett, P.Pracht, L.Rindt, S.Spicher,'
+  write (*,'(4x,a)') ' P.Steinbach, P.Wesolowski, F.Zeller'
   write (*,*)
 
   write (*,'(3x,a)') 'Online documentation is available at'
@@ -132,266 +132,396 @@ end subroutine disclaimer
 
 !=========================================================================================!
 
+subroutine help_section(title)
+  !*************************************
+  !* Print a colored section header.   *
+  !*************************************
+  use iomod,only:colorify
+  use crest_parameters,only:stdout
+  implicit none
+  character(len=*),intent(in) :: title
+  integer :: n
+  n = len_trim(title)
+  write (stdout,'(/,1x,a)') colorify(trim(title),'yellow')
+  write (stdout,'(1x,a)') colorify(repeat('─',n),'yellow')
+end subroutine help_section
+
+subroutine help_opt(flag,fw,desc)
+  !*********************************************************************
+  !* Print one colored flag + description, padding the flag column to  *
+  !* fw characters wide so descriptions align.                         *
+  !*********************************************************************
+  use iomod,only:colorify
+  use crest_parameters,only:stdout
+  implicit none
+  character(len=*),intent(in) :: flag,desc
+  integer,intent(in) :: fw
+  integer :: fl,pad
+  fl = len_trim(flag)
+  pad = max(fw-fl,1)
+  write (stdout,'(a,a,a,a,a)') '   ',colorify(trim(flag),'green'), &
+    & repeat(' ',pad),' : ',trim(desc)
+end subroutine help_opt
+
+!=========================================================================================!
+
 subroutine confscript_help()
-  use crest_data
+  use iomod,only:colorify
+  use crest_parameters,only:stdout
   implicit none
 
-  write (*,'(80("-"))')
-  write (*,*)
-  write (*,'(1x, ''Usage :'')')
-  write (*,'(1x, '' crest [input] [options]'')')
-  write (*,*)
-  write (*,'(1x, ''The [input] argument CAN be a coordinate file in the'')')
-  write (*,'(1x, ''TM (coord, Bohr) or Xmol (*.xyz, Ang.) format.'')')
-  write (*,'(1x, ''If no such file is present as the first argument crest will'')')
-  write (*,'(1x, ''automatically search for a file called "coord" in the TM format.'')')
-  write (*,*)
-  write (*,'(1x, ''Versions >3.0 allow specifying detailed input instructions via'')')
-  write (*,'(1x, ''input files in the TOML format.'')')
-  write (*,'(1x, ''*.toml files can be [input] or specified via "--input <file>"'')')
-  write (*,*)
+  write (stdout,'(/,1x,a)') colorify(repeat('─',76),'gold')
+  write (stdout,'(1x,a,a)') colorify('Usage:','yellow'),'  crest [INPUT] [OPTIONS]'
+  write (stdout,'(1x,a)') colorify(repeat('─',76),'gold')
+  write (stdout,*)
+  write (stdout,'(1x,a)') 'The '//colorify('[INPUT]','blue')//' argument CAN be a coordinate file in the'
+  write (stdout,'(1x,a)') 'TM (coord, Bohr) or Xmol (*.xyz, Ang.) format.'
+  write (stdout,'(1x,a)') 'If no such file is present as the first argument, crest will'
+  write (stdout,'(1x,a)') 'automatically search for a file called "coord" in the TM format.'
+  write (stdout,*)
+  write (stdout,'(1x,a)') colorify('Versions >3.0 allow specifying detailed input instructions via','green')
+  write (stdout,'(1x,a)') colorify('input files in the TOML format.','green')
+  write (stdout,'(1x,a)') colorify('*.toml files can be ','green')//colorify(' [INPUT]','blue')// &
+    colorify(' or specified via "--input <file>"','green')
+  write (stdout,*)
   call confscript_morehelp2()
   stop '   [-h] displayed. exit.'
 end subroutine confscript_help
 
 subroutine confscript_morehelp(flag)
-  use crest_data
+  use iomod,only:colorify
+  use crest_parameters,only:stdout
   implicit none
   character(len=*),intent(in) :: flag
+  integer :: fw
 
-  write (*,'(80("-"))')
-  write (*,*)
+  write (stdout,'(/,1x,a)') colorify(repeat('─',76),'gold')
+  write (stdout,*)
   select case (flag)
-  case default
-    write (*,'(/,1x,''General, technical, and calculation options:'')')
-    write (*,'(5x,''--input <file>     : Specify TOML file with detailed input instructions'')')
-    write (*,'(5x,''-T <int>           : Set total number of CPUs(threads)'')')
-    write (*,'(5x,''                     to be used. Parallel settings are then'')')
-    write (*,'(5x,''                     determined automatically for each step.'')')
-    write (*,'(5x,''                     If not set by "-T", this number is read'')')
-    write (*,'(5x,''                     from the OMP_NUM_THREADS global variable.'')')
-    write (*,'(5x,''-g <string>        : use GBSA implicit solvent'')')
-    write (*,'(5x,''                     for solvent <string>'')')
-    write (*,'(5x,''-alpb <string>     : use ALPB implicit solvent'')')
-    write (*,'(5x,''                     for solvent <string>'')')
-    write (*,'(5x,''-chrg <int>        : set the molecules´ charge'')')
-    write (*,'(5x,''-uhf <int>         : set <int>=Nα-Nβ electrons'')')
-    write (*,'(5x,''-charges <file>    : copy a existing atomic charges file for'')')
-    write (*,'(5x,''                     all optimizations (can be used by GFN-FF)'')')
-    write (*,'(5x,''-opt <"lev">       : set opt. level for ALL GFN-xTB'')')
-    write (*,'(5x,''                     optimizations.'')')
-    write (*,'(5x,''                     <lev>=vloose,loose,normal,tight,vtight'')')
-    write (*,'(5x,''                     [default: vtight]'')')
-    write (*,'(5x,''-gfn1              : use GFN1-xTB'')')
-    write (*,'(5x,''-gfn2              : use GFN2-xTB [default]'')')
-    write (*,'(5x,''-gfn0              : use GFN0-xTB'')')
-    write (*,'(5x,''-gff, -gfnff       : use GFN-FF (requires xtb 6.3 or newer)'')')
-    write (*,'(5x,''                     (for GFN-FF searches bond constraints are applied automatically)'')')
-    write (*,'(5x,''-gfn2//gfnff       : GFN2-xTB//GFN-FF composite mode)'')')
-    write (*,'(3x,''Adding additional constraints to the calculations:'')')
-    write (*,'(3x,''The user is able to include additional constraints to ALL'')')
-    write (*,'(3x,''xtb calculations that are conducted by CREST.'')')
-    write (*,'(5x,''-cinp <file>       : read in a file containing the constraints.'')')
-    write (*,'(5x,''                     constraints have to be in the same format as in xtb.'')')
-    write (*,'(5x,''                     (this was done previously via the ".constrains" file)'')')
-    write (*,'(5x,''-cbonds            : define automatic bond constraints (set up from topology)'')')
-    write (*,'(5x,''-nocbonds          : turn off -cbonds (for GFN-FF, mainly. see above)'')')
-    write (*,'(5x,''-fc <float>        : define force constant for defined constraints (-cbonds)'')')
-    write (*,'(5x,''-xnam <"bin">      : specify name of the xtb binary'')')
-    write (*,'(5x,''                     that should be used.'')')
-    write (*,'(5x,''-niceprint         : progress bar printout for optimizations'')')
-    write (*,'(5x,''-dry               : perform a "dry run". Only prints the settings'')')
-    write (*,'(5x,''                     that would be applied with the CMD input'')')
-    write (*,'(5x,''                     and stops the run before any calculations'')')
-    write (*,*)
 
+    ! ── General / technical ──────────────────────────────────────────────
+  case default
+    fw = 16
+    call help_section('Run modes:')
+    call help_opt('-sp',fw,'Single-point energy calculation')
+    call help_opt('-opt/-optimize',fw,'Geometry optimization')
+    call help_opt('-hess/-numhess',fw,'Numerical Hessian / vibrational frequencies')
+    call help_opt('-md/-dynamics',fw,'Molecular dynamics simulation')
+    call help_opt('-v3/-imtdgc',fw,'iMTD-GC conformational search  (see '//colorify('--help conf','gold')//')')
+    call help_opt('-v4/-entropy',fw,'Entropy/free-energy sampling  (see '//colorify('--help conf','gold')//')')
+    call help_opt('-mdopt',fw,'Ensemble optimization (no sorting)')
+    call help_opt('-screen',fw,'Ensemble screening')
+    call help_opt('-protonate',fw,'Protonation site search')
+    call help_opt('-deprotonate',fw,'Deprotonation site search')
+    call help_opt('-tautomerize',fw,'Tautomer generation')
+    call help_opt('-qcg',fw,'Quantum Cluster Growth workflows  (see '//colorify('--help qcg','gold')//')')
+    call help_opt('-msreact',fw,'MS fragment generator  (see '//colorify('--help msreact','gold')//')')
+    !call help_opt('-bh/-GMIN',fw,'Basin-hopping global optimization')
+    call help_opt('-sort/-cregen',fw,'Ensemble sorting, comparison, clustering  (see '//colorify('--help compare','gold')//')')
+    write (stdout,*)
+    fw = 22
+    call help_section('Method selection:')
+    call help_opt('-gfn2',fw,'Use GFN2-xTB  [default]')
+    call help_opt('-gfn1',fw,'Use GFN1-xTB')
+    call help_opt('-gfn0',fw,'Use GFN0-xTB')
+    call help_opt('-gff/-gfnff',fw,'Use GFN-FF  (bond constraints applied automatically)')
+    call help_opt('-gxtb',fw,'Use g-xTB  (requires special build)')
+    call help_opt('-orca <tmpl> <exe>',fw, &
+    & 'Use an ORCA driver: <tmpl> is an ORCA input template (EnGrad jobs only), <exe> the ORCA executable')
+    call help_opt('-mlip <backend>',fw, &
+    & 'Use an fmlip-relay ML potential: <backend> is uma (omol task) or maceoff (MACE-OFF23 medium)')
+    call help_opt('-A//B  -A/sp/B',fw,'sampling at B; inline SP re-ranking at A  (e.g. -gfn2//gfnff)')
+    call help_opt('-A/opt/B',fw,'sampling at B; inline geometry refinement at A')
+    call help_opt('-A@B',fw,'sampling at B; post-search re-optimization of ensemble at A')
+    write(stdout,'(9x,a)') 'A, B in: gfn0, gfn1, gfn2, gxtb, gfnff'
+    call help_opt('-rerank <method>',fw,'Post-search SP re-ranking of conformer ensemble at <method>')
+    call help_opt('-reopt <method>',fw,'Post-search geometry optimization of conformer ensemble at <method>')
+    call help_opt('-finalhess',fw,'Post-search Hessians on final ensemble, re-sort by Gibbs free energy')
+    call help_opt('-refine <method>',fw,'Post-process conformers at a higher level (single step)')
+    call help_opt('-optlev <level>',fw,'Optimization convergence level for ALL semiempirical calculations')
+    write (stdout,'(9x,a)') '<level> = crude, vloose, loose, normal, tight, vtight, extreme'
+    call help_opt('-dscal [<factor>]',fw,'Scale dispersion energy in MD/MTD simulations')
+    write (stdout,*)
+    fw = 22
+    call help_section('Molecular system:')
+    call help_opt('-T <int>',fw,'Number of CPU threads (or read from OMP_NUM_THREADS)')
+    call help_opt('-chrg <int>',fw,"Molecular charge")
+    call help_opt('-uhf <int>',fw,'Unpaired electrons (N_alpha - N_beta)')
+    call help_opt('-mult <int>',fw,'Spin multiplicity (2S+1 = uhf+1)')
+    call help_opt('-spin-polarized',fw,'Spin-polarized treatment (open-shell, tblite only)')
+    call help_opt('-g/-gbsa <solvent>',fw,'GBSA implicit solvation')
+    call help_opt('-alpb <solvent>',fw,'ALPB implicit solvation')
+    call help_opt('-efield <x> <y> <z>',fw,'External electric field in V/Ang along x, y, z')
+    call help_opt('-charges [<file>]',fw,'Read atomic partial charges from file  [default: "charges"]')
+    write (stdout,*)
+    fw = 22
+    call help_section('Technical:')
+    call help_opt('--input <file>',fw,'Specify TOML input file with detailed settings')
+    call help_opt('-xnam <bin>',fw,'Path to the xtb executable (when using xtb as backend)')
+    call help_opt('-noopt',fw,'Skip pre-optimization of the input structure')
+    call help_opt('-niceprint',fw,'Show progress bar during optimizations')
+    call help_opt('-dry',fw,'Parse args, print resolved settings, then exit')
+    call help_opt('-legacy',fw,'Force CREST < 3.0 behavior')
+    write (stdout,*)
+    fw = 22
+    call help_section('Constraints (applied to ALL calculations):')
+    call help_opt('-cinp <file>',fw,'Read constraints file  (xtb format; formerly ".constrains")')
+    call help_opt('-freeze <atoms>',fw,'Freeze atoms in optimizations/MD  (indices, ranges, or element symbols)')
+    call help_opt('-cbonds [<fc>]',fw,'Constrain all bonds globally  (set up from topology)')
+    call help_opt('-cbonds_md [<fc>]',fw,'Constrain all bonds during MDs/MTDs only')
+    call help_opt('-nocbonds',fw,'Disable automatic bond constraints')
+    call help_opt('-fc <float>',fw,'Global force constant for bond constraints')
+    write (stdout,*)
+
+    ! ── Ensemble comparison / CREGEN ─────────────────────────────────────
   case ('compare','cregen')
-    write (*,'(1x,''Options for ensemble comparisons:'')')
-    write (*,'(5x,''-cregen [file]     : use ONLY the CREGEN subroutine'')')
-    write (*,'(5x,''                     to sort a given ensemble file.'')')
-    write (*,'(5x,''-ewin <real>       : set energy window in kcal/mol,'')')
-    write (*,'(5x,''                     [default: 6.0 kcal/mol]'')')
-    write (*,'(5x,''-rthr <real>       : set RMSD threshold in Ang,'')')
-    write (*,'(5x,''                     [default: 0.125 Ang]'')')
-    write (*,'(5x,''-ethr <real>       : set E threshold in kcal/mol,'')')
-    write (*,'(5x,''                     [default: 0.05 kcal/mol]'')')
-    write (*,'(5x,''-bthr <real>       : set Rot. const. threshold ,'')')
-    write (*,'(5x,''                     [default: 0.01 (= 1%)]'')')
-    write (*,'(5x,''-pthr <real>       : Boltzmann population threshold'')')
-    write (*,'(5x,''                     [default: 0.05 (= 5%)]'')')
-    write (*,'(5x,''-temp <real>       : set temperature in cregen, [default: 298.15 K]'')')
-    write (*,'(5x,''-prsc              : create a scoord.* file for each conformer'')')
-    write (*,'(5x,''-nowr              : don´t write new ensemble files'')')
-    write (*,'(5x,''-eqv,-nmr,-entropy : compare nuclear equivalences (requires rotamers)'')')
-    write (*,'(5x,''-cluster <int>     : PCA and k-Means clustering of sorted ensemble.'')')
-    write (*,'(5x,''                     Works as extenstion to the CREGEN sorting.'')')
-    write (*,'(5x,''                     <int> is the number of clusters to be formed.'')')
-    write (*,'(5x,''-notopo            : turn off any topology checks in CREGEN.'')')
-    write (*,*)
-
+    fw = 22
+    call help_section('Ensemble sorting (CREGEN):')
+    call help_opt('-cregen [file]',fw,'Run CREGEN standalone to sort an ensemble file')
+    call help_opt('-sort <file>',fw,'Ensemble sorting (default: iRMSD-based conformer assignment)')
+    call help_opt('-sort <file> cregen',fw,'CREGEN sorting via --sort')
+    write (stdout,*)
+    call help_section('CREGEN thresholds:')
+    call help_opt('-ewin <real>',fw,'Energy window in kcal/mol  [default: 6.0]')
+    call help_opt('-rthr <real>',fw,'RMSD threshold in Ang  [default: 0.125]')
+    call help_opt('-ethr <real>',fw,'Energy threshold in kcal/mol  [default: 0.05]')
+    call help_opt('-bthr <real>',fw,'Rotational constant threshold  [default: 0.01 = 1%]')
+    call help_opt('-pthr <real>',fw,'Boltzmann population threshold (0-1)  [default: 0.05]')
+    call help_opt('-temp <real>',fw,'Boltzmann temperature in K  [default: 298.15]')
+    write (stdout,*)
+    call help_section('CREGEN algorithm options:')
+    call help_opt('-topo/-notopo',fw,'Enable/disable topology change check')
+    call help_opt('-ezcheck',fw,'Enable E/Z double-bond isomer check')
+    call help_opt('-heavy',fw,'Use heavy-atom-only RMSD')
+    call help_opt('-allrot',fw,'Use all three rotational constants (A, B, C)')
+    call help_opt('-eqv/-nmr',fw,'NMR nuclear equivalence analysis (requires rotamers)')
+    write (stdout,*)
+    call help_section('CREGEN output:')
+    call help_opt('-prsc',fw,'Write scoord.* file for each conformer')
+    call help_opt('-nowr',fw,"Skip writing the sorted ensemble file")
+    call help_opt('-osdf',fw,'Also write output ensemble in SDF format')
+    write (stdout,*)
+    call help_section('Structural comparison tools:')
+    call help_opt('-rmsd <f1> <f2>',fw,'RMSD between two structures')
+    call help_opt('-rmsdheavy <f1> <f2>',fw,'Heavy-atom RMSD between two structures')
+    call help_opt('-irmsd <f1> <f2>',fw,'iRMSD (iterative RMSD with atom permutation)')
+    call help_opt('-compare <f1> <f2>',fw,'Compare two ensembles for structural overlap')
+    write (stdout,'(11x,a)') colorify('-maxcomp <int>','green')//' : max structures per ensemble  [default: 100]'
+    write (stdout,*)
+    call help_section('PCA / k-Means clustering (CCEGEN):')
+    call help_opt('-sort <file> --cluster',fw,'Standalone PCA clustering of an ensemble')
+    call help_opt('-cluster [<N>]',fw,'PCA + k-Means clustering, optionally fix the cluster count')
+    call help_opt('-cluster <level>',fw,'Clustering level: loose, normal, tight, vtight')
+    call help_opt('-cluster incremental',fw,'Test cluster sizes incrementally (large ensembles)')
+    call help_opt('-pctype <type>',fw,'PCA descriptor: dihedral (default), zmat, cartesian, cma')
+    call help_opt('-pccap <int>',fw,'Cap the number of principal components  [default: 100]')
+    call help_opt('-nopcmin',fw,'Include all PCs (disable minimum eigenvalue cutoff)')
+    call help_opt('-pcaexclude <atoms>',fw,'Exclude specified atoms from the PCA')
+    write (stdout,*)
+
+    ! ── Conformer search / sampling ──────────────────────────────────────
   case ('conf','sampling')
-    write (*,'(1x,''Options for sampling workflows:'')')
-    write (*,'(5x,''-v1                : use the MF-MD-GC workflow. (OUTDATED)'')')
-    write (*,'(5x,''-v2                : use the MTD-GC workflow. (OUTDATED)'')')
-    write (*,'(5x,''-v3 (or -v2i)      : use the iMTD-GC workflow. [default]'')')
-    write (*,'(5x,''-v4                : use the iMTD-sMTD workflow.'')')
-    write (*,'(5x,''-entropy           : the same workflow as with "-v4", specialized'')')
-    write (*,'(5x,''                     for the calculation of conformational entropy.'')')
-    write (*,'(5x,''-nozs              : do not perform z-mat sorting [default]'')')
-    write (*,'(5x,''-cross             : do the GC part [default]'')')
-    write (*,'(5x,''-nocross           : don´t do the GC part'')')
-    write (*,'(5x,''-shake <int>       : set SHAKE mode for MD'')')
-    write (*,'(5x,''                     (0=off,1=H-only,2=all bonds) [default: 2]'')')
-    write (*,'(5x,''-tstep <int>       : set MD time step in fs'')')
-    write (*,'(5x,''                     [default: 5 fs]'')')
-    write (*,'(5x,''-mdlen/-len <real> : set MD length (all MTDs) in ps.'')')
-    write (*,'(5x,''                     Also possible are multiplicative factors'')')
-    write (*,'(5x,''                     for the default MD length with "x<real>"'')')
-    write (*,'(5x,''-mddump <int>      : xyz dumpstep to Trajectory in fs'')')
-    write (*,'(5x,''                     [default: 100 fs]'')')
-    write (*,'(5x,''-vbdump <real>     : set Vbias dump frequency in ps'')')
-    write (*,'(5x,''                     [default: 1.0 ps]'')')
-    write (*,'(5x,''-tnmd <real>       : set temperature for additional normal MDs'')')
-    write (*,'(5x,''                     [default: 400 K]'')')
-    write (*,'(5x,''-norotmd           : don´t do the regular MDs after the '')')
-    write (*,'(5x,''                     second multilevel optimization step'')')
-    write (*,'(5x,''-hflip/-noflip     : turn on/off a small enhancement routine to'')')
-    write (*,'(5x,''                     rotate OH groups after MTD. [default: OFF]'')')
-    write (*,'(5x,''-maxflip <int>     : max. number of new structures by the above'')')
-    write (*,'(5x,''                     enhancement routine. [default: 1000]'')')
-    write (*,'(5x,''-quick             : perform a search with reduced settings'')')
-    write (*,'(5x,''                     for a crude ensemble.'')')
-    write (*,'(5x,''-squick            : perform a even further reduced search'')')
-    write (*,'(5x,''-mquick            : perform a search with maximum reduced settings'')')
-    write (*,'(5x,''                     (do not reduce the settings more than that)'')')
-    write (*,'(5x,''-origin            : track the step of generation for'')')
-    write (*,'(5x,''                     each conformer/rotamer. [default]'')')
-    write (*,'(5x,''-keepdir           : keep sub-directories of the conformer'')')
-    write (*,'(5x,''                     generation step.'')')
-    write (*,'(5x,''-nci               : generate an ellipsoide potential around the'')')
-    write (*,'(5x,''                     input structure and add it to the MTD simulation.'')')
-    write (*,'(5x,''                     This can be used to find aggregates of NCI complexes.'')')
-    write (*,'(5x,''-wscal <real>      : scale the ellipsoide potential axes by factor <real>.'')')
-    write (*,*)
-
+    fw = 20
+    call help_section('Conformer search algorithms:')
+    call help_opt('-v3/-v2i',fw,'iMTD-GC (iterative MTD-GC)  [default]')
+    call help_opt('-v4',fw,'iMTD-sMTD (entropy-focused search)')
+    call help_opt('-entropy',fw,'Same as -v4, specialized for conformational entropy')
+
+    write (stdout,*)
+    call help_section('MD / MTD parameters:')
+    call help_opt('-len/-mdlen <t>[x]',fw,'MD/MTD length in ps; append "x" for a scaling factor')
+    call help_opt('-tstep <float>',fw,'MD timestep in fs  [default: 5 fs]')
+    call help_opt('-shake <int>',fw,'SHAKE mode: 0=off, 1=X-H only, 2=all bonds  [default: 1]')
+    call help_opt('-mdtemp <float>',fw,'Temperature for MTD runs in K')
+    call help_opt('-tnmd <float>',fw,'Temperature for extra normal MDs in K')
+    call help_opt('-mddump <int>',fw,'Trajectory dump interval in fs  [default: 100]')
+    call help_opt('-vbdump <real>',fw,'Vbias dump frequency in ps  [default: 1.0]')
+    call help_opt('-nmtd <int>',fw,'Number of MTD simulations per cycle')
+    write (stdout,*)
+    call help_section('Search control:')
+    call help_opt('-cross/-nocross',fw,'Enable/disable genetic structure crossing  [cross=default]')
+    call help_opt('-gcmax <int>',fw,'Max structures fed into genetic crossing')
+    call help_opt('-nozs',fw,'Disable z-matrix sorting')
+    call help_opt('-normmd [<n> [<T>]]',fw,'Run additional unbiased MDs on lowest conformers')
+    call help_opt('-quick/-squick/-mquick',fw,'Progressively reduced search settings')
+    call help_opt('-origin',fw,'Track conformer origin step  [default]')
+    call help_opt('-keepdir',fw,'Keep temporary working directories')
+    call help_opt('-NCI',fw,'NCI cluster mode (flat-bottom wall + specialised MTD settings)')
+    call help_opt('-wscal <float>',fw,'Scale wall potential sphere radius')
+    call help_opt('-hflip/-noflip',fw,'OH proton flip after MTD  [default: OFF]')
+    call help_opt('-maxflip <int>',fw,'Max OH flip attempts  [default: 1000]')
+    write (stdout,*)
+
+    ! ── Thermochemistry / entropy ─────────────────────────────────────────
   case ('thermo','entropy')
-    write (*,'(1x,''Thermostatistical options (used in entropy mode):'')')
-    write (*,'(5x,''-trange <lower> <upper> <step>   : entropies are calculated for different temperatures.'')')
-    write (*,'(5x,''                                   these are calculated in a temperature range from'')')
-    write (*,'(5x,''                                   <lower> to <upper> with <step> in between.'')')
-    write (*,'(5x,''                                   [default: 280K-380K in 10K steps]'')')
-    write (*,'(5x,''-fscal <float>     : frequency scaling factor. [default: 1.0]'')')
-    write (*,'(5x,''-sthr <float>      : vibrational/rotational entropy interpolation threshold (τ)'')')
-    write (*,'(5x,''                     [default: 25.0 cm^-1]'')')
-    write (*,'(5x,''-ithr <float>      : imaginary mode inversion cutoff [default: -50.0 cm^-1]'')')
-    write (*,'(5x,''-ptot <float>      : sum of population for structures considered in msRRHO average.'')')
-    write (*,'(5x,''                     [default: 0.9 (=90%)]'')')
-    write (*,*)
-
+    fw = 28
+    call help_section('Thermostatistical options:')
+    call help_opt('-trange <Tmin> <Tmax> <Tstep>',fw,'Temperature range in K for entropy output')
+    write (stdout,'(9x,a)') '[default: 280-380 K in 10 K steps]'
+    call help_opt('-tread <file>',fw,'Read temperatures (one per line) from file')
+    call help_opt('-fscal <float>',fw,'Frequency scaling factor  [default: 1.0]')
+    call help_opt('-sthr/-rotorcut <float>',fw,'Rotor cutoff in cm^-1 (free-rotor interpolation)  [default: 25.0]')
+    call help_opt('-ithr <float>',fw,'Imaginary mode inversion cutoff  [default: -50.0 cm^-1]')
+    call help_opt('-ptot <float>',fw,'Cumulative population threshold for msRRHO  [default: 0.9]')
+    call help_opt('-pcap <int>',fw,'Max structures used in property calculations')
+    call help_opt('-printpop',fw,'Print Boltzmann populations at every temperature')
+    call help_opt('-avbhess',fw,'Use Boltzmann-averaged Hessian in rrhoav')
+    write (stdout,*)
+
+    ! ── QCG ──────────────────────────────────────────────────────────────
   case ('qcg')
-    write (*,'(1x,''Quantum Cluster Growth (QCG)'')')
-    write (*,'(1x,''General usage :'')')
-    write (*,'(5x,''<solute> -qcg <solvent> [options]'')')
-    write (*,'(1x,''options (additionally to the iMTD-GC options above):'')')
-    write (*,'(5x,''-keepdir           : keep the tmp folder'')')
-    write (*,'(5x,''-nopreopt          : do not perform preoptimization (only for qcg).'')')
-    write (*,'(5x,''-xtbiff            : use the xTB-IFF standalone for docking of solvent'')')
-    write (*,'(5x,''-grow              : cluster generation'')')
-    write (*,'(5x,''-fixsolute         : fix the solute during the growth (recommended for rigid ones)'')')
-    write (*,'(5x,''                   : done automatically for water'')')
-    write (*,'(5x,''-nofix             : fix the solute not during the growth (needed only for water)'')')
-    write (*,'(5x,''-nsolv <INT>       : number of solvent molecules to add'')')
-    write (*,'(5x,''-normdock          : Perform a more extensive docking during grow'')')
-    write (*,'(5x,''-maxsolv           : set limit of convergence, if no number of solutes was given. Default 150 '')')
-    write (*,'(5x,''-wscal <FLOAT>     : Scaling factor for outer wall potential'')')
-    write (*,'(5x,''-samerand          : use same random number for every xtbiff run'')')
-    write (*,'(5x,''-fin_opt_gfn2      : perform GFN2-xTB optimizations for final grow and ensemble structures'')')
-    write (*,'(5x,''-directed <FILE>   : Perform directed solvation at positions defined in <FILE>'')')
-    write (*,'(5x,''-ensemble          : ensemble generation'')')
-    write (*,'(5x,''-qcgmtd            : NCI-MTD CREST ensemble generation (Default)'')')
-    write (*,'(5x,''-ncimtd            : NCI-MTD CREST ensemble generation'')')
-    write (*,'(5x,''-mtd               : MTD for QCG ensemble generation'')')
-    write (*,'(5x,''-md                : normal MD for QCG ensemble search'')')
-    write (*,'(5x,''-enslvl [method]   : define a method for ensemble search. All gfn methods are supported'')')
-    write (*,'(5x,''-clustering        : Turn on clustering for the ensemble search (only for qcgmtd and ncimtd'')')
-    write (*,'(5x,''-esolv             : reference cluster generation and comp. of solvation energy'')')
-    write (*,'(5x,''-gsolv             : reference cluster generation and comp. of solvation free energy'')')
-    write (*,'(5x,''-nclus             : defines how many clusters are taken for reference cluster generation'')')
-    write (*,'(5x,''                   : default 4'')')
-    write (*,'(5x,''-nocff             : switches off the CFF algorithm'')')
-    write (*,'(5x,''-freqscal          : defines frequency scale factor. Only for outprint'')')
-    write (*,'(5x,''-freqlvl [method]  : define a method for frequency computation. All gfn versions are supported'')')
-    write (*,*)
-
+    fw = 20
+    call help_section('Quantum Cluster Growth (QCG)')
+    write (stdout,'(1x,a)') 'General usage:  crest <solute> -qcg <solvent> [options]'
+    write (stdout,'(1x,a)') 'Options (in addition to general / iMTD-GC options):'
+    write (stdout,*)
+    call help_section('Cluster growth:')
+    call help_opt('-grow',fw,'Cluster generation run type')
+    call help_opt('-nsolv <int>',fw,'Number of solvent molecules to add')
+    call help_opt('-fixsolute',fw,'Fix the solute during growth  (auto for water)')
+    call help_opt('-nofix',fw,'Do not fix the solute  (override for water)')
+    call help_opt('-nopreopt',fw,'Skip pre-optimization')
+    call help_opt('-xtbiff',fw,'Use xTB-IFF standalone for solvent docking')
+    call help_opt('-normdock',fw,'More extensive docking during growth')
+    call help_opt('-maxsolv',fw,'Convergence limit if -nsolv not given  [default: 150]')
+    call help_opt('-wscal <float>',fw,'Scaling factor for outer wall potential')
+    call help_opt('-samerand',fw,'Use same random seed for every xtbiff run')
+    call help_opt('-directed <file>',fw,'Directed solvation at positions in <file>')
+    call help_opt('-fin_opt_gfn2',fw,'Final GFN2-xTB optimization for grow and ensemble')
+    write (stdout,*)
+    call help_section('Ensemble generation:')
+    call help_opt('-ensemble',fw,'Ensemble generation run type')
+    call help_opt('-qcgmtd',fw,'NCI-MTD CREST ensemble generation  [default]')
+    call help_opt('-ncimtd',fw,'NCI-MTD CREST ensemble generation  (alias)')
+    call help_opt('-mtd',fw,'MTD for QCG ensemble generation')
+    call help_opt('-md',fw,'Normal MD for QCG ensemble search')
+    call help_opt('-enslvl [method]',fw,'Method for ensemble search (all GFN methods supported)')
+    call help_opt('-clustering',fw,'Clustering for ensemble search  (qcgmtd/ncimtd only)')
+    write (stdout,*)
+    call help_section('Solvation free energy:')
+    call help_opt('-esolv',fw,'Solvation energy  (reference cluster generation)')
+    call help_opt('-gsolv',fw,'Solvation free energy  (reference cluster generation)')
+    call help_opt('-nclus',fw,'Clusters for reference generation  [default: 4]')
+    call help_opt('-nocff',fw,'Switch off the CFF algorithm')
+    call help_opt('-freqscal',fw,'Frequency scale factor  (output only)')
+    call help_opt('-freqlvl [method]',fw,'Method for frequency computation')
+    call help_opt('-keepdir',fw,'Keep temporary directories')
+    write (stdout,*)
+
+    ! ── MSReact ──────────────────────────────────────────────────────────
   case ('msreact')
-    write (*,'(1x,'' mass spectral fragment generator (msreact)'')')
-    write (*,'(1x,''General usage :'')')
-    write (*,'(5x,''<input> -msreact [options]'')')
-    write (*,'(1x,''options:'')')
-    write (*,'(5x,''-msnoattrh           : deactivate attractive potential between hydrogen and LMO centers)'')')
-    write (*,'(5x,''-msnshifts [int]     : perform n optimizations with randomly shifted atom postions (default 0) '')')
-    write (*,'(5x,''-msnshifts2 [int]    : perform n optimizations with randomly shifted atom postions and repulsive potential applied to bonds (default 0) '')')
-    write (*,'(5x ''-msnbonds [int]      : maximum number of bonds between atoms pairs for applying repulsive potential (default 3)'')')
-    write (*,'(5x,''-msmolbar            : sort out topological duplicates by molbar codes (requires  sourced "molbar")'')')
-    write (*,'(5x,''-msinchi             : sort out topological duplicates by inchi codes (requires  sourced "obabel")'')')
-    write (*,'(5x ''-msnfrag [int]       : number of fragments that are printed by msreact (random selection)'')')
-    write (*,'(5x,''-msiso               : print only non-dissociated structures (isomers)'')')
-    write (*,'(5x,''-msnoiso             : print only dissociated structures'')')
-    write (*,'(5x,''-mslargeprint        : do not remove temporary files and MSDIR do not remove temporary files and MSDIR with constrained optimizations'')')
-    write (*,'(5x,''-chrg <int>         : set the molecules´ charge'')')
-    write (*,'(5x,''-ewin <real>        : set energy window in for sorting out fragments kcal/mol,'')')
-    write (*,'(5x,''                     [default: 200.0 kcal/mol] '')')
-    write (*,'(5x,''-msinput <file>     : read in an input file with special settings for msreact'')')
-    write (*,'(5x,''keywords for inputfile:'')')
-    write (*,'(5x,'' fragdist <real>     : increase distance between fragments xyz structures (default 0 Angstrom) '')')
-    write (*,'(5x,'' atomshift <real>    :  shift of atoms in random atom displacement (default 0.75 Angstrom)'')')
-    write (*,'(5x,'' distthr_attr <real> : distance threshold in Angstrom for H-LMO attraction (default 4.0 Angstrom) '')')
-    write (*,'(5x,'' fc_rep <real>       : force constant for repulsive potential between atom pairs (default 0.5) '')')
-    write (*,'(5x,'' fc_attr <real>      : force constant for attractive potential between hydrogen and LMO centers (default -0.5) '')')
-    write (*,'(5x,'' etemp <real>        : electronic temperature in xTB optimizations'')')
-
+    fw = 22
+    call help_section('Mass spectral fragment generator (msreact)')
+    write (stdout,'(1x,a)') 'General usage:  crest <input> -msreact [options]'
+    write (stdout,*)
+    call help_opt('-msnoattrh',fw,'Deactivate H–LMO attractive potential')
+    call help_opt('-msnshifts <int>',fw,'n optimizations with randomly shifted atoms  [default: 0]')
+    call help_opt('-msnshifts2 <int>',fw,'Same but with bond-repulsive potential  [default: 0]')
+    call help_opt('-msnbonds <int>',fw,'Max bond distance for repulsive potential  [default: 3]')
+    call help_opt('-msmolbar',fw,'Deduplicate by molbar codes  (requires "molbar")')
+    call help_opt('-msinchi',fw,'Deduplicate by InChI codes  (requires "obabel")')
+    call help_opt('-msnfrag <int>',fw,'Number of fragments to print  (random selection)')
+    call help_opt('-msiso',fw,'Print only non-dissociated structures (isomers)')
+    call help_opt('-msnoiso',fw,'Print only dissociated structures')
+    call help_opt('-mslargeprint',fw,'Keep all temporary files and MSDIR')
+    call help_opt('-chrg <int>',fw,"Molecular charge")
+    call help_opt('-ewin <real>',fw,'Energy window for fragment sorting in kcal/mol  [default: 200.0]')
+    call help_opt('-msinput <file>',fw,'Read special settings from input file')
+    write (stdout,*)
+    fw = 22
+    call help_section('msreact input file keywords:')
+    call help_opt('fragdist <real>',fw,'Inter-fragment distance increase  [default: 0.0 Ang]')
+    call help_opt('atomshift <real>',fw,'Random atom displacement  [default: 0.75 Ang]')
+    call help_opt('distthr_attr <real>',fw,'H–LMO attraction distance cutoff  [default: 4.0 Ang]')
+    call help_opt('fc_rep <real>',fw,'Repulsive potential force constant  [default: 0.5]')
+    call help_opt('fc_attr <real>',fw,'H–LMO attractive force constant  [default: -0.5]')
+    call help_opt('etemp <real>',fw,'Electronic temperature in xTB optimizations')
+    write (stdout,*)
+
+    ! ── Standalone tools ─────────────────────────────────────────────────
   case ('other')
-    write (*,'(1x,''Other tools for standalone use:'')')
-    write (*,'(5x,''-zsort             : use only the zsort subroutine'')')
-    write (*,'(5x,''                     to sort the z-matrix of the input'')')
-    write (*,'(5x,''                     coord file.'')')
-    write (*,'(5x,''-mdopt <file>      : optimize along trajectory or'')')
-    write (*,'(5x,''                     ensemble file in the XYZ format.'')')
-    write (*,'(5x,''                     Each point on the file is optimized.'')')
-    write (*,'(5x,''-screen <file>     : optimize along ensemble file'')')
-    write (*,'(5x,''                     in the XYZ format. A multilevel'')')
-    write (*,'(5x,''                     optimization is performed with continiously'')')
-    write (*,'(5x,''                     increasing thresholds. After each step'')')
-    write (*,'(5x,''                     the ensemble file is sorted.'')')
-    write (*,'(5x,''-protonate         : find a molecules protomes by using a'')')
-    write (*,'(5x,''                     LMO π- or LP-center approach.'')')
-    write (*,'(5x,''-deprotonate       : find a molecules deprotomers.'')')
-    write (*,'(5x,''-tautomerize       : combine the protonation and deprotonation'')')
-    write (*,'(5x,''                     to find prototropic tautomers.'')')
-    write (*,'(6x,''↳ -trev           : do first the deprotonation and then the'')')
-    write (*,'(8x,''                  protonation in the -tautomerize mode, i.e.,'')')
-    write (*,'(8x,''                  reverse of the default procedure.'')')
-    write (*,'(6x,''↳ -iter <int>     : set number of protonation/deprotonation cycles'')')
-    write (*,'(8x,''                  in the tautomerization script. [default: 2]'')')
-    write (*,'(5x,''-compare <f1> <f2> : compare two ensembles <f1> and <f2>.'')')
-    write (*,'(5x,''                     Both ensembles must have the same'')')
-    write (*,'(5x,''                     order of atoms of the molecule and'')')
-    write (*,'(5x,''                     should contain rotamers.'')')
-    write (*,'(6x,''↳ -maxcomp <int>  : Selcect the lowest <int> conformers'')')
-    write (*,'(8x,''                  out of each ensemble to be compared'')')
-    write (*,'(8x,''                  with "-compare". [default: 10]'')')
-    write (*,'(5x,''-testtopo <file>   : Analyze some stuctural info (topology) for a given file.'')')
-    write (*,'(5x,''-constrain <atoms> : write example file ".xcontrol.sample" for constraints'')')
-    write (*,'(5x,''                     in crest. (see -cinp option above)'')')
-    write (*,'(5x,''-thermo <file>     : Calculate thermo data for given structure. Also requires vibrational'')')
-    write (*,'(5x,''                     frequencies in the TM format, saved as file called "vibspectrum"'')')
-    write (*,'(5x,''-rmsd,-rmsdheavy <file1> <file2>  : Calculate RMSD or heavy atom RMSD between two structures.'')')
-    write (*,'(5x,''                                    Input coords are automatically transformed to Angstroem.'')')
-    write (*,'(5x,''-splitfile <file> [from] [to]     : Split an ensemble from <file> into seperate directories'')')
-    write (*,'(5x,''                                    for each structure. [from] and [to] can be used to select'')')
-    write (*,'(5x,''                                    specific structures from the file.'')')
-    write (*,'(5x,''                                    The new directories are collected in the SPLIT directory.'')')
-    write (*,*)
+    fw = 26
+    call help_section('Single-structure calculations:')
+    call help_opt('-sp',fw,'Single-point energy')
+    call help_opt('-opt/-optimize',fw,'Geometry optimization')
+    call help_opt('-hess/-numhess',fw,'Numerical Hessian / vibrational frequencies')
+    call help_opt('-dynamics/-dyn',fw,'Stand-alone MD run')
+    call help_opt('-thermo <file>',fw,'Thermochemistry from existing Hessian data')
+    write (stdout,'(9x,a)') '(also requires "vibspectrum" in TM format)'
+    write (stdout,*)
+    call help_section('Ensemble tools:')
+    call help_opt('-mdopt <file>',fw,'Optimize every structure in an ensemble (XYZ)')
+    call help_opt('-mdsp <file>',fw,'Singlepoints for every structure in an ensemble (XYZ)')
+    call help_opt('-mdhess <file>',fw,'Hessians + thermochemistry for every structure in an ensemble (XYZ)')
+    call help_opt('-screen <file>',fw,'Multi-level energy screening of an ensemble')
+    call help_opt('-entropy [<T>]',fw,'Conformational entropy from ensemble')
+    call help_opt('-symmetries',fw,'Symmetry analysis of all structures in an ensemble')
+    call help_opt('-printboltz',fw,'Print Boltzmann population weights')
+    call help_opt('-splitfile <f> [i] [j]',fw,'Split ensemble into per-structure directories (SPLIT/)')
+    write (stdout,'(9x,a)') 'For sorting, clustering, RMSD, and ensemble comparison tools'
+    write (stdout,'(9x,a)') 'see '//colorify('--help compare','gold')
+    write (stdout,*)
+    call help_section('Protonation / tautomerization:')
+    call help_opt('-protonate',fw,"Find a molecule's protomers  (LMO π/LP-center approach)")
+    call help_opt('-deprotonate',fw,"Find a molecule's deprotomers")
+    call help_opt('-tautomerize',fw,'Find prototropic tautomers  (protonation + deprotonation)')
+    write (stdout,'(9x,a)') colorify('-trev','green')//'         : deprotonate first, then protonate  (reverse order)'
+    write (stdout,'(9x,a)') colorify('-iter <int>','green')//'    : number of prot/deprot cycles  [default: 2]'
+    write (stdout,*)
+    call help_section('Miscellaneous:')
+    call help_opt('-zsort',fw,'Z-matrix sorting of the input coord file')
+    call help_opt('-testtopo <file>',fw,'Topology / bond connectivity analysis')
+    call help_opt('-constrain <atoms>',fw,'Write example constraint file ".xcontrol.sample"')
+    write (stdout,*)
+
+    ! ── TOML input files ─────────────────────────────────────────────────
+  case ('toml')
+    call help_section('TOML input files')
+    write (stdout,'(1x,a)') 'CREST (v3+) accepts a TOML file as a flexible alternative to CLI flags.'
+    write (stdout,'(1x,a)') 'Pass it as the first argument or explicitly with --input:'
+    write (stdout,*)
+    write (stdout,'(3x,a)') colorify('crest structure.xyz --input settings.toml','green')
+    write (stdout,'(3x,a)') colorify('crest settings.toml','green')//'  (structure path given inside the file)'
+    write (stdout,*)
+    call help_section('Minimal example:')
+    write (stdout,'(3x,a)') colorify('input','yellow')//'   = "struc.xyz"'
+    write (stdout,'(3x,a)') colorify('runtype','yellow')//' = "iMTD-GC"'
+    write (stdout,'(3x,a)') colorify('threads','yellow')//' = 4'
+    write (stdout,*)
+    write (stdout,'(3x,a)') colorify('[calculation]','yellow')
+    write (stdout,'(5x,a)') colorify('[[calculation.level]]','yellow')
+    write (stdout,'(7x,a)') 'method = "gfn2"'
+    write (stdout,'(7x,a)') 'chrg   = 0'
+    write (stdout,'(7x,a)') 'gbsa   = "h2o"'
+    write (stdout,*)
+    call help_section('Key root-level settings:')
+    fw = 20
+    call help_opt('input / structure',fw,'Input coordinate file')
+    call help_opt('runtype',fw,'Workflow to run  (e.g. "iMTD-GC", "optimize", "md", "singlepoint")')
+    call help_opt('threads',fw,'Number of CPU threads')
+    call help_opt('preopt',fw,'Pre-optimize input structure  (true/false)')
+    call help_opt('constraints',fw,'Path to an xtb-format constraint file')
+    write (stdout,*)
+    call help_section('Main blocks:')
+    ! ── padding = 30 - visible_len, so ' — ' aligns at column 30 ──
+    write (stdout,'(3x,a,a)') colorify('[calculation]','yellow'), &
+      & repeat(' ',17)//' — method, charge, solvent, …'
+    write (stdout,'(3x,a,a)') colorify('  [[calculation.level]]','yellow'), &
+      & repeat(' ',7)//' — one or more calculation levels'
+    write (stdout,'(3x,a,a)') colorify('  [[calculation.constraint]]','yellow'), &
+      & repeat(' ',2)//' — geometric constraints'
+    write (stdout,'(3x,a,a)') colorify('[dynamics]','yellow'), &
+      & repeat(' ',20)//' — MD length, timestep, temperature, …'
+    write (stdout,'(3x,a,a)') colorify('  [[dynamics.meta]]','yellow'), &
+      & repeat(' ',11)//' — metadynamics bias settings'
+    write (stdout,'(3x,a,a)') colorify('[cregen]','yellow'), &
+      & repeat(' ',22)//' — ensemble sorting thresholds'
+    write (stdout,'(3x,a,a)') colorify('[thermo]','yellow'), &
+      & repeat(' ',22)//' — thermochemistry settings'
+    write (stdout,*)
+    write (stdout,'(1x,a)') 'Full TOML keyword reference:'
+    write (stdout,'(3x,a)') colorify('https://crest-lab.github.io/crest-docs/','blue')
+    write (stdout,*)
 
   end select
   call confscript_morehelp2()
@@ -399,13 +529,21 @@ subroutine confscript_morehelp(flag)
 end subroutine confscript_morehelp
 
 subroutine confscript_morehelp2
-  write (*,'(1x, ''Some [options] command line flags can be shown with this help menu via:'')')
-  write (*,'(1x, '' --help [general/compare/conf/thermo/qcg/other]'')')
-  write (*,*)
-  write (*,*) 'View literature references with [--cite]'
-  write (*,*) 'For detailed documentation refer to:'
-  write (*,*) ' https://crest-lab.github.io/crest-docs/'
-  write (*,*)
+  use iomod,only:colorify
+  use crest_parameters,only:stdout
+  implicit none
+  write (stdout,'(/,1x,a)') 'For detailed help on option groups, use:'
+  write (stdout,'(3x,a)') colorify('--help general','gold')//'    '// &
+    & colorify('--help compare','gold')//'    '//colorify('--help conf','gold')
+  write (stdout,'(3x,a)') colorify('--help thermo','gold')//'     '// &
+    & colorify('--help qcg','gold')//'        '//colorify('--help msreact','gold')
+  write (stdout,'(3x,a)') colorify('--help other','gold')//'      '// &
+    & colorify('--help toml','gold')
+  write (stdout,*)
+  write (stdout,'(1x,a,a)') 'View literature references with ',colorify('--cite','green')
+  write (stdout,'(1x,a)') 'For detailed documentation refer to:'
+  write (stdout,'(3x,a)') colorify('https://crest-lab.github.io/crest-docs/','blue')
+  write (stdout,*)
 end subroutine confscript_morehelp2
 
 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
@@ -540,25 +678,6 @@ end subroutine zsortwarning2
 
 !========================================================================================!
 
-subroutine qcg_head()
-  implicit none
-  write (*,*)
-  write (*,'(2x,''========================================'')')
-  write (*,'(2x,''|           ----------------           |'')')
-  write (*,'(2x,''|                 Q C G                |'')')
-  write (*,'(2x,''|           ----------------           |'')')
-  write (*,'(2x,''|        Quantum Cluster Growth        |'')')
-  write (*,'(2x,''|       University of Bonn, MCTC       |'')')
-  write (*,'(2x,''========================================'')')
-  write (*,'(2x,'' S. Grimme, S. Spicher, C. Plett.'')')
-  write (*,*)
-  write (*,'(3x,''Cite work conducted with this code as'')')
-  write (*,'(/,3x,''S. Spicher, C. Plett, P. Pracht, A. Hansen, S. Grimme, JCTC, 2022, 18, 3174-3189.'')')
-  write (*,*)
-end subroutine qcg_head
-
-!========================================================================================!
-
 subroutine msreact_head()
   implicit none
   write (*,*)
@@ -678,6 +797,15 @@ subroutine printiter2(i)
   write (*,'("**",21x,"I T E R A T I O N    C Y C L E    ",i3,18x,"**")') i
   write (*,'(80("*"))')
 end subroutine printiter2
+subroutine printiter3(text,i)
+  implicit none
+  character(len=*),intent(in) :: text
+  integer,intent(in) :: i
+  character(len=128) :: atmp
+  write (atmp,'(a,1x,i0)') trim(text),i
+  !call largehead(trim(atmp))
+  call construct_boxed_headline(trim(atmp),80,.true.)
+end subroutine printiter3
 
 !========================================================================================!
 
@@ -706,7 +834,7 @@ subroutine construct_large_headline(symb,str)
   character(len=128) :: str2
   character(len=128) :: str3
   strlen = len_trim(str)
-  str2 = repeat(symb,90)
+  str2 = repeat(symb,80)
   strlen2 = len_trim(str2)
   if (strlen .ge. strlen2) then
     str2 = ''
@@ -726,6 +854,38 @@ subroutine construct_large_headline(symb,str)
   write (*,'(a)') trim(str2)
   return
 end subroutine construct_large_headline
+subroutine construct_boxed_headline(str,width,bold)
+  use crest_parameters,only:stdout
+  implicit none
+  character(len=*),intent(in) :: str
+  integer,intent(in) :: width
+  logical,intent(in) :: bold
+  integer :: strlen,strlen2
+  integer :: k,i,j,jj
+  integer :: wid
+  wid = max(width,len_trim(str)+4)-2
+  wid = width-2
+  strlen = len_trim(str)
+  if (strlen > wid) wid = strlen
+  write (stdout,*)
+  if (bold) then
+    write (stdout,'(a)') "┏"//repeat("━",wid)//"┓"
+  else
+    write (stdout,'(a)') "┌"//repeat("─",wid)//"┐"
+  end if
+  strlen2 = wid+2
+  k = strlen2-strlen
+  j = k/2
+  jj = k-j-2
+  if (bold) then
+    write (stdout,'(a)') "┃"//repeat(" ",j)//trim(str)//repeat(" ",jj)//"┃"
+    write (stdout,'(a)') "┗"//repeat("━",wid)//"┛"
+  else
+    write (stdout,'(a)') "│"//repeat(" ",j)//trim(str)//repeat(" ",jj)//"│"
+    write (stdout,'(a)') "└"//repeat("─",wid)//"┘"
+  end if
+  return
+end subroutine construct_boxed_headline
 
 !========================================================================================!
 
@@ -735,234 +895,28 @@ subroutine print_crest_metadata()
 !********************************
   include 'crest_metadata.fh'
   integer :: l
-  write (*,'(2x,a,1x,a)') 'CREST version    :',version
-  write (*,'(2x,a,1x,a)') 'timestamp        :',date
-  write (*,'(2x,a,1x,a)') 'commit           :',commit
+  write (*,'(2x,a,t22,":   ",a)') 'CREST version    ',version
+  write (*,'(2x,a,t22,":   ",a)') 'timestamp        ',date
+  write (*,'(2x,a,t22,":   ",a)') 'commit           ',commit
+  l = len_trim(author)
   if (author(1:2) .eq. "'@") then
-    l = len_trim(author)
-    write (*,'(2x,a,1x,a)') 'compiled by      :',"'usr"//author(2:l)
+    write (*,'(2x,a,t22,":   ",a)') 'compiled by      ',"usr"//author(2:l-1)
   else
-    write (*,'(2x,a,1x,a)') 'compiled by      :',author
+    write (*,'(2x,a,t22,":   ",a)') 'compiled by      ',author(2:l-1)
   end if
-  write (*,'(2x,a,1x,a)') 'Fortran compiler :',fcompiler
-  write (*,'(2x,a,1x,a)') 'C compiler       :',ccompiler
-  write (*,'(2x,a,1x,a)') 'build system     :',bsystem
-  write (*,'(2x,a,1x,a)') '-DWITH_TOMLF     :',tomlfvar
-  write (*,'(2x,a,1x,a)') '-DWITH_GFN0      :',gfn0var
-  write (*,'(2x,a,1x,a)') '-DWITH_GFNFF     :',gfnffvar
-  write (*,'(2x,a,1x,a)') '-DWITH_TBLITE    :',tblitevar
-  write (*,'(2x,a,1x,a)') '-DWITH_LIBPVOL   :',libpvolvar
-  write (*,'(2x,a,1x,a)') '-DWITH_LWONIOM   :',lwoniomvar
+  write (*,'(2x,a,t22,":   ",a)') 'Fortran compiler ',fcompiler
+  write (*,'(2x,a,t22,":   ",a)') 'C compiler       ',ccompiler
+  write (*,'(2x,a,t22,":   ",a)') 'build system     ',bsystem
+  write (*,'(2x,a,t22,":   ",a)') '-DWITH_TOMLF     ',tomlfvar
+  write (*,'(2x,a,t22,":   ",a)') '-DWITH_GFN0      ',gfn0var
+  write (*,'(2x,a,t22,":   ",a)') '-DWITH_GFNFF     ',gfnffvar
+  write (*,'(2x,a,t22,":   ",a)') '-DWITH_TBLITE    ',tblitevar
+  write (*,'(2x,a,t22,":   ",a)') '-DWITH_DDX       ',ddxvar
+  write (*,'(2x,a,t22,":   ",a)') '-DWITH_LIBPVOL   ',libpvolvar
+  write (*,'(2x,a,t22,":   ",a)') '-DWITH_LWONIOM   ',lwoniomvar
+  write (*,'(2x,a,t22,":   ",a)') '-DWITH_FMLIP_RELAY',fmliprelayvar
 end subroutine print_crest_metadata
 
-!========================================================================================!
-!========================================================================================!
-!> Confscript dry-run printout
-!========================================================================================!
-!========================================================================================!
-subroutine crest_dry(env)
-  use iso_fortran_env,wp => real64
-  use crest_data
-  use iomod
-  implicit none
-
-  type(systemdata),intent(inout) :: env
-  character(len=1024) :: dumstr
-  character(len=:),allocatable :: dum
-  logical :: cregenpr = .false.
-  logical :: mdsetpr = .false.
-  logical :: jobpr = .true.
-  logical :: xtbpr = .true.
-  logical :: techpr = .true.
-
-  call largehead('D R Y    R U N')
-  write (*,'(1x,a)') 'Dry run was requested.'
-  write (*,'(1x,a)') 'Running CREST with the chosen cmd arguments will result in the following settings:'
-
-  write (*,'(/,1x,a,a)') 'Input file : ',trim(env%inputcoords)
-
-  write (*,'(/,1x,a)') 'Job type :'
-  if (env%onlyZsort) then
-    write (*,'(2x,a)',advance='no') '1.'
-    write (*,'(2x,a)') 'Standalone use of ZSORT routine.'
-    xtbpr = .false.
-    techpr = .false.
-    jobpr = .false.
-  else if (env%properties .lt. 0) then
-    jobpr = .false.
-    write (*,'(2x,a)',advance='no') '1.'
-    select case (env%properties)
-    case (-1)
-      write (*,'(2x,a)') 'Standalone use of CREGEN sorting routine.'
-      cregenpr = .true.
-      xtbpr = .false.
-    case (-2)
-      write (*,'(2x,a)') 'Comparison of two conformer-rotamer ensembles'
-      cregenpr = .true.
-      xtbpr = .false.
-    case (-3)
-      write (*,'(2x,a)') 'Automated protonation'
-    case (-4)
-      write (*,'(2x,a)') 'Automated deprotonation'
-    case (-5)
-      write (*,'(2x,a)') 'Automated tautomerization'
-    case (-666)
-      write (*,'(2x,a)') '"Property" calculation (-prop) for a given ensemble.'
-    case default
-      write (*,'(2x,a)') '<undefined>'
-    end select
-  else
-    cregenpr = .true.
-    write (*,'(2x,a)',advance='no') '1.'
-    select case (env%crestver)
-    case (1)
-      write (*,'(2x,a)') 'Conformational search via the MF-MD-GC algo'
-    case (2)
-      if (env%properties == 45) then
-        write (*,'(2x,a)') 'Conformational search via the iMTD-sMTD algo'
-      else if (env%iterativeV2) then
-        write (*,'(2x,a)') 'Conformational search via the iMTD-GC algo'
-      else
-        write (*,'(2x,a)') 'Conformational search via the MTD-GC algo'
-      end if
-      mdsetpr = .true.
-    case (crest_imtd2)
-      write (*,'(2x,a)') 'Conformational search cia the iMTD-sMTD algo (-v4)'
-      mdsetpr = .true.
-    case (3)
-      write (*,'(2x,a)') 'Reoptimization of all structures in a given ensemble (-mdopt)'
-    case (4)
-      write (*,'(2x,a)') 'Reoptimization and sorting of all structures in a given ensemble (-screen)'
-    case (7)
-      write (*,'(2x,a)') 'GFNn-xTB nano reactor (-reactor)'
-    case (crest_pka)
-      write (*,'(2x,a)') 'GFN2-xTB/ALPB(H2O) pKa calculation (-pka)'
-    case default
-      write (*,'(2x,a)') '<undefined>'
-    end select
-    if (env%properties .gt. 0) then
-      select case (env%properties)
-      case (45)
-        write (*,'(2x,a,2x,a)') '2.','Calculation of molecular ensemble entropy (-entropy)'
-      case default
-        write (*,'(2x,a,2x,a)') '2.','Additional "property" calculation requested (-prop)'
-      end select
-    end if
-  end if
-
-  if (jobpr) then
-    write (*,'(/,1x,a)') 'Job settings'
-    write (*,'(2x,a,l6)') 'sort Z-matrix        : ',env%autozsort
-    if (env%crestver .eq. 2) then
-      select case (env%runver)
-      case (2)
-        write (*,'(2x,a,a)') 'MTD-GC modified mode : ','"-quick"'
-      case (4)
-        write (*,'(2x,a,a)') 'MTD-GC modified mode : ','"-nci"'
-      case (5)
-        write (*,'(2x,a,a)') 'MTD-GC modified mode : ','"-squick"'
-      case (6)
-        write (*,'(2x,a,a)') 'MTD-GC modified mode : ','"-mquick"'
-      case (111)
-        write (*,'(2x,a,a)') 'iMTD-sMTD mode       : ','"-entropy"'
-      case default
-        continue
-      end select
-    end if
-    if (env%properties .gt. 0) then
-      select case (env%properties)
-      case (1)
-        dum = '"hess"'
-      case (10)
-        dum = '"ohess"'
-      case (2)
-        dum = '"autoIR (GFN)"'
-      case (20)
-        dum = '"reopt"'
-      case (3:7,100)
-        dum = 'DFT'
-      case (45)
-        dum = 'none'
-      case default
-        dum = '<undefined>'
-      end select
-      if (dum .ne. 'none') then
-        write (*,'(2x,a,a)') 'PROP mode (-prop)    : ',dum
-      end if
-    end if
-  end if
-
-  if (cregenpr) then
-    write (*,'(/,1x,a)') 'CRE settings'
-    write (*,'(2x,a,f10.4)') 'energy window         (-ewin) :',env%ewin
-    write (*,'(2x,a,f10.4)') 'RMSD threshold        (-rthr) :',env%rthr          !RTHR - RMSD thr in Angstroem
-    write (*,'(2x,a,f10.4)') 'energy threshold      (-ethr) :',env%ethr          !ETHR - E threshold in kcal
-    write (*,'(2x,a,f10.2)') 'rot. const. threshold (-bthr) :',env%bthr2         !BTHR - rot const  thr
-    write (*,'(2x,a,f10.2)') 'T (for boltz. weight) (-temp) :',env%tboltz
-  end if
-
-  if (mdsetpr) then
-    write (*,'(/,1x,a)') 'General MD/MTD settings'
-    if (env%mdtime .gt. 0.0d0) then
-      write (*,'(2x,a,f10.1)') 'simulation length [ps]    (-len) :',env%mdtime
-    else
-      write (*,'(2x,a,a)') 'simulation length [ps]    (-len) : ','<system dependent>'
-    end if
-    write (*,'(2x,a,f10.1)') 'time step [fs]          (-tstep) :',env%mdstep
-    write (*,'(2x,a,i10)') 'shake mode              (-shake) :',env%shake
-    write (*,'(2x,a,f10.2)') 'MTD temperature [K]    (-mdtemp) :',env%mdtemp
-    write (*,'(2x,a,i10)') 'trj dump step  [fs]    (-mddump) :',env%mddumpxyz
-    write (*,'(2x,a,f10.1)') 'MTD Vbias dump [ps]    (-vbdump) :',real(env%mddump)/1000.0d0
-  end if
-
-  if (env%cts%used) then
-    write (*,'(/,1x,a)') 'Constrainment info'
-    write (*,'(2x,a,l7)') 'applying constraints?  : ',env%cts%used
-    write (*,'(2x,a,a)') 'constraining file      : ',trim(env%constraints)
-    write (*,'(2x,a)') 'file content :'
-    call cat_mod(6,'  > ',env%constraints,'')
-  end if
-
-  if (xtbpr) then
-    if (env%legacy) then
-      write (*,'(/,1x,a)') 'XTB settings'
-      write (*,'(2x,a,a)') 'binary name        (-xnam) : ',trim(env%ProgName)
-      call checkbinary(env)
-      write (*,'(2x,a,a)') 'GFN method         (-gfn)  : ',trim(env%gfnver)
-    else
-      write (*,'(/,1x,a)') 'Calculation settings'
-    end if
-    write (*,'(2x,a,i0)') '(final) opt level  (-opt)  : ',nint(env%optlev)
-    if (env%gbsa) then
-      if (index(env%solv,'--alpb') .ne. 0) then
-        write (*,'(2x,a,a)') 'Implicit solvation (-alpb) : ',trim(env%solvent)
-      else
-        write (*,'(2x,a,a)') 'Implicit solvation (-gbsa) : ',trim(env%solvent)
-      end if
-    end if
-    if (env%chrg .ne. 0.0d0) then
-      write (*,'(2x,a,i0)') 'Molecular charge   (-chrg) : ',env%chrg
-    end if
-    if (env%uhf .ne. 0) then
-      write (*,'(2x,a,i0)') 'UHF (nα-nβ elec.)  (-uhf)  : ',env%uhf
-    end if
-  end if
-
-  if (techpr) then
-    call getcwd(dumstr)
-    write (*,'(/,1x,a)') 'Technical settings'
-    write (*,'(2x,a,a)') 'working directory : ',trim(dumstr)
-    write (*,'(2x,a,i0)') 'CPUs (threads)     (-T) : ',env%threads
-
-  end if
-
-  write (*,'(/,1x,a)') 'CREST binary info'
-  call print_crest_metadata()
-
-  write (*,'(/)')
-  stop 'normal dry run termination.'
-end subroutine crest_dry
-
 subroutine cat_mod(ch,pre,fname,post)
   implicit none
   integer :: ch
@@ -1001,176 +955,6 @@ subroutine checkbinary(env)
   return
 end subroutine checkbinary
 
-!========================================================================================!
-!========================================================================================!
-!>  QCG-printouts
-!==============================================================================!
-!========================================================================================!
-
-subroutine print_qcg_grow()
-  implicit none
-  write (*,*)
-  write (*,'(2x,''========================================='')')
-  write (*,'(2x,''|   quantum cluster growth: GROW        |'')')
-  write (*,'(2x,''========================================='')')
-  write (*,*)
-end subroutine print_qcg_grow
-subroutine pr_qcg_fastgrow()
-  implicit none
-  write (*,*)
-  write (*,'(2x,''========================================='')')
-  write (*,'(2x,''|   quantum cluster growth: FASTGROW    |'')')
-  write (*,'(2x,''========================================='')')
-  write (*,*)
-end subroutine pr_qcg_fastgrow
-subroutine print_qcg_ensemble()
-  implicit none
-  write (*,*)
-  write (*,'(2x,''========================================='')')
-  write (*,'(2x,''|   quantum cluster growth: ENSEMBLE    |'')')
-  write (*,'(2x,''========================================='')')
-  write (*,*)
-end subroutine print_qcg_ensemble
-subroutine print_qcg_opt()
-  implicit none
-  write (*,*)
-  write (*,'(2x,''========================================='')')
-  write (*,'(2x,''|   quantum cluster growth: OPT         |'')')
-  write (*,'(2x,''========================================='')')
-  write (*,*)
-  write (*,'(2x,''Very tight post optimization of lowest cluster'')')
-end subroutine print_qcg_opt
-subroutine pr_qcg_fill()
-  implicit none
-  write (*,*)
-  write (*,'(2x,''========================================='')')
-  write (*,'(2x,''|   quantum cluster growth: CFF         |'')')
-  write (*,'(2x,''========================================='')')
-  write (*,*)
-  write (*,'(2x,''CUT-FREEZE-FILL Algorithm to generate reference solvent cluster'')')
-end subroutine pr_qcg_fill
-subroutine pr_qcg_freq()
-  implicit none
-  write (*,*)
-  write (*,'(2x,''========================================='')')
-  write (*,'(2x,''|          Frequency evaluation         |'')')
-  write (*,'(2x,''========================================='')')
-  write (*,*)
-end subroutine pr_qcg_freq
-subroutine pr_eval_solute()
-  implicit none
-  write (*,*)
-  write (*,'(2x,''________________________________________________________________________'')')
-  write (*,*)
-  write (*,'(2x,''__________________     Solute Cluster Generation   _____________________'')')
-  write (*,*)
-  write (*,'(2x,''________________________________________________________________________'')')
-  write (*,*)
-end subroutine pr_eval_solute
-subroutine pr_eval_solvent()
-  implicit none
-  write (*,*)
-  write (*,*)
-  write (*,'(2x,''________________________________________________________________________'')')
-  write (*,*)
-  write (*,'(2x,''_________________     Solvent Cluster Generation   _____________________'')')
-  write (*,*)
-  write (*,'(2x,''________________________________________________________________________'')')
-  write (*,*)
-end subroutine pr_eval_solvent
-subroutine pr_eval_eval()
-  implicit none
-  write (*,*)
-  write (*,*)
-  write (*,'(2x,''________________________________________________________________________'')')
-  write (*,*)
-  write (*,'(2x,''_________________________     Evaluation    ____________________________'')')
-  write (*,*)
-  write (*,'(2x,''________________________________________________________________________'')')
-  write (*,*)
-  write (*,*)
-end subroutine pr_eval_eval
-subroutine pr_freq_energy()
-  implicit none
-  write (*,'(2x,"#       H(T)       SVIB      SROT       STRA      G(T)")')
-  write (*,'(2x,"     [kcal/mol]    [      cal/mol/K        ]    [kcal/mol]")')
-  write (*,'(2x,"--------------------------------------------------------")')
-end subroutine pr_freq_energy
-subroutine pr_eval_1(G,H)
-  use iso_fortran_env,only:wp => real64
-  implicit none
-  real(wp),intent(in)       :: G,H
-  write (*,'(2x,"-----------------------------------------------------")')
-  write (*,'(2x,"Gsolv and Hsolv ref. state: [1 M gas/solution] ")')
-  write (*,'(2x,"G_solv (incl.RRHO)      =",F8.2," kcal/mol")') G
-  write (*,'(2x,"H_solv (incl.RRHO)      =",F8.2," kcal/mol")') H
-  write (*,'(2x,"-----------------------------------------------------")')
-  write (*,*)
-end subroutine pr_eval_1
-subroutine pr_eval_2(srange,G,scal)
-  use iso_fortran_env,only:wp => real64
-  implicit none
-! Dummy
-  integer,intent(in)        :: srange
-  real(wp),intent(in)       :: G(srange)
-  real(wp),intent(in)       :: scal(srange)
-! Stack
-  integer                   :: i
-  write (*,'(2x,"-----------------------------------------------------")')
-  write (*,'(2x,"Solvation free energies with scaled translational")')
-  write (*,'(2x,"and rotational degrees of freedom: Gsolv (scaling)")')
-  do i = 1,srange
-    write (*,'(10x,">>",2x,f8.2," (",f4.2,")",4x,"<<")') G(i),scal(i)
-  end do
-  write (*,'(2x,"-----------------------------------------------------")')
-end subroutine pr_eval_2
-subroutine pr_eval_3(srange,freqscal,scal,G)
-  use iso_fortran_env,only:wp => real64
-  implicit none
-! Dummy
-  integer,intent(in)        :: srange
-  integer,intent(in)        :: freqscal
-  real(wp),intent(in)       :: scal
-  real(wp),intent(in)       :: G(srange)
-  write (*,*)
-  write (*,'(2x,"==================================================")')
-  write (*,'(2x,"|  Gsolv with SCALED RRHO contributions: ",f4.2,4x"|")') scal
-  write (*,'(2x,"|  [1 bar gas/ 1 M solution]                     |")')
-  write (*,'(2x,"|                                                |")')
-  write (*,'(2x,"|  G_solv (incl.RRHO)+dV(T)=",F8.2," kcal/mol    |")') G(freqscal)
-  write (*,'(2x,"==================================================")')
-  write (*,*)
-end subroutine pr_eval_3
-subroutine pr_fill_energy()
-  implicit none
-  write (*,'(x,'' Size'',2x,''Cluster '',2x,''E /Eh '',7x,''De/kcal'',3x,&
-          &''Detot/kcal'',2x,''Opt'',4x)')
-end subroutine pr_fill_energy
-subroutine pr_ensemble_energy()
-  implicit none
-  write (*,*)
-  write (*,'(x,'' Cluster'',3x,''E /Eh '',7x,&
-           &''Density'',2x,''Efix'',7x,''R   av/act.'',1x,&
-           &''Surface'',3x,''Opt'',4x)')
-end subroutine pr_ensemble_energy
-subroutine pr_qcg_esolv()
-  implicit none
-  write (*,*)
-  write (*,'(2x,''========================================='')')
-  write (*,'(2x,''|   quantum cluster growth: ESOLV       |'')')
-  write (*,'(2x,''|                                       |'')')
-end subroutine pr_qcg_esolv
-subroutine pr_grow_energy()
-  implicit none
-  write (*,'(x,'' Size'',7x,''E'',8x,''De'',7x,''Detot'',6x,&
-           &''Density'',5x,''Eatom'',4x,''av. R'', 1x,'' Rlast'',3x,&
-           &''Volume'',4x,''Opt'')')
-  write (*,'(12x,''[Eh]'',4x,''[kcal]'',5x,''[kcal]'',5x,&
-           &''[u/Å^3]'',5x,''[kcal]'',3x,''[bohr]'', 1x,''[bohr]'',1x,&
-           &''[bohr^3]'')')
-
-end subroutine pr_grow_energy
-
 !========================================================================================!
 !========================================================================================!
 
@@ -1274,19 +1058,312 @@ end subroutine printprogbar
 
 subroutine gxtb_dev_warning
   use crest_parameters
-  use crest_data, only: status_ioerr
+  use crest_data,only:status_safety
   write (stdout,*)
-  write (stdout,'(a)') "!!! WARNING !!!"
-  write (stdout,'(a)') "You have selected g-xTB for your calculations, but currently only the"
-  write (stdout,'(a)') "preliminary binary version is available."
-  write (stdout,'(a)') "This version does NOT HAVE ANALYTICAL GRADIENTS available and uses"
-  write (stdout,'(a)') "NUMERICAL gradients which are SLOW and NOISY."
+  write (stdout,'(a)') "Note: '--gxtb_dev' is deprecated. Use '--gxtb'."
+  write (stdout,'(a)') "g-xTB via the tblite API is available with this build."
   write (stdout,*)
-  write (stdout,'(a)') 'The cmd argument "--gxtb" will be disabled until an implementation'
-  write(stdout,'(a)')  'with analytical gradients is available'
-  write(stdout,*)
-  write (stdout,'(a)') 'Please use "--gxtb_dev" in the mean time.'
-  write (stdout,'(a)') "Make sure you have the dev version gxtb installed (https://github.com/grimme-lab/g-xtb)"
-  write(stdout,*)
-  call creststop(status_ioerr)
+  call creststop(status_safety)
 end subroutine gxtb_dev_warning
+
+!========================================================================================!
+
+subroutine gxtb_syscall_warning
+!*************************************************************
+!* Warn the user that this build runs g-xTB by invoking the
+!* xtb binary via system calls (slow, temporary workaround).
+!* Only prints in the non-WITH_GXTB call path (have_gxtb=F),
+!* i.e. when no native tblite g-xTB build is available.
+!* Points the user to the static xtb binary of the g-xTB
+!* development release and to the (much faster) static CREST
+!* binary with a tblite g-xTB build available upon request.
+!*************************************************************
+  use crest_parameters,only:stdout
+  use tblite_api,only:have_gxtb
+  implicit none
+  integer,parameter :: w = 70  !> inner box width (ASCII content)
+  character(len=*),parameter :: hz = '─'
+  character(len=*),parameter :: vt = '│'
+  if (have_gxtb) return
+  write (stdout,*)
+  write (stdout,'(1x,a)') '╭'//repeat(hz,w)//'╮'
+  call boxline('Note: g-xTB is currently invoked via the xtb binary (system')
+  call boxline('calls). This is a temporary implementation and may be slow.')
+  call boxline('')
+  call boxline('* A static xtb binary providing g-xTB is available from the')
+  call boxline('  g-xTB development release at:')
+  call boxline('    https://github.com/grimme-lab/g-xtb')
+  call boxline('')
+  call boxline('* A static CREST binary with a native tblite development build')
+  call boxline('  of g-xTB (much faster than the bespoke xtb system call) is')
+  call boxline('  available upon request.')
+  write (stdout,'(1x,a)') '╰'//repeat(hz,w)//'╯'
+  write (stdout,*)
+contains
+  subroutine boxline(text)
+    character(len=*),intent(in) :: text
+    character(len=w) :: buf
+    buf = '  '//text
+    write (stdout,'(1x,a)') vt//buf//vt
+  end subroutine boxline
+end subroutine gxtb_syscall_warning
+
+!========================================================================================!
+!========================================================================================!
+
+subroutine gxtb_solvation_guard(env)
+!**************************************************************************
+!* g-xTB does not (yet) support dedicated implicit solvation. This guard
+!* is meant to be called right after input parsing (CLI and/or TOML),
+!* once the dedicated env%calc object is populated.
+!*
+!* It scans all requested calculation levels (both the native tblite
+!* g-xTB level and the xtb-subprocess driver) as well as the legacy CLI
+!* selection. If a g-xTB level is combined with a request for implicit
+!* solvation, CREST is terminated safely with an explanatory message.
+!*
+!* State of the g-xTB implementation: 05/2026 (development version) — no
+!* solvation support, neither via the native tblite interface nor via the
+!* xtb subprocess driver.
+!*
+!*   env  -  CREST system data (read-only here; holds env%calc)
+!**************************************************************************
+  use crest_parameters
+  use crest_data
+  use crest_calculator,only:jobtype
+  use tblite_api,only:xtblvl,have_gxtb
+  use iomod,only:drawbox
+  implicit none
+  type(systemdata),intent(in) :: env
+  integer :: i
+  logical :: usesgxtb,wantssolv
+  integer,parameter :: bw = 72   !> box width
+
+  usesgxtb = .false.
+  wantssolv = .false.
+
+  ! ── legacy CLI selection (env-level) ────────────────────────────────
+  if (index(env%gfnver,'gxtb') .ne. 0) usesgxtb = .true.
+  if (env%gbsa) wantssolv = .true.
+
+  ! ── per-calculation levels collected in env%calc ────────────────────
+  if (associated(env%calc)) then
+    do i = 1,env%calc%ncalculations
+      associate (job => env%calc%calcs(i))
+        !> native tblite g-xTB level
+        if (job%id == jobtype%tblite .and. job%tblitelvl == xtblvl%gxtb) then
+          usesgxtb = .true.
+        end if
+        !> g-xTB run as an xtb subprocess (--gxtb flag or gxtb binary)
+        if (allocated(job%other)) then
+          if (index(job%other,'gxtb') .ne. 0) usesgxtb = .true.
+        end if
+        if (allocated(job%binary)) then
+          if (index(job%binary,'gxtb') .ne. 0) usesgxtb = .true.
+        end if
+        !> any implicit solvation request on this level
+        if (allocated(job%solvmodel) .or. allocated(job%solvent)) then
+          wantssolv = .true.
+        end if
+      end associate
+    end do
+  end if
+
+  !> the unsupported combination is g-xTB AND implicit solvation
+  if (.not. (usesgxtb .and. wantssolv)) return
+
+  ! ── unsupported combination → print box and terminate safely ────────
+  write (stdout,*)
+  call drawbox(stdout,'',width=bw,charset=6,procedual=0)
+  call drawbox(stdout,'g-xTB: IMPLICIT SOLVATION NOT SUPPORTED',width=bw, &
+  &            charset=6,procedual=1)
+  call drawbox(stdout,'',width=bw,charset=6,procedual=3)
+  call gsg_line('')
+  call gsg_line('You requested g-xTB together with an implicit solvation model.')
+  call gsg_line('')
+  call gsg_line('The current g-xTB implementation (development version, 05/2026)')
+  call gsg_line('does not support dedicated implicit solvation yet, neither via')
+  call gsg_line('the native tblite interface nor via the xtb subprocess driver.')
+  call gsg_line('')
+  call gsg_line('Please run g-xTB in the gas phase (drop --alpb / --gbsa or the')
+  call gsg_line('corresponding TOML solvation keywords), or pick a different')
+  call gsg_line('level of theory for solvated calculations.')
+  call drawbox(stdout,'',width=bw,charset=6,procedual=2)
+  write (stdout,*)
+
+  call creststop(status_safety)
+
+contains
+  subroutine gsg_line(txt)
+    !> emit a single left-aligned content line of the warning box
+    use iomod,only:drawbox
+    character(len=*),intent(in) :: txt
+    call drawbox(stdout,txt,width=bw,charset=6,procedual=1,padl=2)
+  end subroutine gsg_line
+end subroutine gxtb_solvation_guard
+
+!========================================================================================!
+!========================================================================================!
+
+subroutine crest_no_runtype_selected()
+  !*****************************************************
+  !* Print an error when no runtype has been selected, *
+  !* list the available main runtypes, and stop.       *
+  !*****************************************************
+  use crest_parameters,only:stdout
+  use crest_data,only:status_safety
+  use iomod,only:colorify
+  implicit none
+  write (stdout,*)
+  write (stdout,'(1x,a)') repeat('=',60)
+  write (stdout,'(1x,a)') 'No runtype was selected.'
+  write (stdout,'(1x,a)') 'Please choose one of the main runtypes listed below.'
+  write (stdout,'(1x,a)') repeat('=',60)
+  write (stdout,*)
+  write (stdout,'(3x,a)') 'Main runtypes:'
+  write (stdout,*)
+  write (stdout,'(5x,a,t30,a)') '--sp','Single-point energy calculation'
+  write (stdout,'(5x,a,t30,a)') '--opt','Structure optimization'
+  write (stdout,'(5x,a,t30,a)') '--md','Molecular dynamics simulation'
+  write (stdout,'(5x,a,t30,a)') '--imtdgc/--v3','iMTD-GC conformational search '//colorify('(PREVIOUS DEFAULT)','gold')
+  write (stdout,'(5x,a,t30,a)') '--entropy','Entropy/free-energy sampling'
+  write (stdout,'(5x,a,t30,a)') '--mdopt','Ensemble optimization (no sorting)'
+  write (stdout,'(5x,a,t30,a)') '--screen','Ensemble screening'
+  write (stdout,'(5x,a,t30,a)') '--protonate','Protonation site search'
+  write (stdout,'(5x,a,t30,a)') '--deprotonate','Deprotonation site search'
+  write (stdout,'(5x,a,t30,a)') '--tautomerize','Tautomer generation'
+  write (stdout,'(5x,a,t30,a)') '--qcg','QCG workflows'
+  write (stdout,'(5x,a,t30,a)') '--msreact','MSREACT workflows'
+  write (stdout,'(5x,a,t30,a)') '--bh','Basin-hopping global optimization'
+  write (stdout,'(5x,a,t30,a)') '--sort','Ensemble sorting (CREGEN)'
+  write (stdout,*)
+  write (stdout,'(3x,a)') 'For TOML input files use:  crest --input <file.toml>'
+  write (stdout,'(3x,a)') 'For the full option list:  crest --help'
+  write (stdout,*)
+  call creststop(status_safety)
+end subroutine crest_no_runtype_selected
+
+!========================================================================================!
+
+subroutine crest_output_summary(env)
+!**************************************************
+!* Print a table of output files written by CREST *
+!* and a short description of their contents.     *
+!* Which files are listed depends on the runtype. *
+!**************************************************
+  use crest_parameters,only:stdout
+  use crest_data
+  implicit none
+  type(systemdata),intent(in) :: env
+  character(len=72),parameter :: hbar = repeat('-',80)
+  logical :: lexists
+
+  select case (env%crestver)
+  case (crest_imtd,crest_imtd2,crest_screen,crest_mdopt, &
+      & crest_sorting,crest_optimize,crest_trialopt,crest_rigcon, &
+      & crest_moldyn,crest_bh,crest_bhpt,crest_protonate,crest_deprotonate, &
+      & crest_tautomerize,crest_numhessian,crest_ensemblehess)
+    write (stdout,*)
+    write (stdout,*)
+    write (stdout,'(2x,a)') 'Important files written by CREST during this run'
+    write (stdout,'(1x,a)') hbar
+  end select
+
+  select case (env%crestver)
+    ! ── iMTD-GC / sMTD-iMTD conformer search ─────
+  case (crest_imtd,crest_imtd2)
+    call wfe('crest_conformers.xyz','unique conformers (1 per rotamer group), energy-sorted')
+    call wfe('crest_rotamers.xyz','all structures including rotamers, with Boltzmann weights')
+    call wfe('crest_best.xyz','lowest-energy conformer')
+    call wfe('cregen.full','full CREGEN output (written when terminal output is abbreviated)')
+    call wfe('crest.restart','restart/checkpoint file for the iMTD-GC algorithm')
+
+    ! ── ensemble screening / MDOPT ────────────────
+  case (crest_screen)
+    call wfe('crest_ensemble.xyz','ensemble output')
+    call wfe('crest_conformers.xyz','unique conformers (1 per rotamer group), energy-sorted')
+    call wfe('crest_rotamers.xyz','all structures including rotamers')
+    call wfe('crest_best.xyz','lowest-energy structure')
+
+  case (crest_mdopt)
+    call wfe('crest_ensemble.xyz','ensemble output with optimized geometries')
+    if (allocated(env%refine_queue)) &
+    & call wfe('crest_ensemble.xyz.refine','refined ensemble (after the requested --refine step)')
+
+    ! ── standalone CREGEN sorting ─────────────────
+  case (crest_sorting)
+    call wfe('crest_conformers.xyz','unique conformers (1 per rotamer group), energy-sorted')
+    call wfe('crest_rotamers.xyz','all structures including rotamers')
+    call wfe('crest_best.xyz','lowest-energy structure')
+    call wfe('cregen.full','full CREGEN output (written when terminal output is abbreviated)')
+
+    ! ── geometry optimization ─────────────────────
+  case (crest_optimize,crest_trialopt,crest_rigcon)
+    call wfe('crestopt.xyz','final optimized geometry')
+    call wfe('crestopt.log.xyz','step-by-step optimization trajectory')
+    if (env%crest_ohess) then
+      call wfe('numhess','Hessian matrix in Turbomole format (2nd derivatives, a.u.)')
+      call wfe('vibspectrum','vibrational frequencies (cm⁻¹) and IR intensities (km/mol)')
+      call wfe('g98.out','frequencies and normal modes in Gaussian output format')
+    end if
+
+    ! ── numerical Hessian ─────────────────────────
+  case (crest_numhessian)
+    call wfe('numhess','Hessian matrix in Turbomole format (2nd derivatives, a.u.)')
+    call wfe('vibspectrum','vibrational frequencies (cm⁻¹) and IR intensities (km/mol)')
+    call wfe('g98.out','frequencies and normal modes in Gaussian 98 output format')
+    call wfe('dipgrad','Cartesian dipole gradient ∂μ/∂x (a.u.), if available')
+
+    ! ── ensemble Hessians ─────────────────────────
+  case (crest_ensemblehess)
+    call wfe('crest_ensemble.xyz','input ensemble with Gibbs free energies as comments')
+    call wfe('crest.energies','plain list of total Gibbs free energies (Eh)')
+
+    ! ── molecular dynamics ────────────────────────
+  case (crest_moldyn)
+    call wfe('crest_dynamics.trj.xyz','MD trajectory (snapshots)')
+
+    ! ── basin-hopping ─────────────────────────────
+  case (crest_bh,crest_bhpt)
+    call wfe('crest_conformers.xyz','unique conformers found by basin-hopping, energy-sorted')
+    call wfe('crest_rotamers.xyz','all accepted structures including rotamers')
+    call wfe('crest_best.xyz','lowest-energy structure')
+
+    ! ── protonation / deprotonation / tautomers ───
+  case (crest_protonate)
+    call wfe('protonated.xyz','unique site candidates, energy-sorted')
+    call wfe('crest_best.xyz','lowest-energy structure')
+  case (crest_deprotonate)
+    call wfe('deprotonated.xyz','unique site candidates, energy-sorted')
+    call wfe('crest_best.xyz','lowest-energy structure')
+  case (crest_tautomerize)
+    call wfe('tautomers.xyz','unique site candidates, energy-sorted')
+    call wfe('crest_best.xyz','lowest-energy structure')
+
+  case default
+    ! no dedicated file summary for this runtype
+
+  end select
+
+  ! ── if PCA clustering was performed, report the cluster file ─────────────────
+  select case (env%crestver)
+  case (crest_imtd,crest_imtd2,crest_sorting)
+    inquire(file=clusterfile,exist=lexists)
+    if (lexists) call wfe(clusterfile,'representative structures from PCA/k-means clustering')
+  end select
+
+  select case (env%crestver)
+  case (crest_imtd,crest_imtd2,crest_screen,crest_mdopt, &
+      & crest_sorting,crest_optimize,crest_trialopt,crest_rigcon, &
+      & crest_moldyn,crest_bh,crest_bhpt,crest_protonate,crest_deprotonate, &
+      & crest_tautomerize,crest_numhessian,crest_ensemblehess)
+
+    write (stdout,'(1x,a)') hbar
+  end select
+
+contains
+  subroutine wfe(fname,descr)
+    character(len=*),intent(in) :: fname,descr
+    write (stdout,'(1x,a,t30,''│ '',a)') fname,trim(descr)
+  end subroutine wfe
+end subroutine crest_output_summary
diff --git a/src/propcalc.f90 b/src/propcalc.f90
deleted file mode 100644
index 7d22d97d..00000000
--- a/src/propcalc.f90
+++ /dev/null
@@ -1,941 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2018-2020 Philipp Pracht
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!================================================================================!
-
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-!c  Routines related to additonal property calculations
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-subroutine protreffrag(env)
-  use iso_fortran_env,wp => real64
-  use crest_data
-  use strucrd,only:rdnat,rdcoord
-  implicit none
-  type(systemdata) :: env
-  integer,allocatable  :: molvec(:)
-  integer,allocatable  :: at(:)
-  real(wp),allocatable :: xyz(:,:)
-
-  associate (nat => env%nat)
-!------ get number of fragments for original structure
-    allocate (xyz(3,nat),at(nat),molvec(nat))
-    call rdcoord('coord',nat,at,xyz)
-    call mrec(env%protb%nfrag,xyz,nat,at,molvec) !requires xyz in bohr
-    deallocate (molvec,at,xyz)
-  end associate
-end subroutine protreffrag
-
-!---------------------------------------------------------------------------------------
-! perform a property calculation for a given ensemble file
-!---------------------------------------------------------------------------------------
-subroutine propcalc(iname,imode,env,tim)
-  use iso_fortran_env,wp => real64
-  use crest_data
-  use iomod
-  use strucrd,only:rdensembleparam,rdensemble,wrxyz
-  use utilities,only:boltz2
-  use cregen_interface
-  implicit none
-
-  type(systemdata) :: env
-  type(timer)      :: tim
-  integer :: imode
-
-  character(len=*),intent(in)  :: iname   !file name
-
-  integer :: i,k,r,ii
-  integer :: TMPCONF
-  integer :: P
-  integer :: ich,ich2
-
-  interface
-    subroutine prop_OMP_loop(env,TMPCONF,jobcall,pop)
-      import :: systemdata,wp
-      implicit none
-
-      type(systemdata) :: env
-      integer :: TMPCONF
-      character(len=1024) :: jobcall
-      real(wp),intent(in),optional :: pop(TMPCONF)
-    end subroutine
-  end interface
-
-  character(len=20) :: xname
-  character(len=20) :: pipe
-  character(len=80) :: solv
-  character(len=256) :: ctmp
-  character(len=512) :: str,thispath,tmppath,optpath
-  character(len=1024):: jobcall
-  character(len=:),allocatable :: largejobcall
-
-  real(wp) :: pthr,sumpop
-  integer :: maxpop
-  integer :: nat,nall,ng,T,Tn
-  logical :: ex,update
-  logical :: niceprint
-
-  character(len=40),allocatable :: origin(:)
-  real(wp),allocatable :: eread(:),popul(:),dumm(:)
-  real(wp),allocatable :: xyz(:,:,:)
-  integer,allocatable  :: at(:)
-  logical,allocatable :: mask(:)
-  integer,allocatable :: degen(:,:)
-
-!---
-  call largehead('P R O P E R T Y   C A L C U L A T I O N')
-
-!--- some settings
-  solv = ''
-  pipe = '2>/dev/null'
-  xname = 'struc.xyz'
-  call getcwd(thispath)
-  update = .true.
-  maxpop = 1
-
-  if (env%properties == -666) then
-    imode = env%properties2
-  end if
-
-  niceprint = env%niceprint
-
-  pthr = env%pthr
-
-!---- read the input ensemble
-  call rdensembleparam(iname,nat,nall)
-  env%nat = nat
-  if (nall .lt. 1) return
-  allocate (xyz(3,nat,nall),at(nat),eread(nall),mask(nall))
-  mask = .true.
-  if (.not.env%trackorigin) then
-    call rdensemble(iname,nat,nall,at,xyz,eread)
-  else
-    allocate (origin(nall))
-    call rdensemble_origin(iname,nat,nall,at,xyz,eread,origin)
-  end if
-  TMPCONF = nall
-
-!---- Use only populated conformers for special applications
-  if (any((/2,111/) == imode)) then
-
-    allocate (popul(nall))
-    call boltz2(nall,eread,popul)
-    !write(*,*) eread
-    !write(*,*) popul
-    k = 0
-    maxpop = maxloc(popul(:),1) !locate max. populated structure (this one is always taken)
-    sumpop = 0.0_wp
-    do i = 1,nall
-      if (popul(i) .ge. pthr.or.i .eq. maxpop) then
-        k = k+1
-      else
-        exit
-      end if
-    end do
-    write (*,'(1x,a,i0,a)') 'Population threshold (-pthr) : ',nint(pthr*100.0_wp),' %'
-
-    write (*,'(1x,i0,a,i0,a)') k,' populated structure(s) (out of a total ', &
-    & nall,') will be considered.'
-
-    mask(:) = popul(:) .ge. pthr
-    mask(maxpop) = .true.
-  end if
-
-!---- for multilevel reoptimization don't use all rotamers
-  if (imode .ge. 50.and.imode .lt. 60) then
-    inquire (file='cre_members',exist=ex)
-    if (ex) then
-      open (newunit=ich,file='cre_members')
-      read (ich,*) ng
-      allocate (degen(3,ng))
-      do i = 1,ng
-        read (ich,*) degen(1:3,i)
-      end do
-      close (ich)
-      !-- always include lowest rotamer for all conf.
-      do i = 1,ng
-        mask(degen(2,i)) = .true.
-      end do
-    end if
-  end if
-
-!---- create the PROP directory
-  !---- create directory for the optimizations
-  optpath = 'PROP'
-  call rmrf(optpath)
-  r = makedir(trim(optpath))
-
-  call copysub('coord',trim(optpath))
-
-  call env%wrtCHRG(trim(optpath))
-  call copysub(env%fixfile,trim(optpath))
-  !call copysub(env%constraints,trim(optpath))
-  if (env%useqmdff) then
-    call copysub('solvent',trim(optpath))
-  end if
-  if (env%gfnver == '--gff') then
-    r = sylnk(trim(thispath)//'/'//'gfnff_topo',trim(optpath)//'/'//'gfnff_topo')
-  end if
-
-  call chdir(trim(optpath))
-  call getcwd(optpath)
-!---- set up sub-directories
-  write (*,'(1x,a,a,a)',advance='no') 'writing TMPCONF* Dirs from file "',trim(iname),'" ...'
-  ii = 1
-  do i = 1,nall
-    if ((imode .eq. 2).and.(allocated(popul))) then
-      if ((popul(i) .lt. pthr).and.i .ne. maxpop) cycle !skip unpopulated for '-prop autoir'
-    end if
-    if (.not.mask(i)) cycle
-
-    write (ctmp,'(''TMPCONF'',i0)') ii
-    r = makedir(trim(ctmp))
-    call chdir(ctmp)
-    open (newunit=ich,file=xname)
-    call wrxyz(ich,nat,at,xyz(:,:,i))
-
-    call write_cts(ich,env%cts)
-    close (ich)
-
-    if (imode .eq. 2.and.trim(env%gfnver) .eq. '--gfn2') then
-      call add_mass_xtb(xname)
-    end if
-
-    call chdir(optpath)
-
-    call env%wrtCHRG(trim(ctmp))
-    call copysub(env%fixfile,trim(ctmp))
-    if (env%useqmdff) then
-      call copysub('solvent',trim(ctmp))
-    end if
-    if (env%gfnver == '--gff') then
-      r = sylnk(trim(optpath)//'/'//'gfnff_topo',trim(ctmp)//'/'//'gfnff_topo')
-    end if
-
-    ii = ii+1
-  end do
-  write (*,'(1x,a)') 'done.'
-
-  if (any(mask.eqv..false.)) then
-    TMPCONF = ii-1
-    nall = ii-1
-    if (allocated(popul)) deallocate (popul)
-  end if
-
-!--- setting the threads for correct parallelization
-  call new_ompautoset(env,'auto',TMPCONF,T,Tn)
-
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-  call chdir(thispath)
-!--- select what to do
-  P = imode
-  select case (P)
-  case (1)
-    call smallhead('Hessian calculations for all conformers')
-    write (jobcall,'(a,1x,a,1x,a,'' --hess '',a,1x,a,'' >xtb.out'')') &
-    &    trim(env%ProgName),trim(xname),trim(env%gfnver),trim(env%solv),trim(pipe)
-  case (10)
-    call smallhead('Optimization + Hessian calculations for all conformers')
-    write (jobcall,'(a,1x,a,1x,a,'' --ohess '',a,1x,a,'' >xtb.out'')') &
-    &    trim(env%ProgName),trim(xname),trim(env%gfnver),trim(env%solv),trim(pipe)
-  case (13)
-    call smallhead('Free energy calculation in solvation')
-    write (jobcall,'(a,1x,a,1x,a,'' --sp '',a,'' >sp.out'')') &
-    &    trim(env%ProgName),trim(xname),trim(env%gfnver),trim(pipe) !E_gas(Solv_geom) singlepoint
-    largejobcall = trim(jobcall)//' ; '
-    write (jobcall,'(a,1x,a,1x,a,'' --ohess '',a,1x,a,'' >xtb.out'')') &
-    &    trim(env%ProgName),trim(xname),trim(env%gfnver),trim(env%solv),trim(pipe)
-    jobcall = largejobcall//trim(jobcall)
-  case (2)
-    call smallhead('IR calculation for populated conformers')
-    write (jobcall,'(a,1x,a,1x,a,'' --ohess '',a,1x,a,'' >xtb.out'')') &
-    &    trim(env%ProgName),trim(xname),trim(env%gfnver),trim(env%solv),trim(pipe)
-!       case( 3:6,7,8,100 ) ! unspecific case DFT
-!         call smallhead('DFT calculation using xtb as driver')
-!         if( any((/3,4/)==P) )then
-!           call dftrc_reader(env,.true.)  !B97-3c OPT default
-!           call dftTMwarning
-!         else
-!           call dftrc_reader(env,.false.) !read DFT settings
-!         endif
-!         call chdir(optpath)
-!         call cefine_setup(env,TMPCONF)
-!         call xtbDFTdriver(env,xname,jobcall) !create jobcall
-  case (20)
-    call smallhead('Reoptimization for all conformers')
-    write (jobcall,'(a,1x,a,1x,a,'' --opt vtight '',a,1x,a,'' >xtb.out'')') &
-    &    trim(env%ProgName),trim(xname),trim(env%gfnver),trim(env%solv),trim(pipe)
-  case (50:59)
-    call smallhead('Reoptimization of entire CRE')
-    write (jobcall,'(a,1x,a,1x,a,'' --opt vtight '',a,1x,a,'' >xtb.out'')') &
-    &    trim(env%ProgName),trim(xname),trim(env%gfnver2),trim(env%solv),trim(pipe)
-  case default
-    write (jobcall,'(a,1x,a,1x,a,'' --sp '',a,1x,a,'' >xtb.out'')') &
-    &    trim(env%ProgName),trim(xname),trim(env%gfnver),trim(env%solv),trim(pipe)
-  end select
-  call chdir(optpath)
-
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-  write (*,'(1x,a,i0,a)') 'Performing calculations for ', &
-  & TMPCONF,' structures ...'
-  call sleep(1)
-  call tim%start(10,'PROPERTY calc.')
-  allocate (dumm(TMPCONF),source=1.0_wp)
-  call prop_OMP_loop(env,TMPCONF,jobcall,dumm)  !<------- this is where the "magic" happens
-  deallocate (dumm)
-  write (*,*)
-  call tim%stop(10)
-  write (*,*) 'done.'
-
-  call tim%start(10,'PROPERTY calc.')
-
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-!--- select what to do with the output
-  select case (imode)
-
-!------ generate an ensemble with free energies from hessian calculations
-  case (1,10)
-    call rdpropens(TMPCONF,nat,xyz) !get updated geometries
-    open (newunit=ich,file='crest_property.xyz')
-    do i = 1,TMPCONF
-      write (tmppath,'(a,i0,a,a)') 'TMPCONF',i,'/','xtb.out'
-      call grepval(tmppath,'TOTAL FREE ENERGY',ex,eread(i))
-      if (.not.env%trackorigin) then
-        write (str,'(3x,f16.10)') eread(i)
-      else
-        write (str,'(3x,f16.10,2x,a,a)') eread(i),'!',trim(origin(i))
-      end if
-      call wrxyz(ich,nat,at,xyz(:,:,i),trim(str))
-    end do
-    close (ich)
-    env%ensemblename = 'crest_property.xyz'
-    env%confgo = .true.
-
-    call newcregen(env,0)
-
-    call rename('crest_property.xyz.sorted', &
-    & trim(thispath)//'/crest_property.xyz')
-    call remove(env%ensemblename)
-!------ IR averaging
-  case (2)
-    call autoir(TMPCONF,imode,env)
-    call rdpropens(TMPCONF,nat,xyz) !get updated geometries
-    call wrpropens(TMPCONF,nat,xyz,at,eread)
-!!----- DFT handling
-!       case( 3:8,100 )
-!         call DFTprocessing(env,TMPCONF,nat,at)
-!------ vtight reoptimization only for conformers!
-  case (20)
-    call rdpropens(TMPCONF,nat,xyz) !get updated geometries
-    call wrpropens(TMPCONF,nat,xyz,at,eread)
-    env%ensemblename = 'crest_property.xyz'
-    env%confgo = .true.
-
-    call newcregen(env,0)
-
-    call rename('crest_ensemble.xyz', &
-    & trim(thispath)//'/crest_conformers.xyz')
-  case (50:59)
-    call rdpropens(TMPCONF,nat,xyz) !get updated geometries
-    env%ensemblename = 'crest_reopt.xyz'
-    open (newunit=ich,file=env%ensemblename)
-    do i = 1,TMPCONF
-      write (tmppath,'(a,i0,a,a)') 'TMPCONF',i,'/','xtb.out'
-      call grepval(tmppath,'total energy',ex,eread(i))
-      if (.not.env%trackorigin) then
-        write (str,'(3x,f16.10)') eread(i)
-      else
-        write (str,'(3x,f16.10,2x,a,a)') eread(i),'!',trim(origin(i))
-      end if
-      call wrxyz(ich,nat,at,xyz(:,:,i),trim(str))
-    end do
-    close (ich)
-    call rename(env%ensemblename,trim(thispath)//'/'//env%ensemblename)
-    call chdir(thispath)
-    if (imode .lt. 59) then !TODO temporary skip for some testing
-      env%confgo = .true.
-
-      call newcregen(env,0)
-
-      env%confgo = .false.
-      call rename(trim(env%ensemblename)//'.sorted', &
-      & env%ensemblename)
-    end if
-
-  case (998) !singlepoint (no reranking) + dipoles
-    open (newunit=ich,file='crest_property.xyz')
-    open (newunit=ich2,file='crest.dipoles')
-    do i = 1,TMPCONF
-      write (tmppath,'(a,i0,a,a)') 'TMPCONF',i,'/','xtb.out'
-      call grepval(tmppath,'| TOTAL ENERGY',ex,eread(i))
-      write (str,'(3x,f16.10)') eread(i)
-      call wrxyz(ich,nat,at,xyz(:,:,i),trim(str))
-
-      call grepcntxt(tmppath,'molecular dipole:',ex,ctmp,3)
-      if (ex) then
-        write (ich2,'(a)') trim(ctmp(10:))
-      else
-        write (ich2,'(a)') ''
-      end if
-    end do
-    close (ich)
-    close (ich2)
-
-    call rename('crest.dipoles', &
-    & trim(thispath)//'/'//'crest.dipoles')
-
-    write (*,*)
-    write (*,*) 'Dipole moments for each conformer (x,y,z,total) written to crest.dipoles'
-
-  case (999) !singlepoint reranking
-    open (newunit=ich,file='crest_property.xyz')
-    do i = 1,TMPCONF
-      write (tmppath,'(a,i0,a,a)') 'TMPCONF',i,'/','xtb.out'
-      call grepval(tmppath,'| TOTAL ENERGY',ex,eread(i))
-      write (str,'(3x,f16.10)') eread(i)
-      call wrxyz(ich,nat,at,xyz(:,:,i),trim(str))
-    end do
-    close (ich)
-    env%ensemblename = 'crest_property.xyz'
-    env%confgo = .true.
-
-    call newcregen(env,0)
-
-    call rename('crest_property.xyz.sorted', &
-    & trim(thispath)//'/crest_property.xyz')
-    call remove(env%ensemblename)
-    call rename('crest_ensemble.xyz', &
-    & trim(thispath)//'/crest_ensemble.xyz')
-
-  case default
-    continue
-  end select
-
-!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-!>--- move around some files
-
-  inquire (file='cregen.out.tmp',exist=ex)
-  if (ex) then
-    call cat('cregen.out.tmp')
-  end if
-
-  inquire (file='crest.vibspectrum',exist=ex)
-  if (ex) then
-    call rename('crest.vibspectrum', &
-    & trim(thispath)//'/'//'crest.vibspectrum')
-  end if
-
-  inquire (file='crest_property.xyz',exist=ex)
-  if (ex) then
-    call rename('crest_property.xyz', &
-    & trim(thispath)//'/'//'crest_property.xyz')
-  end if
-
-  inquire (file='crest_populated.xyz',exist=ex)
-  if (ex) then
-    call rename('crest_populated.xyz', &
-    & trim(thispath)//'/'//'crest_populated.xyz')
-  end if
-
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-!>--- stop timer
-
-  call tim%stop(10)
-
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-!>--- change back to original directory (just to be sure)
-
-  call chdir(thispath)
-
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-!>--- decide if something has to be cleaned up here
-
-  if (env%pclean) then
-    select case (imode)
-    case (20,50:59,998,999)
-      call rmrf('PROP')
-    case default
-      continue
-    end select
-  end if
-
-  if (allocated(xyz)) deallocate (xyz)
-  if (allocated(at)) deallocate (at)
-  if (allocated(eread)) deallocate (eread)
-  if (allocated(origin)) deallocate (origin)
-  if (allocated(mask)) deallocate (mask)
-  if (allocated(popul)) deallocate (popul)
-
-end subroutine propcalc
-
-!----------------------------------------------------------------------------------------------------
-! THE OMP-PARALLEL LOOP
-!----------------------------------------------------------------------------------------------------
-subroutine prop_OMP_loop(env,TMPCONF,jobcall,pop)
-  use iso_fortran_env,wp => real64
-  use crest_data
-  use iomod
-  implicit none
-
-  type(systemdata) :: env
-  integer :: TMPCONF
-  character(len=1024) :: jobcall
-  real(wp),intent(in),optional :: pop(TMPCONF)
-
-  real(wp) :: pthr
-  logical :: niceprint
-  real(wp) :: percent
-  integer :: vz,k,i,maxpop,io
-  character(len=512) :: tmppath
-
-!----- quick settings
-  niceprint = env%niceprint
-  pthr = env%pthr
-  maxpop = maxloc(pop(:),1)
-  if (niceprint) then
-    call printprogbar(0.0_wp)
-  end if
-  k = 0        ! count finished jobs
-
-!$omp parallel &
-!$omp shared( vz,jobcall,TMPCONF,pop,pthr,percent,k,niceprint,maxpop )
-!$omp single
-  do i = 1,TMPCONF
-    vz = i
-    !$omp task firstprivate( vz ) private( tmppath,io )
-    call initsignal()
-    !$omp critical
-    write (tmppath,'(a,i0)') 'TMPCONF',vz
-    !$omp end critical
-    if (pop(vz) .ge. pthr.or.vz .eq. maxpop) then
-      call command('cd '//trim(tmppath)//' && '//trim(jobcall),io)
-    end if
-    !$omp critical
-    k = k+1
-    if (niceprint) then
-      percent = float(k)/float(TMPCONF)*100
-      call printprogbar(percent)
-    else
-      write (6,'(1x,i0)',advance='no') k
-      flush (6)
-    end if
-    !$omp end critical
-    !$omp end task
-  end do
-!$omp taskwait
-!$omp end single
-!$omp end parallel
-
-  return
-end subroutine prop_OMP_loop
-
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-! grep total energies and printout energy list
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-subroutine etotprop(TMPCONF,pop,pr)
-  use iso_fortran_env,wp => real64
-  use crest_data
-  use iomod
-  use utilities,only:boltz2
-  implicit none
-  integer,intent(in) :: TMPCONF
-  real(wp),intent(inout) :: pop(TMPCONF)
-  logical :: pr
-  character(len=512) :: tmppath
-  logical :: ex
-  integer :: i
-  real(wp) :: dE
-  real(wp),allocatable :: eread(:)
-
-  real(wp),parameter :: kcal = 627.5095_wp
-
-  write (*,'(1x,a)') "Calculating populations from total energies ..."
-  allocate (eread(TMPCONF))
-  do i = 1,TMPCONF
-    write (tmppath,'(a,i0,a,a)') 'TMPCONF',i,'/','xtb.out'
-    call grepval(tmppath,'total energy',ex,eread(i))
-  end do
-
-!--- convert to populations
-  call boltz2(TMPCONF,eread,pop)
-  if (pr) then
-    write (*,'(a)') '========================================================='
-    write (*,'(a)') '============= total energies & populations  ============='
-    write (*,'(a)') '========================================================='
-    write (*,'('' structure    ΔE(kcal/mol)    Etot(Eh)        weight'')')
-    do i = 1,TMPCONF
-      dE = (eread(i)-eread(1))*kcal
-      write (*,'(i5,6x,F10.2,4x,F14.6,F13.4)') i,dE,eread(i),pop(i)
-    end do
-    write (*,*)
-  end if
-  deallocate (eread)
-  return
-end subroutine etotprop
-
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-! grep optimized geometries (ONLY that, no energies)
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-subroutine rdpropens(TMPCONF,n,xyz)
-  use iso_fortran_env,wp => real64
-  use crest_data
-  use iomod
-  implicit none
-
-  integer,intent(in)  :: TMPCONF
-  integer,intent(in)  :: n
-  real(wp),intent(inout) :: xyz(3,n,TMPCONF)
-
-  integer :: ich
-  character(len=512) :: tmppath,atmp
-  character(len=64)  :: dum
-  logical :: ex
-  integer :: i,j
-
-  real(wp),parameter :: kcal = 627.5095_wp
-
-  do i = 1,TMPCONF
-    write (tmppath,'(a,i0,a,a)') 'TMPCONF',i,'/','xtbopt.xyz'
-    inquire (file=tmppath,exist=ex)
-    if (.not.ex) then
-      write (tmppath,'(a,i0,a,a)') 'TMPCONF',i,'/','struc.xyz'
-    end if
-    open (newunit=ich,file=tmppath)
-    read (ich,'(a)') atmp
-    read (ich,'(a)') atmp
-    do j = 1,n
-      read (ich,*) dum,xyz(1:3,j,i)
-    end do
-    close (ich)
-  end do
-
-  return
-end subroutine rdpropens
-subroutine wrpropens(TMPCONF,n,xyz,at,eread)
-  use iso_fortran_env,wp => real64
-  use crest_data
-  use iomod
-  use strucrd,only:wrxyz
-  implicit none
-
-  integer,intent(in)    :: TMPCONF
-  integer,intent(in)    :: n
-  real(wp),intent(in)   :: xyz(3,n,TMPCONF)
-  real(wp),intent(inout):: eread(TMPCONF)
-  integer,intent(in)    :: at(n)
-  integer :: ich
-  character(len=512) :: tmppath
-  logical :: ex
-  integer :: i
-
-  open (newunit=ich,file='crest_property.xyz')
-  do i = 1,TMPCONF
-    write (tmppath,'(a,i0,a,a)') 'TMPCONF',i,'/','xtb.out'
-    call grepval(tmppath,'total energy',ex,eread(i))
-    call wrxyz(ich,n,at,xyz(:,:,i),eread(i))
-  end do
-  return
-end subroutine wrpropens
-subroutine wrpropens_pop(env,TMPCONF,n,xyz,at,eread,pthr)
-  use iso_fortran_env,wp => real64
-  use crest_data
-  use iomod
-  use strucrd,only:wrxyz
-  use utilities,only:boltz2
-  implicit none
-
-  type(systemdata) :: env
-  integer,intent(in)    :: TMPCONF
-  integer,intent(in)    :: n
-  real(wp),intent(in)   :: xyz(3,n,TMPCONF)
-  real(wp),intent(in)   :: eread(TMPCONF)
-  integer,intent(in)    :: at(n)
-  real(wp),intent(in)   :: pthr
-  integer :: ich,ich5
-  integer :: i
-  integer :: pmax
-  real(wp),allocatable :: pop(:),dpop(:),edum(:)
-
-  allocate (pop(TMPCONF),dpop(TMPCONF))
-  call boltz2(TMPCONF,eread,pop)
-  pmax = maxloc(pop,1)
-
-  dpop = pop
-
-!      if(env%hardcutDFT)then
-!         call cutDFTpop(env,dpop,TMPCONF)
-!         allocate(edum(TMPCONF))
-!         edum=eread
-!         do i=1,TMPCONF
-!            if(dpop(i).le.0.00001_wp)then
-!              edum(i)=0.0_wp
-!            endif
-!         enddo
-!         call boltz2(TMPCONF,edum,pop)
-!         deallocate(edum)
-!      endif
-
-  open (newunit=ich5,file='autoir.pop')
-  open (newunit=ich,file='crest_populated.xyz')
-  do i = 1,TMPCONF
-    if (dpop(i) .lt. pthr.and.i .ne. pmax) cycle
-    write (ich5,'(1x,i0,1x,f6.4)') i,pop(i)
-    call wrxyz(ich,n,at,xyz(:,:,i),eread(i))
-  end do
-  close (ich)
-  close (ich5)
-  deallocate (dpop,pop)
-  return
-end subroutine wrpropens_pop
-
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-! obtain an averaged IR spectrum for the ensemble
-!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-subroutine autoir(TMPCONF,imode,env)
-  use iso_fortran_env,wp => real64
-  use crest_data
-  use iomod
-  use utilities,only:boltz2
-  implicit none
-
-  type(systemdata) :: env
-
-  integer,intent(in) :: TMPCONF
-  integer :: imode
-
-  integer :: i,j,k,l
-  integer :: nall,nmodes,mnew,npop
-  integer :: ich,ich5
-  character(len=512) :: tmppath
-  real(wp) :: dE
-  real(wp) :: pthr
-  logical :: ex
-  integer  :: minl,minll(1),maxl
-
-  real(wp),allocatable :: eread(:),pop(:),pop2(:),edum(:)
-  real(wp),allocatable :: vibspec(:,:,:)
-
-  real(wp),allocatable :: freq(:),tmpfreq(:),dum(:)
-  real(wp),allocatable :: inten(:),tmpint(:)
-
-  real(wp),parameter :: kcal = 627.5095_wp
-
-  nall = TMPCONF
-  pthr = env%pthr
-
-  write (*,*)
-  write (*,'(1x,a)') "Obtaining calculated vibspectra ..."
-
-  select case (imode)
-  case (2)
-!--- get the free energies for better weights
-    write (*,'(1x,a)') "Calculating populations from free energies ..."
-    allocate (eread(TMPCONF),pop(TMPCONF))
-    do i = 1,TMPCONF
-      write (tmppath,'(a,i0,a,a)') 'TMPCONF',i,'/','xtb.out'
-      call grepval(tmppath,'TOTAL FREE ENERGY',ex,eread(i))
-    end do
-  case default
-!--- just energies
-    write (*,'(1x,a)') "Calculating populations from total energies ..."
-    allocate (eread(TMPCONF),pop(TMPCONF))
-    do i = 1,TMPCONF
-      write (tmppath,'(a,i0,a,a)') 'TMPCONF',i,'/','xtb.out'
-      call grepval(tmppath,'total energy',ex,eread(i))
-    end do
-  end select
-!--- convert to populations
-  call boltz2(nall,eread,pop)
-!      if(env%hardcutDFT .and. imode.ne.2)then !special sort mode
-!         call cutDFTpop(env,pop,nall)
-!         allocate(edum(nall))
-!         edum(1:nall)=eread(1:nall)*pop(1:nall) !set energies of removed structures to 0
-!         call boltz2(nall,edum,pop) !convert to new populations, only with used structures
-!      endif
-  maxl = maxloc(pop(:),1)
-
-!--- short energy printout
-  write (*,*)
-  select case (imode)
-  case (2)
-    write (*,'(a)') '========================================================='
-    write (*,'(a)') '============= free energies & populations  =============='
-    write (*,'(a)') '========================================================='
-    write (*,'('' structure    ΔG(kcal/mol)    Gtot(Eh)        weight'')')
-  case default
-    write (*,'(a)') '========================================================='
-    write (*,'(a)') '============= total energies & populations  ============='
-    write (*,'(a)') '========================================================='
-    write (*,'('' structure    ΔE(kcal/mol)    Etot(Eh)        weight'')')
-  end select
-  do i = 1,nall
-    dE = (eread(i)-eread(1))*kcal
-    write (*,'(i5,6x,F10.2,4x,F14.6,F13.4)') i,dE,eread(i),pop(i)
-  end do
-  write (*,*)
-
-  !--- if only populated structures are required.
-  npop = 0
-  do i = 1,TMPCONF
-    if (pop(i) .ge. pthr.or.i .eq. maxl) npop = npop+1
-  end do
-  nall = npop
-  write (*,'(1x,i0,a,i0,a)') nall, &
-  & ' structures are above the population threshold of ',nint(pthr*100.0_wp),'%.'
-
-!--- read-in spectra
-  nmodes = env%nat*3
-  allocate (vibspec(2,nmodes,nall),pop2(nall))  !vibspec(1,:,i)=frequencies of mol i
-  !vibspec(2,:,i)=intensities of mol i
-
-  open (newunit=ich5,file='autoir.pop')
-  npop = 1
-  do i = 1,TMPCONF
-    if (pop(i) .ge. pthr.or.i .eq. maxl) then
-      write (ich5,'(1x,i0,1x,f6.4)') i,pop(i)
-      write (tmppath,'(a,i0,a,a)') 'TMPCONF',i,'/','vibspectrum'
-      call rdvibs(tmppath,nmodes,vibspec(1,:,npop),vibspec(2,:,npop))
-      pop2(npop) = pop(i)
-      npop = npop+1
-    end if
-  end do
-  close (ich5)
-
-  write (*,'(1x,a,i0,a)',advance='no') 'Weighting ',nall,' vibspectra ...'
-!--- weight spectra and sort frequencies
-  mnew = (nmodes-6)*nall+6
-  allocate (freq(mnew),inten(mnew))
-!--- write to new arrays
-  !--- translation first
-  do i = 1,6
-    freq(i) = 0.0_wp
-    inten(i) = 0.0_wp
-  end do
-  !--- then the vibspectra
-  l = 7
-  do k = 1,nall
-    do j = 7,nmodes
-      freq(l) = vibspec(1,j,k)
-      inten(l) = vibspec(2,j,k)*pop2(k) !scaled intensity
-      l = l+1
-    end do
-  end do
-
-!--- sort in ascending order
-  allocate (tmpfreq(mnew),tmpint(mnew),dum(mnew-6))
-  tmpfreq = 0.0_wp
-  tmpint = 0.0_wp
-  dum(:) = freq(7:mnew)
-  do i = 7,mnew
-    minll = minloc(dum)
-    minl = minll(1)
-    tmpfreq(i) = dum(minl)
-    tmpint(i) = inten(minl+6)
-    dum(minl) = 100000.0_wp
-  end do
-  freq = tmpfreq
-  inten = tmpint
-  deallocate (dum,tmpint,tmpfreq)
-
-  write (*,'(1x,a)') "done."
-  write (*,*)
-
-!--- write new file
-  open (file='crest.vibspectrum',newunit=ich)
-  call write_tm_vibspectrum(ich,mnew,freq,inten)
-  write (*,'(1x,a)') 'Written to file <crest.vibspectrum>'
-
-  deallocate (inten,freq,pop2,vibspec,pop,eread)
-
-  return
-end subroutine autoir
-
-!--- read vibspectrum file in TM format
-subroutine rdvibs(fname,nmodes,freq,inten)
-  use iso_fortran_env,wp => real64
-  use crest_data
-  use iomod
-  implicit none
-
-  character(len=*),intent(in) :: fname
-  integer,intent(in)   :: nmodes
-  real(wp),intent(out) :: freq(nmodes)    !frequencies
-  real(wp),intent(out) :: inten(nmodes)   !intensities
-
-  integer :: k
-  integer :: ich,io,n
-  character(len=256) :: atmp
-  real(wp) :: floats(10)
-  logical :: ex
-
-  freq = 0.0_wp
-  inten = 0.0_wp
-
-  inquire (file=fname,exist=ex)
-  if (.not.ex) return
-
-  k = 1 !modes
-  open (file=fname,newunit=ich)
-  rdfile: do
-    read (ich,'(a)',iostat=io) atmp
-    if (io < 0) exit
-    if (index(atmp,'$vibrational spectrum') .ne. 0) then
-      rdblock: do
-        read (ich,'(a)',iostat=io) atmp
-        if (io < 0) exit rdfile
-        if (index(atmp,'$end') .ne. 0) exit rdfile
-        if (index(atmp,'#') .ne. 0) cycle rdblock !skip comment lines
-        call readl(atmp,floats,n)
-        freq(k) = floats(2)
-        inten(k) = floats(3)
-        k = k+1
-      end do rdblock
-    end if
-  end do rdfile
-
-  return
-end subroutine rdvibs
-
-subroutine write_tm_vibspectrum(ich,n3,freq,ir_int)
-  use iso_fortran_env,wp => real64
-  integer,intent(in)  :: ich ! file handle
-  integer,intent(in)  :: n3
-  real(wp),intent(in)  :: freq(n3)
-  real(wp),intent(in)  :: ir_int(n3)
-  integer  :: i
-  real(wp) :: thr = 0.01_wp
-  write (ich,'("$vibrational spectrum")')
-  write (ich,'("#  mode     symmetry     wave number   IR intensity    selection rules")')
-  write (ich,'("#                         cm**(-1)        (amu)          IR     RAMAN")')
-  do i = 1,n3
-    if (abs(freq(i)) .lt. thr) then
-      write (ich,'(i6,9x,    f18.2,f16.5,7x," - ",5x," - ")') &
-        i,freq(i),0.0_wp
-    else
-      write (ich,'(i6,8x,"a",f18.2,f16.5,7x,"YES",5x,"YES")') &
-        i,freq(i),ir_int(i)
-    end if
-  end do
-  write (ich,'("$end")')
-end subroutine
-
diff --git a/src/qcg/CMakeLists.txt b/src/qcg/CMakeLists.txt
index 785a6c22..034766bc 100644
--- a/src/qcg/CMakeLists.txt
+++ b/src/qcg/CMakeLists.txt
@@ -18,8 +18,11 @@ set(dir "${CMAKE_CURRENT_SOURCE_DIR}")
 
 list(APPEND srcs
   "${dir}/volume.f90"
-  "${dir}/solvtool_misc.f90"
-  "${dir}/solvtool.f90"
+  "${dir}/qcg_coord_type.f90"
+  "${dir}/qcg_misc.f90"
+  "${dir}/qcg_main.f90"
+  "${dir}/qcg_printouts.f90"
+  "${dir}/qcg_utils.f90"
 )
 
 set(srcs ${srcs} PARENT_SCOPE)
diff --git a/src/qcg/meson.build b/src/qcg/meson.build
index 4e6cacbc..52c3cecf 100644
--- a/src/qcg/meson.build
+++ b/src/qcg/meson.build
@@ -15,7 +15,10 @@
 # along with crest.  If not, see <https://www.gnu.org/licenses/>.
 
 srcs += files(
-  'solvtool.f90',
-  'solvtool_misc.f90',
-  'volume.f90',
+'qcg_coord_type.f90',
+'qcg_main.f90',
+'qcg_misc.f90',
+'qcg_printouts.f90',
+'qcg_utils.f90',
+'volume.f90',
 )
diff --git a/src/qcg/qcg_coord_type.f90 b/src/qcg/qcg_coord_type.f90
new file mode 100644
index 00000000..9e732865
--- /dev/null
+++ b/src/qcg/qcg_coord_type.f90
@@ -0,0 +1,91 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2025 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+!
+module qcg_coord_type
+  use crest_parameters,only:wp
+  use strucrd,only:coord
+  implicit none
+  public
+
+  type,extends(coord) :: coord_qcg
+    !> new components that are added to the coord type:
+    integer   :: nmol          !> number of molecules
+    real(wp)  :: cma(3)        !> center of mass
+    real(wp)  :: aniso         !> anisotropy factor
+    real(wp)  :: ell_abc(3)    !> ellipsoid axis
+    real(wp)  :: atot          !> surface area
+    real(wp)  :: vtot          !> volume
+    real(wp)  :: rtot          !> radius
+    real(wp)  :: mass          !> mass
+    real(wp)  :: gt            !> gibbs free energy
+    real(wp)  :: ht            !> enthalpy
+    real(wp)  :: svib          !> vibrational entropy
+    real(wp)  :: srot          !> rotational entropy
+    real(wp)  :: stra          !> translational entropy
+    real(wp)  :: eax(3)        !> molecular axis
+  contains
+    procedure :: as_coord
+    procedure :: from_coord
+  end type coord_qcg
+
+!==============================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!==============================================================================!
+
+  function as_coord(this) result(mol)
+    class(coord_qcg),intent(in) :: this
+    type(coord) :: mol
+
+    mol%nat = this%nat
+    if (allocated(this%at)) mol%at = this%at
+    if (allocated(this%xyz)) mol%xyz = this%xyz
+
+    mol%energy = this%energy
+    if (allocated(this%comment)) mol%comment = this%comment
+    mol%chrg = this%chrg
+    mol%uhf = this%uhf
+    mol%nbd = this%nbd
+    if (allocated(this%bond)) mol%bond = this%bond
+    if (allocated(this%lat)) mol%lat = this%lat
+    if (allocated(this%qat)) mol%qat = this%qat
+    mol%pdb = this%pdb
+
+  end function as_coord
+
+  subroutine from_coord(this,mol)
+    class(coord_qcg),intent(inout) :: this
+    type(coord),intent(in) :: mol
+
+    this%nat = mol%nat
+    if (allocated(mol%at)) this%at = mol%at
+    if (allocated(mol%xyz)) this%xyz = mol%xyz
+
+    this%energy = mol%energy
+    if (allocated(mol%comment)) this%comment = mol%comment
+    this%chrg = mol%chrg
+    this%uhf = mol%uhf
+    this%nbd = mol%nbd
+    if (allocated(mol%bond)) this%bond = mol%bond
+    if (allocated(mol%lat)) this%lat = mol%lat
+    if (allocated(mol%qat)) this%qat = mol%qat
+    this%pdb = mol%pdb
+  end subroutine from_coord
+
+end module qcg_coord_type
+
diff --git a/src/qcg/qcg_main.f90 b/src/qcg/qcg_main.f90
new file mode 100644
index 00000000..c5bf4486
--- /dev/null
+++ b/src/qcg/qcg_main.f90
@@ -0,0 +1,2178 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2023 Christoph Plett, Sebastian Spicher, Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!> This file contains routines related to QCG and microsolvation
+
+subroutine crest_solvtool(env,tim)
+!***********************************************
+!* Main driver for all QCG runtypes
+!***********************************************
+  use crest_parameters,only:wp,autokcal
+  use qcg_printouts
+  use crest_data
+  use iomod
+  use qcg_coord_type
+  use strucrd
+  implicit none
+
+  type(systemdata):: env    ! MAIN STORAGE OS SYSTEM DATA
+  type(timer):: tim
+  !> Information about solvent, solute and cluster
+  type(coord_qcg) :: solute,solvent,cluster,cluster_backup
+  type(ensemble) :: full_ensemble,solvent_ensemble
+
+  integer :: progress,io
+  character(len=512) :: thispath
+
+!--- Molecule settings
+  solute%nmol = 1
+  solvent%nmol = 1
+  cluster%nmol = 1
+
+  progress = 0
+  call getcwd(thispath)
+
+  !>-----------------------------------
+  call qcg_head()
+  !>-----------------------------------
+
+!> Check, if xtb is present
+  call checkprog_silent(env%ProgName,.true.,iostat=io)
+  if (io /= 0) error stop 'No xtb found'
+
+!> Check, if xtbiff is present (if it is required)
+  if (env%use_xtbiff) then
+    call xtbiff_print_deprecated()
+  else
+    write (stdout,*)
+    write (stdout,*) ' This program uses the the aISS algorithm as implemnted in xtb.'
+    write (stdout,*) '      The aISS method requires xtb version 6.6.0 or newer.'
+    write (stdout,*) '           Tested with xtb version 6.7.1 (902b313)'
+    !write (stdout,*) '  xTB-IFF can still be used with the --xtbiff flag.'
+    write (stdout,*)
+  end if
+
+!------------------------------------------------------------------------------
+!   Setup
+!------------------------------------------------------------------------------
+  call write_qcg_setup(env) !Just an outprint of setup
+  call read_qcg_input(env,solute,solvent) !Reading mol. data and determining r,V,A
+  call qcg_setup(env,solute,solvent)
+  call qcg_restart(env,progress,solute,solvent,cluster,full_ensemble,&
+         & solvent_ensemble,cluster_backup)
+
+!-----------------------------------------------------------------------------
+!   Grow
+!-----------------------------------------------------------------------------
+  if (progress .le. env%qcg_runtype.and.progress .eq. 0) then
+    cluster = solute
+    call qcg_grow(env,solute,solvent,cluster,tim)
+    if (.not.env%cff) then
+      allocate (cluster_backup%at(cluster%nat))
+      allocate (cluster_backup%xyz(3,cluster%nat))
+      cluster_backup = cluster
+    end if
+    progress = progress+1
+    call chdirdbug(thispath)
+  end if
+
+!------------------------------------------------------------------------------
+!   Ensemble search
+!------------------------------------------------------------------------------
+  if (progress .le. env%qcg_runtype.and.progress .eq. 1) then
+    call print_qcg_ensemble()
+    call qcg_ensemble(env,solute,solvent,cluster,full_ensemble,tim,'ensemble')
+    progress = progress+1
+    call chdirdbug(thispath)
+  end if
+
+!------------------------------------------------------------------------------
+!   Solvent cluster generation
+!------------------------------------------------------------------------------
+  if (progress .le. env%qcg_runtype.and.progress .eq. 2) then !esolv
+    call pr_eval_solvent()
+    if (env%cff) then !CFF
+      call qcg_cff(env,solute,solvent,cluster,full_ensemble,&
+             & solvent_ensemble,tim)
+    else !Normal ensemble generation
+      call print_qcg_ensemble()
+      call cluster%deallocate
+      allocate (cluster%at(cluster_backup%nat))
+      allocate (cluster%xyz(3,cluster_backup%nat))
+      cluster = cluster_backup
+      deallocate (cluster_backup%at)
+      deallocate (cluster_backup%xyz)
+      env%solv_md = .true.
+      call qcg_ensemble(env,solute,solvent,cluster,solvent_ensemble,&
+             & tim,'solvent_ensemble')
+    end if
+    call pr_qcg_esolv()
+    write (stdout,'(2x,"|",9x,F8.2," kcal/mol ",12x,"|")') &
+           &   full_ensemble%g-solvent_ensemble%g-(solute%energy*autokcal)
+    write (stdout,'(2x,''========================================='')')
+    call chdirdbug(thispath)
+    progress = progress+1
+  end if
+
+!------------------------------------------------------------------------------
+!   Frequency computation and evaluation
+!------------------------------------------------------------------------------
+  if (progress .le. env%qcg_runtype.and.progress .eq. 3) then !gsolv
+    call qcg_freq(env,tim,solute,solvent,full_ensemble,solvent_ensemble)
+    call qcg_eval(env,solute,full_ensemble,solvent_ensemble)
+    progress = progress+1
+  end if
+
+!------------------------------------------------------------------------------
+!   Cleanup and deallocation
+!------------------------------------------------------------------------------
+  if (env%scratchdir .ne. 'qcg_tmp') call qcg_cleanup(env)
+  if (.not.env%keepModef) call rmrf('qcg_tmp')
+  call solute%deallocate
+  call solvent%deallocate
+  call cluster%deallocate
+  call full_ensemble%deallocate
+  call solvent_ensemble%deallocate
+  return
+end subroutine crest_solvtool
+
+!==============================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!==============================================================================!
+
+subroutine qcg_setup(env,solu,solv)
+  use iso_fortran_env,wp => real64
+  use crest_data
+  use iomod
+  use qcg_coord_type
+  use strucrd
+  use axis_module
+  implicit none
+
+  type(systemdata):: env
+  type(coord_qcg) :: solv,solu
+
+  integer :: io,f,r
+  integer :: num_O,num_H,i
+  character(len=*),parameter :: outfmt = '(1x,1x,a,1x,f14.7,a,1x)'
+  logical :: e_there,tmp,used_tmp,gbsa_tmp
+  character(len=512) :: thispath,tmp_grow
+  character(len=40)  :: solv_tmp
+  character(len=80)  :: atmp
+  character(len=20)  :: gfnver_tmp
+
+  call getcwd(thispath)
+
+  ! Remove scratch dir, if present
+  inquire (file='./qcg_tmp/solute_properties/solute',exist=tmp)
+  if (tmp) call rmrf('qcg_tmp') !User given scratch dir will be removed anyway after run
+
+  ! Make scratch directories
+  if (env%scratchdir .eq. '') then !check if scratch was not set
+    env%scratchdir = 'qcg_tmp'
+    io = makedir('qcg_tmp')
+  end if
+  if (env%fixfile /= 'none selected') then
+    call copysub(env%fixfile,env%scratchdir)
+  end if
+  call chdirdbug(env%scratchdir)
+
+  f = makedir('solute_properties')
+  if (env%fixfile /= 'none selected') then
+    call copysub(env%fixfile,env%scratchdir)
+  end if
+  r = makedir('solvent_properties')
+
+  if (.not.env%nopreopt) then
+    write (stdout,*)
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,'(2x,''|            Preoptimization            |'')')
+    write (stdout,'(2x,''========================================='')')
+  end if
+
+  solv_tmp = env%solv
+  gbsa_tmp = env%gbsa
+  env%solv = ''
+  env%gbsa = .false.
+
+!---- Properties solute
+  call chdirdbug('solute_properties')
+  call env%wrtCHRG('') !Write three lines in QCG mode, but xtb anyway only reads first one
+
+!---- Geometry preoptimization solute
+  if (env%final_gfn2_opt) then !If GFN2 final opt, solute also GFN2 optimized
+    gfnver_tmp = env%gfnver
+    env%gfnver = '--gfn2'
+  end if
+
+  if ((.not.env%nopreopt).and.(solu%nat /= 1)) then
+    call xtb_opt_qcg(env,solu,.true.)
+  end if
+
+!--- Axistrf
+  call axistrf(solu%nat,solu%nat,solu%at,solu%xyz)
+  call solu%write('solute')
+
+!---- SP-Computation solute
+  call xtb_sp_qcg(env,'solute',e_there,solu%energy)
+
+  if (.not.e_there) then
+    write (stdout,*) 'Total Energy of solute not found'
+  else
+    write (stdout,outfmt) 'Total Energy of solute: ',solu%energy,' Eh'
+  end if
+
+  if (env%final_gfn2_opt) then !If GFN2 final opt, solute also GFN2 optimized
+    env%gfnver = gfnver_tmp
+  end if
+
+  call chdirdbug(thispath)
+
+! No constraints for solvent possible
+  used_tmp = env%cts%used
+  env%cts%used = .false.
+
+!---- Properties solvent
+  call chdirdbug(env%scratchdir)
+  call chdirdbug('solvent_properties')
+  !No charges for solvent written. This is currently not possible
+
+!---- Geometry preoptimization solvent
+  if ((.not.env%nopreopt).and.(solv%nat /= 1)) then
+    call xtb_opt_qcg(env,solv,.false.)
+  end if
+  call solv%write('solvent')
+
+!---- SP-Computation solvent
+  call xtb_sp_qcg(env,'solvent',e_there,solv%energy)
+
+  if (.not.e_there) then
+    write (stdout,'(1x,a)') 'Total Energy of solvent not found'
+  else
+    write (stdout,outfmt) 'Total energy of solvent:',solv%energy,' Eh'
+  end if
+
+  call chdirdbug(thispath)
+
+!---- Overwriting solute and solvent in original folder
+  call solu%write('solute')
+  call solv%write('solvent')
+
+  num_O = 0
+  num_H = 0
+!--- Check, if water is solvent
+  if (solv%nat .eq. 3) then
+    do i = 1,solv%nat
+      if (solv%at(i) .eq. 8) num_O = num_O+1
+      if (solv%at(i) .eq. 1) num_H = num_H+1
+    end do
+  end if
+  if (num_O .eq. 1.AND.num_H .eq. 2) then
+    env%water = .true.
+    if (.not.env%noconst) env%constrain_solu = .true.
+  end if
+
+  env%solv = solv_tmp
+  env%gbsa = gbsa_tmp
+  env%cts%used = used_tmp
+
+end subroutine qcg_setup
+
+!==============================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!==============================================================================!
+
+subroutine read_qcg_input(env,solu,solv)
+  use crest_parameters
+  use crest_data
+  use iomod
+  use qcg_coord_type
+  use strucrd
+  use atmasses
+  use qcg_utils
+  implicit none
+
+  type(systemdata)               :: env
+  type(coord_qcg),intent(inout) :: solu,solv
+  logical                        :: pr
+  real(wp),parameter            :: third = 1.0d0/3.0d0
+  integer                        :: i
+  real(wp)                       :: r_solu,r_solv
+
+  pr = .true.
+
+!--- Read in solu and solv coordinates and make solute and solvent file in WD
+  call inputcoords_qcg(env,solu,solv)
+
+!--- CMA-Trafo
+  call cma_shifting(solu,solv)
+
+!--- Setting solute charge and uhf to input
+  solu%chrg = env%chrg
+  solu%uhf = env%uhf
+
+!--- Getting r, V, A
+  write (stdout,*)
+  write (stdout,*) 'Solute geometry'
+  call get_sphere(.true.,solu,.true.) !r,V,A of solute
+  write (stdout,*) 'Solvent geometry'
+  call get_sphere(.true.,solv,.true.) !r,V,A of solvent
+
+  r_solu = solu%vtot**third
+  r_solv = solv%vtot**third
+  write (stdout,*)
+  write (stdout,'(2x,''radius of solute    : '',f8.2)') r_solu
+  write (stdout,'(2x,''radius of solvent   : '',f8.2)') r_solv
+
+!--- Determine masses (for later density computation)
+  do i = 1,solu%nat
+    solu%mass = solu%mass+ams(solu%at(i))
+  end do
+  do i = 1,solv%nat
+    solv%mass = solv%mass+ams(solv%at(i))
+  end do
+  solu%mass = solu%mass*amutokg
+  solv%mass = solv%mass*amutokg
+
+!--- If directed docking is requested, it is read in here:
+  if (allocated(env%directed_file)) then
+    call read_directed_input(env)
+  end if
+
+end subroutine read_qcg_input
+
+!==============================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!==============================================================================!
+
+!> Read input for directed docking
+subroutine read_directed_input(env)
+  use crest_parameters
+  use crest_data
+  implicit none
+
+  type(systemdata)           :: env
+
+  integer                    :: nlines
+  integer                    :: io,ich,i,i_check
+  integer                    :: index
+  character(len=512)         :: dum
+  character(len=1),parameter :: delim_space = ' ',delim_tab = achar(9)
+
+  open (newunit=ich,file=env%directed_file)
+  !First check number of lines
+  nlines = 0
+  do
+    read (ich,*,iostat=io)
+    if (io /= 0) exit
+    nlines = nlines+1
+  end do
+  !Allocate directed list
+  !First entry is the atom number, Second how many solvents to add to this atom
+  allocate (env%directed_list(nlines,2))
+  allocate (env%directed_number(nlines),source=0)
+  !Now read lines into directed_list
+  rewind (ich)
+  do i = 1,nlines
+    read (ich,'(A)') dum
+    !> Remove leading tab and spaces first
+    dum = adjustl(dum) !Leading spaces are removed
+    index = SCAN(trim(dum),delim_tab)
+    if (index == 1) then !Leading tab -> remove it
+      dum = dum(2:)
+    end if
+    index = SCAN(trim(dum),delim_space)
+    if (index == 0) then !No space = check for tab
+      index = SCAN(trim(dum),delim_tab)
+    end if
+    if (index == 0) then  !Second value is missing
+      write (stdout,'(a,1x,i0)') "No second value found in directed list on line",i
+      error stop
+    end if
+    env%directed_list(i,1) = dum(1:index-1)
+    env%directed_list(i,2) = dum(index+1:)
+    !Remove multiple spaces
+    env%directed_list(i,2) = adjustl(env%directed_list(i,2))
+    !Check, if spaces are still in second argument (e.g. a third number is giveb)
+    index = SCAN(trim(env%directed_list(i,2)),delim_space)
+    if (index == 0) index = SCAN(trim(dum),delim_tab)
+    if (index /= 0) then
+      write (stdout,'(a,1x,i0)') "Too many values at line",i
+      error stop
+    end if
+    !> Make array with which solvent molecule at which atom to add
+    read (env%directed_list(i,2),*,iostat=io) env%directed_number(i)
+    env%directed_number(i) = sum(env%directed_number)
+    if (io /= 0) then
+      write (stdout,'(a,1x,i0)') "Second value is no number in line",i
+      error stop
+    end if
+  end do
+  close (ich)
+  write (stdout,*) 'Performing directed docking'
+  do i = 1,nlines
+    write (stdout,'(a,1x,a,1x,a,1x,a)') 'Docking',trim(env%directed_list(i,2)),&
+           & 'solvent molecules at',trim(env%directed_list(i,1))
+  end do
+
+end subroutine read_directed_input
+
+!==============================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!==============================================================================!
+
+subroutine qcg_grow(env,solu,solv,clus,tim)
+  use crest_parameters
+  use crest_data
+  use qcg_printouts
+  use iomod
+  use qcg_coord_type
+  use strucrd
+  use qcg_utils
+  implicit none
+
+  type(systemdata)           :: env
+  type(coord_qcg)            :: solu,solv,clus
+  type(timer)                :: tim
+
+  integer                    :: minE_pos,m
+  integer                    :: iter = 1
+  integer                    :: i,j,io,v
+  integer                    :: max_cycle
+  integer                    :: nat_backup
+  logical                    :: e_there,high_e,success,neg_E
+  real(wp)                   :: etmp(500)
+  real(wp),allocatable       :: e_each_cycle(:)
+  real(wp)                   :: dens,dum,efix
+  real(wp)                   :: e_diff = 0.0_wp
+  real(wp),allocatable       :: E_inter(:)
+  real(wp)                   :: shr = 0.0_wp
+  real(wp)                   :: shr_av = 0.0_wp
+  real(wp)                   :: mean = 0.0_wp
+  real(wp)                   :: mean_old = 0.0_wp
+  real(wp)                   :: mean_diff = 0.0_wp
+  character(len=*),parameter :: outfmt = '(1x,1x,a,1x,f14.7,a,1x)'
+  character(len=512)         :: thispath,resultspath
+  character(len=20)          :: gfnver_tmp
+  integer                    :: ich99,ich15,ich88
+  character(len=LEN(env%solv)) :: solv_tmp
+  logical                    :: gbsa_tmp
+
+  if (env%nsolv .gt. 0) then
+    allocate (e_each_cycle(env%nsolv))
+    allocate (E_inter(env%nsolv))
+  else
+    allocate (e_each_cycle(env%max_solv))
+    allocate (E_inter(env%max_solv))
+  end if
+
+  call tim%start(5,'QCG Grow')
+
+  call pr_eval_solute()
+  call print_qcg_grow()
+  call getcwd(thispath)
+  io = makedir('grow')
+  call chdirdbug('grow') !Results directory
+
+!--- Output Files
+  open (newunit=ich99,file='qcg_energy.dat')
+  write (ich99,'(i0,2F20.8)') 0,solu%energy,solv%energy
+  open (newunit=ich15,file='qcg_grow.xyz')  ! for molden movie
+  open (newunit=ich88,file='qcg_conv.dat')  ! for convergence check
+  write (ich88,'(''   #   Energy       Run. Aver.   Diff / au.'')')
+
+  call getcwd(resultspath)
+  call chdirdbug(thispath)
+
+  if (env%water) then
+    if (.not.env%user_wscal) then
+      if (solu%nat .lt. 18) then
+        env%potscal = 0.7_wp
+      else
+        env%potscal = 0.8_wp
+      end if
+      write (stdout,*)
+      write (stdout,'(2x,''Water as solvent recognized,&
+              & adjusting scaling factor for outer wall pot to '',F4.2)')&
+             & env%potscal
+      write (stdout,*)
+    end if
+  end if
+  if (env%constrain_solu) write (stdout,'(2x,''Constraining solute during Growth '')')
+
+  call get_ellipsoid(env,solu,solv,clus,.true.)
+  call pr_grow_energy()
+
+  call chdirdbug(env%scratchdir)
+  v = makedir('tmp_grow')
+  if (env%fixfile /= 'none selected') then
+    call copysub(env%fixfile,'tmp_grow')
+  end if
+  call chdirdbug('tmp_grow')
+  call solu%write('solute')
+  call solv%write('solvent')
+  call env%wrtCHRG('') !Write .CHRG file for docking
+
+  call ellipsout('solute_cavity.coord',clus%nat,clus%at,clus%xyz,solu%ell_abc)
+  solv%ell_abc = clus%ell_abc
+
+  clus%chrg = solu%chrg
+  clus%uhf = solu%uhf
+
+  if (env%nsolv .gt. 0) then
+    max_cycle = env%nsolv !User set number of solvents to add
+  else
+    max_cycle = env%max_solv !No solvent number set
+  end if
+
+!--------------------------------------------------------
+! Start Loop
+!--------------------------------------------------------
+  GROW_LOOP: do iter = 1,max_cycle
+    e_there = .false.
+    success = .false.
+    high_e = .false.
+    neg_E = .false.
+!---- Computation
+    if (iter .gt. 1) then
+      call get_ellipsoid(env,solu,solv,clus,.false.)
+    end if
+
+    call both_ellipsout('twopot_1.coord',clus%nat,clus%at,clus%xyz,&
+           & clus%ell_abc,solu%ell_abc)
+
+    CHECKWALL: do while (.not.success) !For restart with larger wall pot
+      if (iter .eq. 1) then
+        call xtb_dock(env,'solute','solvent',solu,solv)
+        call check_dock(neg_E)
+
+!-- If Interaction Energy is not negativ and existent, wall pot. too small and increase
+        if (neg_E) then
+          success = .true.
+        else
+          if (env%potscal .lt. 1.0_wp) then
+            write (stdout,*) '  Wall Potential too small, increasing size by 5 %'
+            solv%ell_abc = solv%ell_abc*1.05_wp
+            env%potscal = env%potscal*1.05_wp
+            if (env%potscal .gt. 1.0_wp) env%potscal = 1.0_wp
+            write (stdout,'(''   New scaling factor '',F4.2)') env%potscal
+          else
+            success = .true.
+          end if
+        end if
+      else
+        call xtb_dock(env,'cluster.coord','solvent',solu,clus)
+        call check_dock(neg_E)
+
+        if (neg_E) then
+          success = .true.
+        else
+          if (env%potscal .lt. 1.0_wp) then
+            write (stdout,*) '  Wall Potential too small, increasing size by 5 %'
+            clus%ell_abc = clus%ell_abc*1.05_wp
+            env%potscal = env%potscal*1.05_wp
+            if (env%potscal .gt. 1.0_wp) env%potscal = 1.0_wp
+            write (stdout,'(''   New scaling factor '',F4.2)') env%potscal
+          else
+            success = .true.
+          end if
+        end if
+      end if
+    end do CHECKWALL
+
+!--- Increase cluster size
+    nat_backup = clus%nat
+    call clus%deallocate
+    clus%nat = nat_backup+solv%nat
+    allocate (clus%at(clus%nat))
+    allocate (clus%xyz(3,clus%nat))
+    clus%nmol = clus%nmol+1
+
+!--- Select xtb-IFF stucture to proceed
+    call rdcoord('best.xyz',clus%nat,clus%at,clus%xyz,clus%energy)
+
+    call remove('cluster.coord')
+    call clus%write('cluster.coord')
+    call both_ellipsout('twopot_2.coord',clus%nat,clus%at,clus%xyz,&
+           & clus%ell_abc,solu%ell_abc)
+
+    success = .false.
+
+!--- Cluster restart, if interaction energy not negativ (wall pot. too small)
+    gfnver_tmp = env%gfnver !> backup original level of theory
+    do while (.not.success)
+!--- Cluster optimization
+      if (env%cts%used) then
+        call write_reference(env,solu,clus) !new fixed file
+      end if
+
+!--- Interaction energy
+      !gfnver_tmp = env%gfnver
+      env%gfnver = env%lmover
+      gbsa_tmp = env%gbsa
+      solv_tmp = env%solv
+      env%gbsa = .false.
+      env%solv = ''
+      call get_interaction_E(env,solu,solv,clus,iter,E_inter)
+      env%gbsa = gbsa_tmp
+      env%solv = solv_tmp
+      if (E_inter(iter) .lt. 0) then
+        success = .true.
+      else
+        if (env%potscal .lt. 1.0_wp) then
+          write (stdout,*) '  Interaction Energy positiv, increasing outer wall pot by 5 %'
+          clus%ell_abc = clus%ell_abc*1.05_wp
+          env%potscal = env%potscal*1.05_wp
+          if (env%potscal .gt. 1.0_wp) env%potscal = 1.0_wp
+          write (stdout,'('' New scaling factor '',F4.2)') env%potscal
+        else
+          success = .true.
+        end if
+      end if
+    end do
+    env%gfnver = gfnver_tmp
+
+!--- For output
+    !Energy already read from xyz file
+    e_each_cycle(iter) = clus%energy
+
+!--- Calclulate fix energy + diff. energy
+    efix = clus%energy/sqrt(real(clus%nat))
+    dum = solu%energy
+    if (iter .gt. 1) dum = e_each_cycle(iter-1)
+    e_diff = e_diff+autokcal*(e_each_cycle(iter)-solv%energy-dum)
+    call ellipsout('cluster_cavity.coord',clus%nat,clus%at,clus%xyz,clus%ell_abc)
+    call both_ellipsout('twopot_cavity.coord',clus%nat,clus%at,clus%xyz,&
+           & clus%ell_abc,solu%ell_abc)
+
+!--- Density calculations
+    call get_sphere(.false.,clus,.false.) !V, A of new cluster
+    dens = 0.001*(solu%mass+iter*solv%mass)/(1.0d-30*clus%vtot*bohr**3)
+
+!--- Movie file
+    write (ich15,*) clus%nat
+    write (ich15,'('' SCF done '',2F16.8)') autokcal*(e_each_cycle(iter)-solv%energy-dum)
+    do j = 1,clus%nat
+      write (ich15,'(a,1x,3F24.10)') i2e(clus%at(j)),clus%xyz(1:3,j)*bohr
+    end do
+
+!--- Output
+    ! dist of new mol from solute for output
+    call analyze_cluster(iter,clus%nat,solu%nat,solv%nat,clus%xyz,clus%at,shr_av,shr)
+
+    write (stdout,'(x,i4,F13.6,1x,f7.2,3x,es9.2,5x,f6.3,3x,f8.3,3x,2f6.1,2x,f8.1,3x,a,x)') &
+          & iter,e_each_cycle(iter),autokcal*(e_each_cycle(iter)-solv%energy-dum),&
+          & e_diff,dens,efix,shr_av,shr,clus%vtot,trim(optlevflag(env%optlev))
+    write (ich99,'(i4,F20.10,3x,f8.1)') iter,e_each_cycle(iter),clus%vtot
+
+!--- Calculate moving average
+    mean_old = mean
+    do i = 0,iter-1
+      mean = mean+E_inter(iter-i)
+    end do
+    mean = mean/iter
+    mean_diff = mean-mean_old
+    write (ich88,'(i5,1x,3F13.8)') iter,E_inter(iter)*autokcal,mean,mean_diff
+
+!--- Check if converged when no nsolv was given
+    if (env%nsolv .eq. 0) then
+      if (abs(mean_diff) .lt. 1.0d-4.and.iter .gt. 5) then
+        env%nsolv = iter
+        exit
+      end if
+      if (iter .eq. env%max_solv) then
+        write (stdout,'(1x,''No convergence could be reached upon adding'',1x,i4,1x,&
+                & ''solvent molecules.'')') env%max_solv
+        write (stdout,*) ' Proceeding.'
+        env%nsolv = env%max_solv
+        exit
+      end if
+    end if
+!-----------------------------------------------
+! End loop
+!-----------------------------------------------
+  end do GROW_LOOP
+
+  if (env%nsolv .eq. 0) env%nsolv = iter !if no env%solv was given
+
+  if (env%gfnver .ne. '--gfn2'.and.env%final_gfn2_opt) then
+    gfnver_tmp = env%gfnver
+    env%gfnver = '--gfn2'
+    write (stdout,'(2x,''Final gfn2 optimization'')')
+    call opt_cluster(env,solu,clus,'cluster.coord',.false.)
+    call rdcoord('xtbopt.coord',clus%nat,clus%at,clus%xyz)
+    call clus%write('cluster.coord')
+    call grepval('xtb_sp.out','| TOTAL ENERGY',e_there,clus%energy)
+    if (.not.e_there) then
+      write (stdout,'(1x,a)') 'Total Energy of cluster not found.'
+    else
+      write (stdout,'(2x,''Total gfn2-energy of cluster/Eh:'',f20.6)') clus%energy
+    end if
+    env%gfnver = gfnver_tmp
+  end if
+
+  call wrxyz('cluster.xyz',clus%nat,clus%at,clus%xyz*bohr)
+
+!--- One optimization without Wall Potential and with implicit model
+  gfnver_tmp = env%gfnver
+  if (env%final_gfn2_opt) env%gfnver = '--gfn2'
+  call opt_cluster(env,solu,clus,'cluster.xyz',.true.)
+  env%gfnver = gfnver_tmp
+  call rename('xtbopt.xyz','cluster_optimized.xyz')
+  call copysub('cluster_optimized.xyz',resultspath)
+
+!--- output and files
+  write (stdout,*)
+  write (stdout,'(2x,''Growth finished after '',i0,'' solvents added'')') env%nsolv
+  write (stdout,'(2x,''Results can be found in grow directory'')')
+  write (stdout,'(2x,''Energy list in file <qcg_energy.dat>'')')
+  write (stdout,'(2x,''Interaction energy in file <qcg_conv.dat>'')')
+  write (stdout,'(2x,''Growing process in <qcg_grow.xyz>'')')
+  write (stdout,'(2x,''Final geometry after grow in <cluster.coord> and <cluster.xyz>'')')
+  write (stdout,'(2x,''Final geometry optimized without wall potential in <cluster_optimized.xyz>'')')
+  write (stdout,'(2x,''Potentials and geometry written in <cluster_cavity.coord> and <twopot_cavity.coord>'')')
+
+  close (ich99)
+  close (ich88)
+  close (ich15)
+
+!--- Saving results and cleanup
+  call copysub('cluster.coord',resultspath)
+  call copysub('cluster.xyz',resultspath)
+  call copysub('twopot_cavity.coord',resultspath)
+  call copysub('cluster_cavity.coord',resultspath)
+  call copysub('solute_cavity.coord',resultspath)
+!  call rename('xcontrol','wall_potential')
+  env%constrain_solu = .false.
+  call write_wall(env,solu%nat,solu%ell_abc,clus%ell_abc,'wall_potential')
+  call copysub('wall_potential',resultspath)
+
+  call chdirdbug(thispath)
+  call chdirdbug(env%scratchdir)
+  if (.not.env%keepModef) call rmrf('tmp_grow')
+
+  deallocate (e_each_cycle,E_inter)
+
+  call tim%stop(5)
+
+end subroutine qcg_grow
+
+!==============================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!==============================================================================!
+!
+subroutine qcg_ensemble(env,solu,solv,clus,ens,tim,fname_results)
+  use crest_parameters
+  use crest_data
+  use cregen_interface
+  use crest_calculator
+  use iomod
+  use parse_xtbinput
+  use qcg_coord_type
+  use qcg_printouts
+  use qcg_utils
+  use strucrd
+  use utilities
+  implicit none
+
+  type(systemdata) :: env
+  type(coord_qcg)  :: solu,solv,clus
+  type(ensemble)   :: ens,dum
+  type(timer)      :: tim
+
+  integer :: i,j,k,io,f,r,ich,T,Tn,minpos
+  character(len=512) :: thispath,resultspath,tmppath,tmppath2
+  character(len=512) :: scratchdir_tmp
+  character(len=512) :: jobcall
+  character(len=256) :: inpnam,outnam
+  character(len=80)  :: fname,pipe,to
+  character(len=*)   :: fname_results
+  character(len=64)  :: comment
+  character(len=:),allocatable :: gfnver_tmp
+  character(len=:),allocatable :: solv_tmp
+  logical              :: gbsa_tmp,ex,mdfail,e_there,checkiso_tmp,cbonds_tmp
+  real(wp),allocatable :: e_fix(:),e_clus(:)
+  real(wp)             :: S,H,G,dens,shr,shr_av
+  real(wp)             :: sasa
+  real(wp)             :: newtemp,newmdtime,newmdstep,newhmass
+  real(wp)             :: newmetadlist,newmetadexp,newmetadfac
+  real(wp)             :: optlev_tmp
+  real(wp)             :: e0
+  real(wp),allocatable :: de(:)
+  real(wp),allocatable :: p(:)
+  integer              :: ich98,ich65,ich48
+  logical              :: not_param = .false.
+  type(timer)          :: tim_dum !Dummy timer to avoid double counting
+  type(calcdata) :: calc_tmp
+  logical,parameter :: debug = .true.
+
+  if (.not.env%solv_md) then
+    call tim%start(6,'QCG Solute-Ensemble')
+  else
+    call tim%start(7,'QCG Solvent-Ensemble')
+  end if
+
+  call tim_dum%init(20)
+
+!--- Setting up directories
+  call getcwd(thispath)
+  f = makedir(fname_results)
+  call chdirdbug(fname_results)
+  call getcwd(resultspath)
+  call chdirdbug(thispath)
+
+!--- Setting defaults and backups
+  env%cts%NCI = .true.  !Activating to have wall pot. written in coord file for xtb
+  optlev_tmp = env%optlev
+  env%optlev = 0.0d0
+  gbsa_tmp = env%gbsa
+  solv_tmp = env%solv
+  env%gbsa = .false.
+  env%solv = ''
+
+!--- Setting up potential constraints
+  allocate (env%cts%pots(10))
+  env%cts%pots = ''
+  write (env%cts%pots(1),'("$wall")')
+  write (env%cts%pots(2),'(2x,"potential=polynomial")')
+  write (env%cts%pots(3),'(2x,"ellipsoid:",1x,3(g0,",",1x),"all")') clus%ell_abc
+  if (.not.env%solv_md) write (env%cts%pots(4),'(2x,"ellipsoid:",1x,3(g0,",",1x),"1-",i0)')&
+         & solu%ell_abc,solu%nat
+
+  if (env%cts%used) then
+    call write_reference(env,solu,clus) !new fixed file
+    call copysub(env%fixfile,env%scratchdir)
+  end if
+
+  call chdirdbug(env%scratchdir)
+  scratchdir_tmp = env%scratchdir
+  if (.not.env%solv_md) then
+    io = makedir('tmp_MTD')
+    call copysub('.CHRG','tmp_MTD')
+    call copysub('.UHF','tmp_MTD')
+    if (env%cts%used) call copysub(env%fixfile,'tmp_MTD')
+    call chdirdbug('tmp_MTD')
+  else
+    io = makedir('tmp_solv_MTD')
+    call chdirdbug('tmp_solv_MTD')
+  end if
+  call getcwd(tmppath2)
+  call clus%write('crest_input')
+
+  if (env%solv_md) then
+    call wr_cluster_cut('crest_input',solu%nat,solv%nat,env%nsolv,&
+           & 'solute_cut.coord','solvent_shell.coord')
+    call remove('crest_input')
+    call copy('solvent_shell.coord','crest_input')
+    call clus%open('solvent_shell.coord')
+  end if
+
+  !For newcregen: If env%crestver .eq. crest_solv .and. .not. env%QCG then conffile .eq. .true.
+  env%QCG = .false.
+  call inputcoords(env,'crest_input')
+  call defaultGF(env)         !Setting MTD parameter
+
+!--- Special constraints for gff to safeguard stability
+  if (env%ensemble_opt .eq. '--gff') then
+    checkiso_tmp = env%checkiso
+    env%checkiso = .true.
+    cbonds_tmp = env%cts%cbonds_md
+    env%cts%cbonds_md = .true.
+    call autoBondConstraint_withEZ('coord',env%forceconst,env%wbofile)
+    call rd_cbonds('bondlengths',env)
+  end if
+
+  gfnver_tmp = env%gfnver
+  write (stdout,*) 'Method for ensemble search: ',env%ensemble_opt
+!  if (env%ens_const) write(stdout,*) '  Solute fixed during ensemble generation'
+  env%gfnver = env%ensemble_opt  !Setting method for ensemble search
+
+  !----------------------------------------------------------------
+  ! Case selection of normal Crest, MD or MTD
+  !----------------------------------------------------------------
+
+  !> Parse contraints (wall potentials etc.) into new calculator
+  !> if we are using it.
+  if (.not.env%legacy) then
+    calc_tmp = env%calc
+    call qcg_envcalc_reinit(env,clus,.true.,.true.)
+  end if
+
+  ENSEMBLEGEN:select case(env%ensemble_method)
+  case (-1:0) !qcgmtd/Crest runtype
+
+  !> Some custom Defaults for running the standard search
+  !General settings:
+  if (.not.env%user_mdstep) then
+    if (env%ensemble_opt .EQ. '--gff') then
+      env%mdstep = 1.5d0
+    else
+      env%mdstep = 5.0d0
+    end if
+  end if
+  !Runtype specific settings:
+  if (env%ensemble_method == 0) then
+    if (.not.env%user_dumxyz) then
+      env%mddumpxyz = 200
+    end if
+    if (.not.env%user_mdtime) then
+      env%mdtime = 10.0
+    end if
+  else if (env%ensemble_method == -1) then
+    if (.not.env%user_dumxyz) then
+      env%mddumpxyz = 50
+    end if
+    if (.not.env%user_mdtime) then
+      env%mdtime = 5.0
+    end if
+    env%nmdtemp = 100
+    env%MaxRestart = 6
+  end if
+
+  env%iterativeV2 = .true.  !Safeguards more precise ensemble search
+  write (stdout,*) 'Starting ensemble cluster generation by CREST routine'
+  call confscript2i(env,tim_dum) !Calling ensemble search
+  call copy('crest_rotamers.xyz','crest_rotamers_0.xyz')
+
+  case (1:2) ! Single MD or MTD
+  call xtb_md_ensemble_qcg(env,solu,solv,clus,resultspath)
+
+  end select ENSEMBLEGEN
+
+  env%QCG = .true.
+
+!--- Optimization with gfn2 if necessary
+  if (env%final_gfn2_opt.and.env%gfnver .ne. '--gfn2') then
+    gfnver_tmp = env%gfnver
+    write (stdout,'(2x,a)') 'GFN2-xTB optimization'
+    env%gfnver = '--gfn2'
+
+    if (.not.env%legacy) then
+      !> reinit calculator with GFN2
+      call qcg_envcalc_reinit(env,clus,.true.,.true.)
+      call checkname_xyz(crefile,inpnam,outnam)
+      call crest_multilevel_wrap(env,trim(inpnam),0)
+    else
+      call rmrf('OPTIM')
+      call multilevel_opt(env,99)
+    end if
+    write (stdout,*)
+  end if
+
+!--- Final optimization without wall potentials
+  env%optlev = 1.0d0    !Higher precision for less scattering
+  env%cts%NCI = .false.  !Dactivating the wall pot.
+  env%cts%pots = ''
+  deallocate (env%cts%pots)
+
+  if (.not.env%legacy) then
+    !> wall potential was turned off, add any other constraint back in
+    call qcg_envcalc_reinit(env,clus,.true.,.true.)
+    call checkname_xyz(crefile,inpnam,outnam)
+    call crest_multilevel_wrap(env,trim(inpnam),0)
+  else
+    call rmrf('OPTIM')
+    call multilevel_opt(env,99)
+  end if
+
+!--- Clustering to exclude similar structures if requested with -cluster
+  if (env%properties == 70) then
+    write (stdout,'(3x,''Clustering the remaining structures'')')
+    call checkname_xyz(crefile,inpnam,outnam)
+    call ccegen(env,.false.,inpnam)
+    call move(trim(clusterfile),trim(outnam))
+  end if
+
+!--- Energy sorting and removal of dublicates
+  env%gbsa = gbsa_tmp
+  env%solv = solv_tmp
+  call newcregen(env,0)
+  call checkname_xyz(crefile,inpnam,outnam)
+  call copy(inpnam,'ensemble.xyz')
+  call ens%open('ensemble.xyz') !Read in ensemble
+  call clus%deallocate()
+  clus%nat = ens%nat
+  allocate (clus%at(clus%nat))
+  allocate (clus%xyz(3,clus%nat))
+  write (stdout,'(1x,i0,a)') ens%nall,' structures remaining.'
+  write (stdout,*)
+
+!-------------------------------------------------------------
+!      SP with Implicit solvation model and without wall potentials
+!-------------------------------------------------------------
+  if (env%legacy) then
+    !> old, I/O-heavy version
+    call ens_sp_with_io(env,ens,clus,resultspath)
+  else
+    !> use internal parallel loop, but remember to convert to Bohrs for that
+    clus%at(:) = ens%at(:)
+    clus%xyz(1:3,1:clus%nat) = ens%xyz(1:3,1:ens%nat,1)*aatoau
+    call qcg_envcalc_reinit(env,clus,.true.,.true.)
+
+    ens%xyz = ens%xyz*aatoau
+    call crest_sploop(env,ens%nat,ens%nall,ens%at,ens%xyz,ens%er)
+    ens%xyz = ens%xyz*autoaa
+  end if
+
+!-------------------------------------------------------------
+!      Processing results
+!-------------------------------------------------------------
+  env%gfnver = gfnver_tmp
+  allocate (e_fix(ens%nall),source=0.0_wp)
+  allocate (e_clus(ens%nall),source=0.0_wp)
+
+  call pr_ensemble_energy()
+
+  open (newunit=ich98,file='cluster_energy.dat')
+  write (ich98,'(3x,''#'',9x,''Energy [Eh]'',6x,''SASA'')')
+
+!--- Fixation energy of optimization
+  do i = 1,ens%nall
+    if (env%legacy) then
+      !> old I/O-heady version
+      call chdirdbug('OPTIM')
+      write (to,'("TMPCONF",i0)') i
+      call chdirdbug(to)
+      call grepval('xtb.out','         :: add. restraining',e_there,e_fix(i))
+      call chdirdbug(tmppath2)
+      call rdxmolselec('full_ensemble.xyz',i,clus%nat,clus%at,clus%xyz)
+    else
+      !> quicker version, simply load from 'ens'
+      call ens%get_mol(i,clus)
+    end if
+
+    call get_sphere(.false.,clus,.false.)
+    dens = 0.001*(solu%mass+env%nsolv*solv%mass)/(1.0d-30*clus%vtot*bohr**3)
+    if (env%solv_md) then
+      call analyze_cluster(env%nsolv-1,clus%nat,solv%nat,solv%nat,clus%xyz,clus%at,shr_av,shr)
+    else
+      call analyze_cluster(env%nsolv,clus%nat,solu%nat,solv%nat,clus%xyz,clus%at,shr_av,shr)
+    end if
+    write (ich98,'(i4,F20.10,3x,f8.1)') env%nsolv,ens%er(i),clus%atot
+    write (stdout,'(x,i4,4x,F13.6,2x,f6.3,1x,f8.3,2x,2f6.1,3x,f8.1,3x,a)') &
+          & i,ens%er(i),dens,e_fix(i),shr_av,shr,clus%atot,trim(optlevflag(env%optlev))
+    e_fix(i) = e_fix(i)*autokcal/sqrt(real(clus%nat,wp))
+  end do
+  close (ich98)
+  call copysub('cluster_energy.dat',resultspath)
+
+!--- Checking Boltzmann weighting
+  write (stdout,*)
+  call remove('full_ensemble.xyz')
+  call qcg_dump_sorted_ensemble(ens,ens%er,'full_ensemble.xyz')
+  e_clus = ens%er*autokcal
+  call sort_min(ens%nall,1,1,e_clus)
+  ens%er = e_clus/autokcal !Overwrite ensemble energy with sorted one
+  allocate (de(ens%nall),source=0.0d0)
+  allocate (p(ens%nall),source=0.0d0)
+  e0 = e_clus(1)
+  de(1:ens%nall) = (e_clus(1:ens%nall)-e0)
+  call qcg_boltz(env,ens%nall,de,p)
+  k = 0
+  if (.not.env%user_nclust) env%nqcgclust = 0 !Needed for solvent ensemble
+  if (env%nqcgclust .eq. 0) then
+    do i = 1,ens%nall !Count how many are above 10%
+      if ((p(i)) .gt. 0.1) then
+        k = k+1
+      end if
+    end do
+    if ((k .eq. 0).or.(k .gt. 10)) then
+      k = 10 !If too many structures are relevant, set it 10
+    else if ((k .lt. 4).and.(ens%nall .ge. 4)) then
+      k = 4 !If too less structures are relevant, set it 4
+    else if (ens%nall .gt. 0) then
+      k = ens%nall
+    else
+      error stop 'No structure left. Something went wrong.'
+    end if
+    write (stdout,'(2x,a,1x,i0)') 'Conformers taken:',k
+    env%nqcgclust = k
+  else
+    if (env%nqcgclust .gt. ens%nall) then
+      k = ens%nall !Input larger than remaining structures
+      write (stdout,'(''Less than '',1x,i0,1x,''structures remain'')') env%nqcgclust
+      write (stdout,'(''Only '',1x,i0,1x,''structures are taken'')') ens%nall
+      if (env%cff) env%nqcgclust = ens%nall !Only for CFF, else a second qcg_ensemble run starts for solvent
+    else
+      write (stdout,'(''Taking '',1x,i0,1x,''structures'')') env%nqcgclust
+      k = env%nqcgclust !user input
+    end if
+  end if
+
+  open (newunit=ich65,file='final_ensemble.xyz')
+  do i = 1,k
+    open (newunit=ich48,file='full_population.dat')
+    write (ich48,'(2x, ''cluster'',2x,''E_norm [Eh]'',2x, ''De [kcal]'', 4x, ''p'')')
+    do j = 1,ens%nall
+      if (j .lt. 10) then
+        write (ich48,'(5x,i0,3x,f11.6,5x,f6.4,3x,f6.4)') j,e_clus(j)/autokcal,de(j),p(j)
+      else
+        write (ich48,'(5x,i0,2x,f11.6,5x,f6.4,3x,f6.4)') j,e_clus(j)/autokcal,de(j),p(j)
+      end if
+    end do
+    close (ich48)
+
+!--- Take k energetic least structures (written at beginning of file)
+    call rdxmolselec('full_ensemble.xyz',i,clus%nat,clus%at,clus%xyz)
+    call wrxyz(ich65,clus%nat,clus%at,clus%xyz*bohr,ens%er(i))
+  end do
+  close (ich65)
+
+  call ens%deallocate()
+  call ens%open('final_ensemble.xyz')
+  ens%er = e_clus(1:k)/autokcal
+
+!--- Getting G,S,H
+  write (stdout,*)
+  write (stdout,'(2x,70("-"))')
+  write (stdout,'(2x,70("-"))')
+  write (stdout,'(2x,''Boltz. averaged energy of final cluster:'')')
+  call aver(.true.,env,ens%nall,e_clus(1:ens%nall),S,H,G,sasa,.false.)
+  write (stdout,'(7x,''G /Eh     :'',f15.8)') G/autokcal
+  write (stdout,'(7x,''T*S /kcal :'',f15.8)') S
+
+  ens%g = G
+  ens%s = S
+
+  deallocate (e_fix)
+  deallocate (e_clus)
+
+!---Folder management
+  call rename('cregen.out.tmp','thermo_data')
+  call copysub('thermo_data',resultspath)
+  call copysub('crest_best.xyz',resultspath)
+  call copysub('cre_members.out',resultspath)
+  call copysub('full_ensemble.xyz',resultspath)
+  call copysub('final_ensemble.xyz',resultspath)
+  call copysub('population.dat',resultspath)
+  call copysub('full_population.dat',resultspath)
+
+!---Deleting ensemble tmp
+  call chdirdbug(thispath)
+  call chdirdbug(env%scratchdir)
+  if (.not.env%keepModef) call rmrf(tmppath2)
+!----Outprint
+  write (stdout,*)
+  write (stdout,'(2x,"Ensemble generation finished.")')
+  write (stdout,'(2x,"Results can be found in the [ensemble] directory:")')
+  write (stdout,'(2x,"--> What?                      --> Where?")')
+  write (stdout,'(2x,"Lowest energy conformer        crest_best.xyz")')
+  write (stdout,'(2x,"List of full ensemble          full_ensemble.xyz")')
+  write (stdout,'(2x,"List of used ensemble          final_ensemble.xyz")')
+  write (stdout,'(2x,"Ensemble thermodyn data        thermo_data")')
+  write (stdout,'(2x,"Population of selected         population.dat")')
+  write (stdout,'(2x,"Population of full ensemble    full_population.dat")')
+
+  !>--- restore settings
+  env%gfnver = gfnver_tmp
+  env%optlev = optlev_tmp
+  if (env%ensemble_opt .eq. '--gff') then
+    env%cts%cbonds_md = cbonds_tmp
+    env%checkiso = checkiso_tmp
+  end if
+
+  call tim_dum%clear
+
+  if (.not.env%solv_md) then
+    call tim%stop(6)
+  else
+    call tim%stop(7)
+  end if
+
+end subroutine qcg_ensemble
+
+!==============================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!==============================================================================!
+
+subroutine qcg_cff(env,solu,solv,clus,ens,solv_ens,tim)
+  use crest_parameters
+  use crest_data
+  use qcg_printouts
+  use iomod
+  use qcg_coord_type
+  use strucrd
+  use qcg_utils
+  implicit none
+
+  type(systemdata)           :: env
+  type(timer)                :: tim
+  type(coord_qcg)            :: solu,solv,clus
+  type(ensemble),intent(inout) :: solv_ens
+  type(ensemble),intent(in)    :: ens
+
+  integer                    :: i,j,k,iter
+  integer                    :: io,r
+  integer                    :: nsolv,n_ini
+  integer                    :: ipos,dum
+  integer                    :: v_ratio
+  integer                    :: minE_pos,m,nat_tot
+  integer                    :: nat_frag1 !number of atoms larger fragment (=solvent shell)
+  integer                    :: conv(env%nqcgclust+1)
+  integer                    :: solv_added,minpos
+  character(len=512)         :: thispath,resultspath,tmppath,tmppath2
+  character(len=64)          :: comment
+  character(len=20)          :: to
+  real(wp),allocatable      :: e_empty(:),inner_ell_abc(:,:)
+  real(wp),allocatable      :: outer_ell_abc(:,:)
+  real(wp),allocatable      :: e_cur(:,:)
+  real(wp)                   :: e_cluster(env%nqcgclust)
+  real(wp)                   :: S,H,G
+  real(wp)                   :: sasa,tmp_optlev
+  real(wp)                   :: etmp(500)
+  real(wp)                   :: e_fix(env%nqcgclust),e_norm(env%nqcgclust)
+  real(wp)                   :: dum_e,de
+  real(wp)                   :: de_tot(env%nqcgclust)
+  real(wp)                   :: shr = 0
+  real(wp)                   :: shr_av = 0
+  real(wp)                   :: dens,atotS
+  logical                    :: ex,skip,e_there
+  logical                    :: all_converged
+  logical,allocatable        :: converged(:),nothing_added(:)
+
+  character(len=20)          :: gfnver_tmp
+  real(wp)                   :: optlev_tmp
+  integer                    :: ich98,ich31
+
+  call tim%start(8,'QCG CFF')
+
+  allocate (e_empty(env%nqcgclust))
+  allocate (converged(env%nqcgclust))
+  allocate (nothing_added(env%nqcgclust))
+  allocate (outer_ell_abc(env%nqcgclust,3))
+  allocate (inner_ell_abc(env%nqcgclust,3))
+
+  v_ratio = nint(solu%vtot/solv%vtot)
+  allocate (e_cur(env%nsolv+v_ratio,env%nqcgclust),source=0.0d0)
+
+!--- Setting defaults (same as ensemble optimization to have comparable structures)
+  optlev_tmp = env%optlev
+  env%optlev = 1.0d0    !Increaseing percision for ensemble search to minimze scattering
+  gfnver_tmp = env%gfnver
+  if (env%final_gfn2_opt) then
+    env%gfnver = '--gfn2'
+  else
+    env%gfnver = env%ensemble_opt !CFF always with ensemble method
+  end if
+  nothing_added = .false.
+
+  dum = 0
+  converged = .false.
+  all_converged = .false.
+  nat_tot = clus%nat-solu%nat!*env%nqcgclust
+
+  if (solu%vtot/solv%vtot .lt. 1.0d0) then
+    skip = .true.
+  else
+    skip = .false.
+  end if
+
+!--- Folder management
+  call getcwd(thispath)
+  r = makedir('solvent_ensemble')
+  call chdirdbug('solvent_ensemble')
+  call getcwd(resultspath)
+  call chdirdbug(thispath)
+  call chdirdbug(env%scratchdir)
+  call getcwd(tmppath)
+  io = makedir('tmp_CFF')
+  call chdirdbug('tmp_CFF')
+  call getcwd(tmppath2)
+  call chdirdbug(tmppath)
+  call chdirdbug('solvent_properties')
+  call copysub('solvent',tmppath2)
+  call chdirdbug(tmppath2)
+
+!--- SP of each cluster
+!    (works with legacy and calculator version since xtb_sp_qcg switches automatically)
+  call ens%write('ensemble.xyz')
+  do i = 1,env%nqcgclust
+    call ens%get_mol(i,clus)
+    clus%nmol = clus%nat/solv%nat
+
+    write (to,'("TMPCFF",i0)') i
+    io = makedir(trim(to))
+    call copysub('solvent',to)
+    call chdirdbug(to)
+
+    call clus%write('cluster.coord')
+    call wr_cluster_cut('cluster.coord',solu%nat,solv%nat,env%nsolv,'solute_cut.coord','solvent_shell.coord')
+    call xtb_sp_qcg(env,'solvent_shell.coord',ex,e_empty(i))
+    if (env%legacy) then
+      call grepval('xtb.out','| TOTAL ENERGY',ex,e_empty(i))
+    end if
+    call copy('solvent_shell.coord','solvent_cluster.coord')
+    call copy('solvent_cluster.coord','filled_cluster.coord')
+    call get_ellipsoid(env,solu,solv,clus,.false.) !solu, to have same cavity to fill solvent in
+    outer_ell_abc(i,1:3) = clus%ell_abc(1:3)
+    inner_ell_abc(i,1:3) = solu%ell_abc(1:3)
+    call chdirdbug(tmppath2)
+  end do
+
+  if (skip) write (stdout,'(2x,''solute smaller than solvent, cff skipped'')')
+
+  clus%nat = clus%nat-solu%nat
+  n_ini = clus%nat
+
+!--- If solvent molecules are added
+  if (.not.skip) then
+    call pr_qcg_fill()
+    write (stdout,'(2x,''now adding solvents to fill cluster...'')')
+    call pr_fill_energy()
+    write (stdout,'(2x,70("-"))')
+    nat_frag1 = env%nsolv*solv%nat
+
+    iter = 0
+!--- Main cycle for addition of solvent molecules
+    convergence: do while (.not.all_converged)
+      k = 0
+      iter = iter+1
+      !--- Setting array, with only numbers of dirs that are not converged
+      do i = 1,env%nqcgclust
+        if (.not.converged(i)) then
+          k = k+1
+          conv(k) = i
+          conv(env%nqcgclust+1) = k !How many jobs are open
+        else
+          cycle
+        end if
+      end do
+      conv(k+1:env%nqcgclust) = 0
+
+      call chdirdbug(tmppath2)
+
+!--- Solvent addition to the cluster---------------------------------------------
+      call ensemble_dock(env,outer_ell_abc,nat_frag1,'solvent_cluster.coord',&
+              &'solvent',clus%nat,solv%nat,conv(env%nqcgclust+1),'TMPCFF',conv)
+!--------------------------------------------------------------------------------
+
+      nat_frag1 = nat_frag1+solv%nat
+
+      !--- Increase cluster size
+      deallocate (clus%at)
+      deallocate (clus%xyz)
+      clus%nat = clus%nat+solv%nat
+      allocate (clus%at(clus%nat))
+      allocate (clus%xyz(3,clus%nat))
+      clus%nmol = clus%nmol+1
+
+      do i = 1,env%nqcgclust
+        if (.not.converged(i)) then
+          write (to,'("TMPCFF",i0)') i
+          call chdirdbug(to)
+          call remove('xtbrestart')
+          call remove('xcontrol')
+
+          call rdcoord('best.xyz',clus%nat,clus%at,clus%xyz,e_cur(iter,i))
+          call clus%write('solvent_cluster.coord')
+
+          !--- Check if converged
+          call fill_take(env,solv%nat,clus%nat,inner_ell_abc(i,1:3),ipos)
+          if (ipos .eq. 0) then
+            converged(i) = .true.
+            write (stdout,'(2x,a,i0,a)') &
+              & "no more solvents can be placed inside cavity of cluster: ",i, &
+              & ", taking previous."
+            if (iter .eq. 1) nothing_added(i) = .true.
+          end if
+          call chdirdbug(tmppath2)
+
+        else
+          cycle
+        end if
+      end do
+
+!--- Check, if a structure was converged and iff was not necessary
+      k = 0
+      do i = 1,env%nqcgclust
+        if (.not.converged(i)) then
+          k = k+1
+          conv(k) = i
+          conv(env%nqcgclust+1) = k !How many jobs are open
+        else
+          cycle
+        end if
+      end do
+      conv(k+1:env%nqcgclust) = 0
+
+!--- Parallel optimization-------------------------------------------------------------------
+      ! for some reason pre-processing with constraint is coupled to the pr flag
+      ! also, I don't think this call does anything useful...
+      ! I implemented e_cur readout, this makes sense to me at least
+      call cff_opt(.false.,env,'solvent_cluster.coord',n_ini,conv(env%nqcgclust+1)&
+              &,'TMPCFF',conv,nothing_added,e_cur(iter,:))
+!----------------------------------------------------------------------------------------------
+      de_tot(:) = 0.0_wp
+      do i = 1,env%nqcgclust
+        if (.not.converged(i)) then
+          write (to,'("TMPCFF",i0)') i
+          call chdirdbug(to)
+          dum_e = e_empty(i)
+          if (iter .gt. 1) dum_e = e_cur(iter-1,i)
+          de = autokcal*(e_cur(iter,i)-solv%energy-dum_e)
+          de_tot(i) = de_tot(i)+de
+          !---- Check if solvent added is repulsive
+          if (de .gt. 0) then
+            converged(i) = .true.
+            write (stdout,'(2x,"adding solvent is repulsive for cluster: ",i0,a)') i, &
+            & ", taking previous one instead."
+            if (iter .eq. 1) nothing_added(i) = .true.
+          else !Only if the addition was not repulsive
+            call copy('solvent_cluster.coord','filled_cluster.coord')
+            write (stdout,'(i4,5x,i3,1x,F13.6,3x,f7.2,5x,f7.2,4x,a)') &
+               & iter+env%nsolv,i,e_cur(iter,i),de,de_tot(i),&
+               & trim(optlevflag(env%optlev))
+          end if
+          call chdirdbug(tmppath2)
+        end if
+      end do
+
+      !--- Check if everything is converged
+      dum = 0
+      do i = 1,env%nqcgclust
+        if (converged(1)) then
+          dum = dum+1
+        end if
+      end do
+
+      if (dum .eq. env%nqcgclust) then
+        all_converged = .true.
+      else
+        nat_tot = nat_tot+solv%nat
+      end if
+
+      write (stdout,'(2x,70("-"))')
+      !--- Or if maximum solvent is added
+      if (iter-nsolv .eq. v_ratio) then
+        write (stdout,'(2x,''volume filled'')')
+        all_converged = .true.
+        call copy('solvent_cluster.coord','filled_cluster.coord')
+      end if
+
+    end do convergence
+
+  end if
+
+  !Now in every TMPPath the final cluster file filled_cluster.coord is present
+
+!---------------------------------------------------------------------
+!     Final Optimization
+!---------------------------------------------------------------------
+
+  tmp_optlev = env%optlev
+  if (env%optlev .lt. 1.0) env%optlev = 1.0d0 !higher accuracy
+
+  if (.not.skip) then
+    call cff_opt(.true.,env,'filled_cluster.coord',n_ini,conv(env%nqcgclust+1),&
+           & 'TMPCFF',conv,nothing_added,e_cluster)
+  else
+    n_ini = 0 !If this is 0, no constraining will be done (optimization of total system)
+    nothing_added = .true.
+    call cff_opt(.true.,env,'filled_cluster.coord',n_ini,env%nqcgclust,'TMPCFF',&
+           & conv,nothing_added,e_cluster)
+  end if
+  env%optlev = tmp_optlev
+
+  call pr_ensemble_energy()
+
+  solv_ens%nall = env%nqcgclust
+  solv_ens%nat = nat_tot
+
+!--- Getting results--------------------------------------------------------------
+  open (newunit=ich31,file='crest_rotamers_0.xyz')
+  open (newunit=ich98,file='cluster_energy.dat')
+  write (ich98,'(3x,''#'',11x,''Energy [Eh]'',6x,''SASA'')')
+
+  do i = 1,env%nqcgclust
+    write (to,'("TMPCFF",i0)') i
+    call chdirdbug(to)
+    call copy('xtbopt.coord','final_cluster.coord')
+
+!--- Reading structure
+    call clus%open('final_cluster.coord')
+
+!--- Getting energy and calculating properties
+    if (env%legacy) then
+      call grepval('xtb_sp.out','| TOTAL ENERGY',e_there,e_cluster(i))
+      call grepval('xtb_sp.out','         :: add. restraining',e_there,e_fix(i))
+    end if
+    e_fix(i) = e_fix(i)*autokcal/sqrt(real(clus%nat))
+    call get_sphere(.false.,clus,.false.)
+    if (clus%nat .gt. n_ini) then
+      solv_added = (clus%nat-(n_ini))/solv%nat
+    else
+      solv_added = 0
+    end if
+    dens = 0.001*((clus%nat/solv%nat)*solv%mass)/(1.0d-30*clus%vtot*bohr**3)
+    call analyze_cluster(solv_added,clus%nat,n_ini,solv%nat,clus%xyz,clus%at,shr_av,shr)
+    e_norm(i) = e_cluster(i)*env%nsolv/(clus%nat/solv%nat)
+    atotS = clus%atot*env%nsolv/(clus%nat/solv%nat)
+
+!--- Writing outputfiles
+    write (ich31,'(2x,i0)') clus%nat
+    write (ich31,'(2x,a,f18.8,2x,a)') 'energy=',e_cluster(i)
+    do j = 1,clus%nat
+      write (ich31,'(1x,a2,1x,3f20.10)') i2e(clus%at(j),'nc'),clus%xyz(1:3,j)*bohr
+    end do
+
+    write (ich98,'(''No'',i4,F20.10,3x,f8.1)') i,e_norm(i),atotS
+
+!--- Print to screen
+    write (stdout,'(x,i4,4x,F13.6,2x,f6.3,1x,f8.3,2x,2f6.1,3x,f8.1,3x,a)') &
+            & i,e_norm(i),dens,e_fix(i),shr_av,shr,atotS,trim(optlevflag(env%optlev))
+
+    call chdirdbug(tmppath2)
+  end do
+
+  close (ich98)
+  close (ich31)
+
+  call solv_ens%deallocate()
+  call solv_ens%open('crest_rotamers_0.xyz')
+
+  solv_ens%er = e_cluster
+  call copy('crest_rotamers_0.xyz','crest_ensemble.xyz')
+
+!--- crest_best structure
+  minpos = minloc(solv_ens%er,dim=1)
+  write (to,'("TMPCFF",i0)') minpos
+  call chdirdbug(to)
+  call clus%open('final_cluster.coord')
+
+  clus%xyz = clus%xyz*bohr
+  call chdirdbug(tmppath2)
+  write (comment,'(a,F20.8)') 'energy=',solv_ens%er(minpos)
+  call wrxyz('crest_best.xyz',clus%nat,clus%at,clus%xyz,comment)
+
+!--- Boltz. average-------------------------------------------------------------------------
+  write (stdout,*)
+  write (stdout,'(2x,70("-"))')
+  write (stdout,'(2x,70("-"))')
+  write (stdout,'(2x,''Boltz. averaged energy of final cluster:'')')
+  e_cluster = solv_ens%er*autokcal
+  e_norm = e_norm*autokcal
+  call sort_min(env%nqcgclust,1,1,e_norm)
+  call aver(.true.,env,solv_ens%nall,e_norm(1:env%nqcgclust),S,H,G,sasa,.false.)
+  write (stdout,'(7x,''G /Eh     :'',f15.8)') G/autokcal
+  write (stdout,'(7x,''T*S /kcal :'',f15.8)') S
+  solv_ens%er = e_norm/autokcal !normalized energy needed for final evaluation
+
+  solv_ens%g = G
+  solv_ens%s = S
+
+!--- Cleanup
+  call copysub('crest_ensemble.xyz',resultspath)
+  call copysub('cluster_energy.dat',resultspath)
+  call copysub('crest_best.xyz',resultspath)
+  call copysub('population.dat',resultspath)
+  call chdirdbug(tmppath)
+  if (.not.env%keepModef) call rmrf('tmp_CFF')
+  call chdirdbug(thispath)
+
+!--- Printouts
+  write (stdout,*)
+  write (stdout,'(2x,"Solvent cluster generation finished.")')
+  write (stdout,'(2x,"Results can be found in [solvent_cluster] directory")')
+  write (stdout,'(2x,"--> What?       --> Where?")')
+  write (stdout,'(2x,"Structures      crest_ensemble.xyz")')
+  write (stdout,'(2x,"Energies        cluster_energy.dat")')
+  write (stdout,'(2x,"Population      population.dat")')
+
+  env%gfnver = gfnver_tmp
+  env%optlev = optlev_tmp
+
+  deallocate (e_empty)
+  deallocate (converged)
+  deallocate (outer_ell_abc)
+  deallocate (inner_ell_abc)
+
+  call tim%stop(8)
+
+end subroutine qcg_cff
+
+!==============================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!==============================================================================!
+
+subroutine qcg_freq(env,tim,solu,solv,solu_ens,solv_ens)
+  use crest_parameters
+  use crest_data
+  use qcg_printouts
+  use iomod
+  use qcg_coord_type
+  use strucrd
+  use qcg_utils
+  implicit none
+
+  type(systemdata)           :: env
+  type(timer)                :: tim
+  type(coord_qcg)            :: solu,solv,clus
+  type(ensemble)             :: solu_ens,solv_ens
+
+  integer                    :: r,io,f,g,h
+  integer                    :: i
+  character(len=512)         :: thispath,resultspath,tmppath,tmppath2
+  character(len=80)          :: to
+  character(len=20)          :: gfnver_tmp
+  real(wp)                   :: optlev_tmp
+  real(wp)                   :: gt(3)
+  real(wp)                   :: ht(3)
+  real(wp)                   :: svib(3)
+  real(wp)                   :: srot(3)
+  real(wp)                   :: stra(3)
+  integer                    :: ich65,ich56,ich33,ich81
+  logical                    :: opt
+  type(coord_qcg) :: tmpmol
+
+  call tim%start(9,'QCG Frequencies')
+
+  call pr_qcg_freq()
+
+!--- Setting defaults (same as ensemble optimization and cff to have comparable structures)
+  optlev_tmp = env%optlev
+  env%optlev = 1.0d0    !Increaseing percision for ensemble search to minimze scattering
+  gfnver_tmp = env%gfnver
+  env%gfnver = env%freqver  !Setting method
+
+!--- Folder management
+  call getcwd(thispath)
+  r = makedir('frequencies')
+  call chdirdbug('frequencies')
+  call getcwd(resultspath)
+  call chdirdbug(thispath)
+  call chdirdbug(env%scratchdir)
+  call getcwd(tmppath)
+  io = makedir('tmp_freq')
+  call copysub('.CHRG','tmp_freq')
+  call copysub('.UHF','tmp_freq')
+  call chdirdbug('tmp_freq')
+  call getcwd(tmppath2)
+  f = makedir('tmp_solu')
+  call copysub('.CHRG','tmp_solu')
+  call copysub('.UHF','tmp_solu')
+  g = makedir('tmp_solv')
+  h = makedir('tmp_gas1') !One solute molecule
+  call copysub('.CHRG','tmp_gas1')
+  call copysub('.UHF','tmp_gas1')
+
+!----------------------------------------------------------------------------
+!   frequencies for solute molecule
+!----------------------------------------------------------------------------
+  write (stdout,'(1x,a)') 'processing  SOLUTE MOLECULE'
+  call chdirdbug('tmp_gas1')
+  call solu%write('solute.coord')
+  call chdirdbug(tmppath2)
+  opt = .false.
+  call ens_freq(env,'solute.coord',1,'tmp_gas',opt)
+  call chdirdbug('tmp_gas1')
+  call rdtherm('xtb_freq.out',ht(3),svib(3),srot(3),stra(3),gt(3))
+  solu%gt = gt(3)
+  solu%ht = ht(3)
+  solu%svib = svib(3)
+  solu%srot = srot(3)
+  solu%stra = stra(3)
+
+  call chdirdbug(tmppath2)
+
+!----------------------------------------------------------------------------
+!   frequencies for solute cluster
+!----------------------------------------------------------------------------
+  write (stdout,'(/,1x,a)') 'processing  SOLUTE CLUSTER'
+
+!--- Folder setup for cluster
+  call chdirdbug('tmp_solu')
+  call solu_ens%write('solute_ensemble.xyz')
+
+!--- All cluster are of the same size
+  call clus%deallocate()
+  clus%nat = solu_ens%nat
+  allocate (clus%at(clus%nat))
+  allocate (clus%xyz(3,clus%nat))
+  clus%xyz = 0
+  clus%nmol = env%nsolv+1 !clus%nat/clus%at
+
+  do i = 1,solu_ens%nall
+    !call rdxmolselec('solute_ensemble.xyz',i,clus%nat,clus%at,clus%xyz)
+    call solu_ens%get_mol(i,clus)
+
+!--- Solute cluster
+    write (to,'("TMPFREQ",i0)') i
+    io = makedir(trim(to))
+    call copysub('.UHF',to)
+    call copysub('.CHRG',to)
+    call chdirdbug(to)
+    call clus%write("cluster.xyz")
+
+    call chdirdbug(tmppath2)
+
+    !--- Solvent cluster (only if cff, than the solvent shell is taken, which was fixed all the time)
+    if (env%cff) then
+      call chdirdbug('tmp_solv')
+      write (to,'("TMPFREQ",i0)') i
+      io = makedir(trim(to))
+      call chdirdbug(to)
+      call clus%write('cluster.coord')
+      call wr_cluster_cut('cluster.coord',solu%nat,solv%nat,env%nsolv,&
+             & 'solute_cut.coord','solvent_cut.coord')
+
+      call chdirdbug(tmppath2)
+    end if
+    call chdirdbug('tmp_solu')
+
+  end do
+
+!> Frequency calculation
+  opt = .true.
+  call ens_freq(env,'cluster.xyz',solu_ens%nall,'TMPFREQ',opt)
+  call chdirdbug(tmppath2)
+
+!----------------------------------------------------------------------------
+!   frequencies for solvent cluster
+!----------------------------------------------------------------------------
+  write (stdout,'(/,1x,a)') 'processing  SOLVENT CLUSTER'
+  if (env%cff) then
+    call chdirdbug('tmp_solv')
+    call ens_freq(env,'solvent_cut.coord',solu_ens%nall,'TMPFREQ',opt)
+    call chdirdbug(tmppath2)
+  end if
+
+  call clus%deallocate()
+
+  !--- Frequencies solvent cluster (only, if not cff was used)
+  if (.not.env%cff) then
+    call chdirdbug('tmp_solv')
+    call solv_ens%write('solvent_ensemble.xyz')
+
+    do i = 1,solv_ens%nall
+      call solv_ens%get_mol(i,tmpmol)
+      write (to,'("TMPFREQ",i0)') i
+      io = makedir(trim(to))
+      call copysub('.UHF',to)
+      call copysub('.CHRG',to)
+      call chdirdbug(to)
+      call tmpmol%write("solv_cluster.xyz")
+
+      call chdirdbug(tmppath2)
+      call chdirdbug('tmp_solv')
+    end do
+!> Frequency calculation
+    call ens_freq(env,'solv_cluster.xyz',solv_ens%nall,'TMPFREQ',opt)
+    call chdirdbug(tmppath2)
+  end if
+
+!----------------------------------------------------------------------------
+!   Data read out
+!----------------------------------------------------------------------------
+
+!--- Solute in gas phase
+  write (stdout,*)
+  write (stdout,*) '  Solute Gas properties'
+  call pr_freq_energy()
+  open (newunit=ich56,file='solute.dat')
+  call pr_freq_file(ich56)
+  write (stdout,'(2x,5f10.2)') ht(3),svib(3),srot(3),stra(3),gt(3)
+  write (ich56,'(2x,5f10.2)') ht(3),svib(3),srot(3),stra(3),gt(3)
+  close (ich56)
+
+!--- Solute cluster
+  write (stdout,*)
+  write (stdout,*) '  Solute cluster properties'
+  open (newunit=ich33,file='solute_cluster.dat')
+
+  call chdirdbug('tmp_solu')
+
+  allocate (solu_ens%gt(solu_ens%nall))
+  allocate (solu_ens%ht(solu_ens%nall))
+  allocate (solu_ens%svib(solu_ens%nall))
+  allocate (solu_ens%srot(solu_ens%nall))
+  allocate (solu_ens%stra(solu_ens%nall))
+
+  call pr_freq_energy()
+  call pr_freq_file(ich33)
+
+  do i = 1,solu_ens%nall
+    write (to,'("TMPFREQ",i0)') i
+    call chdirdbug(to)
+    call rdtherm('xtb_freq.out',ht(1),svib(1),srot(1),stra(1),gt(1))
+    write (stdout,'(2x,i0,2x,5f10.2)') i,ht(1),svib(1),srot(1),stra(1),gt(1)
+    write (ich33,'(2x,i0,2x,5f10.2)') i,ht(1),svib(1),srot(1),stra(1),gt(1)
+    solu_ens%gt(i) = gt(1)
+    solu_ens%ht(i) = ht(1)
+    solu_ens%svib(i) = svib(1)
+    solu_ens%srot(i) = srot(1)
+    solu_ens%stra(i) = stra(1)
+
+    call chdirdbug(tmppath2)
+    call chdirdbug('tmp_solu')
+  end do
+  close (ich33)
+
+!--- Solvent cluster
+  write (stdout,*)
+  write (stdout,*) '  Solvent cluster properties'
+  call chdirdbug(tmppath2)
+  open (newunit=ich81,file='solvent_cluster.dat')
+
+  call chdirdbug('tmp_solv')
+
+  allocate (solv_ens%gt(solv_ens%nall))
+  allocate (solv_ens%ht(solv_ens%nall))
+  allocate (solv_ens%svib(solv_ens%nall))
+  allocate (solv_ens%srot(solv_ens%nall))
+  allocate (solv_ens%stra(solv_ens%nall))
+
+  call pr_freq_energy()
+  call pr_freq_file(ich81)
+
+  do i = 1,solv_ens%nall
+    write (to,'("TMPFREQ",i0)') i
+    call chdirdbug(to)
+    call rdtherm('xtb_freq.out',ht(2),svib(2),srot(2),stra(2),gt(2))
+    write (stdout,'(2x,i0,2x,5f10.2)') i,ht(2),svib(2),srot(2),stra(2),gt(2)
+    write (ich81,'(2x,i0,2x,5f10.2)') i,ht(2),svib(2),srot(2),stra(2),gt(2)
+    solv_ens%gt(i) = gt(2)
+    solv_ens%ht(i) = ht(2)
+    solv_ens%svib(i) = svib(2)
+    solv_ens%srot(i) = srot(2)
+    solv_ens%stra(i) = stra(2)
+    call chdirdbug(tmppath2)
+    call chdirdbug('tmp_solv')
+  end do
+  close (ich81)
+
+!--- Saving results
+  call chdirdbug(tmppath2)
+  call copysub('solute.dat',resultspath)
+  call copysub('solute_cluster.dat',resultspath)
+  call copysub('solvent_cluster.dat',resultspath)
+
+!--- Deleting tmp directory
+  call chdirdbug(tmppath)
+  if (.not.env%keepModef) call rmrf(tmppath2)
+  call chdirdbug(thispath)
+
+  env%gfnver = gfnver_tmp
+  env%optlev = optlev_tmp
+
+  call tim%stop(9)
+
+end subroutine qcg_freq
+
+!==============================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!==============================================================================!
+
+subroutine qcg_eval(env,solu,solu_ens,solv_ens)
+  use crest_parameters
+  use crest_data
+  use qcg_printouts
+  use iomod
+  use qcg_coord_type
+  use strucrd
+  use qcg_utils
+  implicit none
+
+  type(systemdata)   :: env
+  type(coord_qcg)    :: solu
+  type(ensemble)     :: solu_ens,solv_ens
+
+  character(len=512) :: thispath
+
+  integer            :: i,j
+  integer            :: srange
+  integer            :: freqscal
+  real(wp)           :: g1(solu_ens%nall)
+  real(wp)           :: g2(solv_ens%nall)
+  real(wp)           :: g3
+  real(wp)           :: Gsolv(20)
+  real(wp)           :: Hsolv
+  real(wp)           :: G_solute(20)
+  real(wp)           :: H_solute
+  real(wp)           :: G_solvent(20)
+  real(wp)           :: H_solvent
+  real(wp)           :: G_mono(20)
+  real(wp)           :: H_mono
+  real(wp)           :: S(20)
+  real(wp)           :: volw
+  real(wp)           :: sasa
+  real(wp)           :: dum,dum1,dum2
+  real(wp)           :: e_solute(solu_ens%nall)
+  real(wp)           :: e_solvent(solv_ens%nall)
+  real(wp)           :: scal(20)
+  integer            :: ich23
+
+  call pr_eval_eval()
+
+  call getcwd(thispath)
+
+  freqscal = nint(env%freq_scal/0.05)
+  srange = 20
+  do i = 1,srange
+    scal(i) = 0.05*i
+  end do
+
+!--- Solute Cluster
+  !H_solv
+  do i = 1,solu_ens%nall
+    e_solute(i) = solu_ens%er(i)*autokcal+solu_ens%ht(i)
+  end do
+  call aver(.false.,env,solu_ens%nall,e_solute,dum1,H_solute,dum2,sasa,.false.)
+  !G_solv
+  do i = 1,srange
+    do j = 1,solu_ens%nall
+      g1(j) = solu_ens%ht(j)-(env%tboltz*(solu_ens%svib(j)+scal(i)*(solu_ens%srot(j)+solu_ens%stra(j)))/1000)
+      e_solute(j) = solu_ens%er(j)*autokcal+g1(j)
+    end do
+    call aver(.false.,env,solu_ens%nall,e_solute,S(i),dum,G_solute(i),sasa,.false.)
+  end do
+
+!--- Solvent Cluster
+  !H_solv
+  do i = 1,solv_ens%nall
+    e_solvent(i) = solv_ens%er(i)*autokcal+solv_ens%ht(i)
+  end do
+  call aver(.false.,env,solv_ens%nall,e_solvent,dum1,H_solvent,dum2,sasa,.false.)
+
+  !G_solv
+  do i = 1,srange
+    do j = 1,solv_ens%nall
+      g2(j) = solv_ens%ht(j)- &
+              & (env%tboltz*(solv_ens%svib(j)+scal(i)*(solv_ens%srot(j)+solv_ens%stra(j)))/1000)
+      e_solvent(j) = solv_ens%er(j)*autokcal+g2(j)
+    end do
+    call aver(.false.,env,solv_ens%nall,e_solvent,S(i),dum,G_solvent(i),sasa,.false.)
+  end do
+
+!--- Solute gas phase
+  H_mono = solu%energy*autokcal+solu%ht
+  do i = 1,srange
+    g3 = solu%ht-(env%tboltz*(solu%svib+scal(i)*(solu%srot+solu%stra))/1000)
+    G_mono(i) = solu%energy*autokcal+g3
+  end do
+
+  Gsolv(1:20) = G_solute(1:20)-G_solvent(1:20)-G_mono(1:20)
+  Hsolv = H_solute-H_solvent-H_mono
+
+!--- Calculate Volume work and include
+  volw = (env%tboltz*8.31451/1000./4.184)*log(24.47d0*env%tboltz/298.15)
+  Gsolv(1:20) = Gsolv(1:20)-volw
+  Hsolv = Hsolv-volw
+  call pr_eval_1(Gsolv(20),Hsolv)
+  call pr_eval_2(srange,Gsolv,scal)
+  call pr_eval_3(srange,freqscal,env%freq_scal,Gsolv)
+
+! Save Result
+  open (newunit=ich23,file='frequencies/result.dat')
+  write (ich23,'("Solvation Free Energy [kcal/mol] :")')
+  write (ich23,'(f8.2)') Gsolv(freqscal)
+  close (ich23)
+
+end subroutine qcg_eval
+
+!==============================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!==============================================================================!
+
+subroutine qcg_restart(env,progress,solu,solv,clus,solu_ens,solv_ens,clus_backup)
+  use crest_parameters
+  use crest_data
+  use iomod
+  use qcg_coord_type
+  use strucrd
+  use qcg_utils
+  implicit none
+
+  type(systemdata)           :: env
+  type(coord_qcg)            :: solu,solv,clus,clus_backup
+  type(ensemble)             :: solu_ens,solv_ens
+  integer                    :: progress
+
+  integer                    :: i
+  character(len=512)         :: thispath
+  character(len=6)           :: counter
+  character(len=7)           :: counter2
+  character(len=8)           :: counter3
+  logical                    :: grow,solu_ensemble,solv_ensemble
+  logical                    :: solv_cff,solv_present,freq,tmp,ex
+  real(wp),allocatable       :: xyz(:,:)
+
+  grow = .false.
+  solu_ensemble = .false.
+  solv_ensemble = .false.
+  solv_cff = .false.
+  solv_present = .false.
+  freq = .false.
+  tmp = .false.
+
+  inquire (file='./grow/cluster.coord',exist=grow)
+  inquire (file='./ensemble/final_ensemble.xyz',exist=solu_ensemble)
+  inquire (file='./solvent_ensemble/final_ensemble.xyz',exist=solv_ensemble)
+  inquire (file='./solvent_ensemble/crest_ensemble.xyz',exist=solv_cff)
+  inquire (file='./frequencies/result.dat',exist=freq)
+
+  if (solv_cff.or.solv_ensemble) solv_present = .true.
+
+  call getcwd(thispath)
+
+!---------------------------------------------------------------------------------
+!        Check, if everything needed is present
+!---------------------------------------------------------------------------------
+
+  if (freq.and.((.not.grow).or.(.not.solu_ensemble).or.(.not.solv_ensemble))) then
+    progress = 0
+    call rmrf('frequencies')
+    freq = .false.
+  end if
+
+  if (solv_present.and.((.not.grow).or.(.not.solu_ensemble))) then
+    progress = 0
+    call rmrf('solvent_ensemble')
+    solv_present = .false.
+    solv_cff = .false.
+    solv_ensemble = .false.
+  end if
+
+  if (solu_ensemble.and.(.not.grow)) then
+    progress = 0
+    call rmrf('ensemble')
+    solu_ensemble = .false.
+  end if
+
+!-------------------------------------------------------------
+!           Data read out
+!-------------------------------------------------------------
+
+!--- Grow process
+  if (grow) then
+    env%qcg_restart = .true.
+    call chdirdbug('grow')
+    call clus%open('cluster.coord')
+
+    clus%nmol = (clus%nat-solu%nat)/solv%nat+1
+    allocate (xyz(3,clus%nat))
+    xyz = clus%xyz
+    call get_ellipsoid(env,solu,solv,clus,.true.)
+    clus%xyz = xyz !Needed, because get_ellipsoid performs axistransformation and not fitting potential
+    deallocate (xyz)
+
+    if (.not.env%cff) then
+      allocate (clus_backup%at(clus%nat))
+      allocate (clus_backup%xyz(3,clus%nat))
+      clus_backup = clus
+    end if
+
+    if (clus%nmol-1 .ge. env%nsolv) then
+      progress = 1
+      env%nsolv = clus%nmol-1
+      write (stdout,*)
+      write (stdout,*)
+      write (stdout,'(''Found cluster with '',i0,'' solvents'')') env%nsolv
+      call chdirdbug(thispath)
+    else
+      error stop 'The found cluster is smaller than nsolv. Please restart the whole computaion by removing the grow directory'
+      !Future implementation continue grow process
+      call chdirdbug(thispath)
+      if (solu_ensemble) call rmrf('ensemble')
+      if (solv_ensemble) call rmrf('solvent_ensemble')
+      if (freq) call rmrf('frequencies')
+      solu_ensemble = .false.
+      solv_ensemble = .false.
+      freq = .false.
+      progress = 0
+    end if
+  end if
+
+!--- Solute Ensemble
+  if (solu_ensemble) then
+    call chdirdbug('ensemble')
+    call solu_ens%open('final_ensemble.xyz')
+    call rdensemble('final_ensemble.xyz',solu_ens%nat,solu_ens%nall,solu_ens%at,solu_ens%xyz,solu_ens%er)
+    env%nqcgclust = solu_ens%nall
+    write (stdout,'("  Ensemble of solute-cluster found.")')
+    write (stdout,'("  Taking all ", i0, " structures")') env%nqcgclust
+    call grepval('population.dat','Ensemble free energy [Eh]:',ex,solu_ens%G)
+    solu_ens%G = solu_ens%G*autokcal
+    write (stdout,*) 'Solute Ensmeble Free E [kcal/mol]',solu_ens%G
+    call chdirdbug(thispath)
+    progress = 2
+  end if
+
+!--- Solvent Ensemble
+  if (solv_present) then
+    call chdirdbug('solvent_ensemble')
+    write (stdout,'("  Ensemble of solvent-cluster found.")')
+
+    !--- Case CFF
+    if (solv_cff) then
+      call solv_ens%open('crest_ensemble.xyz')
+      do i = 1,solv_ens%nall
+        if (i .le. 9) then
+          write (counter,'(''No   '',i1)') i
+          call grepval('cluster_energy.dat',counter,ex,solv_ens%er(i))
+        else if (i .le. 99) then
+          write (counter2,'(''No   '',i2)') i
+          call grepval('cluster_energy.dat',counter2,ex,solv_ens%er(i))
+        else
+          write (counter3,'(''No   '',i3)') i
+          call grepval('cluster_energy.dat',counter3,ex,solv_ens%er(i))
+        end if
+        write (stdout,*) 'Energy of cluster',i,solv_ens%er(i)
+      end do
+    end if
+
+    !--- Case MD/Crest run
+    if (solv_ensemble) then
+      call solv_ens%open('final_ensemble.xyz')
+      call rdensemble('final_ensemble.xyz',solv_ens%nat,solv_ens%nall,solv_ens%at,solv_ens%xyz,solv_ens%er)
+    end if
+    call grepval('population.dat','Ensemble free energy [Eh]:',ex,solv_ens%G)
+    solv_ens%G = solv_ens%G*autokcal
+    write (stdout,*) 'solvent ensmeble free E [kcal/mol]',solv_ens%G
+    call chdirdbug(thispath)
+    progress = 3
+  end if
+
+!--- Frequencies
+  if (freq) then
+    write (stdout,*)
+    write (stdout,*)
+    write (stdout,*) '  Nothing to do'
+    progress = 4
+  end if
+
+end subroutine qcg_restart
+
+!==============================================================================!
+!
+subroutine qcg_cleanup(env)
+  use crest_data
+  implicit none
+  type(systemdata)      :: env
+  character(len=280)    :: thispath
+  logical               :: tmp
+  call getcwd(thispath)
+  call chdirdbug(env%scratchdir)
+  inquire (file='./solute_properties/solute',exist=tmp)
+  if (tmp) then
+    call rmrf('solute_properties')
+    call rmrf('solvent_properties')
+  end if
+end subroutine qcg_cleanup
+
+!==============================================================================!
diff --git a/src/qcg/qcg_misc.f90 b/src/qcg/qcg_misc.f90
new file mode 100644
index 00000000..701da8cb
--- /dev/null
+++ b/src/qcg/qcg_misc.f90
@@ -0,0 +1,1635 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2021 Christoph Plett, Sebastian Spicher, Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+subroutine xtb_sp_qcg(env,fname,success,eout)
+!********************************************************
+!*  xtb_sp_qcg
+!*  A quick single point xtb calculation without wbo
+!********************************************************
+  use crest_parameters
+  use iomod
+  use crest_data
+  use crest_calculator
+  use strucrd
+  implicit none
+  type(systemdata) :: env
+  character(len=*),intent(in) :: fname
+  logical,intent(out) :: success
+  real(wp),intent(out) :: eout
+
+  character(len=512) :: jobcall
+  character(len=*),parameter :: pipe = ' > xtb.out 2> /dev/null'
+  logical,parameter :: debug = .false.
+  integer :: io,T,Tn
+
+  success = .false.
+  eout = 0.0_wp
+
+  if (env%legacy) then
+!>----------------------------------------------
+!> The original implementation with systemcall
+    call remove('gfnff_topo')
+    call remove('energy')
+    call remove('charges')
+    call remove('xtbrestart')
+
+!---- setting threads
+    call new_ompautoset(env,'auto',1,T,Tn)
+
+!---- jobcall
+    write (jobcall,'(a,1x,a,1x,a,'' --sp '',a,1x,a)') &
+    &     trim(env%ProgName),trim(fname),trim(env%gfnver),trim(env%solv),trim(pipe)
+
+    if (debug) write (stdout,*) trim(jobcall)
+    call command(trim(jobcall),io)
+    call grepval('xtb.out','| TOTAL ENERGY',success,eout)
+!---- cleanup
+    call remove('energy')
+    call remove('charges')
+    call remove('xtbrestart')
+    call remove('xtbtopo.mol')
+    call remove('gfnff_topo')
+  else
+!>---------------------------------------------
+!> New implementation with calculator and api
+    block
+      type(calcdata) :: calc
+      type(coord) :: mol
+      real(wp),allocatable :: gradtmp(:,:)
+
+      call mol%open(fname)
+      allocate (gradtmp(3,mol%nat))
+      call env2calc(env,calc,mol)
+      if (debug) call calc%info(stdout)
+      call engrad(mol,calc,eout,gradtmp,io)
+      success = (io == 0)
+    end block
+  end if
+end subroutine xtb_sp_qcg
+
+!--------------------------------------------------------------------------------------------
+! A quick single xtb optimization gets mol and overwrites it with optimized stuff
+!--------------------------------------------------------------------------------------------
+subroutine xtb_opt_qcg(env,mol,constrain)
+  use crest_parameters
+  use iomod
+  use crest_data
+  use qcg_coord_type
+  use strucrd
+  use optimize_module
+
+  implicit none
+  type(systemdata),intent(in) :: env
+  type(coord_qcg),intent(inout) :: mol
+
+  character(:),allocatable :: fname
+  character(len=512) :: jobcall
+  logical :: constrain,const
+  real(wp) :: energy
+  integer :: io,T,Tn
+  character(stdout),parameter :: pipe = ' > xtb_opt.out 2> /dev/null'
+  logical,parameter :: debug = .false.
+
+  if (env%legacy) then
+    !> LEGACY version with syscall
+
+    !--- Write coordinated
+    fname = 'coord'
+    call mol%write(fname)
+
+    !---- setting threads
+    call new_ompautoset(env,'auto',1,T,Tn)
+
+    !---- jobcall & Handling constraints
+    if (constrain.AND.env%cts%used) then
+      call write_constraint(env,fname,'xcontrol')
+      call mol%write('coord.ref')
+      write (jobcall,'(a,1x,a,1x,a,'' --opt --input xcontrol '',a,1x,a)') &
+      &     trim(env%ProgName),trim(fname),trim(env%gfnver),trim(env%solv),trim(pipe)
+    else
+      write (jobcall,'(a,1x,a,1x,a,'' --opt '',a,1x,a)') &
+      &     trim(env%ProgName),trim(fname),trim(env%gfnver),trim(env%solv),trim(pipe)
+    end if
+
+    call command(trim(jobcall),io)
+    !---- cleanup
+    call rdcoord('xtbopt.coord',mol%nat,mol%at,mol%xyz)
+    call remove('energy')
+    call remove('charges')
+    call remove('xtbrestart')
+    call remove('xtbtopo.mol')
+    call remove('gfnff_topo')
+
+  else
+
+    !> NEW version with calculator
+    call new_ompautoset(env,'max',1,T,Tn)
+    block
+      use crest_calculator
+      use optimize_module
+      type(calcdata) :: calc
+      type(coord) :: molin,molout
+      real(wp),allocatable :: gradtmp(:,:)
+
+      allocate (gradtmp(3,mol%nat))
+      molin = mol%as_coord()
+      call env2calc(env,calc,molin)
+      if (debug) call calc%info(stdout)
+
+      call optimize_geometry(molin,molout,calc,energy,gradtmp,debug,.false.,io)
+
+      deallocate (gradtmp)
+      if (io == 0) then
+        call mol%from_coord(molout)
+      else
+        write (stdout,*) 'FAILURE in QCG optimization!'
+        write (stdout,*) 'Stopping run to avoid unecessary compuations'
+        call creststop(status_safety)
+      end if
+    end block
+
+  end if
+end subroutine xtb_opt_qcg
+
+subroutine xtb_md_ensemble_qcg(env,solu,solv,clus,resultspath)
+  use crest_parameters
+  use crest_data
+  use qcg_coord_type
+  use strucrd
+  use iomod
+  use qcg_printouts
+  use crest_calculator
+  use dynamics_module
+  implicit none
+  !> IN/OUTPUTS
+  type(systemdata),intent(inout) :: env
+  type(coord_qcg),intent(inout)  :: solu
+  type(coord_qcg),intent(inout)  :: solv
+  type(coord_qcg),intent(inout)  :: clus
+  character(len=*),intent(in) :: resultspath
+  !> LOCAL
+  integer  :: T,Tn,i,j,k,l,ich,r,io
+  real(wp) :: newtemp,newmdtime,newmdstep,newhmass
+  real(wp) :: newmetadfac,newmetadexp,newmetadlist
+  character(len=:),allocatable :: fname
+  character(len=512) :: tmppath,tmppath2
+  character(len=1024) :: jobcall
+  logical :: ex,mdfail
+  type(ensemble) :: dum
+  type(calcdata),target :: calc
+  type(mddata) :: mddat
+  type(coord)  :: mol
+  type(mtdpot) :: mtd
+  real(wp),allocatable :: cn(:),fakewbo(:,:)
+  character(len=*),parameter :: pipe = ' > xtb.out 2>/dev/null'
+
+  call getcwd(tmppath2)
+
+  !---- Setting threads
+  call new_ompautoset(env,'auto',1,T,Tn)
+
+  !--- Setting new defaults for MD/MTD in qcg
+  if (env%mdtemp .lt. 0.0d0) then
+    newtemp = 400.00d0
+  else if (.not.env%user_temp) then
+    newtemp = 298.0
+  else
+    newtemp = env%mdtemp
+  end if
+  env%mdtemp = newtemp
+
+  if (.not.env%user_mdtime) then
+    newmdtime = 100.0 !100.0
+  else
+    newmdtime = env%mdtime
+  end if
+  env%mdtime = newmdtime
+
+  if (.not.env%user_dumxyz) then
+    env%mddumpxyz = 1000
+  end if
+
+  if (.not.env%user_mdstep) then
+    if (env%ensemble_opt .ne. '--gff') then
+      newmdstep = 4.0d0
+    else
+      newmdstep = 1.5d0
+    end if
+  else
+    newmdstep = env%mdstep
+  end if
+  env%mdstep = newmdstep
+
+  if (env%ensemble_opt .ne. '--gff') then
+    newhmass = 4.0
+  else
+    newhmass = 5.0
+  end if
+  env%hmass = newhmass
+
+  if (.not.allocated(env%metadfac)) then
+    allocate (env%metadfac(1),source=0.02_wp)
+    allocate (env%metadexp(1),source=0.1_wp)
+    allocate (env%metadlist(1),source=10)
+  end if
+  newmetadfac = 0.02_wp
+  newmetadexp = 0.1_wp
+  newmetadlist = 10.0_wp
+
+  fname = 'coord'
+
+!> --------------------------------------------------------------------
+!> Internal calculator version
+!> --------------------------------------------------------------------
+  if (.not.env%legacy) then
+    call mol%open(fname)
+
+    call env_to_mddat(env)
+    mddat = env%mddat
+    calc = env%calc
+    if (.not.env%solv_md) then
+      call calc%set_freeze(mol%nat,1,solu%nat)
+    end if
+
+    if (env%shake .ne. 0) then
+      call mol%cn_to_bond(cn,fakewbo)
+      call move_alloc(fakewbo,mddat%shk%wbo)
+      if (calc%nfreeze > 0) then
+        mddat%shk%freezeptr => calc%freezelist
+      end if
+    end if
+
+    !> for MTD runtype add the corresponding potential
+    if (env%ensemble_method .EQ. 2) then
+      mtd%kpush = newmetadfac
+      mtd%alpha = newmetadexp
+      mtd%cvdump_fs = real(env%mddump)
+      mtd%mtdtype = cv_rmsd
+      allocate (mtd%atinclude(mol%nat),source=.true.)
+      mtd%atinclude(1:clus%nat) = .false. !> only include solvent
+      call mddat%add(mtd)
+    end if
+
+    !> set output file and run
+    mddat%trajectoryfile = 'xtb.trj.xyz'
+    call dynamics(mol,mddat,calc,.true.,io)
+
+    if (io .ne. 0) then
+      write (stdout,*) 'WARNING: MD run terminated ABNORMALLY'
+      call creststop(status_failed)
+    end if
+
+    call rename(mddat%trajectoryfile,'crest_rotamers_0.xyz')
+
+!> --------------------------------------------------------------------
+!> xtb-syscall version
+!> --------------------------------------------------------------------
+  else
+
+    !--- Writing constraining file xcontrol
+    !--- Providing xcontrol overwrites constraints in coord file
+
+    open (newunit=ich,file='xcontrol')
+    if (env%cts%NCI) then
+      do i = 1,10
+        if (trim(env%cts%pots(i)) .ne. '') then
+          write (ich,'(a)') trim(env%cts%pots(i))
+        end if
+      end do
+    end if
+
+    if (.not.env%solv_md) then
+      write (ich,'(a)') '$constrain'
+      write (ich,'(2x,a,i0)') 'atoms: 1-',solu%nat
+      write (ich,'(2x,a)') 'force constant=0.5'
+      write (ich,'(2x,a,a)') 'reference=ref.coord'
+    end if
+
+    write (ich,'(a)') '$md'
+    write (ich,'(2x,a,f10.2)') 'hmass=',newhmass
+    write (ich,'(2x,a,f10.2)') 'time=',newmdtime
+    write (ich,'(2x,a,f10.2)') 'temp=',newtemp
+    write (ich,'(2x,a,f10.2)') 'step=',newmdstep
+    write (ich,'(2x,a,i0)') 'shake=',env%shake
+    write (ich,'(2x,a,i0)') 'dump=',env%mddumpxyz
+    write (ich,'(2x,a)') 'dumpxyz=500.0'
+
+    if (env%ensemble_method .EQ. 2) then
+      write (ich,'(a)') '$metadyn'
+      write (ich,'(2x,a,i0,a,i0)') 'atoms: ',solu%nat+1,'-',clus%nat
+      write (ich,'(2x,a,f10.2)') 'save=',newmetadlist
+      write (ich,'(2x,a,f10.2)') 'kpush=',newmetadfac
+      write (ich,'(2x,a,f10.2)') 'alp=',newmetadexp
+    end if
+
+    if (env%cts%cbonds_md) call write_cts_CBONDS(ich,env%cts)
+
+    close (ich)
+
+!--- Writing jobcall
+    write (jobcall,'(a,1x,a,1x,a,'' --md --input xcontrol '',a,1x,a,a)') &
+          &     trim(env%ProgName),trim(fname),trim(env%gfnver),trim(env%solv),pipe
+!--- slightly different jobcall for QMDFF usage
+    if (env%useqmdff) then
+      write (jobcall,'(a,1x,a,1x,a,'' --md --input xcontrol --qmdff'',a,1x,a,a)') &
+         &     trim(env%ProgName),trim(fname),trim(env%gfnver),trim(env%solv),pipe
+    end if
+!--- MD
+    if (env%ensemble_method .EQ. 1) then
+      call normalMD(fname,env,1,newtemp,newmdtime)
+      write (stdout,*) 'Starting MD with the settings:'
+      write (stdout,'(''     MD time /ps        :'',f8.1)') newmdtime
+      write (stdout,'(''     MD Temperature /K  :'',f8.1)') newtemp
+      write (stdout,'(''     dt /fs             :'',f8.1)') newmdstep
+      write (tmppath,'(a,i0)') 'NORMMD1'
+
+      r = makedir(tmppath)
+      call copysub('xcontrol',tmppath)
+      call chdirdbug(tmppath)
+      call copy('coord','ref.coord')
+      call chdirdbug(tmppath2)
+
+      call command('cd '//trim(tmppath)//' && '//trim(jobcall),io)
+
+      inquire (file=trim(tmppath)//'/'//'xtb.trj',exist=ex)
+      if (.not.ex.or.io .ne. 0) then
+        write (stdout,'(a,i0,a)') '*Warning: MD seemingly failed (no xtb.trj)*'
+      else
+        write (stdout,*) '*MD finished*'
+      end if
+
+      if (env%trackorigin) then
+        call set_trj_origins('NORMMD','md')
+      end if
+      call chdirdbug('NORMMD1')
+    end if
+
+!--- MTD
+
+    if (env%ensemble_method .EQ. 2) then
+      call MetaMD(env,1,newmdtime,env%metadfac(1),env%metadexp(1), &
+         &               env%metadlist(1))
+      write (stdout,'(a,i4,a)') 'Starting Meta-MD with the settings:'
+      write (stdout,'(''     MTD time /ps       :'',f8.1)') newmdtime
+      write (stdout,'(''     dt /fs             :'',f8.1)') newmdstep
+      write (stdout,'(''     MTD Temperature /K  :'',f8.1)') newtemp
+      write (stdout,'(''     dumpstep(trj) /fs  :'',i8)') env%mddumpxyz
+      write (stdout,'(''     Vbias factor k /Eh :'',f8.4)') newmetadfac
+      write (stdout,'(''     Vbias exp α /bohr⁻²:'',f8.2)') newmetadexp
+
+      write (tmppath,'(a,i0)') 'METADYN1'
+      r = makedir(tmppath)
+      call copysub('xcontrol',tmppath)
+      call chdirdbug(tmppath)
+      call copy('coord','ref.coord')
+
+      call chdirdbug(tmppath2)
+
+      call command('cd '//trim(tmppath)//' && '//trim(jobcall),io)
+
+      inquire (file=trim(tmppath)//'/'//'xtb.trj',exist=ex)
+      if (.not.ex.or.io .ne. 0) then
+        write (stdout,'(a,i0,a)') '*Warning: Meta-MTD seemingly failed (no xtb.trj)*'
+      else
+        write (stdout,*) '*MTD finished*'
+      end if
+
+      if (env%trackorigin) then
+        call set_trj_origins('METADYN','mtd')
+      end if
+
+      call chdirdbug('METADYN1')
+
+    end if
+
+    call rename('xtb.trj','crest_rotamers_0.xyz')
+    call copysub('crest_rotamers_0.xyz',tmppath2)
+    call dum%open('crest_rotamers_0.xyz')
+
+!--- M(T)D stability check
+    call minigrep('xtb.out','M(T)D is unstable, emergency exit',mdfail)
+    if (dum%nall .eq. 1) then
+      call copysub('xtb.out',resultspath)
+      write (stdout,*) 'ERROR : M(T)D results only in one structure'
+      if (mdfail) then
+        write (stdout,*) '        It was unstable'
+      else
+        write (stdout,*) '        The M(T)D time step might be too large or the M(T)D time too short.'
+      end if
+      call copysub('xtb.out',resultspath)
+      error stop '         Please check the xtb.out file in the ensemble folder'
+    end if
+    if (mdfail) then
+      write (stdout,*)
+      write (stdout,*) '   WARNING: The M(T)D was unstable.'
+      write (stdout,*) '            Please check the xtb.out file in the ensemble folder.'
+      write (stdout,*)
+      call copysub('xtb.out',resultspath)
+    end if
+    call dum%deallocate
+    call chdirdbug(tmppath2)
+    call clus%write('coord')
+    call inputcoords(env,'coord') !Necessary
+
+!--- Optimization
+    call print_qcg_opt
+    call multilevel_opt(env,99)
+  end if
+
+end subroutine xtb_md_ensemble_qcg
+
+!___________________________________________________________________________________
+!
+! An xTB docking on all available threads
+!___________________________________________________________________________________
+
+subroutine xtb_dock(env,fnameA,fnameB,solu,clus)
+  use crest_parameters
+  use iomod
+  use crest_data
+  use qcg_coord_type
+  implicit none
+
+  type(systemdata)               :: env
+  type(coord_qcg),intent(in)     :: solu,clus
+  character(len=*),intent(in)    :: fnameA,fnameB
+  character(len=80)              :: pipe
+  character(len=512)             :: jobcall
+  integer                        :: i,ich,T,Tn
+
+  call remove('xtb_dock.out')
+  call remove('xcontrol')
+
+  pipe = ' 2>/dev/null'
+
+!---- writing wall pot in xcontrol
+  call write_wall(env,solu%nat,solu%ell_abc,clus%ell_abc,'xcontrol')
+
+!---- Write directed stuff, if requested
+  if (allocated(env%directed_file)) then
+    do i = 1,size(env%directed_number)
+      if &
+      & ((i == 1.and.env%directed_number(i) >= clus%nmol).OR. &
+      & (env%directed_number(i) >= clus%nmol.and.env%directed_number(i-1) < clus%nmol)) &
+      & then
+        open (newunit=ich,file='xcontrol',status='old',position='append',action='write')
+        write (ich,'("$directed")')
+        write (ich,'(a,1x,a)') 'atoms:',trim(env%directed_list(i,1))
+        write (ich,'("$end")')
+      end if
+    end do
+  end if
+
+!--- Setting threads
+  call new_ompautoset(env,'auto',1,T,Tn)
+
+!--- Jobcall docking
+  write (jobcall,'(a,1x,''dock'',1x,a,1x,a,1x,a,1x,f4.2,1x,''--nfrag1'',1x,i0,1x,a,1x, &
+          & ''--input xcontrol > xtb_dock.out'',a)') &
+          &     trim(env%ProgName),trim(fnameA),trim(fnameB),trim(env%gfnver),&
+          &     env%optlev,solu%nat,trim(env%docking_qcg_flag),trim(pipe)
+  call command(trim(jobcall))
+
+! cleanup
+  call remove('wbo')
+  call remove('charges')
+  call remove('xtbrestart')
+
+end subroutine xtb_dock
+
+!___________________________________________________________________________________
+!
+! An xTB optimization on all available threads
+!___________________________________________________________________________________
+
+subroutine opt_cluster(env,solu,clus,fname,without_pot)
+  use crest_parameters
+  use iomod
+  use crest_data
+  use qcg_coord_type
+
+  implicit none
+
+  type(systemdata)              :: env
+  type(coord_qcg),intent(in)    :: solu,clus
+  character(len=*),intent(in)   :: fname
+  logical,optional,intent(in)   :: without_pot
+  character(len=*),parameter    :: pipe = ' 2>/dev/null'
+  character(len=:),allocatable  :: jobcall
+  integer :: T,Tn
+
+  call remove('xtb.out')
+
+!---- writing wall pot in xcontrol
+  if (.not.without_pot) then
+    call write_wall(env,solu%nat,solu%ell_abc,clus%ell_abc,'xcontrol')
+  end if
+
+!--- Setting threads
+  call new_ompautoset(env,'subprocess',1,T,Tn)
+
+!--- Jobcall optimization
+  jobcall = trim(env%ProgName)//' '//trim(fname)//' --opt '//optlevflag(env%optlev)
+  jobcall = trim(jobcall)//' '//trim(env%gfnver)
+  if (without_pot) then
+    jobcall = trim(jobcall)//' '//trim(env%solv)
+  end if
+  jobcall = trim(jobcall)//' > xtb_opt.out 2>/dev/null'
+  call command(trim(jobcall))
+
+! cleanup
+  call remove('wbo')
+  call remove('charges')
+  call remove('xtbrestart')
+
+!--- Jobcall SP for gbsa model
+  if (.not.without_pot) then
+    jobcall = trim(env%ProgName)//' xtbopt.coord --sp '//trim(env%gfnver)
+    jobcall = trim(jobcall)//' '//trim(env%solv)
+    jobcall = trim(jobcall)//' > xtb_sp.out 2>/dev/null'
+    call command(trim(jobcall))
+  end if
+
+! cleanup
+  call remove('wbo')
+  call remove('charges')
+  call remove('xtbrestart')
+
+end subroutine opt_cluster
+
+!___________________________________________________________________________________
+!
+! xTB docking calculation performed in parallel
+!___________________________________________________________________________________
+
+subroutine ensemble_dock(env,outer_ell_abc,nfrag1,frag1_file,frag2_file,n_shell&
+        &,n_solvent,NTMP,TMPdir,conv)
+  use crest_parameters
+  use iomod
+  use crest_data
+  use qcg_coord_type
+
+  implicit none
+  type(systemdata)                :: env
+
+  character(len=*),intent(in)     :: TMPdir     !directory name
+  integer,intent(in)              :: NTMP       !number of structures to be optimized
+  integer,intent(in)              :: nfrag1     !#atoms of larger fragment
+  integer,intent(in)              :: conv(env%nqcgclust+1)
+  real(wp),intent(in)             :: outer_ell_abc(env%nqcgclust,3)
+  integer,intent(in)              :: n_shell,n_solvent
+
+  integer                         :: i,k
+  integer                         :: vz,T,Tn
+  character(len=20)               :: pipe
+  character(len=1024)             :: jobcall
+  character(len=512)              :: thispath,tmppath
+  character(len=*),intent(in)    :: frag1_file
+  character(len=*),intent(in)    :: frag2_file
+  character(len=64)               :: frag1
+  character(len=64)               :: frag2
+  real(wp)                        :: percent
+  character(len=2)                :: flag
+  integer                         :: funit
+
+! some options
+  pipe = '2>/dev/null'
+  frag1 = 'solvent_cluster.coord'
+  frag2 = 'solvent'
+  call getcwd(thispath)
+
+! setting the threads for correct parallelization
+  call new_ompautoset(env,'auto',NTMP,T,Tn)
+
+  write (jobcall,'(a,1x,''dock'',1x,a,1x,a,1x,a,1x,f4.2,1x,''--nfrag1'',1x,i0,1x,&
+          & ''--input xcontrol --fast > xtb_dock.out '',a)') &
+          & trim(env%ProgName),trim(frag1_file),trim(frag2_file),&
+          & trim(env%gfnver),env%optlev,nfrag1,trim(pipe)
+
+  flag = '$'
+  do i = 1,NTMP
+    vz = i
+    write (tmppath,'(a,i0)') trim(TMPdir),conv(i)
+    call chdirdbug(trim(tmppath))
+    open (newunit=funit,file='xcontrol')
+    write (funit,'(a,"fix")') trim(flag)
+    write (funit,'(3x,"atoms: 1-",i0)') n_shell !Initial number of atoms (starting solvent shell)
+    write (funit,'(a,"wall")') trim(flag)
+    write (funit,'(3x,"potential=polynomial")')
+    write (funit,'(3x,"ellipsoid:",1x,3(g0,",",1x),i0,"-",i0)') outer_ell_abc(conv(vz),:), &
+            & n_shell+1,n_shell+n_solvent !Initial number of atoms (starting solvent shell)
+    close (funit)
+    call chdirdbug(trim(thispath))
+  end do
+
+  k = 0 !counting the finished jobs
+
+!___________________________________________________________________________________
+
+!$omp parallel &
+!$omp shared( vz,NTMP,percent,k,TMPdir,conv,n_shell,n_solvent,jobcall )
+!$omp single
+  do i = 1,NTMP
+    vz = i
+    !$omp task firstprivate( vz ) private( tmppath )
+    write (tmppath,'(a,i0)') trim(TMPdir),conv(vz)
+    call command('cd '//trim(tmppath)//' && '//trim(jobcall))
+    !$omp critical
+    k = k+1
+    percent = real(k)/real(NTMP)*100
+    !$omp end critical
+    !$omp end task
+  end do
+
+!$omp taskwait
+!$omp end single
+!$omp end parallel
+
+!___________________________________________________________________________________
+  call chdirdbug(trim(thispath))
+
+end subroutine ensemble_dock
+
+!___________________________________________________________________________________
+!
+! xTB CFF optimization performed in parallel
+!___________________________________________________________________________________
+
+subroutine cff_opt(pr,env,fname,n12,NTMP,TMPdir,conv,nothing_added,eread)
+  use crest_parameters
+  use iomod
+  use crest_data
+  use strucrd
+  use term_ui,only:progress_init,progress_update,progress_finish
+  implicit none
+
+  type(systemdata)                :: env
+  character(len=*),intent(in)     :: fname      !file base name
+  character(len=*),intent(in)     :: TMPdir     !directory name
+  integer,intent(inout)           :: NTMP       !number of structures to be optimized
+  integer,intent(inout)           :: conv(env%nqcgclust+1)
+  logical,intent(in)              :: pr
+  logical,intent(in)              :: nothing_added(env%nqcgclust)
+  integer,intent(in)              :: n12
+  real(wp),intent(out)            :: eread(env%nqcgclust)
+  integer                         :: i,k
+  integer                         :: vz,T,Tn
+  integer                         :: funit
+  character(len=512)              :: thispath,tmppath
+  character(len=1024)             :: jobcall
+  character(len=2)                :: flag
+  real(wp)                        :: percent
+  logical :: ex,e_there
+  character(len=*),parameter      :: pipe = '2>/dev/null'
+
+  !> redirect to calculator version in new implementation
+  if (.not.env%legacy) then
+    call cff_opt_calculator(pr,env,fname,n12,NTMP,TMPdir,conv,nothing_added,eread)
+    return
+  end if
+
+! setting the threads for correct parallelization
+  call new_ompautoset(env,'auto',NTMP,T,Tn)
+
+  if (pr) then
+    write (stdout,'(2x,''Starting optimizations + SP  of structures'')')
+    write (stdout,'(2x,i0,'' jobs to do.'')') NTMP
+  end if
+
+! pr eq true => post opt run, which has to be performed in every directory !!!
+  if (pr) then
+    k = 0
+    NTMP = env%nqcgclust
+    do i = 1,env%nqcgclust
+      k = k+1
+      conv(k) = i
+      conv(env%nqcgclust+1) = k
+    end do
+  end if
+
+  call getcwd(thispath)
+  do i = 1,NTMP
+    write (tmppath,'(a,i0)') trim(TMPdir),conv(i)
+    call chdirdbug(trim(tmppath))
+    open (newunit=funit,file='xcontrol')
+    if (n12 .ne. 0) then
+      flag = '$'
+      write (funit,'(a,"fix")') trim(flag)
+      write (funit,'(3x,"atoms: 1-",i0)') n12 !Initial number of atoms (starting solvent shell)
+    end if
+    close (funit)
+    if (pr.and.nothing_added(i)) call remove('xcontrol')
+    call chdirdbug(trim(thispath))
+  end do
+
+!--- Jobcall
+  write (jobcall,'(a,1x,a,1x,a,'' --input xcontrol --opt '',i0,1x,a,'' >xtb.out'')') &
+  &    trim(env%ProgName),trim(fname),trim(env%gfnver),nint(env%optlev),trim(pipe)
+
+  if (NTMP .lt. 1) then
+    write (stdout,'(2x,"No structures to be optimized")')
+    return
+  end if
+
+  k = 0 !counting the finished jobs
+  if (pr) then
+    call progress_init(env%ps,NTMP,width=50,prefix=" ↳ ", &
+      &                suffix="",show_time=.true.,show_eta=.false.)
+    call progress_update(env%ps,0,NTMP)
+  end if
+!___________________________________________________________________________________
+
+!$omp parallel &
+!$omp shared( env, vz,jobcall,NTMP,percent,k,TMPdir,conv )
+!$omp single
+  do i = 1,NTMP
+    vz = i
+    !$omp task firstprivate( vz ) private( tmppath )
+    write (tmppath,'(a,i0)') trim(TMPdir),conv(vz)
+    call command('cd '//trim(tmppath)//' && '//trim(jobcall))
+    !$omp critical
+    k = k+1
+    percent = real(k)/real(NTMP)*100
+    if (pr) call progress_update(env%ps,k,NTMP)
+    !$omp end critical
+    !$omp end task
+  end do
+!$omp taskwait
+!$omp end single
+!$omp end parallel
+
+!__________________________________________________________________________________
+
+  do i = 1,NTMP
+    write (tmppath,'(a,i0)') trim(TMPdir),conv(i)
+    call chdirdbug(trim(tmppath))
+    call remove('xtbrestart')
+    call chdirdbug(trim(thispath))
+  end do
+
+  !create the system call for sp (needed for gbsa model)
+  write (jobcall,'(a,1x,a,1x,a,'' --sp '',a,1x,a,'' >xtb_sp.out'')') &
+  &    trim(env%ProgName),'xtbopt.coord',trim(env%gfnver),trim(env%solv),trim(pipe)
+
+  if (NTMP .lt. 1) then
+    write (stdout,'(2x,"Nothing to do")')
+    return
+  end if
+
+  k = 0 !counting the finished jobs
+  if (pr) then
+    call progress_init(env%ps,NTMP,width=50,prefix=" ↳ ", &
+      &                suffix="",show_time=.true.,show_eta=.false.)
+    call progress_update(env%ps,0,NTMP)
+  end if
+!___________________________________________________________________________________
+
+!$omp parallel &
+!$omp shared( vz,jobcall,NTMP,percent,k,TMPdir,conv )
+!$omp single
+  do i = 1,NTMP
+    vz = i
+    !$omp task firstprivate( vz ) private( tmppath )
+    write (tmppath,'(a,i0)') trim(TMPdir),conv(vz)
+    call command('cd '//trim(tmppath)//' && '//trim(jobcall))
+    !$omp critical
+    k = k+1
+    percent = real(k)/real(NTMP)*100
+    if (pr) call progress_update(env%ps,k,NTMP)
+    !$omp end critical
+    !$omp end task
+  end do
+!$omp taskwait
+!$omp end single
+!$omp end parallel
+
+!___________________________________________________________________________________
+
+  do i = 1,NTMP
+    write (tmppath,'(a,i0)') trim(TMPdir),conv(i)
+    call chdirdbug(trim(tmppath))
+
+    call grepval('xtb_sp.out','| TOTAL ENERGY',e_there,eread(i))
+
+    call remove('xtbrestart')
+    !call remove('xcontrol')
+    call chdirdbug(trim(thispath))
+  end do
+
+  if (pr) call progress_finish(env%ps)
+
+end subroutine cff_opt
+
+subroutine cff_opt_calculator(pr,env,fname,n12,NTMP,TMPdir, &
+    & conv,nothing_added,eread)
+  use crest_parameters
+  use iomod
+  use crest_data
+  use strucrd
+  use crest_calculator
+  use optimize_module
+  use term_ui,only:progress_init,progress_update,progress_finish
+  implicit none
+
+  type(systemdata)                :: env
+  character(len=*),intent(in)     :: fname      !file base name
+  character(len=*),intent(in)     :: TMPdir     !directory name
+  integer,intent(inout)           :: NTMP       !number of structures to be optimized
+  integer,intent(inout)           :: conv(env%nqcgclust+1)
+  logical,intent(in)              :: pr
+  logical,intent(in)              :: nothing_added(env%nqcgclust)
+  integer,intent(in)              :: n12
+  real(wp),intent(out)            :: eread(env%nqcgclust)
+  integer                         :: i,k
+  integer                         :: vz,T,Tn
+  integer                         :: funit
+  character(len=512)              :: thispath,tmppath
+  character(len=1024)             :: jobcall
+  character(len=2)                :: flag
+  real(wp)                        :: percent
+  logical :: gbsa_tmp,opt_nofreeze
+  integer :: io,nconstraints_tmp
+  character(len=40)  :: solv_tmp
+  real(wp) :: etot
+  type(calcdata),allocatable :: newcalcs(:)
+  type(calculation_settings) :: clevel
+  type(coord) :: mol,molopt
+  type(coord),allocatable :: structures(:)
+  real(wp),allocatable :: grd(:,:)
+  character(len=*),parameter      :: pipe = '2>/dev/null'
+
+  !> setting the threads to accelerate individual energy calculations
+  call new_ompautoset(env,'max',NTMP,T,Tn)
+
+  if (pr) then
+    write (stdout,'(2x,"Starting optimizations + SP  of structures")')
+    write (stdout,'(2x,i0,'' jobs to do.'')') NTMP
+  end if
+  if (NTMP .lt. 1) then
+    write (stdout,'(2x,"No structures to be optimized")')
+    return
+  end if
+
+! pr eq true => post opt run, which has to be performed in every directory !!!
+  if (pr) then
+    k = 0
+    NTMP = env%nqcgclust
+    do i = 1,env%nqcgclust
+      k = k+1
+      conv(k) = i
+      conv(env%nqcgclust+1) = k
+    end do
+  end if
+
+  !> Local storage for structures.
+  allocate (structures(NTMP))
+
+  call getcwd(thispath)
+  do i = 1,NTMP
+    write (tmppath,'(a,i0)') trim(TMPdir),conv(i)
+    call chdirdbug(trim(tmppath))
+    call structures(i)%open(fname)
+    call chdirdbug(trim(thispath))
+  end do
+
+  if (NTMP .lt. 1) then
+    write (stdout,'(2x,"No structures to be optimized")')
+    return
+  end if
+
+!--- Jobcall WITHOUT GBSA, back up data
+  solv_tmp = env%solv
+  gbsa_tmp = env%gbsa
+  env%solv = ''
+  env%gbsa = .false.
+
+  !> keep everything nice and separate, we have different molecules after all...
+  !> also, this will be gas-phase
+  call clevel%create(env%gfnver,chrg=env%chrg,uhf=env%uhf)
+  allocate (newcalcs(NTMP))
+  do i = 1,NTMP
+    call newcalcs(i)%add(clevel)
+    !> other important settings from env
+    newcalcs(i)%optlev = int(env%optlev)
+  end do
+
+  !> -------------------------------------------------
+  !> OPTIMIZATIONS
+  !> -------------------------------------------------
+  !> The structures may have different numbers
+  !> and it should not not be many structures anyways.
+  !> therefore, just optimize them serially.
+
+  k = 0 !counting the finished jobs
+  if (pr) then
+    call progress_init(env%ps,NTMP,width=50,prefix=" ↳ ", &
+      &                suffix="",show_time=.true.,show_eta=.false.)
+    call progress_update(env%ps,0,NTMP)
+  end if
+!___________________________________________________________________________________
+
+  do i = 1,NTMP
+    mol = structures(i)
+    allocate (grd(3,mol%nat))
+    opt_nofreeze = (pr.and.nothing_added(i))
+    if (.not.opt_nofreeze.and.n12 > 0) then
+      call newcalcs(i)%set_freeze(mol%nat,1,n12)
+      if (n12 == mol%nat) cycle !> safeguard against freezing all
+    end if
+
+    call optimize_geometry(mol,molopt,newcalcs(i),etot,grd, &
+      & .false.,.false.,io)
+    structures(i) = molopt
+    structures(i)%energy = etot
+
+    k = k+1
+    percent = real(k)/real(NTMP)*100.0_wp
+    if (pr) call progress_update(env%ps,k,NTMP)
+
+    deallocate (grd)
+  end do
+  if (pr) call progress_finish(env%ps)
+  !> clear up space
+  deallocate (newcalcs)
+!__________________________________________________________________________________
+
+!> -------------------------------------------------
+!> SINGLEPOINTS
+!> -------------------------------------------------
+!> same as for optimizations, turn on impl. solv again
+  env%solv = solv_tmp
+  env%gbsa = gbsa_tmp
+
+  !> again, keep everything nice and separate (now with impl. solv)
+  call clevel%create(env%gfnver,chrg=env%chrg,uhf=env%uhf,&
+    &  solvmodel=env%solv,solvent=env%solvent &
+  )
+  allocate (newcalcs(NTMP))
+  do i = 1,NTMP
+    call newcalcs(i)%add(clevel)
+  end do
+
+  k = 0 !counting the finished jobs
+  if (pr) then
+    call progress_init(env%ps,NTMP,width=50,prefix=" ↳ ", &
+      &                suffix="",show_time=.true.,show_eta=.false.)
+    call progress_update(env%ps,0,NTMP)
+  end if
+!___________________________________________________________________________________
+
+  do i = 1,NTMP
+    mol = structures(i)
+    allocate (grd(3,mol%nat))
+
+    call engrad(mol,newcalcs(i),etot,grd,io)
+    structures(i)%energy = etot
+
+    k = k+1
+    percent = real(k)/real(NTMP)*100.0_wp
+    if (pr) call progress_update(env%ps,k,NTMP)
+
+    deallocate (grd)
+  end do
+  if (pr) call progress_finish(env%ps)
+!___________________________________________________________________________________
+
+  !> for compatibility reasons, let's write the optimized geometries
+  !> and pass on energies
+  call getcwd(thispath)
+  do i = 1,NTMP
+    eread(i) = structures(i)%energy
+    write (tmppath,'(a,i0)') trim(TMPdir),conv(i)
+    call chdirdbug(trim(tmppath))
+    call structures(i)%write('xtbopt.coord')
+    call chdirdbug(trim(thispath))
+  end do
+
+  if (allocated(newcalcs)) deallocate (newcalcs)
+  if (allocated(structures)) deallocate (structures)
+end subroutine cff_opt_calculator
+
+!___________________________________________________________________________________
+!
+! xTB SP performed in parallel
+!___________________________________________________________________________________
+subroutine ens_sp_with_io(env,ens,clus,resultspath)
+  use crest_parameters
+  use crest_data
+  use qcg_coord_type
+  use strucrd
+  use iomod
+  implicit none
+  type(systemdata),intent(inout) :: env
+  type(ensemble),intent(inout)   :: ens
+  type(coord_qcg),intent(inout)  :: clus
+  character(len=512),intent(in)  :: resultspath
+  character(len=512) :: tmppath2,to,comment
+  integer :: i,io,minpos
+  logical :: e_there,not_param,ex
+
+  call getcwd(tmppath2)
+
+  !--- Write folder with xyz-coordinates
+  do i = 1,ens%nall
+    call rdxmolselec('ensemble.xyz',i,clus%nat,clus%at,clus%xyz)
+    write (to,'("TMPSP",i0)') i
+    io = makedir(trim(to))
+    call copysub('.UHF',to)
+    call copysub('.CHRG',to)
+    call chdirdbug(to)
+    call wrxyz('cluster.xyz',clus%nat,clus%at,clus%xyz*bohr)
+    call chdirdbug(tmppath2)
+  end do
+  !--- SP
+  write (stdout,*)
+  call ens_sp(env,'cluster.xyz',ens%nall,'TMPSP')
+  !--- Getting energy
+  do i = 1,ens%nall
+    call rdxmolselec('ensemble.xyz',i,clus%nat,clus%at,clus%xyz)
+    write (to,'("TMPSP",i0)') i
+    call chdirdbug(to)
+    call grepval('xtb_sp.out','| TOTAL ENERGY',e_there,ens%er(i))
+    call chdirdbug(tmppath2)
+  end do
+
+  if (.not.e_there) then
+    write (stdout,*)
+    write (stdout,*) 'Energy not found. Error in xTB computations occured'
+    call chdirdbug(to)
+    call minigrep('xtb_sp.out','solv_model_loadInternalParam',not_param)
+    call chdirdbug(tmppath2)
+    if (not_param) then
+      write (stdout,*) '  !!!WARNIG: CHOSEN SOLVENT NOT PARAMETERIZED &
+      & FOR IMPLICIT SOLVATION MODEL!!!'
+      write (stdout,'(''  CHECK IF '',A,'' IS AVAILABLE IN xTB'')') env%solv
+      write (stdout,*) '  PLEASE RESTART THE ENSEMBLE GENERATION WITH AVAILABLE&
+             &  PARAMETERIZATION IF YOU NEED ENERGIES'
+      call copysub('crest_conformers.xyz',resultspath)
+      write (stdout,*) '  The enesemble can be found in the <ensemble> directory&
+             & as <crest_conformers.xyz>'
+      error stop
+    end if
+  end if
+  call ens%write('full_ensemble.xyz')
+
+!--- crest_best structure
+  minpos = minloc(ens%er,dim=1)
+  write (to,'("TMPSP",i0)') minpos
+  call chdirdbug(to)
+  call rdxmol('cluster.xyz',clus%nat,clus%at,clus%xyz)
+  call chdirdbug(tmppath2)
+  write (comment,'(F20.8)') ens%er(minpos)
+  inquire (file='crest_best.xyz',exist=ex)
+  if (ex) then
+    call rmrf('crest_best.xyz') !remove crest_best from
+  end if
+  call wrxyz('crest_best.xyz',clus%nat,clus%at,clus%xyz,trim(comment))
+
+end subroutine ens_sp_with_io
+
+subroutine ens_sp(env,fname,NTMP,TMPdir)
+  use crest_parameters
+  use iomod
+  use crest_data
+  use strucrd
+  use term_ui,only:progress_init,progress_update,progress_finish
+  implicit none
+
+  type(systemdata)                :: env
+  character(len=*),intent(in)     :: fname      !file base name
+  character(len=*),intent(in)     :: TMPdir     !directory name
+  integer,intent(inout)           :: NTMP       !number of structures to be optimized
+
+  integer                         :: i,k
+  integer                         :: vz,T,Tn
+  character(len=20)               :: pipe
+  character(len=512)              :: thispath,tmppath
+  character(len=1024)             :: jobcall
+  real(wp)                        :: percent
+
+! setting the threads for correct parallelization
+  call new_ompautoset(env,'auto',NTMP,T,Tn)
+
+  write (stdout,'(2x,''---------------------------------------------'')')
+  write (stdout,'(2x,''Single point computation with GBSA/ALPB model'')')
+  write (stdout,'(2x,''---------------------------------------------'')')
+  write (stdout,'(2x,i0,'' jobs to do.'')') NTMP
+
+  pipe = '2>/dev/null'
+
+  call getcwd(thispath)
+
+  if (NTMP .lt. 1) then
+    write (stdout,'(2x,"No structures to be optimized")')
+    return
+  end if
+
+!--- Jobcall
+  write (jobcall,'(a,1x,a,1x,a,'' --sp '',a,1x,a,'' > xtb_sp.out'')') &
+  &    trim(env%ProgName),trim(fname),trim(env%gfnver),trim(env%solv),trim(pipe)
+
+  k = 0 !counting the finished jobs
+  call progress_init(env%ps,NTMP,width=50,prefix=" ↳ ", &
+    &                suffix="",show_time=.true.,show_eta=.false.)
+  call progress_update(env%ps,0,NTMP)
+
+!___________________________________________________________________________________
+
+!$omp parallel &
+!$omp shared( env,vz,NTMP,percent,k,TMPdir,jobcall )
+!$omp single
+  do i = 1,NTMP
+    vz = i
+    !$omp task firstprivate( vz ) private( tmppath )
+    call initsignal()
+    !$omp critical
+    write (tmppath,'(a,i0)') trim(TMPdir),vz
+    !$omp end critical
+    call command('cd '//trim(tmppath)//' && '//trim(jobcall))
+    !$omp critical
+    k = k+1
+    percent = real(k)/real(NTMP)*100
+    call progress_update(env%ps,k,NTMP)
+    !$omp end critical
+    !$omp end task
+  end do
+!$omp taskwait
+!$omp end single
+!$omp end parallel
+
+!__________________________________________________________________________________
+
+  do i = 1,NTMP
+    write (tmppath,'(a,i0)') trim(TMPdir),i
+    call chdirdbug(trim(tmppath))
+    call remove('xtbrestart')
+    call chdirdbug(trim(thispath))
+  end do
+  call progress_finish(env%ps)
+
+end subroutine ens_sp
+
+!___________________________________________________________________________________
+!
+! xTB Freq compuatation performed in parallel
+!___________________________________________________________________________________
+
+subroutine ens_freq(env,fname,NTMP,TMPdir,opt)
+  use crest_parameters
+  use iomod
+  use crest_data
+  use strucrd
+  use term_ui,only:progress_init,progress_update,progress_finish
+  implicit none
+
+  type(systemdata)                :: env
+  character(len=*),intent(in)     :: fname      !file base name
+  character(len=*),intent(in)     :: TMPdir     !directory name
+  integer,intent(inout)           :: NTMP       !number of structures to be optimized
+
+  integer                         :: i,k
+  integer                         :: vz,T,Tn
+  character(len=512)              :: thispath,tmppath
+  character(len=1024)             :: jobcall
+  real(wp)                        :: percent
+  logical                         :: opt
+  character(len=*),parameter      :: pipe = '2>/dev/null'
+
+  !> redirect to new calculator version if available
+  if (.not.env%legacy) then
+    call ens_freq_calculator(env,fname,NTMP,TMPdir,opt)
+    return
+  end if
+
+! setting the threads for correct parallelization
+  call new_ompautoset(env,'auto',NTMP,T,Tn)
+
+  write (stdout,'(2x,''Starting reoptimizations + Frequency computation of ensemble'')')
+  write (stdout,'(2x,i0,'' jobs to do.'')') NTMP
+
+  call getcwd(thispath)
+
+  if (NTMP .lt. 1) then
+    write (stdout,'(2x,"No structures to be optimized")')
+    return
+  end if
+
+  k = 0 !counting the finished jobs
+  call progress_init(env%ps,NTMP,width=50,prefix=" ↳ ", &
+    &                suffix="",show_time=.true.,show_eta=.false.)
+  call progress_update(env%ps,0,NTMP)
+
+!--- Jobcall
+  if (.not.opt) then
+    write (jobcall,'(a,1x,a,1x,a,'' --hess '',a,'' >xtb_freq.out'')') &
+     &    trim(env%ProgName),trim(fname),trim(env%gfnver),trim(pipe)
+  else
+    write (jobcall,'(a,1x,a,1x,a,'' --ohess '',a,'' >xtb_freq.out'')') &
+    &    trim(env%ProgName),trim(fname),trim(env%gfnver),trim(pipe)
+  end if
+
+!___________________________________________________________________________________
+
+!$omp parallel &
+!$omp shared( env,vz,NTMP,percent,k,TMPdir,jobcall )
+!$omp single
+  do i = 1,NTMP
+    vz = i
+    !$omp task firstprivate( vz ) private( tmppath )
+    write (tmppath,'(a,i0)') trim(TMPdir),i
+    call command('cd '//trim(tmppath)//' && '//trim(jobcall))
+    !$omp critical
+    k = k+1
+    percent = real(k)/real(NTMP)*100
+    call progress_update(env%ps,k,NTMP)
+    !$omp end critical
+    !$omp end task
+  end do
+!$omp taskwait
+!$omp end single
+!$omp end parallel
+
+!__________________________________________________________________________________
+
+  do i = 1,NTMP
+    write (tmppath,'(a,i0)') trim(TMPdir),i
+    call chdirdbug(trim(tmppath))
+    call remove('xtbrestart')
+    call chdirdbug(trim(thispath))
+  end do
+  call progress_finish(env%ps)
+
+end subroutine ens_freq
+
+subroutine ens_freq_calculator(env,fname,NTMP,TMPdir,opt)
+  use crest_parameters
+  use iomod
+  use crest_data
+  use strucrd
+  use crest_calculator
+  use thermochem_module
+  use optimize_module
+  use term_ui,only:progress_init,progress_update,progress_finish
+  implicit none
+
+  type(systemdata)                :: env
+  character(len=*),intent(in)     :: fname      !file base name
+  character(len=*),intent(in)     :: TMPdir     !directory name
+  integer,intent(inout)           :: NTMP       !number of structures to be optimized
+
+  integer                         :: i,k
+  integer                         :: vz,T,Tn
+  character(len=*),parameter      :: pipe = '2>/dev/null'
+  character(len=512)              :: thispath,tmppath
+  character(len=1024)             :: jobcall
+  real(wp)                        :: percent
+  logical                         :: opt
+
+  !> local calculation setup
+  type(coord) :: tmpmol,mol
+  type(calculation_settings) :: clevel
+  type(calcdata),allocatable :: newcalcs(:)
+  real(wp),allocatable :: tmpgrd(:,:),hess(:,:),freq(:)
+  real(wp) :: etmp
+  integer :: n3,io,ich
+
+  real(wp) :: ithr,fscal,sthr
+  character(len=:),allocatable :: emodel
+  integer :: nt,nfreq,nrt
+  real(wp),allocatable :: temps(:),et(:),ht(:),stot(:),gt(:)
+  real(wp) :: zpve
+
+! setting the threads for correct parallelization
+  call new_ompautoset(env,'max',NTMP,T,Tn)
+
+  write (stdout,'(2x,''Starting reoptimizations + Frequency computation of ensemble'')')
+  write (stdout,'(2x,i0,'' jobs to do.'')') NTMP
+
+  call getcwd(thispath)
+
+  if (NTMP .lt. 1) then
+    write (stdout,'(2x,"No structures to be optimized")')
+    return
+  end if
+
+  k = 0 !counting the finished jobs
+  call progress_init(env%ps,NTMP,width=50,prefix=" ↳ ", &
+    &                suffix="",show_time=.true.,show_eta=.false.)
+  call progress_update(env%ps,0,NTMP)
+
+!--- Jobcall
+  if (.not.opt) then
+    write (jobcall,'(a,1x,a,1x,a,'' --hess '',a,'' >xtb_freq.out'')') &
+     &    trim(env%ProgName),trim(fname),trim(env%gfnver),trim(pipe)
+  else
+    write (jobcall,'(a,1x,a,1x,a,'' --ohess '',a,'' >xtb_freq.out'')') &
+    &    trim(env%ProgName),trim(fname),trim(env%gfnver),trim(pipe)
+  end if
+
+!--- prepare calcs
+  call clevel%create(env%gfnver,chrg=env%chrg,uhf=env%uhf)
+  allocate (newcalcs(NTMP))
+  do i = 1,NTMP
+    call newcalcs(i)%add(clevel)
+    newcalcs(i)%optlev = int(env%optlev)
+    !call newcalcs(i)%info(stdout)
+  end do
+
+!--- prepare thermo
+  !> inversion threshold
+  ithr = env%thermo%ithr
+  !> frequency scaling factor
+  fscal = env%thermo%fscal
+  !> RR-HO interpolation
+  sthr = env%thermo%sthr
+  !> Svib model
+  emodel = env%thermo%emodel
+
+  !> we just need one temperature
+  nt = 1
+  allocate (temps(nt),et(nt),ht(nt),gt(nt),stot(nt),source=0.0_wp)
+  temps(:) = 298.15_wp
+
+!___________________________________________________________________________________
+!> serial runtype
+  do i = 1,NTMP
+    write (tmppath,'(a,i0)') trim(TMPdir),i
+    call chdirdbug(trim(tmppath))
+    call tmpmol%open(fname)
+
+    allocate (tmpgrd(3,tmpmol%nat),source=0.0_wp)
+    if (opt) then
+      call optimize_geometry(tmpmol,mol,newcalcs(i),etmp,tmpgrd, &
+      & .false.,.false.,io)
+    else
+      mol = tmpmol
+    end if
+
+    n3 = mol%nat*3
+    allocate (hess(n3,n3),source=0.0_wp)
+    allocate (freq(n3),source=0.0_wp)
+
+    !>-- compute Hessian
+    call numhess2(mol%nat,mol%at,mol%xyz,newcalcs(i),hess,io)
+
+    !>-- Projects and mass-weights the Hessian
+    call prj_mw_hess(mol%nat,mol%at,n3,mol%xyz,hess(:,:))
+
+    !>-- Computes the Frequencies
+    call frequencies(mol%nat,mol%at,mol%xyz,n3,hess(:,:),freq(:),io)
+
+    !> write dummy "xtb_freq.out"
+    open (newunit=ich,file="xtb_freq.out")
+    !> calcthermo wants input in Bohr
+    call calcthermo(mol%nat,mol%at,mol%xyz,freq,.true., &
+    & ithr,fscal,sthr,nt,temps,et,ht,gt,stot,ich,emodel=emodel)
+    close (ich)
+
+    deallocate (freq,hess,tmpgrd)
+    k = k+1
+    call progress_update(env%ps,k,NTMP)
+    call chdirdbug(trim(thispath))
+  end do
+
+!__________________________________________________________________________________
+
+  call progress_finish(env%ps)
+end subroutine ens_freq_calculator
+
+!============================================================!
+! subroutine wr_cluster_cut
+! Cuts a cluster file and and writes the parts
+!
+! On Input: fname          - name of the coord file
+!           n1             - number of atoms fragment1
+!           n2             - number of atmos fragment2
+!           iter           - number of solvent molecules
+!           fname_solu_cut - name of outputfile fragment1
+!           fname_solv_cut - name of outputfile fragment2
+!
+!============================================================!
+
+subroutine wr_cluster_cut(fname_cluster,n1,n2,iter,fname_solu_cut,fname_solv_cut)
+  use crest_parameters
+  use strucrd
+  implicit none
+  integer,intent(in)         :: n1,n2,iter
+  real(wp)                    :: xyz1(3,n1)
+  real(wp)                    :: xyz2(3,n2*iter)
+  integer                     :: at1(n1),at2(n2*iter)
+  character(len=*),intent(in) :: fname_cluster,fname_solu_cut,fname_solv_cut
+  character(len=256)         :: atmp
+  character(len=2)           :: a2
+  integer                     :: ich,i,k,stat,io,io2
+
+  !ich = 142
+  open (newunit=ich,file=fname_cluster,iostat=stat)
+  read (ich,'(a)') atmp
+  k = 1
+  do i = 1,n1
+    read (ich,'(a)',iostat=io) atmp
+    if (io < 0) exit
+    atmp = adjustl(atmp)
+    call coordline(atmp,a2,xyz1(1:3,k),io2)
+    at1(k) = e2i(a2)
+    k = k+1
+  end do
+  k = 1
+  do i = 1,n2*iter
+    read (ich,'(a)',iostat=io) atmp
+    if (io < 0) exit
+    atmp = adjustl(atmp)
+    call coordline(atmp,a2,xyz2(1:3,k),io2)
+    at2(k) = e2i(a2)
+    k = k+1
+  end do
+
+  call wrc0(fname_solu_cut,n1,at1,xyz1)
+  call wrc0(fname_solv_cut,n2*iter,at2,xyz2)
+  close (ich)
+
+end subroutine wr_cluster_cut
+
+!----------------------------------------------------------------------------
+! write a wall potential in a file used as xtb input
+
+subroutine write_wall(env,n1,rabc1,rabc12,fname)
+  use crest_parameters
+  use crest_data
+
+  implicit none
+
+  type(systemdata)     :: env
+  integer,intent(in)  :: n1
+  real(wp),intent(in)  :: rabc1(3),rabc12(3)
+  character(len=8)    :: flag
+  character(len=*)    :: fname
+  integer :: funit
+
+  open (newunit=funit,file=fname)
+  flag = '$'
+  write (funit,'(a,"wall")') trim(flag)
+  write (funit,'(3x,"potential=polynomial")')
+  write (funit,'(3x,"ellipsoid:",1x,3(g0,",",1x),"all")') rabc12
+  write (funit,'(3x,"ellipsoid:",1x,3(g0,",",1x),"1-",i0)') rabc1,n1
+  if (env%constrain_solu) then
+    write (funit,'("$fix")')
+    write (funit,'(3x,"atoms: 1-",i0)') n1
+  end if
+  call write_cts(funit,env%cts)
+  call write_cts_biasext(funit,env%cts)
+  if (env%cts%used) then !Only, if user set constrians is an $end written
+    write (funit,'(a)') '$end'
+  end if
+  close (funit)
+
+end subroutine write_wall
+
+subroutine check_dock(neg_E)
+  use crest_parameters
+  use crest_data
+  use iomod,only:minigrep,grepval
+
+  implicit none
+  real(wp)             :: int_E
+  logical,intent(out) :: neg_E
+  logical :: ex
+  character(len=*),parameter :: filename = 'xtbscreen.xyz'
+
+  neg_E = .false.
+  int_E = 0.0_wp
+
+  call minigrep('xtb_dock.out','  Lowest Interaction Energy: ********** kcal/mol',ex)
+  if (ex) return
+
+  call grepval('xtb_dock.out','Lowest Interaction Energy:',ex,int_E)
+
+  if (ex.and.int_E < 0.0_wp) neg_E = .true.
+
+end subroutine check_dock
+
+subroutine write_constraint(env,coord_name,fname)
+  use crest_parameters
+  use crest_data
+  use iomod
+
+  implicit none
+
+  type(systemdata)     :: env
+  character(len=*),intent(in)    :: fname,coord_name
+  integer :: funit
+
+  call copysub(coord_name,'coord.ref')
+  open (newunit=funit,file=fname)
+  call write_cts(funit,env%cts)
+  call write_cts_biasext(funit,env%cts)
+  if (env%cts%used) then !Only, if user set constrians is an $end written
+    write (funit,'(a)') '$end'
+  end if
+  close (funit)
+
+end subroutine write_constraint
+
+!==============================================================================!
+
+subroutine get_interaction_E(env,solu,solv,clus,iter,E_inter)
+  use iso_fortran_env,wp => real64
+  use crest_data
+  use iomod
+  use qcg_coord_type
+  use strucrd
+  implicit none
+
+  type(systemdata)           :: env
+  type(coord_qcg),intent(in) :: solu,solv,clus
+  real(wp)                   :: e_cluster,e_solute,e_solvent
+  real(wp)                   :: E_inter(env%nsolv)           ! interaction energy
+  integer                    :: iter
+  logical                    :: e_there
+
+  call remove('cluster.coord')
+
+!--- Prepare input coordinate files
+  call clus%write('cluster.coord')
+  call wr_cluster_cut('cluster.coord',solu%nat,solv%nat,iter,'solute_cut.coord','solvent_cut.coord')
+
+!--- Perform single point calculations and recieve energies
+  call xtb_sp_qcg(env,'solute_cut.coord',e_there,e_solute)
+  if (.not.e_there) write (stdout,*) 'Solute energy not found'
+
+  call xtb_sp_qcg(env,'solvent_cut.coord',e_there,e_solvent)
+  if (.not.e_there) write (stdout,*) 'Solvent energy not found'
+
+  call xtb_sp_qcg(env,'cluster.coord',e_there,e_cluster)
+  if (.not.e_there) write (stdout,*) 'Cluster energy not found'
+
+  E_inter(iter) = e_cluster-e_solute-e_solvent
+
+end subroutine get_interaction_E
+
+!===============================================================================!
+subroutine chdirdbug(path)
+  implicit none
+  character(len=*),intent(in) :: path
+  logical,parameter :: debug = .false.
+  character(len=500) :: debugpath
+  call chdir(path)
+  if (debug) then
+    call getcwd(debugpath)
+    write (*,'(a,a)') '>>>>>>> NOW IN ',trim(debugpath)
+  end if
+end subroutine chdirdbug
+
+!===============================================================================!
+subroutine qcg_envcalc_reinit(env,mol,addconstraints,printinfo)
+  use crest_parameters
+  use crest_data
+  use qcg_coord_type
+  use strucrd
+  use parse_xtbinput
+  implicit none
+  type(systemdata),intent(inout) :: env
+  type(coord),intent(inout) :: mol
+  logical,intent(in) :: addconstraints
+  logical,intent(in) :: printinfo
+
+  !> clear old data
+  if (allocated(env%calc%calcs)) deallocate (env%calc%calcs)
+  env%calc%ncalculations = 0
+
+  !> and re-initialize
+  call env2calc(env,env%calc,mol)
+
+  !> add constraints from 'cts' if we want this
+  if (addconstraints) then
+    if (allocated(env%calc%cons)) deallocate (env%calc%cons)
+    env%calc%nconstraints = 0
+    if (printinfo) then
+      write (stdout,'(a,a,a)') 'Parsing xtb-type constraints from internal backup to set up calculators ...'
+    end if
+    call parse_constraints_from_cts(env%calc,mol,env%cts)
+  end if
+
+  !> do a printout to stdout, if selected
+  if (printinfo) then
+    call env%calc%info(stdout)
+  end if
+
+end subroutine qcg_envcalc_reinit
+
diff --git a/src/qcg/qcg_printouts.f90 b/src/qcg/qcg_printouts.f90
new file mode 100644
index 00000000..6591563f
--- /dev/null
+++ b/src/qcg/qcg_printouts.f90
@@ -0,0 +1,298 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2021-2025 Christoph Plett, Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module qcg_printouts
+  use crest_parameters,only:stdout,wp
+
+  use crest_data
+  use iomod
+  implicit none
+  public
+
+contains
+
+  subroutine qcg_head()
+    implicit none
+    write (stdout,*)
+    write (stdout,'(10x,''========================================'')')
+    write (stdout,'(10x,''|           ----------------           |'')')
+    write (stdout,'(10x,''|                 Q C G                |'')')
+    write (stdout,'(10x,''|           ----------------           |'')')
+    write (stdout,'(10x,''|        Quantum Cluster Growth        |'')')
+    write (stdout,'(10x,''|       University of Bonn, MCTC       |'')')
+    write (stdout,'(10x,''========================================'')')
+    write (stdout,'(10x,''    S. Grimme, S. Spicher, C. Plett.'')')
+    write (stdout,*)
+    write (stdout,'(10x,''Cite work conducted with this code as:'')')
+    write (stdout,'(/,9x,''S. Spicher, C. Plett, P. Pracht, A. Hansen,'')')
+    write (stdout,'(9x,''S. Grimme, JCTC, 2022, 18, 3174-3189.'')')
+    write (stdout,*)
+  end subroutine qcg_head
+
+  subroutine write_qcg_setup(env)
+    implicit none
+    type(systemdata) :: env
+
+    write (stdout,*)
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,'(2x,''|   quantum cluster growth: INPUT       |'')')
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,*)
+    select case (env%qcg_runtype)
+    case (0)
+      write (stdout,'(2x,''QCG: Only Cluster Generation'')')
+    case (1)
+      write (stdout,'(2x,''QCG: Cluster + Ensemble Generation'')')
+      if (env%ensemble_method .eq. 0) write (stdout,'(2x,''Ensemble generated via CREST'')')
+      if (env%ensemble_method .eq. 1) write (stdout,'(2x,''Ensemble generated via MD Simulation'')')
+      if (env%ensemble_method .eq. 2) write (stdout,'(2x,''Ensemble generated via MetaDynamic'')')
+    case (2)
+      write (stdout,'(2x,''QCG: Calculation of delta E_solv'')')
+      if (env%ensemble_method .eq. 0) write (stdout,'(2x,''Ensemble generated via CREST'')')
+      if (env%ensemble_method .eq. 1) write (stdout,'(2x,''Ensemble generated via MD Simulation'')')
+      if (env%ensemble_method .eq. 2) write (stdout,'(2x,''Ensemble generated via MetaDynamic'')')
+    case (3)
+      write (stdout,'(2x,''QCG: Calculation of delta G_solv'')')
+      if (env%ensemble_method .eq. 0) write (stdout,'(2x,''Ensemble generated via CREST'')')
+      if (env%ensemble_method .eq. 1) write (stdout,'(2x,''Ensemble generated via MD Simulation'')')
+      if (env%ensemble_method .eq. 2) write (stdout,'(2x,''Ensemble generated via MetaDynamic'')')
+    case default
+      continue
+    end select
+    write (stdout,*)
+    write (stdout,'(2x,''input parameters     '')')
+    write (stdout,'(2x,''solute                 : '',a)') trim(env%solu_file)
+    write (stdout,'(2x,''charge                 : '',i0)') env%chrg
+    write (stdout,'(2x,''uhf                    : '',i0)') env%uhf
+    write (stdout,'(2x,''solvent                : '',a)') trim(env%solv_file)
+    if (env%nsolv .ne. 0) then
+      write (stdout,'(2x,''# of solvents to add   : '',i0)') env%nsolv
+    else if (env%nsolv .eq. 0) then
+      write (stdout,'(2x,''# of solvents to add   : until convergence, but maximal'',1x,i4)') env%max_solv
+    end if
+    if (env%nqcgclust .ne. 0) then
+      write (stdout,'(2x,''# of cluster generated : '',i0)') env%nqcgclust
+    else
+      write (stdout,'(2x,''Cluster generated that are above 10 % populated '')')
+    end if
+
+    write (stdout,'(2x,''# of CPUs used         : '',i0)') env%Threads
+    if (env%solvent .eq. '') then
+      write (stdout,'(2x,''No gbsa/alpb model''  )')
+    else
+      write (stdout,'(2x,''Solvation model        : '',a)') env%solvent
+    end if
+    write (stdout,'(2x,''xtb opt level          : '',a)') trim(optlevflag(env%optlev))
+    write (stdout,'(2x,''System temperature [K] : '',F5.1)') env%tboltz
+    write (stdout,'(2x,''RRHO scaling factor    : '',F4.2)') env%freq_scal
+    write (stdout,*)
+
+  end subroutine write_qcg_setup
+
+!========================================================================================!
+!========================================================================================!
+!>  QCG-printouts
+!==============================================================================!
+!========================================================================================!
+
+  subroutine print_qcg_grow()
+    implicit none
+    write (stdout,*)
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,'(2x,''|   quantum cluster growth: GROW        |'')')
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,*)
+  end subroutine print_qcg_grow
+  subroutine pr_qcg_fastgrow()
+    implicit none
+    write (stdout,*)
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,'(2x,''|   quantum cluster growth: FASTGROW    |'')')
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,*)
+  end subroutine pr_qcg_fastgrow
+  subroutine print_qcg_ensemble()
+    implicit none
+    write (stdout,*)
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,'(2x,''|   quantum cluster growth: ENSEMBLE    |'')')
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,*)
+  end subroutine print_qcg_ensemble
+  subroutine print_qcg_opt()
+    implicit none
+    write (stdout,*)
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,'(2x,''|   quantum cluster growth: OPT         |'')')
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,*)
+    write (stdout,'(2x,''Very tight post optimization of lowest cluster'')')
+  end subroutine print_qcg_opt
+  subroutine pr_qcg_fill()
+    implicit none
+    write (stdout,*)
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,'(2x,''|   quantum cluster growth: CFF         |'')')
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,*)
+    write (stdout,'(2x,''CUT-FREEZE-FILL Algorithm to generate reference solvent cluster'')')
+  end subroutine pr_qcg_fill
+  subroutine pr_qcg_freq()
+    implicit none
+    write (stdout,*)
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,'(2x,''|          Frequency evaluation         |'')')
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,*)
+  end subroutine pr_qcg_freq
+  subroutine pr_eval_solute()
+    implicit none
+    write (stdout,*)
+    write (stdout,'(2x,''________________________________________________________________________'')')
+    write (stdout,*)
+    write (stdout,'(2x,''__________________     Solute Cluster Generation   _____________________'')')
+    write (stdout,*)
+    write (stdout,'(2x,''________________________________________________________________________'')')
+    write (stdout,*)
+  end subroutine pr_eval_solute
+  subroutine pr_eval_solvent()
+    implicit none
+    write (stdout,*)
+    write (stdout,*)
+    write (stdout,'(2x,''________________________________________________________________________'')')
+    write (stdout,*)
+    write (stdout,'(2x,''_________________     Solvent Cluster Generation   _____________________'')')
+    write (stdout,*)
+    write (stdout,'(2x,''________________________________________________________________________'')')
+    write (stdout,*)
+  end subroutine pr_eval_solvent
+  subroutine pr_eval_eval()
+    implicit none
+    write (stdout,*)
+    write (stdout,*)
+    write (stdout,'(2x,''________________________________________________________________________'')')
+    write (stdout,*)
+    write (stdout,'(2x,''_________________________     Evaluation    ____________________________'')')
+    write (stdout,*)
+    write (stdout,'(2x,''________________________________________________________________________'')')
+    write (stdout,*)
+    write (stdout,*)
+  end subroutine pr_eval_eval
+  subroutine pr_freq_energy()
+    implicit none
+    write (stdout,'(2x,"#       H(T)       SVIB      SROT       STRA      G(T)")')
+    write (stdout,'(2x,"     [kcal/mol]    [      cal/mol/K        ]    [kcal/mol]")')
+    write (stdout,'(2x,"--------------------------------------------------------")')
+  end subroutine pr_freq_energy
+  subroutine pr_eval_1(G,H)
+    implicit none
+    real(wp),intent(in)       :: G,H
+    write (stdout,'(2x,"-----------------------------------------------------")')
+    write (stdout,'(2x,"Gsolv and Hsolv ref. state: [1 M gas/solution] ")')
+    write (stdout,'(2x,"G_solv (incl.RRHO)      =",F8.2," kcal/mol")') G
+    write (stdout,'(2x,"H_solv (incl.RRHO)      =",F8.2," kcal/mol")') H
+    write (stdout,'(2x,"-----------------------------------------------------")')
+    write (stdout,*)
+  end subroutine pr_eval_1
+  subroutine pr_eval_2(srange,G,scal)
+    implicit none
+! Dummy
+    integer,intent(in)        :: srange
+    real(wp),intent(in)       :: G(srange)
+    real(wp),intent(in)       :: scal(srange)
+! Stack
+    integer                   :: i
+    write (stdout,'(2x,"-----------------------------------------------------")')
+    write (stdout,'(2x,"Solvation free energies with scaled translational")')
+    write (stdout,'(2x,"and rotational degrees of freedom: Gsolv (scaling)")')
+    do i = 1,srange
+      write (stdout,'(10x,">>",2x,f8.2," (",f4.2,")",4x,"<<")') G(i),scal(i)
+    end do
+    write (stdout,'(2x,"-----------------------------------------------------")')
+  end subroutine pr_eval_2
+  subroutine pr_eval_3(srange,freqscal,scal,G)
+    implicit none
+! Dummy
+    integer,intent(in)        :: srange
+    integer,intent(in)        :: freqscal
+    real(wp),intent(in)       :: scal
+    real(wp),intent(in)       :: G(srange)
+    write (stdout,*)
+    write (stdout,'(2x,"==================================================")')
+    write (stdout,'(2x,"|  Gsolv with SCALED RRHO contributions: ",f4.2,4x"|")') scal
+    write (stdout,'(2x,"|  [1 bar gas/ 1 M solution]                     |")')
+    write (stdout,'(2x,"|                                                |")')
+    write (stdout,'(2x,"|  G_solv (incl.RRHO)+dV(T)=",F8.2," kcal/mol    |")') G(freqscal)
+    write (stdout,'(2x,"==================================================")')
+    write (stdout,*)
+  end subroutine pr_eval_3
+  subroutine pr_fill_energy()
+    implicit none
+    write (stdout,'(x,'' Size'',2x,''Cluster '',2x,''E /Eh '',7x,''De/kcal'',3x,&
+            &''Detot/kcal'',2x,''Opt'',4x)')
+  end subroutine pr_fill_energy
+  subroutine pr_ensemble_energy()
+    implicit none
+    write (stdout,*)
+    write (stdout,'(x,'' Cluster'',3x,''E /Eh '',7x,&
+             &''Density'',2x,''Efix'',7x,''R   av/act.'',1x,&
+             &''Surface'',3x,''Opt'',4x)')
+  end subroutine pr_ensemble_energy
+  subroutine pr_qcg_esolv()
+    implicit none
+    write (stdout,*)
+    write (stdout,'(2x,''========================================='')')
+    write (stdout,'(2x,''|   quantum cluster growth: ESOLV       |'')')
+    write (stdout,'(2x,''|                                       |'')')
+  end subroutine pr_qcg_esolv
+  subroutine pr_grow_energy()
+    implicit none
+    write (stdout,'(x,'' Size'',7x,''E'',8x,''De'',7x,''Detot'',6x,&
+             &''Density'',5x,''Eatom'',4x,''av. R'', 1x,'' Rlast'',3x,&
+             &''Volume'',4x,''Opt'')')
+    write (stdout,'(12x,''[Eh]'',4x,''[kcal]'',5x,''[kcal]'',5x,&
+             &''[u/Å^3]'',5x,''[kcal]'',3x,''[bohr]'', 1x,''[bohr]'',1x,&
+             &''[bohr^3]'')')
+
+  end subroutine pr_grow_energy
+
+  subroutine pr_freq_file(ich)
+    implicit none
+    integer :: ich
+    write (ich,'(2x,"#       H(T)       SVIB      SROT       STRA      G(T)")')
+    write (ich,'(2x,"     [kcal/mol]    [      cal/mol/K        ]    [kcal/mol]")')
+    write (ich,'(2x,"--------------------------------------------------------")')
+  end subroutine pr_freq_file
+
+!========================================================================================!
+
+  subroutine xtbiff_print_deprecated()
+    external creststop
+    write (stdout,*)
+    write (stdout,*) 'WARNING WARNING WARNING'
+    write (stdout,*) ' The use of xtbiff in QCG is deprecated and is disabled'
+    write (stdout,*) ' following CREST 3.1.0, in favor of the aISS algorithm.'
+    write (stdout,*) ' This requires a current version of the xtb program.'
+    write (stdout,*)
+    call creststop(status_safety)
+  end subroutine xtbiff_print_deprecated
+
+!========================================================================================!
+!========================================================================================!
+end module qcg_printouts
diff --git a/src/qcg/qcg_utils.f90 b/src/qcg/qcg_utils.f90
new file mode 100644
index 00000000..fb453ba3
--- /dev/null
+++ b/src/qcg/qcg_utils.f90
@@ -0,0 +1,774 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2021-2025 Christoph Plett, Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module qcg_utils
+  use crest_parameters,only:stdout,wp
+  use crest_data
+  use iomod
+  implicit none
+  public
+
+contains
+
+!========================================================================================!
+!> Convert given QCG coordinate files into (TM format)
+!> Write "solute" and "solvent" coordinate files
+!========================================================================================!
+  subroutine inputcoords_qcg(env,solute,solvent)
+    use crest_parameters
+    use crest_data
+    use strucrd
+    use qcg_coord_type
+    use iomod
+    implicit none
+
+    type(systemdata),intent(inout) :: env
+    type(coord_qcg),intent(out) :: solute,solvent
+
+    logical :: ex11,ex21,solu,solv
+    type(coord_qcg) :: mol
+    integer :: i
+
+!--------------------Checking for input-------------!
+
+    !Solute
+    inquire (file=env%solu_file,exist=ex11)
+    inquire (file='solute',exist=solu)
+    if (solu) call copy('solute','solute.old') !Backup solute file
+    if ((.not.ex11).and.(.not.solu)) then
+      error stop 'No (valid) solute file! exit.'
+    else if ((.not.ex11).and.(solu)) then
+      env%solu_file = 'solute'
+    end if
+
+    !Solvent
+    inquire (file=env%solv_file,exist=ex21)
+    inquire (file='solvent',exist=solv)
+    if (solu) call copy('solvent','solvent.old') !Backup solvent file
+    if ((.not.ex21).and.(.not.solv)) then
+      error stop 'No (valid) solvent file! exit.'
+    else if ((.not.ex11).and.(solu)) then
+      env%solu_file = 'solvent'
+    end if
+
+!---------------Handling solute---------------------!
+    call mol%open(env%solu_file)
+    call mol%write('solute')
+    solute%nat = mol%nat
+    solute%at = mol%at
+    solute%xyz = mol%xyz
+
+    !--- if the input was a SDF file, special handling
+    env%sdfformat = .false.
+    call checkcoordtype(env%solu_file,i)
+    if (i == 31.or.i == 32) then
+      !Add sdf stuff here, if somebody needs it
+    end if
+    !--- Add as ref structure in env
+    call env%ref%load(mol)
+    call mol%deallocate()
+!---------------Handling solvent---------------------!
+
+    call mol%open(env%solv_file)
+    call mol%write('solvent')
+    solvent%nat = mol%nat
+    solvent%at = mol%at
+    solvent%xyz = mol%xyz
+    call mol%deallocate()
+
+    !--- if the input was a SDF file, special handling
+    env%sdfformat = .false.
+    call checkcoordtype(env%solv_file,i)
+    if (i == 31.or.i == 32) then
+      !Add sdf stuff here, if somebody needs it
+    end if
+
+    return
+  end subroutine inputcoords_qcg
+
+!==============================================================================!
+
+  subroutine write_reference(env,solu,clus)
+    use crest_data
+    use qcg_coord_type
+    use iomod
+    use strucrd
+    implicit none
+    type(systemdata):: env    ! MAIN STORAGE OS SYSTEM DATA
+    type(coord_qcg)            :: solu,clus
+    type(coord_qcg)            :: ref_mol,ref_clus
+    ref_mol = solu
+    call rdcoord(env%solu_file,ref_mol%nat,ref_mol%at,ref_mol%xyz) !original solute coordinates
+    call remove(env%fixfile)
+    ref_clus = clus
+    ref_clus%xyz(1:3,1:solu%nat) = solu%xyz
+    call wrc0(env%fixfile,ref_clus%nat,ref_clus%at,ref_clus%xyz)
+  end subroutine write_reference
+
+!=============================================================================!
+
+  subroutine aver(pr,env,runs,e_tot,S,H,G,sasa,a_present,a_tot)
+    use crest_parameters
+    use crest_data
+
+    implicit none
+!---- Dummy
+    type(systemdata),intent(in)   :: env
+    integer,intent(in)            :: runs
+    real(wp),intent(inout)        :: e_tot
+    real(wp),intent(in),optional  :: a_tot
+    real(wp),intent(out)          :: S
+    real(wp),intent(out)          :: H
+    real(wp),intent(out)          :: G
+    real(wp),intent(out)          :: sasa
+!---- Stack
+    logical,intent(in)            :: pr,a_present
+    integer                       :: j,jmin
+    real(wp)                      :: A
+    real(wp)                      :: e0
+    real(wp),allocatable          :: de(:)
+    real(wp),allocatable          :: p(:)
+    real(wp)                      :: pmax
+    real(wp)                      :: eav
+    real(wp)                      :: area
+    real(wp)                      :: beta
+    real(wp)                      :: temp
+    integer                       :: ich48
+    dimension e_tot(runs)
+    dimension a_tot(runs)
+
+    temp = env%tboltz
+    allocate (de(runs),source=0.0d0)
+    allocate (p(runs),source=0.0d0)
+
+    beta = 1./(temp*8.314510/4.184/1000.+1.d-14)
+    e0 = e_tot(1)
+    de(1:runs) = (e_tot(1:runs)-e0)
+    call qcg_boltz(env,runs,de,p)
+
+    A = 0
+    eav = 0
+    pmax = 0
+    area = 0
+    do j = 1,runs
+      A = A+p(j)*log(p(j)+1.d-12)
+      eav = eav+p(j)*e_tot(j)
+      if (p(j) .gt. pmax) then
+        pmax = p(j)
+        jmin = j
+      end if
+      if (a_present) area = area+p(j)*a_tot(j)
+    end do
+    sasa = area
+    S = (1./beta)*A
+    H = eav
+    G = eav+S
+    if (pr) then
+      open (newunit=ich48,file='population.dat')
+      write (ich48,'(2x, ''cluster'',2x,''E_norm [Eh]'',2x, ''De [kcal]'', 4x, ''p'')')
+      do j = 1,runs
+        if (j .lt. 10) then
+          write (ich48,'(5x,i0,3x,f11.6,5x,f6.4,3x,f6.4)') j,e_tot(j)/autokcal,de(j),p(j)
+        else
+          write (ich48,'(5x,i0,2x,f11.6,5x,f6.4,3x,f6.4)') j,e_tot(j)/autokcal,de(j),p(j)
+        end if
+      end do
+      write (ich48,*)
+      write (ich48,'(''Ensemble free energy [Eh]:'', f20.10)') G/autokcal
+      close (ich48)
+    end if
+
+    deallocate (de,p)
+
+  end subroutine aver
+
+  !==============================================================================!
+
+  subroutine get_sphere(pr,mol,r_logical)
+    use crest_parameters
+    use qcg_coord_type
+    use miscdata
+    implicit none
+    type(coord_qcg),intent(inout) :: mol
+    type(coord_qcg) :: dum
+    logical        :: pr
+    logical        :: r_logical !Determines wether r is overwritten or not
+    real(wp),parameter :: pi43 = pi*4.0d0/3.0d0
+    real(wp),parameter :: third = 1.0d0/3.0d0
+    integer :: i
+    real(wp) :: rad(mol%nat),xyz_tmp(3,mol%nat)
+    external get_volume
+
+    do i = 1,mol%nat
+      rad(i) = bohr*rcov_qcg(mol%at(i))*1.40 ! scale factor adjusted to rough
+      xyz_tmp(1:3,i) = bohr*mol%xyz(1:3,i)
+    end do
+
+    dum = mol
+    dum%xyz = xyz_tmp
+
+    call get_volume(dum,rad)
+
+    mol%atot = dum%atot/bohr**2
+    mol%vtot = dum%vtot/bohr**3
+
+    if (r_logical) then
+      mol%rtot = mol%vtot*3.0/4.d0/pi
+      mol%rtot = mol%rtot**(1.d0/3.d0)
+    end if
+
+    if (pr) then
+      if (r_logical) then
+        write (stdout,'(2x,''molecular radius (Bohr**1):'',F8.2)') mol%rtot
+      end if
+      write (stdout,'(2x,''molecular area   (Bohr**2):'',F8.2)') mol%atot
+      write (stdout,'(2x,''molecular volume (Bohr**3):'',F8.2)') mol%vtot
+    end if
+  end subroutine get_sphere
+
+  !=============================================================================!
+  !
+  subroutine cma_shifting(solu,solv)
+    use crest_parameters
+    use crest_data
+    use iomod
+    use qcg_coord_type
+    use strucrd
+    use axis_module,only:cma
+    implicit none
+
+    type(coord_qcg)    :: solu,solv
+
+    integer            :: i
+
+    call cma(solu%nat,solu%at,solu%xyz,solu%cma)
+    call cma(solv%nat,solv%at,solv%xyz,solv%cma)
+
+    do i = 1,solu%nat
+      solu%xyz(1:3,i) = solu%xyz(1:3,i)-solu%cma(1:3)
+    end do
+    do i = 1,solv%nat
+      solv%xyz(1:3,i) = solv%xyz(1:3,i)-solv%cma(1:3)
+    end do
+
+  end subroutine cma_shifting
+
+!==============================================================================!
+!
+  subroutine get_ellipsoid(env,solu,solv,clus,pr1)
+    use crest_parameters
+    use crest_data
+    use iomod
+    use qcg_coord_type
+    use strucrd
+    use axis_module
+    implicit none
+
+    type(systemdata)   :: env
+    type(coord_qcg)    :: solu,solv,clus
+    type(coord_qcg)    :: dummy_solu,dummy_solv
+    real(wp)           :: rabc_solu(3),rabc_solv(3)
+    real(wp)           :: aniso,sola
+    real(wp)           :: rmax_solu,rmax_solv
+    real(wp)           :: boxr,roff,r
+    character(len=10) :: fname
+    logical            :: ex,pr,pr1
+
+    real(wp),parameter :: pi43 = pi*4.0d0/3.0d0
+    real(wp),parameter :: third = 1.0d0/3.0d0
+
+    pr = .false. !Outprint deactivated
+
+    fname = 'eaxis.qcg'
+    inquire (file=fname,exist=ex)
+
+    if (pr1) then !First time called
+!--- Moving all coords to the origin (transformation)
+      call axistrf(solu%nat,solu%nat,solu%at,solu%xyz)
+!  call axistrf(solv%nat,solv%nat,solv%at,solv%xyz)  !Not done in original QCG code
+      call axistrf(clus%nat,solu%nat,clus%at,clus%xyz)
+
+!--- Overwrite solute and solvent coord in original file with transformed and optimized ones
+      call solu%write('solute')
+      call solv%write('solvent')
+
+!--- Getting axis
+      write (stdout,*) 'Solute:'
+      call axis(pr1,solu%nat,solu%at,solu%xyz,solu%eax)
+      write (stdout,*) 'Solvent:'
+      call axis(pr1,solv%nat,solv%at,solv%xyz,solv%eax)
+      write (stdout,*)
+    end if
+
+!--- Computing anisotropy factor of solute and solvent
+    sola = sqrt(1.+(solu%eax(1)-solu%eax(3))/((solu%eax(1)+solu%eax(2)+solu%eax(3))/3.))
+    aniso = sqrt(1.+(solv%eax(1)-solv%eax(3))/((solv%eax(1)+solv%eax(2)+solv%eax(3))/3.)) ! =1 for a spherical system
+
+!--- Get maximum intramoleclar distance of solute and solvent
+    call getmaxrad(solu%nat,solu%at,solu%xyz,rmax_solu)
+    call getmaxrad(solv%nat,solv%at,solv%xyz,rmax_solv)
+
+!--- Getting V and A of dummies
+    dummy_solu = solu
+    dummy_solv = solv !Why is dummy_solv%vtot different to solv%vtot
+    call get_sphere(.false.,dummy_solu,.false.)
+    call get_sphere(.false.,dummy_solv,.false.)
+
+!--- Computation of outer Wall
+    roff = sola*dummy_solu%vtot/1000
+    boxr = ((0.5*aniso*clus%nmol*dummy_solv%vtot+dummy_solu%vtot)/pi43)**third+roff+rmax_solv*0.5 !0.5 both
+    r = (boxr**3/(solu%eax(1)*solu%eax(2)*solu%eax(3)))**third       ! volume of ellipsoid = volume of sphere
+    rabc_solv = solu%eax*r                              ! outer solvent wall
+
+!--- Computation of inner wall
+    roff = sola*dummy_solu%vtot/1000
+    boxr = ((sola*dummy_solu%vtot)/pi43)**third+roff+rmax_solu*0.1 !0.1 before
+    r = (boxr**3/(solu%eax(1)*solu%eax(2)*solu%eax(3)))**third       ! volume of ellipsoid = volume of sphere
+    rabc_solu = solu%eax*r
+    dummy_solu%ell_abc(1) = solu%eax(1)**2/sum((solu%eax(1:3))**2)
+    dummy_solu%ell_abc(2) = solu%eax(2)**2/sum((solu%eax(1:3))**2)
+    dummy_solu%ell_abc(3) = solu%eax(3)**2/sum((solu%eax(1:3))**2)
+    rabc_solu = dummy_solu%ell_abc*r
+
+    solu%aniso = sola
+    solv%aniso = aniso
+    solu%ell_abc = rabc_solu
+    clus%ell_abc = rabc_solv*env%potscal
+
+    if (pr1) then
+      write (stdout,'(2x,''solvent anisotropy            :'',4f10.3)') aniso
+      write (stdout,'(2x,''solute anisotropy             :'',4f10.3)') sola
+      write (stdout,'(2x,''roff inner wall               :'',4f10.3)') roff
+      write (stdout,'(2x,''solute max dist               :'',4f10.3)') rmax_solu
+      write (stdout,'(2x,''solvent max dist              :'',4f10.3)') rmax_solv
+      write (stdout,'(2x,''inner unit axis               :'',3f10.3)') dummy_solu%ell_abc(1:3)
+      write (stdout,'(2x,''inner ellipsoid/Bohr          :'',3f10.3)') rabc_solu(1:3)
+      write (stdout,'(2x,''scaling factor outer ellipsoid:'',3f10.3)') env%potscal
+      write (stdout,'(2x,''outer ellipsoid/Bohr          :'',3f10.3)') clus%ell_abc(1:3)
+      if (env%potscal .gt. 1.0_wp) write &
+           &(stdout,'(2x,''!!!WARNING: A SCALING FACTOR LARGER 1.0 IS ONLY RECOMMENDED FOR MICROSOLVATION'')')
+      write (stdout,*)
+    end if
+
+  end subroutine get_ellipsoid
+
+!==============================================================================!
+
+  subroutine getmaxrad(n,at,xyz,r)
+    use crest_parameters,only:wp
+    use miscdata,only:rcov_qcg
+    implicit none
+    real(wp) :: xyz(3,n),r
+    integer :: n,at(n)
+    real(wp) :: rx,ry,rz,rr
+    integer :: i,j
+
+    r = 0
+    do i = 1,n-1
+      do j = i+1,n
+        rx = xyz(1,i)-xyz(1,j)
+        ry = xyz(2,i)-xyz(2,j)
+        rz = xyz(3,i)-xyz(3,j)
+        rr = sqrt(rx**2+ry**2+rz**2)+rcov_qcg(at(i))+rcov_qcg(at(j))
+        if (rr .gt. r) r = rr
+      end do
+    end do
+  end subroutine getmaxrad
+
+!==============================================================================!
+
+  subroutine ellipsout(fname,n,at,xyz,r1)
+    use crest_parameters
+    use strucrd,only:i2e
+    implicit none
+
+    integer            :: i
+    integer            :: n,at(n)
+    real(wp)           :: xyz(3,n),r1(3)
+    real(wp)           :: x,y,z,f,rr
+    character(len=*)   :: fname
+    integer            :: ich11
+
+    open (newunit=ich11,file=fname)
+    write (ich11,'(a)') '$coord'
+    do i = 1,n
+      write (ich11,'(3F24.14,6x,a)') xyz(1,i),xyz(2,i),xyz(3,i),i2e(at(i))
+    end do
+    do i = 1,500
+      call random_number(x)
+      call random_number(f)
+      if (f .gt. 0.5) x = -x
+      call random_number(y)
+      call random_number(f)
+      if (f .gt. 0.5) y = -y
+      call random_number(z)
+      call random_number(f)
+      if (f .gt. 0.5) z = -z
+      rr = sqrt(x*x+y*y+z*z)
+      x = x*r1(1)/rr
+      y = y*r1(2)/rr
+      z = z*r1(3)/rr
+      write (ich11,'(3F24.14,6x,a2)') x,y,z,'he'
+    end do
+    write (ich11,'(a)') '$end'
+    close (ich11)
+
+  end subroutine ellipsout
+
+!==============================================================================!
+
+  subroutine both_ellipsout(fname,n,at,xyz,r1,r2)
+    use crest_parameters
+    use strucrd,only:i2e
+    implicit none
+
+    integer            :: i
+    integer            :: n,at(n)
+    real(wp)           :: xyz(3,n),r1(3)
+    real(wp),optional :: r2(3)
+    real(wp)           :: x,y,z,f,rr
+    character(len=*)   :: fname
+    integer            :: ich11
+
+    open (newunit=ich11,file=fname)
+    write (ich11,'(a)') '$coord'
+    do i = 1,n
+      write (ich11,'(3F24.14,6x,a)') xyz(1,i),xyz(2,i),xyz(3,i),i2e(at(i))
+    end do
+    do i = 1,500
+      call random_number(x)
+      call random_number(f)
+      if (f .gt. 0.5) x = -x
+      call random_number(y)
+      call random_number(f)
+      if (f .gt. 0.5) y = -y
+      call random_number(z)
+      call random_number(f)
+      if (f .gt. 0.5) z = -z
+      rr = sqrt(x*x+y*y+z*z)
+      x = x*r1(1)/rr
+      y = y*r1(2)/rr
+      z = z*r1(3)/rr
+      write (ich11,'(3F24.14,6x,a2)') x,y,z,'he'
+    end do
+    if (present(r2)) then
+      do i = 1,100
+        call random_number(x)
+        call random_number(f)
+        if (f .gt. 0.5) x = -x
+        call random_number(y)
+        call random_number(f)
+        if (f .gt. 0.5) y = -y
+        call random_number(z)
+        call random_number(f)
+        if (f .gt. 0.5) z = -z
+        rr = sqrt(x*x+y*y+z*z)
+        x = x*r2(1)/rr
+        y = y*r2(2)/rr
+        z = z*r2(3)/rr
+        write (ich11,'(3F24.14,6x,a2)') x,y,z,'b'
+      end do
+    end if
+    write (ich11,'(a)') '$end'
+    close (ich11)
+
+  end subroutine both_ellipsout
+
+!==============================================================================!
+
+  subroutine analyze_cluster(nsolv,n,nS,nM,xyz,at,av,last)
+    use crest_parameters
+    use axis_module,only:cma
+    implicit none
+    real(wp) xyz(3,n)
+    real(wp) av,last
+    integer n,nS,nM,nsolv,at(n)
+    real(wp) xyzM(3,nM)
+    integer atm(nM)
+    real(wp) xyzS(3,nS)
+    integer atS(nS)
+    real(wp) x1(3),x2(3),r
+    integer i,is,ie
+
+    if (nsolv .eq. 1) return
+    xyzS(1:3,1:nS) = xyz(1:3,1:nS)
+    atS(1:nS) = at(1:nS)
+    call cma(nS,atS,xyzS,x1)
+
+    av = 0
+    do i = 1,nsolv
+      is = nS+(i-1)*nM+1
+      ie = is+nM-1
+      xyzM(1:3,1:nM) = xyz(1:3,is:ie)
+      atM(1:nM) = at(is:ie)
+      call cma(nM,atM,xyzM,x2)
+      r = sqrt((x1(1)-x2(1))**2+(x1(2)-x2(2))**2+(x1(3)-x2(3))**2)
+      if (i .lt. nsolv) then
+        av = av+r
+      else
+        last = r
+      end if
+    end do
+    av = av/real(nsolv-1,wp)
+  end subroutine analyze_cluster
+
+!==============================================================================!
+!
+  subroutine qcg_boltz(env,n,e,p)
+    use crest_parameters
+    use crest_data
+    implicit none
+    type(systemdata),intent(in)    :: env
+    integer,intent(in)              :: n
+    real(wp),intent(in)             :: e(:)
+    real(wp),intent(out)            :: p(:)
+    integer                         :: i
+    real(wp)                        :: temp
+    real(wp)                        :: f,hsum,esum
+
+    temp = env%tboltz
+    f = 8.314*temp/4.184d+3
+    esum = 0
+    do i = 1,n
+      esum = esum+exp(-e(i)/f)
+    end do
+    hsum = 0
+    do i = 1,n
+      p(i) = exp(-e(i)/f)/esum
+    end do
+  end subroutine qcg_boltz
+
+!==============================================================================!
+
+!==============================================================================!
+
+  subroutine fill_take(env,n2,n12,rabc,ipos)
+    use crest_parameters
+    use crest_data
+    use strucrd
+    use axis_module,only:cma
+    implicit none
+
+    type(systemdata)      :: env
+    integer,intent(in)   :: n2,n12
+    real(wp),intent(in)   :: rabc(3)
+    integer,intent(out)  :: ipos
+    integer               :: i,m,n21
+    integer               :: at2(n2),at12(n12)
+    integer               :: counter
+    real(wp)              :: xyz2(3,n2),xyz12(3,n12)
+    real(wp)              :: etmp(100)
+    real(wp)              :: eabc
+    real(wp)              :: cma2(3)
+    real(wp),allocatable  :: dist(:)
+
+    eabc = 0
+    counter = 0
+    n21 = n12-n2+1
+    if (env%use_xtbiff) then
+      call rdxtbiffE('xtbscreen.xyz',m,n12,etmp)
+    else
+      call rdxtbiffE('best.xyz',m,n12,etmp)
+    end if
+
+    allocate (dist(m),source=0.0d0)
+    dist = 0.0d0
+
+    do i = 1,m
+      if (env%use_xtbiff) then
+        call rdxmolselec('xtbscreen.xyz',i,n12,at12,xyz12)
+      else
+        call rdxmolselec('final_structures.xyz',i,n12,at12,xyz12)
+      end if
+
+      at2(1:n2) = at12(n21:n12)
+      xyz2(1:3,1:n2) = xyz12(1:3,n21:n12)
+      call cma(n2,at2,xyz2,cma2)
+      call calc_dist(cma2,rabc,dist(i),eabc)
+      if (eabc .gt. 1.0d0) then
+        dist(i) = 1.0d42
+        counter = counter+1
+      end if
+    end do
+
+    ipos = minloc(dist(1:m),dim=1)
+
+    if (counter .eq. m) ipos = 0
+
+    deallocate (dist)
+  end subroutine fill_take
+
+!==============================================================================!
+
+  subroutine calc_dist(xyz,rabc,dist,eabc)
+    use crest_parameters
+    implicit none
+
+    real(wp),intent(in)    :: xyz(3)
+    real(wp),intent(in)    :: rabc(3)
+    real(wp),intent(out)   :: dist
+    real(wp),intent(out)   :: eabc
+    real(wp)                :: center(3),rc(3)
+
+    center = 0.d0
+    rc = (xyz(1:3)-center)
+    dist = norm2(rc)
+    eabc = sum((xyz(1:3)**2)/(rabc(1:3)**2))
+  end subroutine calc_dist
+
+!==============================================================================!
+
+  subroutine sort_min(i,j,col,A)
+    use crest_parameters
+    implicit none
+    integer,intent(in)   :: i,j,col
+    real*8,intent(inout) :: A(i,j)
+    real*8                :: buf(j)
+    integer               :: nsize,irow,krow
+    nsize = i
+
+    do irow = 1,nsize
+      krow = minloc(A(irow:nsize,col),dim=1)+irow-1
+      buf(:) = A(irow,:)
+      A(irow,:) = A(krow,:)
+      A(krow,:) = buf(:)
+    end do
+  end subroutine sort_min
+
+!==============================================================================!
+
+  subroutine qcg_dump_sorted_ensemble(ens,e_ens,fname)
+    use crest_parameters
+    use crest_data
+    use strucrd
+    implicit none
+    type(ensemble),intent(in) :: ens
+    real(wp),intent(in)       :: e_ens(ens%nall)
+    real(wp),allocatable :: dum(:)
+    character(len=*) :: fname
+    integer          :: ich,i,e_min
+    allocate(dum(ens%nall))
+    dum(:) = e_ens(:)
+    open (newunit=ich,file=fname)
+    do i = 1,ens%nall
+      e_min = minloc(dum,dim=1)
+      call wrxyz(ich,ens%nat,ens%at,ens%xyz(:,:,e_min),e_ens(e_min))
+      dum(e_min) = huge(1.0_wp)
+    end do
+    close (ich)
+    deallocate(dum)
+  end subroutine qcg_dump_sorted_ensemble
+
+!==============================================================================!
+
+  subroutine rdtherm(fname,ht,svib,srot,stra,gt)
+    use crest_parameters
+    use crest_data
+    use iomod
+
+    implicit none
+! Dummy
+    real(wp),intent(out)  :: ht
+    real(wp),intent(out)  :: gt
+    real(wp),intent(out)  :: svib
+    real(wp),intent(out)  :: srot
+    real(wp),intent(out)  :: stra
+! Stack
+    integer :: nn,io,counter,hg_line,ich
+    real(wp) :: xx(20)
+    logical :: ende
+    character(len=*) :: fname
+    character(len=128) :: a
+
+    ende = .false.
+    counter = 0
+    hg_line = 0
+
+    open (newunit=ich,file=fname)
+    do while (.not.ende)
+      read (ich,'(a)',iostat=io) a
+      if (io .lt. 0) then
+        ende = .true.
+        cycle
+      end if
+      if (index(a,'G(T)/Eh ') .ne. 0) then
+        hg_line = counter
+      end if
+      if (index(a,'  VIB  ') .ne. 0) then
+        call readl(a,xx,nn)
+        svib = xx(5)
+        if (svib .eq. 0.0d0) then
+          call readl(a,xx,nn)
+          svib = xx(4)
+        end if
+      end if
+      if (index(a,'  ROT  ') .ne. 0) then
+        call readl(a,xx,nn)
+        srot = xx(4)
+      end if
+      if (index(a,'  TR   ') .ne. 0) then
+        call readl(a,xx,nn)
+        stra = xx(4)
+      end if
+      if (counter .eq. hg_line+2) then
+        call readl(a,xx,nn)
+        ht = xx(3)*autokcal
+        gt = xx(5)*autokcal
+      end if
+      counter = counter+1
+    end do
+    close (ich)
+  end subroutine rdtherm
+
+!============================================================!
+! Read the Energies from a xtbiff output
+!============================================================!
+
+  subroutine rdxtbiffE(fname,m,n,e)
+    use crest_parameters
+    implicit none
+    integer :: m,n
+    character(len=*),intent(in) :: fname
+    real(wp) :: e(:)
+
+    character(len=128) :: line
+    real(wp) :: xx(10)
+    integer :: ich,i,j,nn
+
+    open (newunit=ich,file=fname)
+
+    j = 1
+10  continue
+    read (ich,'(a)',end=999) line
+    read (ich,'(a)') line
+    call readl(line,xx,nn)
+    e(j) = xx(1)
+    do i = 1,n
+      read (ich,'(a)') line
+    end do
+    j = j+1
+    goto 10
+
+999 close (ich)
+    m = j-1
+  end subroutine rdxtbiffE
+
+!==============================================================================!
+!==============================================================================!
+end module qcg_utils
diff --git a/src/qcg/solvtool.f90 b/src/qcg/solvtool.f90
deleted file mode 100644
index 575e093c..00000000
--- a/src/qcg/solvtool.f90
+++ /dev/null
@@ -1,3389 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2023 Christoph Plett, Sebastian Spicher, Philipp Pracht
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!================================================================================!
-!===================================================================!
-! This file contains routines related to QCG and microsolvation
-!===================================================================!
-!======================================================!
-! main routine
-!======================================================!
-subroutine crest_solvtool(env, tim)
-   use iso_fortran_env, wp => real64
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-   implicit none
-
-   type(systemdata):: env    ! MAIN STORAGE OS SYSTEM DATA
-   type(timer):: tim
-   !> Information about solvent, solute and cluster
-   type(zmolecule) :: solute, solvent, cluster, cluster_backup 
-   type(ensemble) :: full_ensemble, solvent_ensemble
-
-   integer :: progress,io
-   character(len=512) :: thispath
-
-   real(wp), parameter         :: eh = 627.509541d0
-
-!--- Molecule settings
-   solute%nmol = 1
-   solvent%nmol = 1
-   cluster%nmol = 1
-
-   progress = 0
-   call getcwd(thispath)
-
-   !>-----------------------------------
-   call qcg_head()
-   !>-----------------------------------
-
-!> Check, if xtb is present
-   call checkprog_silent(env%ProgName,.true.,iostat=io)
-   if(io /= 0 ) error stop 'No xtb found'
-
-!> Check, if xtbiff is present (if it is required)
-   if (env%use_xtbiff) then
-      call checkprog_silent(env%ProgIFF,.true.,iostat=io)
-      if(io /= 0 ) error stop 'No xtbiff found'
-   else
-      write (*, *)
-      write (*, *) '  The use of the aISS algorithm is requested (recommend).'
-      write (*, *) '  This requires xtb version 6.6.0 or newer.'
-      write (*, *) '  xTB-IFF can still be used with the --xtbiff flag.'
-      write (*, *)
-   end if
-
-!------------------------------------------------------------------------------
-!   Setup
-!------------------------------------------------------------------------------
-
-   call write_qcg_setup(env) !Just an outprint of setup
-   call read_qcg_input(env, solute, solvent) !Reading mol. data and determining r,V,A
-   call qcg_setup(env, solute, solvent)
-   call qcg_restart(env, progress, solute, solvent, cluster, full_ensemble,&
-          & solvent_ensemble, cluster_backup)
-
-!-----------------------------------------------------------------------------
-!   Grow
-!-----------------------------------------------------------------------------
-   if (progress .le. env%qcg_runtype .and. progress .eq. 0) then
-      cluster = solute
-      call qcg_grow(env, solute, solvent, cluster, tim)
-      if (.not. env%cff) then
-         allocate (cluster_backup%at(cluster%nat))
-         allocate (cluster_backup%xyz(3, cluster%nat))
-         cluster_backup = cluster
-      end if
-      progress = progress + 1
-      call chdir(thispath)
-   end if
-
-!------------------------------------------------------------------------------
-!   Ensemble search
-!------------------------------------------------------------------------------
-   if (progress .le. env%qcg_runtype .and. progress .eq. 1) then
-      call print_qcg_ensemble()
-      call qcg_ensemble(env, solute, solvent, cluster, full_ensemble, tim, 'ensemble')
-      progress = progress + 1
-      call chdir(thispath)
-   end if
-
-!------------------------------------------------------------------------------
-!   Solvent cluster generation
-!------------------------------------------------------------------------------
-   if (progress .le. env%qcg_runtype .and. progress .eq. 2) then !esolv
-      call pr_eval_solvent()
-      if (env%cff) then !CFF
-         call qcg_cff(env, solute, solvent, cluster, full_ensemble,&
-                & solvent_ensemble, tim)
-      else !Normal ensemble generation
-         call print_qcg_ensemble()
-         call cluster%deallocate
-         allocate (cluster%at(cluster_backup%nat))
-         allocate (cluster%xyz(3, cluster_backup%nat))
-         cluster = cluster_backup
-         deallocate (cluster_backup%at)
-         deallocate (cluster_backup%xyz)
-         env%solv_md = .true.
-         call qcg_ensemble(env, solute, solvent, cluster, solvent_ensemble,&
-                & tim, 'solvent_ensemble')
-      end if
-      call pr_qcg_esolv()
-      write (*, '(2x,"|",9x,F8.2," kcal/mol ",12x,"|")') &
-             &   full_ensemble%g - solvent_ensemble%g - (solute%energy*eh)
-      write (*, '(2x,''========================================='')')
-      call chdir(thispath)
-      progress = progress + 1
-   end if
-
-!------------------------------------------------------------------------------
-!   Frequency computation and evaluation
-!------------------------------------------------------------------------------
-   if (progress .le. env%qcg_runtype .and. progress .eq. 3) then !gsolv
-      call qcg_freq(env, tim, solute, solvent, full_ensemble, solvent_ensemble)
-      call qcg_eval(env, solute, full_ensemble, solvent_ensemble)
-
-      progress = progress + 1
-   end if
-
-   !<----------------------------------
-!  call tim%stop(2) !stop a timer
-
-!------------------------------------------------------------------------------
-!   Cleanup and deallocation
-!------------------------------------------------------------------------------
-   if (env%scratchdir .ne. 'qcg_tmp') call qcg_cleanup(env)
-   if (.not. env%keepModef) call rmrf('qcg_tmp')
-   call solute%deallocate
-   call solvent%deallocate
-   call cluster%deallocate
-   call full_ensemble%deallocate
-   call solvent_ensemble%deallocate
-   return
-end subroutine crest_solvtool
-
-subroutine qcg_setup(env, solu, solv)
-   use iso_fortran_env, wp => real64
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-   use axis_module
-   implicit none
-
-   type(systemdata):: env
-   type(zmolecule) :: solv, solu
-
-   integer :: io, f, r
-   integer :: num_O, num_H, i
-   character(len=*), parameter :: outfmt = '(1x,1x,a,1x,f14.7,a,1x)'
-   logical :: e_there, tmp, used_tmp
-   character(len=512) :: thispath, tmp_grow
-   character(len=40)  :: solv_tmp
-   character(len=80)  :: atmp
-   character(len=20)  :: gfnver_tmp
-
-   call getcwd(thispath)
-
-   ! Remove scratch dir, if present
-   inquire (file='./qcg_tmp/solute_properties/solute', exist=tmp)
-   if (tmp) call rmrf('qcg_tmp') !User given scratch dir will be removed anyway after run
-
-   ! Make scratch directories
-   if (env%scratchdir .eq. '') then !check if scratch was not set
-      env%scratchdir = 'qcg_tmp'
-      io = makedir('qcg_tmp')
-   end if
-   if(env%fixfile /= 'none selected') then
-      call copysub(env%fixfile, env%scratchdir)
-   end if
-   call chdir(env%scratchdir)
-
-   f = makedir('solute_properties')
-   if(env%fixfile /= 'none selected') then
-      call copysub(env%fixfile, env%scratchdir)
-   end if
-   r = makedir('solvent_properties')
-
-   if (.not. env%nopreopt) then
-      write (*, *)
-      write (*, '(2x,''========================================='')')
-      write (*, '(2x,''|            Preoptimization            |'')')
-      write (*, '(2x,''========================================='')')
-   end if
-
-   solv_tmp = env%solv
-   env%solv = ''
-
-!---- Properties solute
-   call chdir('solute_properties')
-   call env%wrtCHRG('') !Write three lines in QCG mode, but xtb anyway only reads first one
-
-!---- Geometry preoptimization solute
-   if (env%final_gfn2_opt) then !If GFN2 final opt, solute also GFN2 optimized
-      gfnver_tmp = env%gfnver
-      env%gfnver = '--gfn2'
-   end if
-
-   if ((.not. env%nopreopt) .and. (solu%nat /= 1)) then
-      call xtb_opt_qcg(env, solu, .true.)
-   end if
-
-!--- Axistrf
-   call axistrf(solu%nat, solu%nat, solu%at, solu%xyz)
-   call wrc0('solute', solu%nat, solu%at, solu%xyz)
-
-!---- LMO/SP-Computation solute
-   if (env%use_xtbiff) then
-      write (*, *) 'Generating LMOs for solute'
-      call xtb_lmo(env, 'solute')
-   else
-      call xtb_sp_qcg(env, 'solute')
-   end if
-
-   if (env%final_gfn2_opt) then !If GFN2 final opt, solute also GFN2 optimized
-      env%gfnver = gfnver_tmp
-   end if
-
-   call grepval('xtb.out', '| TOTAL ENERGY', e_there, solu%energy)
-   if (.not. e_there) then
-      write (*, *) 'Total Energy of solute not found'
-   else
-      write (*, outfmt) 'Total Energy of solute: ', solu%energy, ' Eh'
-   end if
-
-   if (env%use_xtbiff) then
-      call rename('xtblmoinfo', 'solute.lmo')
-   end if
-
-   call chdir(thispath)
-
-! No constraints for solvent possible
-   used_tmp = env%cts%used
-   env%cts%used = .false.
-
-!---- Properties solvent
-   call chdir(env%scratchdir)
-   call chdir('solvent_properties')
-   !No charges for solvent written. This is currently not possible
-
-!---- Geometry preoptimization solvent
-   if ((.not. env%nopreopt) .and. (solv%nat /= 1)) then
-      call xtb_opt_qcg(env, solv, .false.)
-   end if
-   call wrc0('solvent', solv%nat, solv%at, solv%xyz)
-
-!---- LMO-Computation solvent
-   if (env%use_xtbiff) then
-      write (*, *) 'Generating LMOs for solvent'
-      call xtb_lmo(env, 'solvent')!,solv%chrg)
-   else
-      call xtb_sp_qcg(env, 'solvent')
-   end if
-
-   call grepval('xtb.out', '| TOTAL ENERGY', e_there, solv%energy)
-   if (.not. e_there) then
-      write (*, '(1x,a)') 'Total Energy of solvent not found'
-   else
-      write (*, outfmt) 'Total energy of solvent:', solv%energy, ' Eh'
-   end if
-
-   if (env%use_xtbiff) then
-      call rename('xtblmoinfo', 'solvent.lmo')
-   end if
-
-   call chdir(thispath)
-
-!---- Overwriting solute and solvent in original folder
-   call wrc0('solute', solu%nat, solu%at, solu%xyz)
-   call wrc0('solvent', solv%nat, solv%at, solv%xyz)
-
-   num_O = 0
-   num_H = 0
-!--- Check, if water is solvent
-   if (solv%nat .eq. 3) then
-      do i = 1, solv%nat
-         if (solv%at(i) .eq. 8) num_O = num_O + 1
-         if (solv%at(i) .eq. 1) num_H = num_H + 1
-      end do
-   end if
-   if (num_O .eq. 1 .AND. num_H .eq. 2) then
-      env%water = .true.
-      if (.not. env%noconst) env%constrain_solu = .true.
-   end if
-
-   env%solv = solv_tmp
-   env%cts%used = used_tmp
-
-end subroutine qcg_setup
-
-subroutine read_qcg_input(env, solu, solv)
-   use iso_fortran_env, wp => real64
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-   use atmasses
-   implicit none
-
-   type(systemdata)               :: env
-   type(zmolecule), intent(inout) :: solu, solv
-   logical                        :: pr
-   real(wp), parameter            :: amutokg = 1.66053886E-27
-   real(wp), parameter            :: third = 1.0d0/3.0d0
-   integer                        :: i
-   real(wp)                       :: r_solu, r_solv
-
-   pr = .true.
-
-!--- Read in solu and solv coordinates and make solute and solvent file in WD
-   call inputcoords_qcg(env, solu, solv)
-
-!--- CMA-Trafo
-   call cma_shifting(solu, solv)
-
-!--- Setting solute charge and uhf to input
-   solu%chrg = env%chrg
-   solu%uhf = env%uhf
-
-!--- Getting r, V, A
-   write (*, *)
-   write (*, *) 'Solute geometry'
-   call get_sphere(.true., solu, .true.) !r,V,A of solute
-   write (*, *) 'Solvent geometry'
-   call get_sphere(.true., solv, .true.) !r,V,A of solvent
-
-   r_solu = solu%vtot**third
-   r_solv = solv%vtot**third
-   write (*, *)
-   write (*, '(2x,''radius of solute    : '',f8.2)') r_solu
-   write (*, '(2x,''radius of solvent   : '',f8.2)') r_solv
-
-!--- Determine masses (for later density computation)
-   do i = 1, solu%nat
-      solu%mass = solu%mass + ams(solu%at(i))
-   end do
-   do i = 1, solv%nat
-      solv%mass = solv%mass + ams(solv%at(i))
-   end do
-   solu%mass = solu%mass*amutokg
-   solv%mass = solv%mass*amutokg
-
-!--- If directed docking is requested, it is read in here:
-   if(allocated(env%directed_file)) then
-      if (env%use_xtbiff) error stop 'xTB-IFF does not support directed docking. &
-              &Please use the aISS algorithm of xtb.'
-      call read_directed_input(env)
-   end if
-
-end subroutine read_qcg_input
-
-!> Read input for directed docking
-subroutine read_directed_input(env)
-   use iso_fortran_env, wp => real64
-   use crest_data
-   implicit none
-
-   type(systemdata)           :: env
-
-   integer                    :: nlines
-   integer                    :: io, ich, i, i_check
-   integer                    :: index
-   character(len=512)         :: dum
-   character(len=1), parameter :: delim_space = ' ', delim_tab = achar(9)
-
-     open (newunit=ich, file=env%directed_file) 
-        !First check number of lines
-        nlines = 0
-        do
-           read(ich,*,iostat=io)
-           if (io /= 0) exit
-           nlines = nlines + 1
-        end do
-        !Allocate directed list 
-        !First entry is the atom number, Second how many solvents to add to this atom
-        allocate(env%directed_list(nlines,2))
-        allocate(env%directed_number(nlines), source = 0)
-        !Now read lines into directed_list
-        rewind(ich)
-        do i=1, nlines
-           read(ich,'(A)') dum
-           !> Remove leading tab and spaces first
-           dum = adjustl(dum) !Leading spaces are removed
-           index = SCAN(trim(dum), delim_tab) 
-           if (index == 1) then !Leading tab -> remove it
-              dum = dum(2:)
-           end if
-           index = SCAN(trim(dum), delim_space)
-           if (index == 0) then !No space = check for tab
-              index = SCAN(trim(dum), delim_tab)
-           end if
-           if (index == 0) then  !Second value is missing
-              write(*,'(a,1x,i0)') "No second value found in directed list on line", i
-              error stop
-           end if
-           env%directed_list(i, 1) = dum(1:index-1)
-           env%directed_list(i, 2) = dum(index+1:)
-           !Remove multiple spaces
-           env%directed_list(i, 2) = adjustl(env%directed_list(i, 2))
-           !Check, if spaces are still in second argument (e.g. a third number is giveb)
-           index = SCAN(trim(env%directed_list(i, 2)), delim_space)
-           if (index == 0) index = SCAN(trim(dum), delim_tab)
-           if (index /= 0) then
-              write(*,'(a,1x,i0)') "Too many values at line", i
-              error stop
-           end if
-           !> Make array with which solvent molecule at which atom to add
-           read(env%directed_list(i,2), *, iostat=io) env%directed_number(i)
-           env%directed_number(i) = sum(env%directed_number)
-           if (io/= 0) then
-              write(*,'(a,1x,i0)') "Second value is no number in line", i
-              error stop
-           end if
-        end do
-     close(ich)
-     write(*,*) 'Performing directed docking'
-     do i=1, nlines
-        write(*,'(a,1x,a,1x,a,1x,a)') 'Docking', trim(env%directed_list(i,2)),&
-               & 'solvent molecules at', trim(env%directed_list(i,1))
-     end do
-
-end subroutine read_directed_input
-
-
-subroutine qcg_grow(env, solu, solv, clus, tim)
-   use crest_parameters
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-   implicit none
-
-   type(systemdata)           :: env
-   type(zmolecule)            :: solu, solv, clus
-   type(timer)                :: tim
-
-   integer                    :: minE_pos, m
-   integer                    :: iter = 1
-   integer                    :: i, j, io, v
-   integer                    :: max_cycle
-   logical                    :: e_there, high_e, success, neg_E
-   real(wp)                   :: etmp(500)
-   real(wp), allocatable       :: e_each_cycle(:)
-   real(wp)                   :: dens, dum, efix
-   real(wp)                   :: e_diff = 0.0_wp
-   real(wp), parameter         :: eh = 627.509541d0
-   real(wp), allocatable       :: E_inter(:)
-   real(wp)                   :: shr = 0.0_wp
-   real(wp)                   :: shr_av = 0.0_wp
-   real(wp)                   :: mean = 0.0_wp
-   real(wp)                   :: mean_old = 0.0_wp
-   real(wp)                   :: mean_diff = 0.0_wp
-   character(len=*), parameter :: outfmt = '(1x,1x,a,1x,f14.7,a,1x)'
-   character(len=512)         :: thispath, resultspath
-   character(len=20)          :: gfnver_tmp
-   integer                    :: ich99, ich15, ich88
-   character(len=LEN(env%solv)) :: solv_tmp
-   logical                    :: gbsa_tmp
-
-   interface
-      subroutine both_ellipsout(fname, n, at, xyz, r1, r2)
-         use iso_fortran_env, only: wp => real64
-         use strucrd, only: i2e
-         implicit none
-
-         integer            :: i, j
-         integer            :: n, at(n)
-         real(wp)           :: dum(3)
-         real(wp)           :: rx, ry, rz
-         real(wp)           :: xyz(3, n), r1(3)
-         real(wp), optional :: r2(3)
-         real               :: x, y, z, f, rr
-         character(len=*)   :: fname
-         integer            :: ich11
-      end subroutine both_ellipsout
-   end interface
-
-   if (env%nsolv .gt. 0) then
-      allocate (e_each_cycle(env%nsolv))
-      allocate (E_inter(env%nsolv))
-   else
-      allocate (e_each_cycle(env%max_solv))
-      allocate (E_inter(env%max_solv))
-   end if
-
-   call tim%start(5, 'Grow')
-
-   call pr_eval_solute()
-   call print_qcg_grow()
-   call getcwd(thispath)
-   io = makedir('grow')
-   call chdir('grow') !Results directory
-
-!--- Output Files
-   open (newunit=ich99, file='qcg_energy.dat')
-   write (ich99, '(i0,2F20.8)') 0, solu%energy, solv%energy
-   open (newunit=ich15, file='qcg_grow.xyz')  ! for molden movie
-   open (newunit=ich88, file='qcg_conv.dat')  ! for convergence check
-   write (ich88, '(''   #   Energy       Run. Aver.   Diff / au.'')')
-
-   call getcwd(resultspath)
-   call chdir(thispath)
-
-   if (env%water) then
-      if (.not. env%user_wscal) then
-         if (solu%nat .lt. 18) then
-            env%potscal = 0.7_wp
-         else
-            env%potscal = 0.8_wp
-         end if
-         write (*, *)
-         write (*, '(2x,''Water as solvent recognized,&
-                 & adjusting scaling factor for outer wall pot to '',F4.2)')&
-                & env%potscal
-         write (*, *)
-      end if
-   end if
-   if (env%constrain_solu) write (*, '(2x,''Constraining solute during Growth '')')
-
-   call get_ellipsoid(env, solu, solv, clus, .true.)
-   call pr_grow_energy()
-
-   call chdir(env%scratchdir)
-   v = makedir('tmp_grow')
-   if(env%fixfile /= 'none selected') then
-      call copysub(env%fixfile, 'tmp_grow')
-   end if
-   if (env%use_xtbiff) then
-     call copy('solute_properties/solute.lmo', 'tmp_grow/solute.lmo')
-     call copy('solvent_properties/solvent.lmo', 'tmp_grow/solvent.lmo')
-   end if
-   call chdir('tmp_grow')
-   call wrc0('solute', solu%nat, solu%at, solu%xyz)
-   call wrc0('solvent', solv%nat, solv%at, solv%xyz)
-   call env%wrtCHRG('') !Write .CHRG file for docking
-
-   call ellipsout('solute_cavity.coord', clus%nat, clus%at, clus%xyz, solu%ell_abc)
-   solv%ell_abc = clus%ell_abc
-
-   clus%chrg = solu%chrg
-   clus%uhf = solu%uhf
-
-   if (env%nsolv .gt. 0) then
-      max_cycle = env%nsolv !User set number of solvents to add
-   else
-      max_cycle = env%max_solv !No solvent number set
-   end if
-
-!--------------------------------------------------------
-! Start Loop
-!--------------------------------------------------------
-   do iter = 1, max_cycle
-      e_there = .false.
-      success = .false.
-      high_e = .false.
-      neg_E = .false.
-!---- LMO-Computation
-      if (iter .gt. 1) then
-         call get_ellipsoid(env, solu, solv, clus, .false.)
-         if (env%use_xtbiff) then
-            call xtb_lmo(env, 'xtbopt.coord')!,clus%chrg)
-            call grepval('xtb.out', '| TOTAL ENERGY', e_there, clus%energy)
-            if (.not. e_there) then
-               write (*, '(1x,a)') 'Total Energy of cluster LMO computation not found'
-            end if
-            call rename('xtblmoinfo', 'cluster.lmo')
-         end if
-      end if
-
-      call both_ellipsout('twopot_1.coord', clus%nat, clus%at, clus%xyz,&
-             & clus%ell_abc, solu%ell_abc)
-
-      do while (.not. success) !For restart with larger wall pot
-         if (iter .eq. 1) then
-            if (env%use_xtbiff) then
-               call xtb_iff(env, 'solute.lmo', 'solvent.lmo', solu, solv)
-               !solu for nat of core pot. solv for outer ellips
-               call check_iff(neg_E)
-            else
-               call xtb_dock(env, 'solute', 'solvent', solu, solv)
-               call check_dock(neg_E)
-            end if
-
-!-- If Interaction Energy is not negativ and existent, wall pot. too small and increase
-            if (neg_E) then
-               success = .true.
-            else
-               if (env%potscal .lt. 1.0_wp) then
-                  write (*, *) '  Wall Potential too small, increasing size by 5 %'
-                  solv%ell_abc = solv%ell_abc*1.05_wp
-                  env%potscal = env%potscal*1.05_wp
-                  if (env%potscal .gt. 1.0_wp) env%potscal = 1.0_wp
-                  write (*, '(''   New scaling factor '',F4.2)') env%potscal
-               else
-                  success = .true.
-               end if
-            end if
-         else
-            if (env%use_xtbiff) then
-               call xtb_iff(env, 'cluster.lmo', 'solvent.lmo', solu, clus)
-               call check_iff(neg_E)
-            else
-               call xtb_dock(env, 'cluster.coord', 'solvent', solu, clus)
-               call check_dock(neg_E)
-            end if
-
-            if (neg_E) then
-               success = .true.
-            else
-               if (env%potscal .lt. 1.0_wp) then
-                  write (*, *) '  Wall Potential too small, increasing size by 5 %'
-                  clus%ell_abc = clus%ell_abc*1.05_wp
-                  env%potscal = env%potscal*1.05_wp
-                  if (env%potscal .gt. 1.0_wp) env%potscal = 1.0_wp
-                  write (*, '(''   New scaling factor '',F4.2)') env%potscal
-               else
-                  success = .true.
-               end if
-            end if
-         end if
-      end do
-
-!--- Increase cluster size
-      call clus%deallocate
-      clus%nat = clus%nat + solv%nat
-      allocate (clus%at(clus%nat))
-      allocate (clus%xyz(3, clus%nat))
-      clus%nmol = clus%nmol + 1
-
-!--- Select xtb-IFF stucture to proceed
-      if (env%use_xtbiff) then
-         call rdxtbiffE('xtbscreen.xyz', m, clus%nat, etmp) !Get energy of screening
-         minE_pos = minloc(etmp(1:m), dim=1) !Get minimum of those
-         !Read the struc into clus%xyz
-         call rdxmolselec('xtbscreen.xyz', minE_pos, clus%nat, clus%at, clus%xyz) 
-      else
-         call rdcoord('best.xyz', clus%nat, clus%at, clus%xyz, clus%energy)
-      end if
-
-      call remove('cluster.coord')
-      call wrc0('cluster.coord', clus%nat, clus%at, clus%xyz)
-      call both_ellipsout('twopot_2.coord', clus%nat, clus%at, clus%xyz,&
-             & clus%ell_abc, solu%ell_abc)
-
-      success = .false.
-
-!--- Cluster restart, if interaction energy not negativ (wall pot. too small)
-      gfnver_tmp = env%gfnver !> backup original level of theory
-      do while (.not. success)
-!--- Cluster optimization
-         if (env%cts%used) then
-            call write_reference(env, solu, clus) !new fixed file
-         end if
-
-         if (env%use_xtbiff) then
-            call opt_cluster(env, solu, clus, 'cluster.coord', .false.)
-            call rdcoord('xtbopt.coord', clus%nat, clus%at, clus%xyz)
-         end if
-
-!--- Interaction energy
-         !gfnver_tmp = env%gfnver
-         env%gfnver = env%lmover
-         gbsa_tmp = env%gbsa
-         solv_tmp = env%solv
-         env%gbsa = .false.
-         env%solv = ''
-         call get_interaction_E(env, solu, solv, clus, iter, E_inter)
-         env%gbsa = gbsa_tmp
-         env%solv = solv_tmp
-         if (E_inter(iter) .lt. 0) then
-            success = .true.
-         else
-            if (env%potscal .lt. 1.0_wp) then
-               write (*, *) '  Interaction Energy positiv, increasing outer wall pot by 5 %'
-               clus%ell_abc = clus%ell_abc*1.05_wp
-               env%potscal = env%potscal*1.05_wp
-               if (env%potscal .gt. 1.0_wp) env%potscal = 1.0_wp
-               write (*, '('' New scaling factor '',F4.2)') env%potscal
-            else
-               success = .true.
-            end if
-         end if
-      end do
-      env%gfnver = gfnver_tmp
-
-!--- For output
-      if (env%use_xtbiff) then
-         call grepval('xtb.out', '| TOTAL ENERGY', e_there, clus%energy)
-         call wrc0('optimized_cluster.coord', clus%nat, clus%at, clus%xyz)
-         if (.not. e_there) then
-            write (*, '(1x,a)') 'Total Energy of cluster not found.'
-         end if
-      else
-         !Energy already read from xyz file
-      end if
-      e_each_cycle(iter) = clus%energy
-
-!--- Calclulate fix energy + diff. energy
-      efix = clus%energy/sqrt(float(clus%nat))
-      dum = solu%energy
-      if (iter .gt. 1) dum = e_each_cycle(iter - 1)
-      e_diff = e_diff + eh*(e_each_cycle(iter) - solv%energy - dum)
-      call ellipsout('cluster_cavity.coord', clus%nat, clus%at, clus%xyz, clus%ell_abc)
-      call both_ellipsout('twopot_cavity.coord', clus%nat, clus%at, clus%xyz,&
-             & clus%ell_abc, solu%ell_abc)
-
-!--- Density calculations
-      call get_sphere(.false., clus, .false.) !V, A of new cluster
-      dens = 0.001*(solu%mass + iter*solv%mass)/(1.0d-30*clus%vtot*bohr**3)
-
-!--- Movie file
-      write (ich15, *) clus%nat
-      write (ich15, '('' SCF done '',2F16.8)') eh*(e_each_cycle(iter) - solv%energy - dum)
-      do j = 1, clus%nat
-         write (ich15, '(a,1x,3F24.10)') i2e(clus%at(j)), clus%xyz(1:3, j)*bohr
-      end do
-
-!--- Output
-     ! dist of new mol from solute for output
-      call analyze_cluster(iter, clus%nat, solu%nat, solv%nat, clus%xyz, clus%at, shr_av, shr)
-
-      write (*, '(x,i4,F13.6,1x,f7.2,3x,f8.2,6x,f6.3,3x,f8.3,3x,2f6.1,2x,f8.1,3x,a,x)') &
-            & iter, e_each_cycle(iter), eh*(e_each_cycle(iter) - solv%energy - dum),&
-            & e_diff, dens, efix, shr_av, shr, clus%vtot, trim(optlevflag(env%optlev))
-      write (ich99, '(i4,F20.10,3x,f8.1)') iter, e_each_cycle(iter), clus%vtot
-
-!--- Calculate moving average
-      mean_old = mean
-      do i = 0, iter - 1
-         mean = mean + E_inter(iter - i)
-      end do
-      mean = mean/iter
-      mean_diff = mean - mean_old
-      write (ich88, '(i5,1x,3F13.8)') iter, E_inter(iter)*eh, mean, mean_diff
-
-!--- Check if converged when no nsolv was given
-      if (env%nsolv .eq. 0) then
-         if (abs(mean_diff) .lt. 1.0d-4 .and. iter .gt. 5) then
-            env%nsolv = iter
-            exit
-         end if
-         if (iter .eq. env%max_solv) then
-            write (*, '(1x,''No convergence could be reached upon adding'',1x,i4,1x,&
-                    & ''solvent molecules.'')') env%max_solv
-            write (*, *) ' Proceeding.'
-            env%nsolv = env%max_solv
-            exit
-         end if
-      end if
-!-----------------------------------------------
-! End loop
-!-----------------------------------------------
-   end do
-
-   if (env%nsolv .eq. 0) env%nsolv = iter !if no env%solv was given
-
-   if (env%gfnver .ne. '--gfn2' .and. env%final_gfn2_opt) then
-      gfnver_tmp = env%gfnver
-      env%gfnver = '--gfn2'
-      write (*, '(2x,''Final gfn2 optimization'')')
-      call opt_cluster(env, solu, clus, 'cluster.coord', .false.)
-      call rdcoord('xtbopt.coord', clus%nat, clus%at, clus%xyz)
-      call wrc0('cluster.coord', clus%nat, clus%at, clus%xyz)
-      call grepval('xtb_sp.out', '| TOTAL ENERGY', e_there, clus%energy)
-      if (.not. e_there) then
-         write (*, '(1x,a)') 'Total Energy of cluster not found.'
-      else
-         write (*, '(2x,''Total gfn2-energy of cluster/Eh:'',f20.6)') clus%energy
-      end if
-      env%gfnver = gfnver_tmp
-   end if
-
-   call wrxyz('cluster.xyz', clus%nat, clus%at, clus%xyz*bohr)
-
-!--- One optimization without Wall Potential and with implicit model
-   gfnver_tmp = env%gfnver
-   if (env%final_gfn2_opt) env%gfnver = '--gfn2'
-   call opt_cluster(env, solu, clus, 'cluster.xyz', .true.)
-   env%gfnver = gfnver_tmp
-   call rename('xtbopt.xyz', 'cluster_optimized.xyz')
-   call copysub('cluster_optimized.xyz', resultspath)
-
-!--- output and files
-   write (*, *)
-   write (*, '(2x,''Growth finished after '',i0,'' solvents added'')') env%nsolv
-   write (*, '(2x,''Results can be found in grow directory'')')
-   write (*, '(2x,''Energy list in file <qcg_energy.dat>'')')
-   write (*, '(2x,''Interaction energy in file <qcg_conv.dat>'')')
-   write (*, '(2x,''Growing process in <qcg_grow.xyz>'')')
-   write (*, '(2x,''Final geometry after grow in <cluster.coord> and <cluster.xyz>'')')
-   write (*, '(2x,''Final geometry optimized without wall potential in <cluster_optimized.xyz>'')')
-   write (*, '(2x,''Potentials and geometry written in <cluster_cavity.coord> and <twopot_cavity.coord>'')')
-
-   close (ich99)
-   close (ich88)
-   close (ich15)
-
-!--- Saving results and cleanup
-   call copysub('cluster.coord', resultspath)
-   call copysub('cluster.xyz', resultspath)
-   call copysub('twopot_cavity.coord', resultspath)
-   call copysub('cluster_cavity.coord', resultspath)
-   call copysub('solute_cavity.coord', resultspath)
-!  call rename('xcontrol','wall_potential')
-   env%constrain_solu = .false.
-   call write_wall(env, solu%nat, solu%ell_abc, clus%ell_abc, 'wall_potential')
-   call copysub('wall_potential', resultspath)
-
-   call chdir(thispath)
-   call chdir(env%scratchdir)
-   if (.not. env%keepModef) call rmrf('tmp_grow')
-
-   deallocate (e_each_cycle, E_inter)
-
-   call tim%stop(5)
-
-end subroutine qcg_grow
-
-subroutine qcg_ensemble(env, solu, solv, clus, ens, tim, fname_results)
-   use crest_parameters
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-   use utilities
-   use cregen_interface
-   implicit none
-
-   type(systemdata)           :: env
-   type(zmolecule)            :: solu, solv, clus
-   type(ensemble)             :: ens, dum
-   type(timer)                :: tim
-
-   integer                    :: i, j, k
-   integer                    :: io, f, r, ich,T,Tn
-   integer                    :: minpos
-   character(len=512)         :: thispath, resultspath, tmppath, tmppath2
-   character(len=512)         :: scratchdir_tmp
-   character(len=512)         :: jobcall
-   character(len=256)         :: inpnam, outnam
-   character(len=80)          :: fname, pipe, to
-   character(len=*)           :: fname_results
-   character(len=64)          :: comment
-   character(len=20)          :: gfnver_tmp
-   character(len=LEN(env%solv)) :: solv_tmp
-   logical                    :: gbsa_tmp
-   logical                    :: ex, mdfail, e_there
-   logical                    :: checkiso_tmp, cbonds_tmp
-   real(wp), allocatable      :: e_fix(:), e_clus(:)
-   real(wp), parameter         :: eh = 627.509541d0
-   real(wp)                   :: S, H, G, dens, shr, shr_av
-   real(wp)                   :: sasa
-   real(wp)                   :: newtemp, newmdtime, newmdstep, newhmass
-   real(wp)                   :: newmetadlist, newmetadexp, newmetadfac
-   real(wp)                   :: optlev_tmp
-   real(wp)                   :: e0
-   real(wp), allocatable      :: de(:)
-   real(wp), allocatable      :: p(:)
-   integer                    :: ich98, ich65, ich48
-   logical                    :: not_param = .false.
-   type(timer)                :: tim_dum !Dummy timer to avoid double counting
-
-   interface
-      subroutine aver(pr, env, runs, e_tot, S, H, G, sasa, a_present, a_tot)
-         use iso_fortran_env, only: wp => real64
-         use crest_data
-
-         implicit none
-         type(systemdata), intent(in)     :: env
-         integer, intent(in)             :: runs
-         real(wp), intent(inout)         :: e_tot
-         real(wp), intent(in), optional  :: a_tot
-         real(wp), intent(out)           :: S
-         real(wp), intent(out)           :: H
-         real(wp), intent(out)           :: G
-         real(wp), intent(out)           :: sasa
-         logical, intent(in)             :: pr, a_present
-         dimension e_tot(runs)
-         dimension a_tot(runs)
-      end subroutine aver
-   end interface
-
-   if (.not. env%solv_md) then
-      call tim%start(6, 'Solute-Ensemble')
-   else
-      call tim%start(7, 'Solvent-Ensemble')
-   end if
-
-   call tim_dum%init(20)
-
-!--- Setting up directories
-   call getcwd(thispath)
-   f = makedir(fname_results)
-   call chdir(fname_results)
-   call getcwd(resultspath)
-   call chdir(thispath)
-
-!--- Setting defaults
-   env%cts%NCI = .true.  !Activating to have wall pot. written in coord file for xtb
-   optlev_tmp = env%optlev
-   env%optlev = 0.0d0
-   gbsa_tmp = env%gbsa
-   solv_tmp = env%solv
-   env%gbsa = .false.
-   env%solv = ''
-
-!--- Setting up potential constraints
-   allocate (env%cts%pots(10))
-   env%cts%pots = ''
-   write (env%cts%pots(1), '("$wall")')
-   write (env%cts%pots(2), '(2x,"potential=polynomial")')
-   write (env%cts%pots(3), '(2x,"ellipsoid:",1x,3(g0,",",1x),"all")') clus%ell_abc
-   if (.not. env%solv_md) write (env%cts%pots(4), '(2x,"ellipsoid:",1x,3(g0,",",1x),"1-",i0)')&
-          & solu%ell_abc, solu%nat
-
-   if (env%cts%used) then
-      call write_reference(env, solu, clus) !new fixed file
-      call copysub(env%fixfile, env%scratchdir)
-   end if
-
-   call chdir(env%scratchdir)
-   scratchdir_tmp = env%scratchdir
-   if (.not. env%solv_md) then
-      io = makedir('tmp_MTD')
-      call copysub('.CHRG', 'tmp_MTD')
-      call copysub('.UHF', 'tmp_MTD')
-      if (env%cts%used) call copysub(env%fixfile, 'tmp_MTD')
-      call chdir('tmp_MTD')
-   else
-      io = makedir('tmp_solv_MTD')
-      call chdir('tmp_solv_MTD')
-   end if
-   call getcwd(tmppath2)
-   call wrc0('crest_input', clus%nat, clus%at, clus%xyz)
-
-   if (env%solv_md) then
-      call wr_cluster_cut('crest_input', solu%nat, solv%nat, env%nsolv,&
-             & 'solute_cut.coord', 'solvent_shell.coord')
-      call remove('crest_input')
-      call copy('solvent_shell.coord', 'crest_input')
-      deallocate (clus%at)
-      deallocate (clus%xyz)
-      call rdnat('solvent_shell.coord', clus%nat)
-      allocate (clus%at(clus%nat), clus%xyz(3, clus%nat))
-      call rdcoord('solvent_shell.coord', clus%nat, clus%at, clus%xyz)
-   end if
-
-   !For newcregen: If env%crestver .eq. crest_solv .and. .not. env%QCG then conffile .eq. .true.
-   env%QCG = .false. 
-   call inputcoords(env, 'crest_input')
-   call defaultGF(env)         !Setting MTD parameter
-
-!--- Special constraints for gff to safeguard stability
-   if (env%ensemble_opt .eq. '--gff') then
-      checkiso_tmp = env%checkiso
-      env%checkiso = .true.
-      cbonds_tmp = env%cts%cbonds_md
-      env%cts%cbonds_md = .true.
-      call autoBondConstraint_withEZ('coord', env%forceconst, env%wbofile)
-      call rd_cbonds('bondlengths', env)
-   end if
-
-   gfnver_tmp = env%gfnver
-   write (*, *) '  Method for ensemble search:', env%ensemble_opt
-!  if (env%ens_const) write(*,*) '  Solute fixed during ensemble generation'
-   env%gfnver = env%ensemble_opt  !Setting method for ensemble search
-
-   !----------------------------------------------------------------
-   ! Case selection of normal Crest, MD or MTD
-   !----------------------------------------------------------------
-
-   select case (env%ensemble_method)
-   case (-1:0) !qcgmtd/Crest runtype
-
-      !Defaults
-      !General settings:
-      if (.not. env%user_mdstep) then
-         if (env%ensemble_opt .EQ. '--gff') then
-            env%mdstep = 1.5d0
-         else
-            env%mdstep = 5.0d0
-         end if
-      end if
-      !Runtype specific settings:
-      if(env%ensemble_method == 0) then
-         if (.not. env%user_dumxyz) then
-            env%mddumpxyz = 200
-         end if
-         if (.not. env%user_mdtime) then
-            env%mdtime = 10.0
-         end if
-      else if(env%ensemble_method == -1) then
-         if (.not. env%user_dumxyz) then
-            env%mddumpxyz = 50
-         end if
-         if (.not. env%user_mdtime) then
-            env%mdtime = 5.0
-         end if
-         env%nmdtemp = 100
-         env%MaxRestart = 6
-      endif
-
-      env%iterativeV2 = .true.  !Safeguards more precise ensemble search
-      write (*, *) 'Starting ensemble cluster generation by CREST routine'
-      call confscript2i(env, tim_dum) !Calling ensemble search
-      call copy('crest_rotamers.xyz', 'crest_rotamers_0.xyz')
-
-   case (1:2) ! Single MD or MTD
-
-      !---- Setting threads
-      call new_ompautoset(env,'auto',1,T,Tn)
-
-      !--- Setting new defaults for MD/MTD in qcg
-      if (env%mdtemp .lt. 0.0d0) then
-         newtemp = 400.00d0
-      else if (.not. env%user_temp) then
-         newtemp = 298.0
-      else
-         newtemp = env%mdtemp
-      end if
-
-      if (.not. env%user_mdtime) then
-         newmdtime = 100.0 !100.0
-      else
-         newmdtime = env%mdtime
-      end if
-
-      if (.not. env%user_dumxyz) then
-         env%mddumpxyz = 1000
-      end if
-
-      if (.not. env%user_mdstep) then
-         if (env%ensemble_opt .ne. '--gff') then
-            newmdstep = 4.0d0
-         else
-            newmdstep = 1.5d0
-         end if
-      else
-         newmdstep = env%mdstep
-      end if
-
-      if (env%ensemble_opt .ne. '--gff') then
-         newhmass = 4.0
-      else
-         newhmass = 5.0
-      end if
-
-      if (.not. allocated(env%metadfac)) then
-         allocate (env%metadfac(1))
-         allocate (env%metadexp(1))
-         allocate (env%metadlist(1))
-      end if
-      newmetadfac = 0.02_wp
-      newmetadexp = 0.1_wp
-      newmetadlist = 10.0_wp
-
-      fname = 'coord'
-      pipe = ' > xtb.out 2>/dev/null'
-
-      !--- Writing constraining file xcontrol
-      !--- Providing xcontrol overwrites constraints in coord file
-
-      open (newunit=ich, file='xcontrol')
-      if (env%cts%NCI) then
-         do i = 1, 10
-            if (trim(env%cts%pots(i)) .ne. '') then
-               write (ich, '(a)') trim(env%cts%pots(i))
-            end if
-         end do
-      end if
-
-      if (.not. env%solv_md) then
-         write (ich, '(a)') '$constrain'
-         write (ich, '(2x,a,i0)') 'atoms: 1-', solu%nat
-         write (ich, '(2x,a)') 'force constant=0.5'
-         write (ich, '(2x,a,a)') 'reference=ref.coord'
-      end if
-
-      write (ich, '(a)') '$md'
-      write (ich, '(2x,a,f10.2)') 'hmass=', newhmass
-      write (ich, '(2x,a,f10.2)') 'time=', newmdtime
-      write (ich, '(2x,a,f10.2)') 'temp=', newtemp
-      write (ich, '(2x,a,f10.2)') 'step=', newmdstep
-      write (ich, '(2x,a,i0)') 'shake=', env%shake
-      write (ich, '(2x,a,i0)') 'dump=', env%mddumpxyz
-      write (ich, '(2x,a)') 'dumpxyz=500.0'
-
-      if (env%ensemble_method .EQ. 2) then
-         write (ich, '(a)') '$metadyn'
-         write (ich, '(2x,a,i0,a,i0)') 'atoms: ', solu%nat + 1, '-', clus%nat
-         write (ich, '(2x,a,f10.2)') 'save=', newmetadlist
-         write (ich, '(2x,a,f10.2)') 'kpush=', newmetadfac
-         write (ich, '(2x,a,f10.2)') 'alp=', newmetadexp
-      end if
-
-      if (env%cts%cbonds_md) call write_cts_CBONDS(ich, env%cts)
-
-      close (ich)
-
-!--- Writing jobcall
-      write (jobcall, '(a,1x,a,1x,a,'' --md --input xcontrol '',a,1x,a,a)') &
-            &     trim(env%ProgName), trim(fname), trim(env%gfnver), trim(env%solv), pipe
-!--- slightly different jobcall for QMDFF usage
-      if (env%useqmdff) then
-         write (jobcall, '(a,1x,a,1x,a,'' --md --input xcontrol --qmdff'',a,1x,a,a)') &
-            &     trim(env%ProgName), trim(fname), trim(env%gfnver), trim(env%solv), pipe
-      end if
-
-!--- MD
-      if (env%ensemble_method .EQ. 1) then
-         call normalMD(fname, env, 1, newtemp, newmdtime)
-         write (*, *) 'Starting MD with the settings:'
-         write (*, '(''     MD time /ps        :'',f8.1)') newmdtime
-         write (*, '(''     MD Temperature /K  :'',f8.1)') newtemp
-         write (*, '(''     dt /fs             :'',f8.1)') newmdstep
-         write (tmppath, '(a,i0)') 'NORMMD1'
-
-         r = makedir(tmppath)
-         call copysub('xcontrol', tmppath)
-         call chdir(tmppath)
-         call copy('coord', 'ref.coord')
-         call chdir(tmppath2)
-
-         call command('cd '//trim(tmppath)//' && '//trim(jobcall), io)
-
-         inquire (file=trim(tmppath)//'/'//'xtb.trj', exist=ex)
-         if (.not. ex .or. io .ne. 0) then
-            write (*, '(a,i0,a)') '*Warning: MD seemingly failed (no xtb.trj)*'
-         else
-            write (*, *) '*MD finished*'
-         end if
-
-         if (env%trackorigin) then
-            call set_trj_origins('NORMMD', 'md')
-         end if
-         call chdir('NORMMD1')
-      end if
-
-!--- MTD
-
-      if (env%ensemble_method .EQ. 2) then
-         call MetaMD(env, 1, newmdtime, env%metadfac(1), env%metadexp(1), &
-            &               env%metadlist(1))
-         write (*, '(a,i4,a)') 'Starting Meta-MD with the settings:'
-         write (*, '(''     MTD time /ps       :'',f8.1)') newmdtime
-         write (*, '(''     dt /fs             :'',f8.1)') newmdstep
-         write (*, '(''     MTD Temperature /K  :'',f8.1)') newtemp
-         write (*, '(''     dumpstep(trj) /fs  :'',i8)') env%mddumpxyz
-         write (*, '(''     Vbias factor k /Eh :'',f8.4)') newmetadfac
-         write (*, '(''     Vbias exp α /bohr⁻²:'',f8.2)') newmetadexp
-
-         write (tmppath, '(a,i0)') 'METADYN1'
-         r = makedir(tmppath)
-         call copysub('xcontrol', tmppath)
-         call chdir(tmppath)
-         call copy('coord', 'ref.coord')
-
-         call chdir(tmppath2)
-
-         call command('cd '//trim(tmppath)//' && '//trim(jobcall), io)
-
-         inquire (file=trim(tmppath)//'/'//'xtb.trj', exist=ex)
-         if (.not. ex .or. io .ne. 0) then
-            write (*, '(a,i0,a)') '*Warning: Meta-MTD seemingly failed (no xtb.trj)*'
-         else
-            write (*, *) '*MTD finished*'
-         end if
-
-         if (env%trackorigin) then
-            call set_trj_origins('METADYN', 'mtd')
-         end if
-
-         call chdir('METADYN1')
-
-      end if
-
-      call rename('xtb.trj', 'crest_rotamers_0.xyz')
-      call copysub('crest_rotamers_0.xyz', tmppath2)
-      call dum%open('crest_rotamers_0.xyz')
-
-!--- M(T)D stability check
-      call minigrep('xtb.out', 'M(T)D is unstable, emergency exit', mdfail)
-      if (dum%nall .eq. 1) then
-         call copysub('xtb.out', resultspath)
-         write (*, *) 'ERROR : M(T)D results only in one structure'
-         if (mdfail) then
-            write (*, *) '        It was unstable'
-         else
-            write (*, *) '        The M(T)D time step might be too large or the M(T)D time too short.'
-         end if
-         call copysub('xtb.out', resultspath)
-         error stop '         Please check the xtb.out file in the ensemble folder'
-      end if
-      if (mdfail) then
-         write (*, *)
-         write (*, *) '   WARNING: The M(T)D was unstable.'
-         write (*, *) '            Please check the xtb.out file in the ensemble folder.'
-         write (*, *)
-         call copysub('xtb.out', resultspath)
-      end if
-      call dum%deallocate
-      call chdir(tmppath2)
-      call wrc0('coord', clus%nat, clus%at, clus%xyz)
-      call inputcoords(env, 'coord') !Necessary
-
-!--- Optimization
-      call print_qcg_opt
-      !if (env%gfnver .eq. '--gfn2') 
-      call multilevel_opt(env, 99)
-
-   end select
-
-   env%QCG = .true.
-
-!--- Optimization with gfn2 if necessary
-      if (env%final_gfn2_opt) then
-      gfnver_tmp = env%gfnver
-!      if (env%gfnver .ne. '--gfn2') then
-      write (*, '(2x,a)') 'GFN2-xTB optimization'
-      env%gfnver = '--gfn2'
-      call rmrf('OPTIM')
-      call multilevel_opt(env, 99)
-   end if
-
-!--- Final optimization without potentials
-   call rmrf('OPTIM')
-   env%optlev = 1.0d0    !Higher precision for less scattering
-   env%cts%NCI = .false.  !Dactivating the wall pot.
-   env%cts%pots = ''
-   deallocate (env%cts%pots)
-   call multilevel_opt(env, 99)
-
-  !Clustering to exclude similar structures if requested with -cluster
-  if (env%properties == 70) then
-    write(*,'(3x,''Clustering the remaining structures'')')
-    call checkname_xyz(crefile,inpnam,outnam)
-    call ccegen(env, .false. , inpnam)
-    call move(trim(clusterfile),trim(outnam))
-  end if
-
-!--- Energy sorting and removal of dublicates
-   env%gbsa = gbsa_tmp
-   env%solv = solv_tmp
-   call newcregen(env, 0)
-   call checkname_xyz(crefile, inpnam, outnam)
-   call copy(inpnam, 'ensemble.xyz')
-   call ens%open('ensemble.xyz') !Read in ensemble
-   call clus%deallocate()
-   clus%nat = ens%nat
-   allocate (clus%at(clus%nat))
-   allocate (clus%xyz(3, clus%nat))
-
-!-------------------------------------------------------------
-!      SP with GBSA model and without wall potentials
-!-------------------------------------------------------------
-
-   !--- Write folder with xyz-coordinates
-   do i = 1, ens%nall
-      call rdxmolselec('ensemble.xyz', i, clus%nat, clus%at, clus%xyz)
-      write (to, '("TMPSP",i0)') i
-      io = makedir(trim(to))
-      call copysub('.UHF', to)
-      call copysub('.CHRG', to)
-      call chdir(to)
-      call wrxyz('cluster.xyz', clus%nat, clus%at, clus%xyz*bohr)
-      call chdir(tmppath2)
-   end do
-   !--- SP
-   write (*, *)
-   call ens_sp(env, 'cluster.xyz', ens%nall, 'TMPSP')
-   !--- Getting energy
-   do i = 1, ens%nall
-      call rdxmolselec('ensemble.xyz', i, clus%nat, clus%at, clus%xyz)
-      write (to, '("TMPSP",i0)') i
-      call chdir(to)
-      call grepval('xtb_sp.out', '| TOTAL ENERGY', e_there, ens%er(i))
-      call chdir(tmppath2)
-   end do
-
-   if (.not. e_there) then
-      write (*, *)
-      write (*, *) 'Energy not found. Error in xTB computations occured'
-      call chdir(to)
-      call minigrep('xtb_sp.out', 'solv_model_loadInternalParam', not_param)
-      call chdir(tmppath2)
-      if (not_param) then
-         write (*, *) '  !!!WARNIG: CHOSEN SOLVENT NOT PARAMETERIZED &
-         & FOR IMPLICIT SOLVATION MODEL!!!'
-         write (*, '(''  CHECK IF '',A,'' IS AVAILABLE IN xTB'')') env%solv
-         write (*, *) '  PLEASE RESTART THE ENSEMBLE GENERATION WITH AVAILABLE&
-                &  PARAMETERIZATION IF YOU NEED ENERGIES'
-         call copysub('crest_conformers.xyz', resultspath)
-         write (*, *) '  The enesemble can be found in the <ensemble> directory&
-                & as <crest_conformers.xyz>'
-         error stop
-      end if
-   end if
-
-   env%gfnver = gfnver_tmp
-   call ens%write('full_ensemble.xyz')
-
-!--- crest_best structure
-   minpos = minloc(ens%er, dim=1)
-   write (to, '("TMPSP",i0)') minpos
-   call chdir(to)
-   call rdxmol('cluster.xyz', clus%nat, clus%at, clus%xyz)
-   call chdir(tmppath2)
-   write (comment, '(F20.8)') ens%er(minpos)
-   inquire (file='crest_best.xyz', exist=ex)
-   if (ex) then
-      call rmrf('crest_best.xyz') !remove crest_best from
-   end if
-   call wrxyz('crest_best.xyz', clus%nat, clus%at, clus%xyz, comment)
-
-!-------------------------------------------------------------
-!      Processing results
-!-------------------------------------------------------------
-
-   allocate (e_fix(ens%nall))
-   allocate (e_clus(ens%nall))
-
-   call pr_ensemble_energy()
-
-   open (newunit=ich98, file='cluster_energy.dat')
-   write (ich98, '(3x,''#'',9x,''Energy [Eh]'',6x,''SASA'')')
-
-!--- Fixation energy of optimization
-   do i = 1, ens%nall
-      call chdir('OPTIM')
-      write (to, '("TMPCONF",i0)') i
-      call chdir(to)
-      call grepval('xtb.out', '         :: add. restraining', e_there, e_fix(i))
-      call chdir(tmppath2)
-
-      call rdxmolselec('full_ensemble.xyz', i, clus%nat, clus%at, clus%xyz)
-      call get_sphere(.false., clus, .false.)
-      dens = 0.001*(solu%mass + env%nsolv*solv%mass)/(1.0d-30*clus%vtot*bohr**3)
-      if (env%solv_md) then
-         call analyze_cluster(env%nsolv - 1, clus%nat, solv%nat, solv%nat, clus%xyz, clus%at, shr_av, shr)
-      else
-         call analyze_cluster(env%nsolv, clus%nat, solu%nat, solv%nat, clus%xyz, clus%at, shr_av, shr)
-      end if
-      write (ich98, '(i4,F20.10,3x,f8.1)') env%nsolv, ens%er(i), clus%atot
-      write (*, '(x,i4,4x,F13.6,2x,f6.3,1x,f8.3,2x,2f6.1,3x,f8.1,3x,a)') &
-            & i, ens%er(i), dens, e_fix(i), shr_av, shr, clus%atot, trim(optlevflag(env%optlev))
-      e_fix(i) = e_fix(i)*eh/sqrt(float(clus%nat))
-   end do
-   close (ich98)
-   call copysub('cluster_energy.dat', resultspath)
-
-!--- Checking Boltzmann weighting
-   write (*, *)
-   call remove('full_ensemble.xyz')
-   call sort_ensemble(ens, ens%er, 'full_ensemble.xyz')
-   e_clus = ens%er*eh
-   call sort_min(ens%nall, 1, 1, e_clus)
-   ens%er = e_clus/eh !Overwrite ensemble energy with sorted one
-   allocate (de(ens%nall), source=0.0d0)
-   allocate (p(ens%nall), source=0.0d0)
-   e0 = e_clus(1)
-   de(1:ens%nall) = (e_clus(1:ens%nall) - e0)
-   call qcg_boltz(env, ens%nall, de, p)
-   k = 0
-   if (.not. env%user_nclust) env%nqcgclust = 0 !Needed for solvent ensemble
-   if (env%nqcgclust .eq. 0) then
-      do i = 1, ens%nall !Count how many are above 10%
-         if ((p(i)) .gt. 0.1) then
-            k = k + 1
-         end if
-      end do
-      if ((k .eq. 0) .or. (k .gt. 10)) then
-         k = 10 !If too many structures are relevant, set it 10
-      else if ((k .lt. 4) .and. (ens%nall .ge. 4)) then
-         k = 4 !If too less structures are relevant, set it 4
-      else if (ens%nall .gt. 0) then 
-         k=ens%nall
-      else
-         error stop 'No structure left. Something went wrong.' 
-      end if
-      write (*, '(2x,a,1x,i0)') 'Conformers taken:', k
-      env%nqcgclust = k
-   else
-      if (env%nqcgclust .gt. ens%nall) then
-         k = ens%nall !Input larger than remaining structures
-         write (*, '(''Less than '',1x,i0,1x,''structures remain'')') env%nqcgclust
-         write (*, '(''Only '',1x,i0,1x,''structures are taken'')') ens%nall
-         if (env%cff) env%nqcgclust = ens%nall !Only for CFF, else a second qcg_ensemble run starts for solvent
-      else
-         write (*, '(''Taking '',1x,i0,1x,''structures'')') env%nqcgclust
-         k = env%nqcgclust !user input
-      end if
-   end if
-
-   open (newunit=ich65, file='final_ensemble.xyz')
-   do i = 1, k
-      open (newunit=ich48, file='full_population.dat')
-      write (ich48, '(2x, ''cluster'',2x,''E_norm [Eh]'',2x, ''De [kcal]'', 4x, ''p'')')
-      do j = 1, ens%nall
-         if (j .lt. 10) then
-            write (ich48, '(5x,i0,3x,f11.6,5x,f6.4,3x,f6.4)') j, e_clus(j)/eh, de(j), p(j)
-         else
-            write (ich48, '(5x,i0,2x,f11.6,5x,f6.4,3x,f6.4)') j, e_clus(j)/eh, de(j), p(j)
-         end if
-      end do
-      close (ich48)
-
-!--- Take k energetic least structures (written at beginning of file)
-      call rdxmolselec('full_ensemble.xyz', i, clus%nat, clus%at, clus%xyz)
-      call wrxyz(ich65, clus%nat, clus%at, clus%xyz*bohr, ens%er(i))
-   end do
-   close (ich65)
-
-   call ens%deallocate()
-   call ens%open('final_ensemble.xyz')
-   ens%er = e_clus(1:k)/eh
-
-!--- Getting G,S,H
-   write (*, *)
-   write (*, '(2x,''------------------------------------------------------------------------'')')
-   write (*, '(2x,''------------------------------------------------------------------------'')')
-   write (*, '(2x,''Boltz. averaged energy of final cluster:'')')
-   call aver(.true., env, ens%nall, e_clus(1:ens%nall), S, H, G, sasa, .false.)
-   write (*, '(7x,''G /Eh     :'',F14.8)') G/eh
-   write (*, '(7x,''T*S /kcal :'',f8.3)') S
-
-   ens%g = G
-   ens%s = S
-
-   deallocate (e_fix)
-   deallocate (e_clus)
-
-!---Folder management
-   call rename('cregen.out.tmp', 'thermo_data')
-   call copysub('thermo_data', resultspath)
-   call copysub('crest_best.xyz', resultspath)
-   call copysub('cre_members.out', resultspath)
-   call copysub('full_ensemble.xyz', resultspath)
-   call copysub('final_ensemble.xyz', resultspath)
-   call copysub('population.dat', resultspath)
-   call copysub('full_population.dat', resultspath)
-
-!---Deleting ensemble tmp
-   call chdir(thispath)
-   call chdir(env%scratchdir)
-   if (.not. env%keepModef) call rmrf(tmppath2)
-!----Outprint
-   write (*, *)
-   write (*, '(2x,''Ensemble generation finished.'')')
-   write (*, '(2x,''Results can be found in ensemble directory'')')
-   write (*, '(2x,''Lowest energy conformer in file <crest_best.xyz>'')')
-   write (*, '(2x,''List of full ensemble in file <full_ensemble.xyz>'')')
-   write (*, '(2x,''List of used ensemble in file <final_ensemble.xyz>'')')
-   write (*, '(2x,''Thermodynamical data in file <thermo_data>'')')
-   write (*, '(2x,''Population of full ensemble in file <full_population.dat>'')')
-   write (*, '(2x,''Population in file <population.dat>'')')
-
-   env%gfnver = gfnver_tmp
-   env%optlev = optlev_tmp
-   if (env%ensemble_opt .eq. '--gff') then
-      env%cts%cbonds_md = cbonds_tmp
-      env%checkiso = checkiso_tmp
-   end if
-
-   call tim_dum%clear
-
-   if (.not. env%solv_md) then
-      call tim%stop(6)
-   else
-      call tim%stop(7)
-   end if
-
-end subroutine qcg_ensemble
-
-subroutine qcg_cff(env, solu, solv, clus, ens, solv_ens, tim)
-   use crest_parameters
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-
-   implicit none
-
-   type(systemdata)           :: env
-   type(timer)                :: tim
-   type(zmolecule)            :: solu, solv, clus
-   type(ensemble)             :: solv_ens
-   type(ensemble), intent(in)  :: ens
-
-   integer                    :: i, j, k, iter
-   integer                    :: io, r
-   integer                    :: nsolv, n_ini
-   integer                    :: ipos, dum
-   integer                    :: v_ratio
-   integer                    :: minE_pos, m, nat_tot
-   integer                    :: nat_frag1 !number of atoms larger fragment (=solvent shell)
-   integer                    :: conv(env%nqcgclust + 1)
-   integer                    :: solv_added, minpos
-   character(len=512)         :: thispath, resultspath, tmppath, tmppath2
-   character(len=64)          :: fname_lmo1, fname_lmo2, comment
-   character(len=20)          :: to
-   real(wp), allocatable      :: e_empty(:), inner_ell_abc(:, :)
-   real(wp), allocatable      :: outer_ell_abc(:, :)
-   real(wp), allocatable      :: e_cur(:, :)
-   real(wp)                   :: e_cluster(env%nqcgclust)
-   real(wp), parameter        :: eh = 627.509541d0
-   real(wp)                   :: S, H, G
-   real(wp)                   :: sasa, tmp_optlev
-   real(wp)                   :: etmp(500)
-   real(wp)                   :: e_fix(env%nqcgclust), e_norm(env%nqcgclust)
-   real(wp)                   :: dum_e, de
-   real(wp)                   :: de_tot(env%nqcgclust)
-   real(wp)                   :: shr = 0
-   real(wp)                   :: shr_av = 0
-   real(wp)                   :: dens, atotS
-   logical                    :: ex, skip, e_there
-   logical                    :: all_converged
-   logical, allocatable        :: converged(:), nothing_added(:)
-
-   character(len=20)          :: gfnver_tmp
-   real(wp)                   :: optlev_tmp
-   integer                    :: ich98, ich31
-
-   interface
-      subroutine aver(pr, env, runs, e_tot, S, H, G, sasa, a_present, a_tot)
-         use iso_fortran_env, only: wp => real64
-         use crest_data
-
-         implicit none
-         type(systemdata), intent(in)     :: env
-         integer, intent(in)             :: runs
-         real(wp), intent(inout)         :: e_tot
-         real(wp), intent(in), optional  :: a_tot
-         real(wp), intent(out)           :: S
-         real(wp), intent(out)           :: H
-         real(wp), intent(out)           :: G
-         real(wp), intent(out)           :: sasa
-         logical, intent(in)             :: pr, a_present
-         dimension e_tot(runs)
-         dimension a_tot(runs)
-      end subroutine aver
-   end interface
-
-   call tim%start(8, 'CFF')
-
-   allocate (e_empty(env%nqcgclust))
-   allocate (converged(env%nqcgclust))
-   allocate (nothing_added(env%nqcgclust))
-   allocate (outer_ell_abc(env%nqcgclust, 3))
-   allocate (inner_ell_abc(env%nqcgclust, 3))
-
-   v_ratio = nint(solu%vtot/solv%vtot)
-   allocate (e_cur(env%nsolv + v_ratio, env%nqcgclust), source=0.0d0)
-
-!--- Setting defaults (same as ensemble optimization to have comparable structures)
-   optlev_tmp = env%optlev
-   env%optlev = 1.0d0    !Increaseing percision for ensemble search to minimze scattering
-   gfnver_tmp = env%gfnver
-   if (env%final_gfn2_opt) then
-      env%gfnver = '--gfn2'
-   else
-      env%gfnver = env%ensemble_opt !CFF always with ensemble method
-   end if
-   nothing_added = .false.
-
-   dum = 0
-   converged = .false.
-   all_converged = .false.
-   nat_tot = clus%nat - solu%nat!*env%nqcgclust
-
-   if (solu%vtot/solv%vtot .lt. 1.0d0) then
-      skip = .true.
-   else
-      skip = .false.
-   end if
-
-!--- Folder management
-   call getcwd(thispath)
-   r = makedir('solvent_ensemble')
-   call chdir('solvent_ensemble')
-   call getcwd(resultspath)
-   call chdir(thispath)
-   call chdir(env%scratchdir)
-   call getcwd(tmppath)
-   io = makedir('tmp_CFF')
-   call chdir('tmp_CFF')
-   call getcwd(tmppath2)
-   call chdir(tmppath)
-   call chdir('solvent_properties')
-   if (env%use_xtbiff) then
-      call copysub('solvent.lmo', tmppath2)
-   else
-      call copysub('solvent', tmppath2)
-   end if
-   call chdir(tmppath2)
-
-!--- SP of each cluster
-   call ens%write('ensemble.xyz')
-   do i = 1, env%nqcgclust
-      call rdxmolselec('ensemble.xyz', i, clus%nat, clus%at, clus%xyz)
-      clus%nmol = clus%nat/solv%nat
-      write (to, '("TMPCFF",i0)') i
-      io = makedir(trim(to))
-      if (env%use_xtbiff) then
-         call copysub('solvent.lmo', to)
-      else
-         call copysub('solvent', to)
-      end if
-      call chdir(to)
-      call wrc0('cluster.coord', clus%nat, clus%at, clus%xyz)
-      call wr_cluster_cut('cluster.coord', solu%nat, solv%nat, env%nsolv, 'solute_cut.coord', 'solvent_shell.coord')
-      call xtb_sp_qcg(env, 'solvent_shell.coord')
-      call grepval('xtb.out', '| TOTAL ENERGY', ex, e_empty(i))
-      call copy('solvent_shell.coord', 'solvent_cluster.coord')
-      call copy('solvent_cluster.coord', 'filled_cluster.coord')
-      call get_ellipsoid(env, solu, solv, clus, .false.) !solu, to have same cavity to fill solvent in
-      outer_ell_abc(i, 1:3) = clus%ell_abc(1:3)
-      inner_ell_abc(i, 1:3) = solu%ell_abc(1:3)
-      call chdir(tmppath2)
-   end do
-
-   if (skip) write (*, '(2x,''solute smaller than solvent, cff skipped'')')
-
-   clus%nat = clus%nat - solu%nat
-   n_ini = clus%nat
-
-!--- If solvent molecules are added
-   if (.not. skip) then
-      call pr_qcg_fill()
-      write (*, '(2x,''now adding solvents to fill cluster...'')')
-      call pr_fill_energy()
-      write (*, '(2x,''------------------------------------------------------------------------'')')
-      nat_frag1 = env%nsolv*solv%nat
-
-      iter = 0
-!--- Main cycle for addition of solvent molecules
-      convergence: do while (.not. all_converged)
-         k = 0
-         iter = iter + 1
-         !--- Setting array, with only numbers of dirs that are not converged
-         do i = 1, env%nqcgclust
-            if (.not. converged(i)) then
-               k = k + 1
-               conv(k) = i
-               conv(env%nqcgclust + 1) = k !How many jobs are open
-            else
-               cycle
-            end if
-         end do
-         conv(k + 1:env%nqcgclust) = 0
-
-         if (env%use_xtbiff) then
-!----------- LMO computation for solvent cluster---------------------------------------------------
-            call ensemble_lmo(env, 'solvent_cluster.coord', solv, conv(env%nqcgclust + 1),&
-                   & 'TMPCFF', conv)
-!--------------------------------------------------------------------------------------------------
-
-            do i = 1, env%nqcgclust
-               if (.not. converged(i)) then
-                  write (to, '("TMPCFF",i0)') i
-                  call chdir(to)
-                  call rename('xtblmoinfo', 'solvent_cluster.lmo')
-                  call chdir(tmppath2)
-               else
-                  cycle
-               end if
-            end do
-         end if
-
-         call chdir(tmppath2)
-
-         fname_lmo1 = 'solvent_cluster.lmo'
-         fname_lmo2 = 'solvent.lmo'
-
-!--- Solvent addition to the cluster---------------------------------------------
-         if (env%use_xtbiff) then
-            call ensemble_iff(env, outer_ell_abc, nat_frag1, fname_lmo1, fname_lmo2,&
-                    &conv(env%nqcgclust + 1), 'TMPCFF', conv)
-         else
-            call ensemble_dock(env, outer_ell_abc, nat_frag1, 'solvent_cluster.coord',&
-                    &'solvent', clus%nat, solv%nat, conv(env%nqcgclust + 1), 'TMPCFF', conv)
-         end if
-!--------------------------------------------------------------------------------
-
-         nat_frag1 = nat_frag1 + solv%nat
-
-         !--- Increase cluster size
-         deallocate (clus%at)
-         deallocate (clus%xyz)
-         clus%nat = clus%nat + solv%nat
-         allocate (clus%at(clus%nat))
-         allocate (clus%xyz(3, clus%nat))
-         clus%nmol = clus%nmol + 1
-
-         do i = 1, env%nqcgclust
-            if (.not. converged(i)) then
-               write (to, '("TMPCFF",i0)') i
-               call chdir(to)
-               call remove('xtbrestart')
-               call remove('xcontrol')
-
-               if (env%use_xtbiff) then
-                  !--- Select xtb-IFF stucture to proceed
-                  call rdxtbiffE('xtbscreen.xyz', m, clus%nat, etmp) !Get energy of screening
-                  minE_pos = minloc(etmp(1:m), dim=1)            !Get minimum of those
-                  call rdxmolselec('xtbscreen.xyz', minE_pos, clus%nat, clus%at, clus%xyz) !Read the struc into clus%xyz
-                  call wrc0('solvent_cluster.coord', clus%nat, clus%at, clus%xyz)
-               else
-                  call rdcoord('best.xyz', clus%nat, clus%at, clus%xyz, e_cur(iter, i))
-                  call wrc0('solvent_cluster.coord', clus%nat, clus%at, clus%xyz)
-               end if
-
-               !--- Check if converged
-               call fill_take(env, solv%nat, clus%nat, inner_ell_abc(i, 1:3), ipos)
-               if (ipos .eq. 0) then
-                  converged(i) = .true.
-                  write (*, '(2x,''no more solvents can be placed inside cavity of cluster: '',i0)') i
-                  write (*, '(2x,''previous cluster taken...'')')
-                  if (iter .eq. 1) nothing_added(i) = .true.
-               end if
-               call chdir(tmppath2)
-
-            else
-               cycle
-            end if
-         end do
-
-!--- Check, if a structure was converged and iff was not necessary
-         k = 0
-         do i = 1, env%nqcgclust
-            if (.not. converged(i)) then
-               k = k + 1
-               conv(k) = i
-               conv(env%nqcgclust + 1) = k !How many jobs are open
-            else
-               cycle
-            end if
-         end do
-         conv(k + 1:env%nqcgclust) = 0
-
-!      if(env%use_xtbiff) then
-!--- Parallel optimization-------------------------------------------------------------------
-         call cff_opt(.false., env, 'solvent_cluster.coord', n_ini, conv(env%nqcgclust + 1)&
-                 &, 'TMPCFF', conv, nothing_added)
-!----------------------------------------------------------------------------------------------
-!      end if
-
-         do i = 1, env%nqcgclust
-            if (.not. converged(i)) then
-               write (to, '("TMPCFF",i0)') i
-               call chdir(to)
-               if (env%use_xtbiff) then
-                  call copy('xtbopt.coord', 'solvent_cluster.coord')
-                  call grepval('xtb_sp.out', '| TOTAL ENERGY', e_there, e_cur(iter, i))
-               end if
-               dum_e = e_empty(i)
-               if (iter - nsolv .gt. 1) dum_e = e_cur(iter - 1, i)
-               de = eh*(e_cur(iter, i) - solv%energy - dum_e)
-               de_tot(i) = de_tot(i) + de
-               !---- Check if solvent added is repulsive
-               if (de .gt. 0) then
-                  converged(i) = .true.
-                  write (*, '(2x,''adding solvent is repulsive for cluster: '',i0)') i
-                  write (*, '(2x,''previous cluster taken...'')')
-                  if (iter .eq. 1) nothing_added(i) = .true.
-               else !Only if the addition was not repulsive
-                  call copy('solvent_cluster.coord', 'filled_cluster.coord')
-                  write (*, '(i4,5x,i3,1x,F13.6,3x,f7.2,5x,f7.2,4x,a)') &
-                     & iter + env%nsolv, i, e_cur(iter, i), de, de_tot(i),&
-                     & trim(optlevflag(env%optlev))
-               end if
-               call chdir(tmppath2)
-            end if
-         end do
-
-         !--- Check if everything is converged
-         dum = 0
-         do i = 1, env%nqcgclust
-            if (converged(1)) then
-               dum = dum + 1
-            end if
-         end do
-
-         if (dum .eq. env%nqcgclust) then
-            all_converged = .true.
-         else
-            nat_tot = nat_tot + solv%nat
-         end if
-
-         write (*, '(2x,''------------------------------------------------------------------------'')')
-         !--- Or if maximum solvent is added
-         if (iter - nsolv .eq. v_ratio) then
-            write (*, '(2x,''volume filled'')')
-            all_converged = .true.
-            call copy('solvent_cluster.coord', 'filled_cluster.coord')
-         end if
-
-      end do convergence
-
-   end if
-
-   !Now in every TMPPath the final cluster file filled_cluster.coord is present
-
-!---------------------------------------------------------------------
-!     Final Optimization
-!---------------------------------------------------------------------
-
-   tmp_optlev = env%optlev
-   if (env%optlev .lt. 1.0) env%optlev = 1.0d0 !higher accuracy
-
-   if (.not. skip) then
-      call cff_opt(.true., env, 'filled_cluster.coord', n_ini, conv(env%nqcgclust + 1),&
-             & 'TMPCFF', conv, nothing_added)
-   else
-      n_ini = 0 !If this is 0, no constraining will be done (optimization of total system)
-      nothing_added = .true.
-      call cff_opt(.true., env, 'filled_cluster.coord', n_ini, env%nqcgclust, 'TMPCFF',&
-             & conv, nothing_added)
-   end if
-   env%optlev = tmp_optlev
-
-   call pr_ensemble_energy()
-
-   solv_ens%nall = env%nqcgclust
-   solv_ens%nat = nat_tot
-
-!--- Getting results--------------------------------------------------------------
-   open (newunit=ich31, file='crest_rotamers_0.xyz')
-   open (newunit=ich98, file='cluster_energy.dat')
-   write (ich98, '(3x,''#'',11x,''Energy [Eh]'',6x,''SASA'')')
-
-   do i = 1, env%nqcgclust
-      write (to, '("TMPCFF",i0)') i
-      call chdir(to)
-      call copy('xtbopt.coord', 'final_cluster.coord')
-
-!--- Reading structure
-      call clus%deallocate()
-      call rdnat('final_cluster.coord', clus%nat)
-      allocate (clus%at(clus%nat), clus%xyz(3, clus%nat))
-      call rdcoord('final_cluster.coord', clus%nat, clus%at, clus%xyz)
-
-!--- Getting energy and calculating properties
-      call grepval('xtb_sp.out', '| TOTAL ENERGY', e_there, e_cluster(i))
-      call grepval('xtb_sp.out', '         :: add. restraining', e_there, e_fix(i))
-      e_fix(i) = e_fix(i)*eh/sqrt(float(clus%nat))
-      call get_sphere(.false., clus, .false.)
-      if (clus%nat .gt. n_ini) then
-         solv_added = (clus%nat - (n_ini))/solv%nat
-      else
-         solv_added = 0
-      end if
-      dens = 0.001*((clus%nat/solv%nat)*solv%mass)/(1.0d-30*clus%vtot*bohr**3)
-      call analyze_cluster(solv_added, clus%nat, n_ini, solv%nat, clus%xyz, clus%at, shr_av, shr)
-      e_norm(i) = e_cluster(i)*env%nsolv/(clus%nat/solv%nat)
-      atotS = clus%atot*env%nsolv/(clus%nat/solv%nat)
-
-!--- Writing outputfiles
-      write (ich31, '(2x,i0)') clus%nat
-      write (ich31, '(2x,f18.8,2x,a)') e_cluster(i)
-      do j = 1, clus%nat
-         write (ich31, '(1x,a2,1x,3f20.10)') i2e(clus%at(j), 'nc'), clus%xyz(1:3, j)*bohr
-      end do
-
-      write (ich98, '(''No'',i4,F20.10,3x,f8.1)') i, e_norm(i), atotS
-
-!--- Print to screen
-      write (*, '(x,i4,4x,F13.6,2x,f6.3,1x,f8.3,2x,2f6.1,3x,f8.1,3x,a)') &
-              & i, e_norm(i), dens, e_fix(i), shr_av, shr, atotS, trim(optlevflag(env%optlev))
-
-      call chdir(tmppath2)
-   end do
-
-   close (ich98)
-   close (ich31)
-
-   call solv_ens%deallocate()
-   call solv_ens%open('crest_rotamers_0.xyz')
-
-   solv_ens%er = e_cluster
-   call copy('crest_rotamers_0.xyz', 'crest_ensemble.xyz')
-
-!--- crest_best structure
-   minpos = minloc(solv_ens%er, dim=1)
-   write (to, '("TMPCFF",i0)') minpos
-   call chdir(to)
-   call clus%deallocate
-   call rdnat('final_cluster.coord', clus%nat)
-   allocate (clus%at(clus%nat), clus%xyz(3, clus%nat))
-   call rdcoord('final_cluster.coord', clus%nat, clus%at, clus%xyz)
-   clus%xyz = clus%xyz*bohr
-   call chdir(tmppath2)
-   write (comment, '(F20.8)') solv_ens%er(minpos)
-   call wrxyz('crest_best.xyz', clus%nat, clus%at, clus%xyz, comment)
-
-!--- Boltz. average-------------------------------------------------------------------------
-   write (*, *)
-   write (*, '(2x,''------------------------------------------------------------------------'')')
-   write (*, '(2x,''------------------------------------------------------------------------'')')
-   write (*, '(2x,''Boltz. averaged energy of final cluster:'')')
-   e_cluster = solv_ens%er*eh
-   e_norm = e_norm*eh
-   call sort_min(env%nqcgclust, 1, 1, e_norm)
-   call aver(.true., env, solv_ens%nall, e_norm(1:env%nqcgclust), S, H, G, sasa, .false.)
-   write (*, '(7x,''G /Eh     :'',F14.8)') G/eh
-   write (*, '(7x,''T*S /kcal :'',f8.3)') S
-   solv_ens%er = e_norm/eh !normalized energy needed for final evaluation
-
-   solv_ens%g = G
-   solv_ens%s = S
-
-!--- Cleanup
-   call copysub('crest_ensemble.xyz', resultspath)
-   call copysub('cluster_energy.dat', resultspath)
-   call copysub('crest_best.xyz', resultspath)
-   call copysub('population.dat', resultspath)
-   call chdir(tmppath)
-   if (.not. env%keepModef) call rmrf('tmp_CFF')
-   call chdir(thispath)
-
-!--- Printouts
-   write (*, *)
-   write (*, '(2x,''Solvent cluster generation finished.'')')
-   write (*, '(2x,''Results can be found in solvent_cluster directory'')')
-   write (*, '(2x,''Structures in file <crest_ensemble.xyz>'')')
-   write (*, '(2x,''Energies in file <cluster_energy.dat>'')')
-   write (*, '(2x,''Population in file <population.dat>'')')
-
-   env%gfnver = gfnver_tmp
-   env%optlev = optlev_tmp
-
-   deallocate (e_empty)
-   deallocate (converged)
-   deallocate (outer_ell_abc)
-   deallocate (inner_ell_abc)
-
-   call tim%stop(8)
-
-end subroutine qcg_cff
-
-subroutine qcg_freq(env, tim, solu, solv, solu_ens, solv_ens)
-   use crest_parameters
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-
-   implicit none
-
-   type(systemdata)           :: env
-   type(timer)                :: tim
-   type(zmolecule)            :: solu, solv, clus
-   type(ensemble)             :: solu_ens, solv_ens
-
-   integer                    :: r, io, f, g, h
-   integer                    :: i
-   character(len=512)         :: thispath, resultspath, tmppath, tmppath2
-   character(len=80)          :: to
-   character(len=20)          :: gfnver_tmp
-   real(wp)                   :: optlev_tmp
-   real(wp)                   :: gt(3)
-   real(wp)                   :: ht(3)
-   real(wp)                   :: svib(3)
-   real(wp)                   :: srot(3)
-   real(wp)                   :: stra(3)
-   integer                    :: ich65, ich56, ich33, ich81
-   logical                    :: opt
-
-   call tim%start(9, 'Frequencies')
-
-   call pr_qcg_freq()
-
-!--- Setting defaults (same as ensemble optimization and cff to have comparable structures)
-   optlev_tmp = env%optlev
-   env%optlev = 1.0d0    !Increaseing percision for ensemble search to minimze scattering
-   gfnver_tmp = env%gfnver
-   env%gfnver = env%freqver  !Setting method
-
-!--- Folder management
-   call getcwd(thispath)
-   r = makedir('frequencies')
-   call chdir('frequencies')
-   call getcwd(resultspath)
-   call chdir(thispath)
-   call chdir(env%scratchdir)
-   call getcwd(tmppath)
-   io = makedir('tmp_freq')
-   call copysub('.CHRG', 'tmp_freq')
-   call copysub('.UHF', 'tmp_freq')
-   call chdir('tmp_freq')
-   call getcwd(tmppath2)
-   f = makedir('tmp_solu')
-   call copysub('.CHRG', 'tmp_solu')
-   call copysub('.UHF', 'tmp_solu')
-   g = makedir('tmp_solv')
-   h = makedir('tmp_gas1') !One solute molecule
-   call copysub('.CHRG', 'tmp_gas1')
-   call copysub('.UHF', 'tmp_gas1')
-
-!--- Frequencies solute molecule
-   write (*, *) '  SOLUTE MOLECULE'
-   call chdir('tmp_gas1')
-   call wrc0('solute.coord', solu%nat, solu%at, solu%xyz)
-   call chdir(tmppath2)
-   opt = .false.
-   call ens_freq(env, 'solute.coord', 1, 'tmp_gas', opt)
-   call chdir('tmp_gas1')
-   call rdtherm('xtb_freq.out', ht(3), svib(3), srot(3), stra(3), gt(3))
-   solu%gt = gt(3)
-   solu%ht = ht(3)
-   solu%svib = svib(3)
-   solu%srot = srot(3)
-   solu%stra = stra(3)
-
-   call chdir(tmppath2)
-
-!--- Folder setup for cluster
-   call chdir('tmp_solu')
-   call solu_ens%write('solute_ensemble.xyz')
-
-!--- All cluster are of the same size
-   call clus%deallocate()
-   clus%nat = solu_ens%nat
-   allocate (clus%at(clus%nat))
-   allocate (clus%xyz(3, clus%nat))
-   clus%xyz = 0
-   clus%nmol = env%nsolv + 1 !clus%nat/clus%at
-
-   do i = 1, solu_ens%nall
-      call rdxmolselec('solute_ensemble.xyz', i, clus%nat, clus%at, clus%xyz)
-
-!--- Solute cluster
-      write (to, '("TMPFREQ",i0)') i
-      io = makedir(trim(to))
-      call copysub('.UHF', to)
-      call copysub('.CHRG', to)
-      call chdir(to)
-      open (newunit=ich65, file='cluster.xyz')
-      call wrxyz(ich65, clus%nat, clus%at, clus%xyz*bohr)
-      close (ich65)
-
-      call chdir(tmppath2)
-
-      !--- Solvent cluster (only if cff, than the solvent shell is taken, which was fixed all the time)
-      if (env%cff) then
-         call chdir('tmp_solv')
-         write (to, '("TMPFREQ",i0)') i
-         io = makedir(trim(to))
-         call chdir(to)
-         call wrc0('cluster.coord', clus%nat, clus%at, clus%xyz)
-         call wr_cluster_cut('cluster.coord', solu%nat, solv%nat, env%nsolv,&
-                & 'solute_cut.coord', 'solvent_cut.coord')
-
-         call chdir(tmppath2)
-      end if
-      call chdir('tmp_solu')
-
-   end do
-
-   write (*, *) '  SOLUTE CLUSTER'
-
-!> Frequency calculation
-   opt = .true.
-   call ens_freq(env, 'cluster.xyz', solu_ens%nall, 'TMPFREQ', opt)
-   call chdir(tmppath2)
-
-   write (*, *) '  SOLVENT CLUSTER'
-   if (env%cff) then
-      call chdir('tmp_solv')
-      call ens_freq(env, 'solvent_cut.coord', solu_ens%nall, 'TMPFREQ', opt)
-      call chdir(tmppath2)
-   end if
-
-   call clus%deallocate()
-
-   !--- Frequencies solvent cluster (only, if not cff was used)
-   if (.not. env%cff) then
-      call chdir('tmp_solv')
-      call solv_ens%write('solvent_ensemble.xyz')
-
-      do i = 1, solv_ens%nall
-         write (to, '("TMPFREQ",i0)') i
-         io = makedir(trim(to))
-         call copysub('.UHF', to)
-         call copysub('.CHRG', to)
-         call chdir(to)
-         open (newunit=ich65, file='solv_cluster.xyz')
-         call wrxyz(ich65, solv_ens%nat, solv_ens%at, solv_ens%xyz(:, :, i))
-         close (ich65)
-         call chdir(tmppath2)
-         call chdir('tmp_solv')
-      end do
-!> Frequency calculation
-      call ens_freq(env, 'solv_cluster.xyz', solv_ens%nall, 'TMPFREQ', opt)
-      call chdir(tmppath2)
-   end if
-
-!----------------------------------------------------------------------------
-!   Data read out
-!----------------------------------------------------------------------------
-
-!--- Solute in gas phase
-   write (*, *)
-   write (*, *) '  Solute Gas properties'
-   call pr_freq_energy()
-   open (newunit=ich56, file='solute.dat')
-   call pr_freq_file(ich56)
-   write (*, '(2x,5f10.2)') ht(3), svib(3), srot(3), stra(3), gt(3)
-   write (ich56, '(2x,5f10.2)') ht(3), svib(3), srot(3), stra(3), gt(3)
-   close (ich56)
-
-!--- Solute cluster
-   write (*, *)
-   write (*, *) '  Solute cluster properties'
-   open (newunit=ich33, file='solute_cluster.dat')
-
-   call chdir('tmp_solu')
-
-   allocate (solu_ens%gt(solu_ens%nall))
-   allocate (solu_ens%ht(solu_ens%nall))
-   allocate (solu_ens%svib(solu_ens%nall))
-   allocate (solu_ens%srot(solu_ens%nall))
-   allocate (solu_ens%stra(solu_ens%nall))
-
-   call pr_freq_energy()
-   call pr_freq_file(ich33)
-
-   do i = 1, solu_ens%nall
-      write (to, '("TMPFREQ",i0)') i
-      call chdir(to)
-      call rdtherm('xtb_freq.out', ht(1), svib(1), srot(1), stra(1), gt(1))
-      write (*, '(2x,i0,2x,5f10.2)') i, ht(1), svib(1), srot(1), stra(1), gt(1)
-      write (ich33, '(2x,i0,2x,5f10.2)') i, ht(1), svib(1), srot(1), stra(1), gt(1)
-      solu_ens%gt(i) = gt(1)
-      solu_ens%ht(i) = ht(1)
-      solu_ens%svib(i) = svib(1)
-      solu_ens%srot(i) = srot(1)
-      solu_ens%stra(i) = stra(1)
-
-      call chdir(tmppath2)
-      call chdir('tmp_solu')
-   end do
-   close (ich33)
-
-!--- Solvent cluster
-   write (*, *)
-   write (*, *) '  Solvent cluster properties'
-   call chdir(tmppath2)
-   open (newunit=ich81, file='solvent_cluster.dat')
-
-   call chdir('tmp_solv')
-
-   allocate (solv_ens%gt(solv_ens%nall))
-   allocate (solv_ens%ht(solv_ens%nall))
-   allocate (solv_ens%svib(solv_ens%nall))
-   allocate (solv_ens%srot(solv_ens%nall))
-   allocate (solv_ens%stra(solv_ens%nall))
-
-   call pr_freq_energy()
-   call pr_freq_file(ich81)
-
-   do i = 1, solv_ens%nall
-      write (to, '("TMPFREQ",i0)') i
-      call chdir(to)
-      call rdtherm('xtb_freq.out', ht(2), svib(2), srot(2), stra(2), gt(2))
-      write (*, '(2x,i0,2x,5f10.2)') i, ht(2), svib(2), srot(2), stra(2), gt(2)
-      write (ich81, '(2x,i0,2x,5f10.2)') i, ht(2), svib(2), srot(2), stra(2), gt(2)
-      solv_ens%gt(i) = gt(2)
-      solv_ens%ht(i) = ht(2)
-      solv_ens%svib(i) = svib(2)
-      solv_ens%srot(i) = srot(2)
-      solv_ens%stra(i) = stra(2)
-      call chdir(tmppath2)
-      call chdir('tmp_solv')
-   end do
-   close (ich81)
-
-!--- Saving results
-   call chdir(tmppath2)
-   call copysub('solute.dat', resultspath)
-   call copysub('solute_cluster.dat', resultspath)
-   call copysub('solvent_cluster.dat', resultspath)
-
-!--- Deleting tmp directory
-   call chdir(tmppath)
-   if (.not. env%keepModef) call rmrf(tmppath2)
-   call chdir(thispath)
-
-   env%gfnver = gfnver_tmp
-   env%optlev = optlev_tmp
-
-   call tim%stop(9)
-
-end subroutine qcg_freq
-
-subroutine qcg_eval(env, solu, solu_ens, solv_ens)
-   use iso_fortran_env, wp => real64
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-
-   implicit none
-
-   type(systemdata)           :: env
-   type(zmolecule)            :: solu
-   type(ensemble)             :: solu_ens, solv_ens
-
-   character(len=512)         :: thispath
-
-   integer                    :: i, j
-   integer                    :: srange
-   integer                    :: freqscal
-   real(wp)                   :: g1(solu_ens%nall)
-   real(wp)                   :: g2(solv_ens%nall)
-   real(wp)                   :: g3
-   real(wp)                   :: Gsolv(20)
-   real(wp)                   :: Hsolv
-   real(wp)                   :: G_solute(20)
-   real(wp)                   :: H_solute
-   real(wp)                   :: G_solvent(20)
-   real(wp)                   :: H_solvent
-   real(wp)                   :: G_mono(20)
-   real(wp)                   :: H_mono
-   real(wp)                   :: S(20)
-   real(wp)                   :: volw
-   real(wp)                   :: sasa
-   real(wp)                   :: dum, dum1, dum2
-   real(wp)                   :: e_solute(solu_ens%nall)
-   real(wp)                   :: e_solvent(solv_ens%nall)
-   real(wp)                   :: scal(20)
-   integer                    :: ich23
-   real(wp), parameter         :: eh = 627.509541d0
-
-   interface
-      subroutine aver(pr, env, runs, e_tot, S, H, G, sasa, a_present, a_tot)
-         use iso_fortran_env, only: wp => real64
-         use crest_data
-
-         implicit none
-         type(systemdata), intent(in)     :: env
-         integer, intent(in)             :: runs
-         real(wp), intent(inout)         :: e_tot
-         real(wp), intent(in), optional  :: a_tot
-         real(wp), intent(out)           :: S
-         real(wp), intent(out)           :: H
-         real(wp), intent(out)           :: G
-         real(wp), intent(out)           :: sasa
-         logical, intent(in)             :: pr, a_present
-         dimension e_tot(runs)
-         dimension a_tot(runs)
-      end subroutine aver
-   end interface
-
-   call pr_eval_eval()
-
-   call getcwd(thispath)
-
-   freqscal = nint(env%freq_scal/0.05)
-   srange = 20
-   do i = 1, srange
-      scal(i) = 0.05*i
-   end do
-
-!--- Solute Cluster
-   !H_solv
-   do i = 1, solu_ens%nall
-      e_solute(i) = solu_ens%er(i)*eh + solu_ens%ht(i)
-   end do
-   call aver(.false., env, solu_ens%nall, e_solute, dum1, H_solute, dum2, sasa, .false.)
-   !G_solv
-   do i = 1, srange
-      do j = 1, solu_ens%nall
-         g1(j) = solu_ens%ht(j) - (env%tboltz*(solu_ens%svib(j) + scal(i)*(solu_ens%srot(j) + solu_ens%stra(j)))/1000)
-         e_solute(j) = solu_ens%er(j)*eh + g1(j)
-      end do
-      call aver(.false., env, solu_ens%nall, e_solute, S(i), dum, G_solute(i), sasa, .false.)
-   end do
-
-!--- Solvent Cluster
-   !H_solv
-   do i = 1, solv_ens%nall
-      e_solvent(i) = solv_ens%er(i)*eh + solv_ens%ht(i)
-   end do
-   call aver(.false., env, solv_ens%nall, e_solvent, dum1, H_solvent, dum2, sasa, .false.)
-
-   !G_solv
-   do i = 1, srange
-      do j = 1, solv_ens%nall
-         g2(j) = solv_ens%ht(j) - &
-                 & (env%tboltz*(solv_ens%svib(j) + scal(i)*(solv_ens%srot(j) + solv_ens%stra(j)))/1000)
-         e_solvent(j) = solv_ens%er(j)*eh + g2(j)
-      end do
-      call aver(.false., env, solv_ens%nall, e_solvent, S(i), dum, G_solvent(i), sasa, .false.)
-   end do
-
-!--- Solute gas phase
-   H_mono = solu%energy*eh + solu%ht
-   do i = 1, srange
-      g3 = solu%ht - (env%tboltz*(solu%svib + scal(i)*(solu%srot + solu%stra))/1000)
-      G_mono(i) = solu%energy*eh + g3
-   end do
-
-   Gsolv(1:20) = G_solute(1:20) - G_solvent(1:20) - G_mono(1:20)
-   Hsolv = H_solute - H_solvent - H_mono
-
-!--- Calculate Volume work and include
-   volw = (env%tboltz*8.31451/1000./4.184)*log(24.47d0*env%tboltz/298.15)
-   Gsolv(1:20) = Gsolv(1:20) - volw
-   Hsolv = Hsolv - volw
-   call pr_eval_1(Gsolv(20), Hsolv)
-   call pr_eval_2(srange, Gsolv, scal)
-   call pr_eval_3(srange, freqscal, env%freq_scal, Gsolv)
-
-! Save Result
-   open (newunit=ich23, file='frequencies/result.dat')
-   write (ich23, '("Solvation Free Energy [kcal/mol] :")')
-   write (ich23, '(f8.2)') Gsolv(freqscal)
-   close (ich23)
-
-end subroutine qcg_eval
-
-subroutine write_qcg_setup(env)
-   use crest_data
-   use iomod
-   implicit none
-
-   type(systemdata) :: env
-
-   write (*, *)
-   write (*, '(2x,''========================================='')')
-   write (*, '(2x,''|   quantum cluster growth: INPUT       |'')')
-   write (*, '(2x,''========================================='')')
-   write (*, *)
-   select case (env%qcg_runtype)
-   case (0)
-      write (*, '(2x,''QCG: Only Cluster Generation'')')
-   case (1)
-      write (*, '(2x,''QCG: Cluster + Ensemble Generation'')')
-      if (env%ensemble_method .eq. 0) write (*, '(2x,''Ensemble generated via CREST'')')
-      if (env%ensemble_method .eq. 1) write (*, '(2x,''Ensemble generated via MD Simulation'')')
-      if (env%ensemble_method .eq. 2) write (*, '(2x,''Ensemble generated via MetaDynamic'')')
-   case (2)
-      write (*, '(2x,''QCG: Calculation of delta E_solv'')')
-      if (env%ensemble_method .eq. 0) write (*, '(2x,''Ensemble generated via CREST'')')
-      if (env%ensemble_method .eq. 1) write (*, '(2x,''Ensemble generated via MD Simulation'')')
-      if (env%ensemble_method .eq. 2) write (*, '(2x,''Ensemble generated via MetaDynamic'')')
-   case (3)
-      write (*, '(2x,''QCG: Calculation of delta G_solv'')')
-      if (env%ensemble_method .eq. 0) write (*, '(2x,''Ensemble generated via CREST'')')
-      if (env%ensemble_method .eq. 1) write (*, '(2x,''Ensemble generated via MD Simulation'')')
-      if (env%ensemble_method .eq. 2) write (*, '(2x,''Ensemble generated via MetaDynamic'')')
-   case default
-      continue
-   end select
-   write (*, *)
-   write (*, '(2x,''input parameters     '')')
-   write (*, '(2x,''solute                 : '',a)') trim(env%solu_file)
-   write (*, '(2x,''charge                 : '',i0)') env%chrg
-   write (*, '(2x,''uhf                    : '',i0)') env%uhf
-   write (*, '(2x,''solvent                : '',a)') trim(env%solv_file)
-   if (env%nsolv .ne. 0) then
-      write (*, '(2x,''# of solvents to add   : '',i0)') env%nsolv
-   else if (env%nsolv .eq. 0) then
-      write (*, '(2x,''# of solvents to add   : until convergence, but maximal'',1x,i4)') env%max_solv
-   end if
-   if (env%nqcgclust .ne. 0) then
-      write (*, '(2x,''# of cluster generated : '',i0)') env%nqcgclust
-   else
-      write (*, '(2x,''Cluster generated that are above 10 % populated '')')
-   end if
-
-   write (*, '(2x,''# of CPUs used         : '',i0)') env%Threads
-   if (env%solvent .eq. '') then
-      write (*, '(2x,''No gbsa/alpb model''  )')
-   else
-      write (*, '(2x,''Solvation model        : '',a)') env%solvent
-   end if
-   write (*, '(2x,''xtb opt level          : '',a)') trim(optlevflag(env%optlev))
-   write (*, '(2x,''System temperature [K] : '',F5.1)') env%tboltz
-   write (*, '(2x,''RRHO scaling factor    : '',F4.2)') env%freq_scal
-   write (*, *)
-   if (env%use_xtbiff) write (*, '(2x,''Use of xTB-IFF standalone requested'')')
-
-end subroutine write_qcg_setup
-
-subroutine get_sphere(pr, zmol, r_logical)
-   use crest_parameters, only : wp
-   use zdata
-
-   implicit none
-   type(zmolecule), intent(inout) :: zmol
-   type(zmolecule) :: dum
-   logical        :: pr
-   logical        :: r_logical !Determines wether r is overwritten or not
-   real(wp), parameter :: pi43 = 3.1415926540d0*4.0d0/3.0d0
-   real(wp), parameter :: pi = 3.1415926540d0
-   real(wp), parameter :: third = 1.0d0/3.0d0
-   real(wp), parameter :: bohr = 0.52917726d0
-
-   integer :: i
-   real*8 :: rad(zmol%nat), xyz_tmp(3, zmol%nat)
-   real(wp), allocatable :: rcov(:)
-
-   allocate (rcov(94))
-   rcov = (/ &
-       &  2.18230009, 1.73469996, 3.49559999, 3.09820008, 3.21600008, &
-       &  2.91030002, 2.62249994, 2.48169994, 2.29959989, 2.13739991, &
-       &  3.70819998, 3.48390007, 4.01060009, 3.79169989, 3.50169992, &
-       &  3.31069994, 3.10459995, 2.91479993, 4.24109983, 4.10349989, &
-       &  3.89030004, 3.76419997, 3.72110009, 3.44140005, 3.54620004, &
-       &  3.44210005, 3.43269992, 3.34619999, 3.30080009, 3.23090005, &
-       &  3.95790005, 3.86190009, 3.66249990, 3.52679992, 3.36619997, &
-       &  3.20959997, 4.61759996, 4.47639990, 4.21960020, 4.05970001, &
-       &  3.85960007, 3.75430012, 3.56900001, 3.46230006, 3.39750004, &
-       &  3.35249996, 3.33080006, 3.46199989, 4.26230001, 4.18739986, &
-       &  4.01499987, 3.89010000, 3.73799992, 3.58890009, 5.05670023, &
-       &  5.18139982, 4.62610006, 4.62010002, 4.57019997, 4.52710009, &
-       &  4.48960018, 4.45149994, 4.42339993, 4.12430000, 4.24270010, &
-       &  4.15409994, 4.27939987, 4.24499989, 4.22079992, 4.19859982, &
-       &  4.01300001, 4.24499989, 4.09800005, 3.98550010, 3.89549994, &
-       &  3.74900007, 3.44560003, 3.35249996, 3.25640011, 3.35990000, &
-       &  4.31269979, 4.27640009, 4.11749983, 4.00540018, 3.86439991, &
-       &  3.72160006, 5.07959986, 4.92939997, 4.70429993, 4.42519999, &
-       &  4.45940018, 4.39569998, 4.35389996, 4.43410015/)
-
-   do i = 1, zmol%nat
-      rad(i) = bohr*rcov(zmol%at(i))*1.40 ! scale factor adjusted to rough
-      xyz_tmp(1:3, i) = bohr*zmol%xyz(1:3, i)
-   end do
-
-   dum = zmol
-   dum%xyz = xyz_tmp
-
-   call get_volume(dum, rad)
-
-   zmol%atot = dum%atot/bohr**2
-   zmol%vtot = dum%vtot/bohr**3
-
-   if (r_logical) then
-      zmol%rtot = zmol%vtot*3.0/4.d0/pi
-      zmol%rtot = zmol%rtot**(1.d0/3.d0)
-   end if
-
-   if (pr) then
-      if (r_logical) then
-         write (*, '(2x,''molecular radius (Bohr**1):'',F8.2)') zmol%rtot
-      end if
-      write (*, '(2x,''molecular area   (Bohr**2):'',F8.2)') zmol%atot
-      write (*, '(2x,''molecular volume (Bohr**3):'',F8.2)') zmol%vtot
-   end if
-
-   deallocate (rcov)
-end subroutine get_sphere
-
-subroutine cma_shifting(solu, solv)
-   use iso_fortran_env, wp => real64
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-   use axis_module, only: cma
-   implicit none
-
-   type(zmolecule)    :: solu, solv
-
-   integer            :: i
-
-   call cma(solu%nat, solu%at, solu%xyz, solu%cma)
-   call cma(solv%nat, solv%at, solv%xyz, solv%cma)
-
-   do i = 1, solu%nat
-      solu%xyz(1:3, i) = solu%xyz(1:3, i) - solu%cma(1:3)
-   end do
-   do i = 1, solv%nat
-      solv%xyz(1:3, i) = solv%xyz(1:3, i) - solv%cma(1:3)
-   end do
-
-end subroutine cma_shifting
-
-subroutine get_ellipsoid(env, solu, solv, clus, pr1)
-   use iso_fortran_env, wp => real64
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-   use axis_module
-   implicit none
-
-   type(systemdata)   :: env
-   type(zmolecule)    :: solu, solv, clus
-   type(zmolecule)    :: dummy_solu, dummy_solv
-   real(wp)           :: rabc_solu(3), rabc_solv(3)
-   real(wp)           :: aniso, sola
-   real(wp)           :: rmax_solu, rmax_solv
-   real(wp)           :: boxr, roff, r
-   character(len=10) :: fname
-   logical            :: ex, pr, pr1
-
-   real(wp), parameter :: pi43 = 3.1415926540d0*4.0d0/3.0d0
-   real(wp), parameter :: pi = 3.1415926540d0
-   real(wp), parameter :: third = 1.0d0/3.0d0
-
-   pr = .false. !Outprint deactivated
-
-   fname = 'eaxis.qcg'
-   inquire (file=fname, exist=ex)
-
-   if (pr1) then !First time called
-!--- Moving all coords to the origin (transformation)
-      call axistrf(solu%nat, solu%nat, solu%at, solu%xyz)
-!  call axistrf(solv%nat,solv%nat,solv%at,solv%xyz)  !Not done in original QCG code
-      call axistrf(clus%nat, solu%nat, clus%at, clus%xyz)
-
-!--- Overwrite solute and solvent coord in original file with transformed and optimized ones
-      call wrc0('solute', solu%nat, solu%at, solu%xyz)
-      call wrc0('solvent', solv%nat, solv%at, solv%xyz)
-
-!--- Getting axis
-      write (*, *) 'Solute:'
-      call axis(pr1, solu%nat, solu%at, solu%xyz, solu%eax)
-      write (*, *) 'Solvent:'
-      call axis(pr1, solv%nat, solv%at, solv%xyz, solv%eax)
-      write (*, *)
-   end if
-
-!--- Computing anisotropy factor of solute and solvent
-   sola = sqrt(1.+(solu%eax(1) - solu%eax(3))/((solu%eax(1) + solu%eax(2) + solu%eax(3))/3.))
-   aniso = sqrt(1.+(solv%eax(1) - solv%eax(3))/((solv%eax(1) + solv%eax(2) + solv%eax(3))/3.)) ! =1 for a spherical system
-
-!--- Get maximum intramoleclar distance of solute and solvent
-   call getmaxrad(solu%nat, solu%at, solu%xyz, rmax_solu)
-   call getmaxrad(solv%nat, solv%at, solv%xyz, rmax_solv)
-
-!--- Getting V and A of dummies
-   dummy_solu = solu
-   dummy_solv = solv !Why is dummy_solv%vtot different to solv%vtot
-   call get_sphere(.false., dummy_solu, .false.)
-   call get_sphere(.false., dummy_solv, .false.)
-
-!--- Computation of outer Wall
-   roff = sola*dummy_solu%vtot/1000
-   boxr = ((0.5*aniso*clus%nmol*dummy_solv%vtot + dummy_solu%vtot)/pi43)**third + roff + rmax_solv*0.5 !0.5 both
-   r = (boxr**3/(solu%eax(1)*solu%eax(2)*solu%eax(3)))**third       ! volume of ellipsoid = volume of sphere
-   rabc_solv = solu%eax*r                              ! outer solvent wall
-
-!--- Computation of inner wall
-   roff = sola*dummy_solu%vtot/1000
-   boxr = ((sola*dummy_solu%vtot)/pi43)**third + roff + rmax_solu*0.1 !0.1 before
-   r = (boxr**3/(solu%eax(1)*solu%eax(2)*solu%eax(3)))**third       ! volume of ellipsoid = volume of sphere
-   rabc_solu = solu%eax*r
-   dummy_solu%ell_abc(1) = solu%eax(1)**2/sum((solu%eax(1:3))**2)
-   dummy_solu%ell_abc(2) = solu%eax(2)**2/sum((solu%eax(1:3))**2)
-   dummy_solu%ell_abc(3) = solu%eax(3)**2/sum((solu%eax(1:3))**2)
-   rabc_solu = dummy_solu%ell_abc*r
-
-   solu%aniso = sola
-   solv%aniso = aniso
-   solu%ell_abc = rabc_solu
-   clus%ell_abc = rabc_solv*env%potscal
-
-   if (pr1) then
-      write (*, '(2x,''solvent anisotropy            :'',4f10.3)') aniso
-      write (*, '(2x,''solute anisotropy             :'',4f10.3)') sola
-      write (*, '(2x,''roff inner wall               :'',4f10.3)') roff
-      write (*, '(2x,''solute max dist               :'',4f10.3)') rmax_solu
-      write (*, '(2x,''solvent max dist              :'',4f10.3)') rmax_solv
-      write (*, '(2x,''inner unit axis               :'',3f10.3)') dummy_solu%ell_abc(1:3)
-      write (*, '(2x,''inner ellipsoid/Bohr          :'',3f10.3)') rabc_solu(1:3)
-      write (*, '(2x,''scaling factor outer ellipsoid:'',3f10.3)') env%potscal
-      write (*, '(2x,''outer ellipsoid/Bohr          :'',3f10.3)') clus%ell_abc(1:3)
-      if (env%potscal .gt. 1.0_wp) write &
-           &(*, '(2x,''!!!WARNING: A SCALING FACTOR LARGER 1.0 IS ONLY FOR MICROSOLVATION RECOMMENDED'')')
-      write (*, *)
-   end if
-
-end subroutine get_ellipsoid
-
-subroutine getmaxrad(n, at, xyz, r)
-   use crest_parameters, only : wp
-   implicit none
-   real(wp) :: xyz(3, n), r
-   integer :: n, at(n)
-
-   real(wp) :: rx, ry, rz, rr
-   integer :: i, j
-   real(wp), allocatable :: rcov(:)
-
-   allocate (rcov(94))
-   rcov = (/ &
-    &  2.18230009, 1.73469996, 3.49559999, 3.09820008, 3.21600008, &
-    &  2.91030002, 2.62249994, 2.48169994, 2.29959989, 2.13739991, &
-    &  3.70819998, 3.48390007, 4.01060009, 3.79169989, 3.50169992, &
-    &  3.31069994, 3.10459995, 2.91479993, 4.24109983, 4.10349989, &
-    &  3.89030004, 3.76419997, 3.72110009, 3.44140005, 3.54620004, &
-    &  3.44210005, 3.43269992, 3.34619999, 3.30080009, 3.23090005, &
-    &  3.95790005, 3.86190009, 3.66249990, 3.52679992, 3.36619997, &
-    &  3.20959997, 4.61759996, 4.47639990, 4.21960020, 4.05970001, &
-    &  3.85960007, 3.75430012, 3.56900001, 3.46230006, 3.39750004, &
-    &  3.35249996, 3.33080006, 3.46199989, 4.26230001, 4.18739986, &
-    &  4.01499987, 3.89010000, 3.73799992, 3.58890009, 5.05670023, &
-    &  5.18139982, 4.62610006, 4.62010002, 4.57019997, 4.52710009, &
-    &  4.48960018, 4.45149994, 4.42339993, 4.12430000, 4.24270010, &
-    &  4.15409994, 4.27939987, 4.24499989, 4.22079992, 4.19859982, &
-    &  4.01300001, 4.24499989, 4.09800005, 3.98550010, 3.89549994, &
-    &  3.74900007, 3.44560003, 3.35249996, 3.25640011, 3.35990000, &
-    &  4.31269979, 4.27640009, 4.11749983, 4.00540018, 3.86439991, &
-    &  3.72160006, 5.07959986, 4.92939997, 4.70429993, 4.42519999, &
-    &  4.45940018, 4.39569998, 4.35389996, 4.43410015/)
-
-   r = 0
-   do i = 1, n - 1
-      do j = i + 1, n
-         rx = xyz(1, i) - xyz(1, j)
-         ry = xyz(2, i) - xyz(2, j)
-         rz = xyz(3, i) - xyz(3, j)
-         rr = sqrt(rx**2 + ry**2 + rz**2) + rcov(at(i)) + rcov(at(j))
-         if (rr .gt. r) r = rr
-      end do
-   end do
-
-   deallocate (rcov)
-
-end subroutine getmaxrad
-
-subroutine ellipsout(fname, n, at, xyz, r1)
-   use iso_fortran_env, only: wp => real64
-   use strucrd, only: i2e
-   implicit none
-
-   integer            :: i
-   integer            :: n, at(n)
-   real(wp)           :: xyz(3, n), r1(3)
-   real(wp)           :: x, y, z, f, rr
-   character(len=*)   :: fname
-   integer            :: ich11
-
-   open (newunit=ich11, file=fname)
-   write (ich11, '(a)') '$coord'
-   do i = 1, n
-      write (ich11, '(3F24.14,6x,a)') xyz(1, i), xyz(2, i), xyz(3, i), i2e(at(i))
-   end do
-   do i = 1, 500
-      call random_number(x)
-      call random_number(f)
-      if (f .gt. 0.5) x = -x
-      call random_number(y)
-      call random_number(f)
-      if (f .gt. 0.5) y = -y
-      call random_number(z)
-      call random_number(f)
-      if (f .gt. 0.5) z = -z
-      rr = sqrt(x*x + y*y + z*z)
-      x = x*r1(1)/rr
-      y = y*r1(2)/rr
-      z = z*r1(3)/rr
-      write (ich11, '(3F24.14,6x,a2)') x, y, z, 'he'
-   end do
-   write (ich11, '(a)') '$end'
-   close (ich11)
-
-end subroutine ellipsout
-
-subroutine both_ellipsout(fname, n, at, xyz, r1, r2)
-   use iso_fortran_env, only: wp => real64
-   use strucrd, only: i2e
-   implicit none
-
-   integer            :: i
-   integer            :: n, at(n)
-   real(wp)           :: xyz(3, n), r1(3)
-   real(wp), optional :: r2(3)
-   real(wp)           :: x, y, z, f, rr
-   character(len=*)   :: fname
-   integer            :: ich11
-
-   open (newunit=ich11, file=fname)
-   write (ich11, '(a)') '$coord'
-   do i = 1, n
-      write (ich11, '(3F24.14,6x,a)') xyz(1, i), xyz(2, i), xyz(3, i), i2e(at(i))
-   end do
-   do i = 1, 500
-      call random_number(x)
-      call random_number(f)
-      if (f .gt. 0.5) x = -x
-      call random_number(y)
-      call random_number(f)
-      if (f .gt. 0.5) y = -y
-      call random_number(z)
-      call random_number(f)
-      if (f .gt. 0.5) z = -z
-      rr = sqrt(x*x + y*y + z*z)
-      x = x*r1(1)/rr
-      y = y*r1(2)/rr
-      z = z*r1(3)/rr
-      write (ich11, '(3F24.14,6x,a2)') x, y, z, 'he'
-   end do
-   if (present(r2)) then
-      do i = 1, 100
-         call random_number(x)
-         call random_number(f)
-         if (f .gt. 0.5) x = -x
-         call random_number(y)
-         call random_number(f)
-         if (f .gt. 0.5) y = -y
-         call random_number(z)
-         call random_number(f)
-         if (f .gt. 0.5) z = -z
-         rr = sqrt(x*x + y*y + z*z)
-         x = x*r2(1)/rr
-         y = y*r2(2)/rr
-         z = z*r2(3)/rr
-         write (ich11, '(3F24.14,6x,a2)') x, y, z, 'b'
-      end do
-   end if
-   write (ich11, '(a)') '$end'
-   close (ich11)
-
-end subroutine both_ellipsout
-
-subroutine get_interaction_E(env, solu, solv, clus, iter, E_inter)
-   use iso_fortran_env, wp => real64
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-   implicit none
-
-   type(systemdata)            :: env
-   type(zmolecule), intent(in) :: solu, solv, clus
-   real(wp)                    :: e_cluster, e_solute, e_solvent
-   real(wp)                    :: E_inter(env%nsolv)           ! interaction energy
-   integer                     :: iter
-   logical                     :: e_there
-
-   call remove('cluster.coord')
-
-!--- Prepare input coordinate files
-   call wrc0('cluster.coord', clus%nat, clus%at, clus%xyz)
-   call wr_cluster_cut('cluster.coord', solu%nat, solv%nat, iter, 'solute_cut.coord', 'solvent_cut.coord')
-
-!--- Perform single point calculations and recieve energies
-   call xtb_sp_qcg(env, 'solute_cut.coord')
-   call grepval('xtb.out', '| TOTAL ENERGY', e_there, e_solute)
-   if (.not. e_there) write (*, *) 'Solute energy not found'
-   call xtb_sp_qcg(env, 'solvent_cut.coord')
-   call grepval('xtb.out', '| TOTAL ENERGY', e_there, e_solvent)
-   if (.not. e_there) write (*, *) 'Solvent energy not found'
-   call xtb_sp_qcg(env, 'cluster.coord')
-   call grepval('xtb.out', '| TOTAL ENERGY', e_there, e_cluster)
-   if (.not. e_there) write (*, *) 'Cluster energy not found'
-
-   E_inter(iter) = e_cluster - e_solute - e_solvent
-
-end subroutine get_interaction_E
-
-subroutine analyze_cluster(nsolv, n, nS, nM, xyz, at, av, last)
-   use iso_fortran_env, only: wp => real64
-   use axis_module, only: cma
-   implicit none
-   real(wp) xyz(3, n)
-   real(wp) av, last
-   integer n, nS, nM, nsolv, at(n)
-   real(wp) xyzM(3, nM)
-   integer atm(nM)
-   real(wp) xyzS(3, nS)
-   integer atS(nS)
-   real(wp) x1(3), x2(3), r
-   integer i, is, ie
-
-   if (nsolv .eq. 1) return
-   xyzS(1:3, 1:nS) = xyz(1:3, 1:nS)
-   atS(1:nS) = at(1:nS)
-   call cma(nS, atS, xyzS, x1)
-
-   av = 0
-   do i = 1, nsolv
-      is = nS + (i - 1)*nM + 1
-      ie = is + nM - 1
-      xyzM(1:3, 1:nM) = xyz(1:3, is:ie)
-      atM(1:nM) = at(is:ie)
-      call cma(nM, atM, xyzM, x2)
-      r = sqrt((x1(1) - x2(1))**2 + (x1(2) - x2(2))**2 + (x1(3) - x2(3))**2)
-      if (i .lt. nsolv) then
-         av = av + r
-      else
-         last = r
-      end if
-   end do
-   av = av/float(nsolv - 1)
-end subroutine analyze_cluster
-
-subroutine aver(pr, env, runs, e_tot, S, H, G, sasa, a_present, a_tot)
-   use iso_fortran_env, only: wp => real64
-   use crest_data
-
-   implicit none
-!---- Dummy
-   type(systemdata), intent(in)     :: env
-   integer, intent(in)             :: runs
-   real(wp), intent(inout)         :: e_tot
-   real(wp), intent(in), optional  :: a_tot
-   real(wp), intent(out)           :: S
-   real(wp), intent(out)           :: H
-   real(wp), intent(out)           :: G
-   real(wp), intent(out)           :: sasa
-!---- Stack
-   logical, intent(in)             :: pr, a_present
-   integer                         :: j, jmin
-   real(wp)                        :: A
-   real(wp)                        :: e0
-   real(wp), allocatable           :: de(:)
-   real(wp), allocatable           :: p(:)
-   real(wp)                        :: pmax
-   real(wp)                        :: eav
-   real(wp)                        :: area
-   real(wp)                        :: beta
-   real(wp)                        :: temp
-   integer                         :: ich48
-   real(wp), parameter              :: eh = 627.509541d0
-   dimension e_tot(runs)
-   dimension a_tot(runs)
-
-   temp = env%tboltz
-   allocate (de(runs), source=0.0d0)
-   allocate (p(runs), source=0.0d0)
-
-   beta = 1./(temp*8.314510/4.184/1000.+1.d-14)
-   e0 = e_tot(1)
-   de(1:runs) = (e_tot(1:runs) - e0)
-   call qcg_boltz(env, runs, de, p)
-
-   A = 0
-   eav = 0
-   pmax = 0
-   area = 0
-   do j = 1, runs
-      A = A + p(j)*log(p(j) + 1.d-12)
-      eav = eav + p(j)*e_tot(j)
-      if (p(j) .gt. pmax) then
-         pmax = p(j)
-         jmin = j
-      end if
-      if (a_present) area = area + p(j)*a_tot(j)
-   end do
-   sasa = area
-   S = (1./beta)*A
-   H = eav
-   G = eav + S
-   if (pr) then
-      open (newunit=ich48, file='population.dat')
-      write (ich48, '(2x, ''cluster'',2x,''E_norm [Eh]'',2x, ''De [kcal]'', 4x, ''p'')')
-      do j = 1, runs
-         if (j .lt. 10) then
-            write (ich48, '(5x,i0,3x,f11.6,5x,f6.4,3x,f6.4)') j, e_tot(j)/eh, de(j), p(j)
-         else
-            write (ich48, '(5x,i0,2x,f11.6,5x,f6.4,3x,f6.4)') j, e_tot(j)/eh, de(j), p(j)
-         end if
-      end do
-      write (ich48, *)
-      write (ich48, '(''Ensemble free energy [Eh]:'', f20.10)') G/eh
-      close (ich48)
-   end if
-
-   deallocate (de, p)
-
-end subroutine aver
-
-subroutine qcg_boltz(env, n, e, p)
-   use iso_fortran_env, only: wp => real64
-   use crest_data
-   implicit none
-   type(systemdata), intent(in)    :: env
-   integer, intent(in)              :: n
-   real(wp), intent(in)             :: e(*)
-   real(wp), intent(out)            :: p(*)
-   integer                         :: i
-   real(wp)                        :: temp
-   real(wp)                        :: f, hsum, esum
-
-   temp = env%tboltz
-   f = 8.314*temp/4.184d+3
-   esum = 0
-   do i = 1, n
-      esum = esum + exp(-e(i)/f)
-   end do
-   hsum = 0
-   do i = 1, n
-      p(i) = exp(-e(i)/f)/esum
-   end do
-end subroutine qcg_boltz
-
-subroutine fill_take(env, n2, n12, rabc, ipos)
-   use iso_fortran_env, only: wp => real64
-   use crest_data
-   use strucrd
-   use axis_module, only: cma
-   implicit none
-
-   type(systemdata)      :: env
-   integer, intent(in)   :: n2, n12
-   real(wp), intent(in)   :: rabc(3)
-   integer, intent(out)  :: ipos
-   integer               :: i, m, n21
-   integer               :: at2(n2), at12(n12)
-   integer               :: counter
-   real(wp)              :: xyz2(3, n2), xyz12(3, n12)
-   real(wp)              :: etmp(100)
-   real(wp)              :: eabc
-   real(wp)              :: cma2(3)
-   real(wp), allocatable  :: dist(:)
-
-   eabc = 0
-   counter = 0
-   n21 = n12 - n2 + 1
-   if (env%use_xtbiff) then
-      call rdxtbiffE('xtbscreen.xyz', m, n12, etmp)
-   else
-      call rdxtbiffE('best.xyz', m, n12, etmp)
-   end if
-
-   allocate (dist(m), source=0.0d0)
-   dist = 0.0d0
-
-   do i = 1, m
-      if (env%use_xtbiff) then
-         call rdxmolselec('xtbscreen.xyz', i, n12, at12, xyz12)
-      else
-         call rdxmolselec('final_structures.xyz', i, n12, at12, xyz12)
-      end if
-
-      at2(1:n2) = at12(n21:n12)
-      xyz2(1:3, 1:n2) = xyz12(1:3, n21:n12)
-      call cma(n2, at2, xyz2, cma2)
-      call calc_dist(cma2, rabc, dist(i), eabc)
-      if (eabc .gt. 1.0d0) then
-         dist(i) = 1.0d42
-         counter = counter + 1
-      end if
-   end do
-
-   ipos = minloc(dist(1:m), dim=1)
-
-   if (counter .eq. m) ipos = 0
-
-   deallocate (dist)
-end subroutine fill_take
-
-subroutine calc_dist(xyz, rabc, dist, eabc)
-   use iso_fortran_env, only: wp => real64
-   implicit none
-
-   real(wp), intent(in)    :: xyz(3)
-   real(wp), intent(in)    :: rabc(3)
-   real(wp), intent(out)   :: dist
-   real(wp), intent(out)   :: eabc
-   real(wp)                :: center(3), rc(3)
-
-   center = 0.d0
-   rc = (xyz(1:3) - center)
-   dist = norm2(rc)
-   eabc = sum((xyz(1:3)**2)/(rabc(1:3)**2))
-end subroutine calc_dist
-
-subroutine sort_min(i, j, col, A)
-   use iso_fortran_env, only: wp => real64
-   implicit none
-   integer, intent(in)   :: i, j, col
-   real*8, intent(inout) :: A(i, j)
-   real*8                :: buf(j)
-   integer               :: nsize, irow, krow
-! dimension A(i,j)
-   nsize = i
-
-   do irow = 1, nsize
-      krow = minloc(A(irow:nsize, col), dim=1) + irow - 1
-      buf(:) = A(irow, :)
-      A(irow, :) = A(krow, :)
-      A(krow, :) = buf(:)
-   end do
-end subroutine sort_min
-
-subroutine sort_ensemble(ens, e_ens, fname)
-   use iso_fortran_env, only: wp => real64
-   use crest_data
-   use strucrd
-   implicit none
-   type(ensemble)       :: ens
-   real(wp)             :: e_ens(ens%nall), dum(ens%nall)
-   character(len=*)     :: fname
-   integer              :: ich
-   integer              :: i, e_min
-
-   dum = e_ens
-
-   open (newunit=ich, file=fname)
-
-   do i = 1, ens%nall
-      e_min = minloc(dum, dim=1)
-      call wrxyz(ich, ens%nat, ens%at, ens%xyz(:, :, e_min), e_ens(e_min))
-      dum(e_min) = 0.0d0
-   end do
-   close (ich)
-
-end subroutine sort_ensemble
-
-subroutine rdtherm(fname, ht, svib, srot, stra, gt)
-   use iso_fortran_env, only: wp => real64
-   use crest_data
-   use iomod
-
-   implicit none
-! Dummy
-   real(wp), intent(out)  :: ht
-   real(wp), intent(out)  :: gt
-   real(wp), intent(out)  :: svib
-   real(wp), intent(out)  :: srot
-   real(wp), intent(out)  :: stra
-! Stack
-   integer                :: nn
-   integer                :: io
-   integer                :: counter
-   integer                :: hg_line
-   real(wp)               :: xx(20)
-   logical                :: ende
-   character(len=*)       :: fname
-   character(len=128)     :: a
-   real(wp), parameter     :: eh = 627.509541d0
-   integer                :: ich
-
-   ende = .false.
-   counter = 0
-   hg_line = 0
-
-   open (newunit=ich, file=fname)
-   do while (.not. ende)
-      read (ich, '(a)', iostat=io) a
-      if (io .lt. 0) then
-         ende = .true.
-         cycle
-      end if
-      if (index(a, 'G(T)/Eh ') .ne. 0) then
-         hg_line = counter
-      end if
-      if (index(a, '  VIB  ') .ne. 0) then
-         call readl(a, xx, nn)
-         svib = xx(5)
-         if (svib .eq. 0.0d0) then
-            call readl(a, xx, nn)
-            svib = xx(4)
-         end if
-      end if
-      if (index(a, '  ROT  ') .ne. 0) then
-         call readl(a, xx, nn)
-         srot = xx(4)
-      end if
-      if (index(a, '  TR   ') .ne. 0) then
-         call readl(a, xx, nn)
-         stra = xx(4)
-      end if
-      if (counter .eq. hg_line + 2) then
-         call readl(a, xx, nn)
-         ht = xx(3)*eh
-         gt = xx(5)*eh
-      end if
-      counter = counter + 1
-   end do
-   close (ich)
-end subroutine rdtherm
-
-subroutine pr_freq_file(ich)
-   implicit none
-   integer :: ich
-   write (ich, '(2x,"#       H(T)       SVIB      SROT       STRA      G(T)")')
-   write (ich, '(2x,"     [kcal/mol]    [      cal/mol/K        ]    [kcal/mol]")')
-   write (ich, '(2x,"--------------------------------------------------------")')
-end subroutine pr_freq_file
-
-subroutine qcg_restart(env, progress, solu, solv, clus, solu_ens, solv_ens, clus_backup)
-   use iso_fortran_env, wp => real64
-   use crest_data
-   use iomod
-   use zdata
-   use strucrd
-
-   implicit none
-
-   type(systemdata)           :: env
-   type(zmolecule)            :: solu, solv, clus, clus_backup
-   type(ensemble)             :: solu_ens, solv_ens
-   integer                    :: progress
-
-   integer                    :: i
-   character(len=512)         :: thispath
-   character(len=6)           :: counter
-   character(len=7)           :: counter2
-   character(len=8)           :: counter3
-   logical                    :: grow, solu_ensemble, solv_ensemble
-   logical                    :: solv_cff, solv_present, freq, tmp, ex
-   real(wp), allocatable       :: xyz(:, :)
-   real(wp), parameter         :: eh = 627.509541d0
-
-   grow = .false.
-   solu_ensemble = .false.
-   solv_ensemble = .false.
-   solv_cff = .false.
-   solv_present = .false.
-   freq = .false.
-   tmp = .false.
-
-   inquire (file='./grow/cluster.coord', exist=grow)
-   inquire (file='./ensemble/final_ensemble.xyz', exist=solu_ensemble)
-   inquire (file='./solvent_ensemble/final_ensemble.xyz', exist=solv_ensemble)
-   inquire (file='./solvent_ensemble/crest_ensemble.xyz', exist=solv_cff)
-   inquire (file='./frequencies/result.dat', exist=freq)
-
-   if (solv_cff .or. solv_ensemble) solv_present = .true.
-
-   call getcwd(thispath)
-
-!---------------------------------------------------------------------------------
-!        Check, if everything needed is present
-!---------------------------------------------------------------------------------
-
-   if (freq .and. ((.not. grow) .or. (.not. solu_ensemble) .or. (.not. solv_ensemble))) then
-      progress = 0
-      call rmrf('frequencies')
-      freq = .false.
-   end if
-
-   if (solv_present .and. ((.not. grow) .or. (.not. solu_ensemble))) then
-      progress = 0
-      call rmrf('solvent_ensemble')
-      solv_present = .false.
-      solv_cff = .false.
-      solv_ensemble = .false.
-   end if
-
-   if (solu_ensemble .and. (.not. grow)) then
-      progress = 0
-      call rmrf('ensemble')
-      solu_ensemble = .false.
-   end if
-
-!-------------------------------------------------------------
-!           Data read out
-!-------------------------------------------------------------
-
-!--- Grow process
-   if (grow) then
-      env%qcg_restart = .true.
-      call chdir('grow')
-      call rdnat('cluster.coord', clus%nat)
-      allocate (clus%at(clus%nat), clus%xyz(3, clus%nat))
-      call rdcoord('cluster.coord', clus%nat, clus%at, clus%xyz)
-      clus%nmol = (clus%nat - solu%nat)/solv%nat + 1
-      allocate (xyz(3, clus%nat))
-      xyz = clus%xyz
-      call get_ellipsoid(env, solu, solv, clus, .true.)
-      clus%xyz = xyz !Needed, because get_ellipsoid performs axistransformation and not fitting potential
-      deallocate (xyz)
-
-      if (.not. env%cff) then
-         allocate (clus_backup%at(clus%nat))
-         allocate (clus_backup%xyz(3, clus%nat))
-         clus_backup = clus
-      end if
-
-      if (clus%nmol - 1 .ge. env%nsolv) then
-         progress = 1
-         env%nsolv = clus%nmol - 1
-         write (*, *)
-         write (*, *)
-         write (*, '(''Found cluster with '',i0,'' solvents'')') env%nsolv
-         call chdir(thispath)
-      else
-         error stop 'The found cluster is smaller than nsolv. Please restart the whole computaion by removing the grow directory'
-         !Future implementation continue grow process
-         call chdir(thispath)
-         if (solu_ensemble) call rmrf('ensemble')
-         if (solv_ensemble) call rmrf('solvent_ensemble')
-         if (freq) call rmrf('frequencies')
-         solu_ensemble = .false.
-         solv_ensemble = .false.
-         freq = .false.
-         progress = 0
-      end if
-   end if
-
-!--- Solute Ensemble
-   if (solu_ensemble) then
-      call chdir('ensemble')
-      call solu_ens%open('final_ensemble.xyz')
-      call rdensemble('final_ensemble.xyz', solu_ens%nat, solu_ens%nall, solu_ens%at, solu_ens%xyz, solu_ens%er)
-      env%nqcgclust = solu_ens%nall
-      write (*, '("  Ensemble of solute-cluster found.")')
-      write (*, '("  Taking all ", i0, " structures")') env%nqcgclust
-      call grepval('population.dat', 'Ensemble free energy [Eh]:', ex, solu_ens%G)
-      solu_ens%G = solu_ens%G*eh
-      write (*, *) 'Solute Ensmeble Free E [kcal/mol]', solu_ens%G
-      call chdir(thispath)
-      progress = 2
-   end if
-
-!--- Solvent Ensemble
-   if (solv_present) then
-      call chdir('solvent_ensemble')
-      write (*, '("  Ensemble of solvent-cluster found.")')
-
-      !--- Case CFF
-      if (solv_cff) then
-         call solv_ens%open('crest_ensemble.xyz')
-         do i = 1, solv_ens%nall
-            if (i .le. 9) then
-               write (counter, '(''No   '',i1)') i
-               call grepval('cluster_energy.dat', counter, ex, solv_ens%er(i))
-            else if (i .le. 99) then
-               write (counter2, '(''No   '',i2)') i
-               call grepval('cluster_energy.dat', counter2, ex, solv_ens%er(i))
-            else
-               write (counter3, '(''No   '',i3)') i
-               call grepval('cluster_energy.dat', counter3, ex, solv_ens%er(i))
-            end if
-            write (*, *) 'Energy of cluster', i, solv_ens%er(i)
-         end do
-      end if
-
-      !--- Case MD/Crest run
-      if (solv_ensemble) then
-         call solv_ens%open('final_ensemble.xyz')
-         call rdensemble('final_ensemble.xyz', solv_ens%nat, solv_ens%nall, solv_ens%at, solv_ens%xyz, solv_ens%er)
-      end if
-      call grepval('population.dat', 'Ensemble free energy [Eh]:', ex, solv_ens%G)
-      solv_ens%G = solv_ens%G*eh
-      write (*, *) 'solvent ensmeble free E [kcal/mol]', solv_ens%G
-      call chdir(thispath)
-      progress = 3
-   end if
-
-!--- Frequencies
-   if (freq) then
-      write (*, *)
-      write (*, *)
-      write (*, *) '  Nothing to do'
-      progress = 4
-   end if
-
-end subroutine qcg_restart
-
-subroutine qcg_cleanup(env)
-   use crest_data
-
-   implicit none
-
-   type(systemdata)      :: env
-   character(len=280)    :: thispath
-   logical               :: tmp
-
-   call getcwd(thispath)
-   call chdir(env%scratchdir)
-   inquire (file='./solute_properties/solute', exist=tmp)
-   if (tmp) then
-      call rmrf('solute_properties')
-      call rmrf('solvent_properties')
-   end if
-
-end subroutine qcg_cleanup
-
-subroutine write_reference(env, solu, clus)
-   use iso_fortran_env, wp => real64
-   use crest_data
-   use zdata, only: zmolecule
-   use iomod
-   use strucrd
-
-   implicit none
-   type(systemdata):: env    ! MAIN STORAGE OS SYSTEM DATA
-   type(zmolecule)            :: solu, clus
-   type(zmolecule)            :: ref_mol, ref_clus
-
-   ref_mol = solu
-   call rdcoord(env%solu_file, ref_mol%nat, ref_mol%at, ref_mol%xyz) !original solute coordinates
-   call remove(env%fixfile)
-   ref_clus = clus
-   ref_clus%xyz(1:3, 1:solu%nat) = solu%xyz
-   call wrc0(env%fixfile, ref_clus%nat, ref_clus%at, ref_clus%xyz)
-
-end subroutine write_reference
-
-
-!========================================================================================!
-!> Convert given QCG coordinate files into (TM format)
-!> Write "solute" and "solvent" coordinate files
-!========================================================================================!
-subroutine inputcoords_qcg(env, solute, solvent)
-  use iso_fortran_env,only:wp => real64
-  use crest_data
-  use strucrd
-  use zdata
-  use iomod
-  implicit none
-
-  type(systemdata), intent(inout) :: env
-  type(zmolecule), intent(out) :: solute, solvent
-
-  logical :: ex11,ex21,solu,solv
-  type(coord) :: mol
-  type(zmolecule) :: zmol,zmol1
-  integer :: i
-
-!--------------------Checking for input-------------!
-
-  !Solute
-  inquire (file=env%solu_file,exist=ex11)
-  inquire (file='solute',exist=solu)
-  if (solu) call copy('solute','solute.old') !Backup solute file
-  if ((.not. ex11) .and. (.not. solu)) then
-    error stop 'No (valid) solute file! exit.'
-  else if ((.not. ex11) .and. (solu)) then
-    env%solu_file = 'solute'
-  end if
-
-  !Solvent
-  inquire (file=env%solv_file,exist=ex21)
-  inquire (file='solvent',exist=solv)
-  if (solu) call copy('solvent','solvent.old') !Backup solvent file
-  if ((.not. ex21) .and. (.not. solv)) then
-    error stop 'No (valid) solvent file! exit.'
-  else if ((.not. ex11) .and. (solu)) then
-    env%solu_file = 'solvent'
-  end if
-
-!---------------Handling solute---------------------!
-  call mol%open(env%solu_file)
-  call mol%write('solute')
-  solute%nat = mol%nat
-  solute%at = mol%at
-  solute%xyz = mol%xyz
-  call mol%deallocate()
-
-  !--- if the input was a SDF file, special handling
-  env%sdfformat = .false.
-  call checkcoordtype(env%solu_file,i)
-  if (i == 31.or.i == 32) then
-    !Add sdf stuff here, if somebody needs it
-  end if
-
-!---------------Handling solvent---------------------!
-
-  call mol%open(env%solv_file)
-  call mol%write('solvent')
-  solvent%nat = mol%nat
-  solvent%at = mol%at
-  solvent%xyz = mol%xyz
-  call mol%deallocate()
-
-  !--- if the input was a SDF file, special handling
-  env%sdfformat = .false.
-  call checkcoordtype(env%solv_file,i)
-  if (i == 31.or.i == 32) then
-    !Add sdf stuff here, if somebody needs it
-  end if
-
-  return
-end subroutine inputcoords_qcg
diff --git a/src/qcg/solvtool_misc.f90 b/src/qcg/solvtool_misc.f90
deleted file mode 100644
index 3ff1ca92..00000000
--- a/src/qcg/solvtool_misc.f90
+++ /dev/null
@@ -1,1063 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2021 Christoph Plett, Sebastian Spicher, Philipp Pracht
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!================================================================================!
-
-!--------------------------------------------------------------------------------------------
-! A quick single point xtb calculation without wbo
-!--------------------------------------------------------------------------------------------
-subroutine xtb_sp_qcg(env, fname)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   implicit none
-   character(len=*) :: fname
-   type(systemdata) :: env
-   character(len=512) :: jobcall
-   character(*), parameter :: pipe = ' > xtb.out 2> /dev/null'
-   integer :: io,T,Tn
-   call remove('gfnff_topo')
-   call remove('energy')
-   call remove('charges')
-   call remove('xtbrestart')
-
-!---- setting threads
-   call new_ompautoset(env,'auto',1,T,Tn)
-
-!---- jobcall
-   write (jobcall, '(a,1x,a,1x,a,'' --sp '',a,1x,a)') &
-   &     trim(env%ProgName), trim(fname), trim(env%gfnver), trim(env%solv), trim(pipe)
-
-   call command(trim(jobcall), io)
-!---- cleanup
-   call remove('energy')
-   call remove('charges')
-   call remove('xtbrestart')
-   call remove('xtbtopo.mol')
-   call remove('gfnff_topo')
-end subroutine xtb_sp_qcg
-
-!--------------------------------------------------------------------------------------------
-! A quick single xtb optimization gets zmol and overwrites it with optimized stuff
-!--------------------------------------------------------------------------------------------
-subroutine xtb_opt_qcg(env, zmol, constrain)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   use zdata
-   use strucrd
-
-   implicit none
-   type(systemdata), intent(in) :: env
-   type(zmolecule), intent(inout) :: zmol
-
-   character(:), allocatable :: fname
-   character(len=512) :: jobcall
-   logical :: constrain
-   logical :: const
-   character(*), parameter :: pipe = ' > xtb_opt.out 2> /dev/null'
-   integer :: io,T,Tn
-
-!--- Write coordinated
-   fname = 'coord'
-   call wrc0(fname, zmol%nat, zmol%at, zmol%xyz) !write coord for xtbopt routine
-
-!---- setting threads
-   call new_ompautoset(env,'auto',1,T,Tn)
-
-!---- jobcall & Handling constraints
-   if(constrain .AND. env%cts%used) then
-     call write_constraint(env, fname, 'xcontrol')
-     call wrc0('coord.ref', zmol%nat, zmol%at, zmol%xyz) !write coord for xtbopt routine
-     write (jobcall, '(a,1x,a,1x,a,'' --opt --input xcontrol '',a,1x,a)') &
-     &     trim(env%ProgName), trim(fname), trim(env%gfnver), trim(env%solv), trim(pipe)
-   else
-     write (jobcall, '(a,1x,a,1x,a,'' --opt '',a,1x,a)') &
-     &     trim(env%ProgName), trim(fname), trim(env%gfnver), trim(env%solv), trim(pipe)
-   end if
-
-   call command(trim(jobcall), io)
-!---- cleanup
-   call rdcoord('xtbopt.coord', zmol%nat, zmol%at, zmol%xyz)
-   call remove('energy')
-   call remove('charges')
-   call remove('xtbrestart')
-   call remove('xtbtopo.mol')
-   call remove('gfnff_topo')
-end subroutine xtb_opt_qcg
-
-!___________________________________________________________________________________
-!
-! An xTB single point calculation and lmo generation on all available threads
-!___________________________________________________________________________________
-
-subroutine xtb_lmo(env, fname)!,chrg)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   use zdata
-   implicit none
-   type(systemdata) :: env
-   character(len=*), intent(in)     :: fname
-   character(len=80)               :: pipe
-   character(len=512)              :: jobcall
-   integer :: T,Tn,io
-
-   pipe = ' > xtb.out 2>/dev/null'
-
-!---- setting threads
-   call new_ompautoset(env,'auto',1,T,Tn)
-
-!---- jobcall, special gbsa treatment not needed, as the entire flag is included in env%solv
-   write (jobcall, '(a,1x,a,1x,a,'' --sp --lmo '',a)') &
-   &     trim(env%ProgName), trim(fname), trim(env%lmover), trim(pipe)
-   call command(trim(jobcall), exitstat=io)
-   
-   if(io /= 0)then
-     write(*,*) 'error in xtb_lmo'
-     stop
-   endif
-
-!--- cleanup
-   call remove('wbo')
-   call remove('charges')
-   call remove('xtbrestart')
-   call remove('xtbscreen.xyz')
-   call remove('lmocent.coord')
-   call remove('coordprot.0')
-end subroutine xtb_lmo
-
-!___________________________________________________________________________________
-!
-! An xTB-IFF calculation on all available threads
-!___________________________________________________________________________________
-
-subroutine xtb_iff(env, file_lmo1, file_lmo2, solu, clus)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   use zdata
-
-   implicit none
-
-   type(systemdata)                :: env
-   type(zmolecule), intent(in)     :: solu, clus
-   character(len=80)               :: pipe
-   character(len=512)              :: jobcall
-   character(len=*)                :: file_lmo1, file_lmo2
-   integer :: T,Tn
-
-!--- Option setting
-   pipe = ' > iff.out 2>/dev/null'
-
-!--- Setting threads
-   call new_ompautoset(env,'auto',1,T,Tn)
-
-!--- Jobcall
-   if (env%sameRandomNumber) then
-      write (jobcall, '(a,1x,a,1x,a,'' -nfrag1 '',i3,'' -ellips '',3f9.3,'' -qcg -test '',a)') &
-      &     trim(env%ProgIFF), trim(file_lmo1), trim(file_lmo2), solu%nat, clus%ell_abc, trim(pipe)
-   else
-      write (jobcall, '(a,1x,a,1x,a,'' -nfrag1 '',i3,'' -ellips '',3f9.3,'' -qcg '',a)') &
-      &     trim(env%ProgIFF), trim(file_lmo1), trim(file_lmo2), solu%nat, clus%ell_abc, trim(pipe)
-!            &     trim(env%ProgIFF),trim(solvent_file),trim(solute_file),solu%nat,clus%ell_abc,trim(pipe)
-   end if
-   call command(trim(jobcall))
-
-!--- Cleanup
-   call remove('xtbiff_bestsofar.xyz')
-   call remove('xtbiff_genstart.xyz')
-   call remove('xtbrestart')
-
-end subroutine xtb_iff
-
-!___________________________________________________________________________________
-!
-! An xTB docking on all available threads
-!___________________________________________________________________________________
-
-subroutine xtb_dock(env, fnameA, fnameB, solu, clus)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   use zdata
-
-   implicit none
-
-   type(systemdata)                :: env
-   type(zmolecule), intent(in)     :: solu, clus
-   character(len=*), intent(in)    :: fnameA, fnameB
-   character(len=80)               :: pipe
-   character(len=512)              :: jobcall
-   integer                         :: i, ich, T, Tn
-
-   call remove('xtb_dock.out')
-   call remove('xcontrol')
-
-   pipe = ' 2>/dev/null'
-
-!---- writing wall pot in xcontrol
-   call write_wall(env, solu%nat, solu%ell_abc, clus%ell_abc, 'xcontrol')
-
-!---- Write directed stuff, if requested
-   if (allocated(env%directed_file)) then
-      do i=1, size(env%directed_number)
-         if &
-         & ((i==1 .and. env%directed_number(i) >= clus%nmol) .OR. &
-         & (env%directed_number(i) >= clus%nmol .and. env%directed_number(i-1) < clus%nmol)) &
-         & then
-            open(newunit=ich, file='xcontrol', status='old', position='append', action='write')
-                 write(ich,'("$directed")')
-                 write(ich,'(a,1x,a)') 'atoms:', trim(env%directed_list(i,1))
-                 write(ich,'("$end")')
-         end if
-      end do
-   end if
-
-!--- Setting threads
-   call new_ompautoset(env,'auto',1,T,Tn)
-
-!--- Jobcall docking
-   write (jobcall, '(a,1x,''dock'',1x,a,1x,a,1x,a,1x,f4.2,1x,''--nfrag1'',1x,i0,1x,a,1x, &
-           & ''--input xcontrol > xtb_dock.out'',a)') &
-           &     trim(env%ProgName), trim(fnameA), trim(fnameB), trim(env%gfnver),&
-           &     env%optlev, solu%nat, trim(env%docking_qcg_flag), trim(pipe)
-   call command(trim(jobcall))
-
-! cleanup
-   call remove('wbo')
-   call remove('charges')
-   call remove('xtbrestart')
-
-end subroutine xtb_dock
-
-!___________________________________________________________________________________
-!
-! An xTB optimization on all available threads
-!___________________________________________________________________________________
-
-subroutine opt_cluster(env, solu, clus, fname, without_pot)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   use zdata
-
-   implicit none
-
-   type(systemdata)                :: env
-   type(zmolecule), intent(in)     :: solu, clus
-   character(len=*), intent(in)     :: fname
-   logical, optional, intent(in)   :: without_pot
-   character(len=80)               :: pipe
-   character(len=:),allocatable    :: jobcall
-   integer :: T,Tn
-
-   if (env%niceprint) then
-      call printprogbar(0.0_wp)
-   end if
-
-   call remove('xtb.out')
-   pipe = ' 2>/dev/null'
-
-!---- writing wall pot in xcontrol
-   if (.not. without_pot) then
-      call write_wall(env, solu%nat, solu%ell_abc, clus%ell_abc, 'xcontrol')
-   end if
-
-!--- Setting threads
-   call new_ompautoset(env,'subprocess',1,T,Tn)
-
-!--- Jobcall optimization
-   jobcall = trim(env%ProgName)//' '//trim(fname)//' --opt '//optlevflag(env%optlev) 
-   jobcall = trim(jobcall)//' '//trim(env%gfnver)
-   if(without_pot)then
-     jobcall = trim(jobcall)//' '//trim(env%solv)
-   endif
-   jobcall = trim(jobcall)//' > xtb_opt.out 2>/dev/null' 
-   call command(trim(jobcall))
-
-! cleanup
-   call remove('wbo')
-   call remove('charges')
-   call remove('xtbrestart')
-
-!--- Jobcall SP for gbsa model
-   if (.not. without_pot) then
-      jobcall =  trim(env%ProgName)//' xtbopt.coord --sp '//trim(env%gfnver)
-      jobcall = trim(jobcall)//' '//trim(env%solv)
-      jobcall = trim(jobcall)//' > xtb_sp.out 2>/dev/null' 
-   end if
-   call command(trim(jobcall))
-
-! cleanup
-   call remove('wbo')
-   call remove('charges')
-   call remove('xtbrestart')
-
-end subroutine opt_cluster
-
-!___________________________________________________________________________________
-!
-! xTB LMO calculation performed in parallel
-!___________________________________________________________________________________
-
-subroutine ensemble_lmo(env, fname, self, NTMP, TMPdir, conv)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   use zdata
-
-   implicit none
-   type(systemdata)                :: env
-   type(zmolecule), intent(in)     :: self
-   character(len=*), intent(in)    :: fname      !file base name
-   character(len=*), intent(in)    :: TMPdir     !directory name
-   integer, intent(in)             :: NTMP       !number of structures to be optimized
-   integer, intent(in)             :: conv(env%nqcgclust + 1)
-   integer                         :: i, k,T, Tn
-   integer                         :: vz
-   character(len=20)               :: pipe
-   character(len=512)              :: thispath, tmppath
-   character(len=1024)             :: jobcall
-   real(wp)                        :: percent
-
-! setting the threads for correct parallelization
-   call new_ompautoset(env,'auto',NTMP,T,Tn)
-
-   pipe = '2>/dev/null'
-
-   !create the system call (it is the same for every optimization)
-
-   write (jobcall, '(a,1x,a,1x,a,'' --sp --lmo --chrg '',f4.1,1x,a,'' >xtb_lmo.out'')') &
-   &     trim(env%ProgName), trim(fname), trim(env%lmover), self%chrg, trim(pipe)
-   k = 0 !counting the finished jobs
-!___________________________________________________________________________________
-
-!$omp parallel &
-!$omp shared( vz,jobcall,NTMP,percent,k,TMPdir,conv )
-!$omp single
-   do i = 1, NTMP
-      vz = i
-      !$omp task firstprivate( vz ) private( tmppath )
-      write (tmppath, '(a,i0)') trim(TMPdir), conv(vz)
-      call command('cd '//trim(tmppath)//' && '//trim(jobcall))
-      !$omp critical
-      k = k + 1
-      percent = float(k)/float(NTMP)*100
-      !$omp end critical
-      !$omp end task
-   end do
-!$omp taskwait
-!$omp end single
-!$omp end parallel
-
-!___________________________________________________________________________________
-
-   call getcwd(thispath)
-   do i = 1, NTMP
-      write (tmppath, '(a,i0)') trim(TMPdir), i
-      call chdir(trim(tmppath))
-      call remove('xtbrestart')
-      call chdir(trim(thispath))
-   end do
-
-end subroutine ensemble_lmo
-
-!___________________________________________________________________________________
-!
-! xTB-IFF calculation performed in parallel
-!___________________________________________________________________________________
-
-subroutine ensemble_iff(env, outer_ell_abc, nfrag1, frag1_file, frag2_file, NTMP, TMPdir, conv)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   use zdata
-
-   implicit none
-   type(systemdata)                :: env
-
-   character(len=*), intent(in)    :: TMPdir     !directory name
-   integer, intent(in)             :: NTMP       !number of structures to be optimized
-   integer, intent(in)             :: nfrag1     !#atoms of larger fragment
-   integer, intent(in)             :: conv(env%nqcgclust + 1)
-   real(wp), intent(in)            :: outer_ell_abc(env%nqcgclust, 3)
-
-   integer                         :: i, k
-   integer                         :: vz,T,Tn
-   character(len=20)               :: pipe
-   character(len=512)              :: tmppath
-   character(len=1024)             :: jobcall
-   character(len=64), intent(in)   :: frag1_file
-   character(len=64), intent(in)   :: frag2_file
-   character(len=64)               :: frag1
-   character(len=64)               :: frag2
-   real(wp)                        :: percent
-
-! some options
-   pipe = '2>/dev/null'
-   frag1 = 'solvent_cluster.lmo'
-   frag2 = 'solvent.lmo'
-
-! setting the threads for correct parallelization
-   call new_ompautoset(env,'auto',NTMP,T,Tn)
-
-   k = 0 !counting the finished jobs
-
-!___________________________________________________________________________________
-
-!$omp parallel &
-!$omp shared( vz,NTMP,percent,k,TMPdir,conv )
-!$omp single
-   do i = 1, NTMP
-      vz = i
-      !$omp task firstprivate( vz ) private( tmppath,jobcall )
-! create the system call
-      write (jobcall, '(a,1x,a,1x,a,'' -nfrag1 '',i3,'' -ellips '',3f9.3,'' -qcg '',a,'' >iff.out'')') &
-&         trim(env%ProgIFF), trim(frag1_file), trim(frag2_file), nfrag1, outer_ell_abc(conv(vz), 1:3)*0.9, trim(pipe)
-      write (tmppath, '(a,i0)') trim(TMPdir), conv(vz)
-      call command('cd '//trim(tmppath)//' && '//trim(jobcall))
-      !$omp critical
-      k = k + 1
-      percent = float(k)/float(NTMP)*100
-      !$omp end critical
-      !$omp end task
-   end do
-!$omp taskwait
-!$omp end single
-!$omp end parallel
-
-!___________________________________________________________________________________
-
-end subroutine ensemble_iff
-
-!___________________________________________________________________________________
-!
-! xTB docking calculation performed in parallel
-!___________________________________________________________________________________
-
-subroutine ensemble_dock(env, outer_ell_abc, nfrag1, frag1_file, frag2_file, n_shell&
-        &, n_solvent, NTMP, TMPdir, conv)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   use zdata
-
-   implicit none
-   type(systemdata)                :: env
-
-   character(len=*), intent(in)     :: TMPdir     !directory name
-   integer, intent(in)              :: NTMP       !number of structures to be optimized
-   integer, intent(in)              :: nfrag1     !#atoms of larger fragment
-   integer, intent(in)              :: conv(env%nqcgclust + 1)
-   real(wp), intent(in)             :: outer_ell_abc(env%nqcgclust, 3)
-   integer, intent(in)              :: n_shell, n_solvent
-
-   integer                         :: i, k
-   integer                         :: vz, T,Tn
-   character(len=20)               :: pipe
-   character(len=1024)             :: jobcall
-   character(len=512)              :: thispath, tmppath
-   character(len=*), intent(in)    :: frag1_file
-   character(len=*), intent(in)    :: frag2_file
-   character(len=64)               :: frag1
-   character(len=64)               :: frag2
-   real(wp)                        :: percent
-   character(len=2)                :: flag
-   integer                         :: ich31
-
-! some options
-   pipe = '2>/dev/null'
-   frag1 = 'solvent_cluster.coord'
-   frag2 = 'solvent'
-   call getcwd(thispath)
-
-! setting the threads for correct parallelization
-   call new_ompautoset(env,'auto',NTMP,T,Tn)
-
-   write (jobcall, '(a,1x,''dock'',1x,a,1x,a,1x,a,1x,f4.2,1x,''--nfrag1'',1x,i0,1x,&
-           & ''--input xcontrol --fast > xtb_dock.out '',a)') &
-           & trim(env%ProgName), trim(frag1_file), trim(frag2_file),&
-           & trim(env%gfnver), env%optlev, nfrag1, trim(pipe)
-
-   flag = '$'
-   do i = 1, NTMP
-      vz = i
-      write (tmppath, '(a,i0)') trim(TMPdir), conv(i)
-      call chdir(trim(tmppath))
-      open (newunit=ich31, file='xcontrol')
-      write (ich31, '(a,"fix")') trim(flag)
-      write (ich31, '(3x,"atoms: 1-",i0)') n_shell !Initial number of atoms (starting solvent shell)
-      write (ich31, '(a,"wall")') trim(flag)
-      write (31, '(3x,"potential=polynomial")')
-      write (ich31, '(3x,"ellipsoid:",1x,3(g0,",",1x),i0,"-",i0)') outer_ell_abc(conv(vz), :), &
-              & n_shell + 1, n_shell + n_solvent !Initial number of atoms (starting solvent shell)
-      close (ich31)
-      call chdir(trim(thispath))
-   end do
-
-   k = 0 !counting the finished jobs
-
-!___________________________________________________________________________________
-
-!$omp parallel &
-!$omp shared( vz,NTMP,percent,k,TMPdir,conv,n_shell,n_solvent,jobcall )
-!$omp single
-   do i = 1, NTMP
-      vz = i
-      !$omp task firstprivate( vz ) private( tmppath )
-      write (tmppath, '(a,i0)') trim(TMPdir), conv(vz)
-      call command('cd '//trim(tmppath)//' && '//trim(jobcall))
-      !$omp critical
-      k = k + 1
-      percent = float(k)/float(NTMP)*100
-      !$omp end critical
-      !$omp end task
-   end do
-
-!$omp taskwait
-!$omp end single
-!$omp end parallel
-
-!___________________________________________________________________________________
-   call chdir(trim(thispath))
-
-end subroutine ensemble_dock
-
-!___________________________________________________________________________________
-!
-! xTB CFF optimization performed in parallel
-!___________________________________________________________________________________
-
-subroutine cff_opt(postopt, env, fname, n12, NTMP, TMPdir, conv, nothing_added)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   use strucrd
-   implicit none
-
-   type(systemdata)                :: env
-   character(len=*), intent(in)     :: fname      !file base name
-   character(len=*), intent(in)     :: TMPdir     !directory name
-   integer, intent(inout)           :: NTMP       !number of structures to be optimized
-   integer, intent(inout)           :: conv(env%nqcgclust + 1)
-   logical, intent(in)              :: postopt
-   logical, intent(in)              :: nothing_added(env%nqcgclust)
-   integer                         :: i, k, n12
-   integer                         :: vz,T,Tn
-   integer                         :: ich31
-   character(len=20)               :: pipe
-   character(len=512)              :: thispath, tmppath
-   character(len=1024)             :: jobcall
-   character(len=2)                :: flag
-   real(wp)                        :: percent
-
-! setting the threads for correct parallelization
-   call new_ompautoset(env,'auto',NTMP,T,Tn)
-
-   if (postopt) then
-      write (*, '(2x,''Starting optimizations + SP  of structures'')')
-      write (*, '(2x,i0,'' jobs to do.'')') NTMP
-   end if
-
-! postopt eq true => post opt run, which has to be performed in every directory !!!
-   if (postopt) then
-      k = 0
-      NTMP = env%nqcgclust
-      do i = 1, env%nqcgclust
-         k = k + 1
-         conv(k) = i
-         conv(env%nqcgclust + 1) = k
-      end do
-   end if
-   pipe = '2>/dev/null'
-
-   call getcwd(thispath)
-   do i = 1, NTMP
-      write (tmppath, '(a,i0)') trim(TMPdir), conv(i)
-      call chdir(trim(tmppath))
-      open (newunit=ich31, file='xcontrol')
-      if (n12 .ne. 0) then
-         flag = '$'
-         write (ich31, '(a,"fix")') trim(flag)
-         write (ich31, '(3x,"atoms: 1-",i0)') n12 !Initial number of atoms (starting solvent shell)
-      end if
-      close (ich31)
-      if (postopt .and. nothing_added(i)) call remove('xcontrol')
-      call chdir(trim(thispath))
-   end do
-
-!--- Jobcall
-   write (jobcall, '(a,1x,a,1x,a,'' --input xcontrol --opt '',i0,1x,a,'' >xtb.out'')') &
-   &    trim(env%ProgName), trim(fname), trim(env%gfnver), nint(env%optlev), trim(pipe)
-
-   if (NTMP .lt. 1) then
-      write (*, '(2x,"No structures to be optimized")')
-      return
-   end if
-
-   k = 0 !counting the finished jobs
-   if (postopt) call printprogbar(0.0_wp)
-!___________________________________________________________________________________
-
-!$omp parallel &
-!$omp shared( vz,jobcall,NTMP,percent,k,TMPdir,conv )
-!$omp single
-   do i = 1, NTMP
-      vz = i
-      !$omp task firstprivate( vz ) private( tmppath )
-      write (tmppath, '(a,i0)') trim(TMPdir), conv(vz)
-      call command('cd '//trim(tmppath)//' && '//trim(jobcall))
-      !$omp critical
-      k = k + 1
-      percent = float(k)/float(NTMP)*100
-      if (postopt) then
-         call printprogbar(percent)
-      end if
-      !$omp end critical
-      !$omp end task
-   end do
-!$omp taskwait
-!$omp end single
-!$omp end parallel
-
-!__________________________________________________________________________________
-
-   do i = 1, NTMP
-      write (tmppath, '(a,i0)') trim(TMPdir), conv(i)
-      call chdir(trim(tmppath))
-      call remove('xtbrestart')
-      call chdir(trim(thispath))
-   end do
-
-   !create the system call for sp (needed for gbsa model)
-   write (jobcall, '(a,1x,a,1x,a,'' --sp '',a,1x,a,'' >xtb_sp.out'')') &
-   &    trim(env%ProgName), 'xtbopt.coord', trim(env%gfnver), trim(env%solv), trim(pipe)
-
-   if (NTMP .lt. 1) then
-      write (*, '(2x,"Nothing to do")')
-      return
-   end if
-
-   k = 0 !counting the finished jobs
-   if (postopt) call printprogbar(0.0_wp)
-!___________________________________________________________________________________
-
-!$omp parallel &
-!$omp shared( vz,jobcall,NTMP,percent,k,TMPdir,conv )
-!$omp single
-   do i = 1, NTMP
-      vz = i
-      !$omp task firstprivate( vz ) private( tmppath )
-      write (tmppath, '(a,i0)') trim(TMPdir), conv(vz)
-      call command('cd '//trim(tmppath)//' && '//trim(jobcall))
-      !$omp critical
-      k = k + 1
-      percent = float(k)/float(NTMP)*100
-      if (postopt) then
-         call printprogbar(percent)
-      end if
-      !$omp end critical
-      !$omp end task
-   end do
-!$omp taskwait
-!$omp end single
-!$omp end parallel
-
-!___________________________________________________________________________________
-
-   do i = 1, NTMP
-      write (tmppath, '(a,i0)') trim(TMPdir), conv(i)
-      call chdir(trim(tmppath))
-      call remove('xtbrestart')
-      !call remove('xcontrol')
-      call chdir(trim(thispath))
-   end do
-
-   if (postopt) then
-      write (*, *) ''
-      write (*, '(2x,"done.")')
-   end if
-
-end subroutine cff_opt
-
-!___________________________________________________________________________________
-!
-! xTB SP performed in parallel
-!___________________________________________________________________________________
-
-subroutine ens_sp(env, fname, NTMP, TMPdir)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   use strucrd
-   implicit none
-
-   type(systemdata)                :: env
-   character(len=*), intent(in)     :: fname      !file base name
-   character(len=*), intent(in)     :: TMPdir     !directory name
-   integer, intent(inout)           :: NTMP       !number of structures to be optimized
-
-   integer                         :: i, k
-   integer                         :: vz, T, Tn
-   character(len=20)               :: pipe
-   character(len=512)              :: thispath, tmppath
-   character(len=1024)             :: jobcall
-   real(wp)                        :: percent
-
-! setting the threads for correct parallelization
-   call new_ompautoset(env,'auto',NTMP,T,Tn)
-
-   write (*, '(2x,''Single point computation with GBSA model'')')
-   write (*, '(2x,i0,'' jobs to do.'')') NTMP
-
-   pipe = '2>/dev/null'
-
-   call getcwd(thispath)
-
-   if (NTMP .lt. 1) then
-      write (*, '(2x,"No structures to be optimized")')
-      return
-   end if
-
-!--- Jobcall
-   write (jobcall, '(a,1x,a,1x,a,'' --sp '',a,1x,a,'' > xtb_sp.out'')') &
-   &    trim(env%ProgName), trim(fname), trim(env%gfnver), trim(env%solv), trim(pipe)
-
-   k = 0 !counting the finished jobs
-   call printprogbar(0.0_wp)
-!___________________________________________________________________________________
-
-!$omp parallel &
-!$omp shared( vz,NTMP,percent,k,TMPdir,jobcall )
-!$omp single
-   do i = 1, NTMP
-      vz = i
-      !$omp task firstprivate( vz ) private( tmppath )
-      call initsignal()
-      !$omp critical
-      write (tmppath, '(a,i0)') trim(TMPdir), vz
-      !$omp end critical
-      call command('cd '//trim(tmppath)//' && '//trim(jobcall))
-      !$omp critical
-      k = k + 1
-      percent = float(k)/float(NTMP)*100
-      call printprogbar(percent)
-      !$omp end critical
-      !$omp end task
-   end do
-!$omp taskwait
-!$omp end single
-!$omp end parallel
-
-!__________________________________________________________________________________
-
-   do i = 1, NTMP
-      write (tmppath, '(a,i0)') trim(TMPdir), i
-      call chdir(trim(tmppath))
-      call remove('xtbrestart')
-      call chdir(trim(thispath))
-   end do
-   write (*, *) ''
-   write (*, '(2x,"done.")')
-
-end subroutine ens_sp
-
-!___________________________________________________________________________________
-!
-! xTB Freq compuatation performed in parallel
-!___________________________________________________________________________________
-
-subroutine ens_freq(env, fname, NTMP, TMPdir, opt)
-   use iso_fortran_env, only: wp => real64
-   use iomod
-   use crest_data
-   use strucrd
-   implicit none
-
-   type(systemdata)                :: env
-   character(len=*), intent(in)     :: fname      !file base name
-   character(len=*), intent(in)     :: TMPdir     !directory name
-   integer, intent(inout)           :: NTMP       !number of structures to be optimized
-
-   integer                         :: i, k
-   integer                         :: vz, T,Tn
-   character(len=20)               :: pipe
-   character(len=512)              :: thispath, tmppath
-   character(len=1024)             :: jobcall
-   real(wp)                        :: percent
-   logical                         :: opt
-
-! setting the threads for correct parallelization
-   call new_ompautoset(env,'auto',NTMP,T,Tn)
-
-   write (*, '(2x,''Starting reoptimizations + Frequency computation of ensemble'')')
-   write (*, '(2x,i0,'' jobs to do.'')') NTMP
-
-   pipe = '2>/dev/null'
-
-   call getcwd(thispath)
-
-   if (NTMP .lt. 1) then
-      write (*, '(2x,"No structures to be optimized")')
-      return
-   end if
-
-   k = 0 !counting the finished jobs
-   call printprogbar(0.0_wp)
-
-!--- Jobcall
-   if (.not. opt) then
-      write (jobcall, '(a,1x,a,1x,a,'' --hess '',a,'' >xtb_freq.out'')') &
-       &    trim(env%ProgName), trim(fname), trim(env%gfnver), trim(pipe)
-   else
-      write (jobcall, '(a,1x,a,1x,a,'' --ohess '',a,'' >xtb_freq.out'')') &
-      &    trim(env%ProgName), trim(fname), trim(env%gfnver), trim(pipe)
-   end if
-
-!___________________________________________________________________________________
-
-!$omp parallel &
-!$omp shared( vz,NTMP,percent,k,TMPdir,jobcall )
-!$omp single
-   do i = 1, NTMP
-      vz = i
-      !$omp task firstprivate( vz ) private( tmppath )
-      write (tmppath, '(a,i0)') trim(TMPdir), i
-      call command('cd '//trim(tmppath)//' && '//trim(jobcall))
-      !$omp critical
-      k = k + 1
-      percent = float(k)/float(NTMP)*100
-      call printprogbar(percent)
-      !$omp end critical
-      !$omp end task
-   end do
-!$omp taskwait
-!$omp end single
-!$omp end parallel
-
-!__________________________________________________________________________________
-
-   do i = 1, NTMP
-      write (tmppath, '(a,i0)') trim(TMPdir), i
-      call chdir(trim(tmppath))
-      call remove('xtbrestart')
-      call chdir(trim(thispath))
-   end do
-   write (*, *) ''
-   write (*, '(2x,"done.")')
-
-end subroutine ens_freq
-
-!============================================================!
-! Read the Energies from a xtbiff output
-!============================================================!
-
-subroutine rdxtbiffE(fname, m, n, e)
-
-   implicit none
-   integer :: m, n
-   character(len=*),intent(in) :: fname
-   real*8 :: e(*)
-
-   character(len=128) :: line
-   real*8 :: xx(10)
-   integer :: ich, i, j, nn
-
-   open (newunit=ich, file=fname)
-
-   j = 1
-10 continue
-   read (ich, '(a)', end=999) line
-   read (ich, '(a)') line
-   call readl(line, xx, nn)
-   e(j) = xx(1)
-   do i = 1, n
-      read (ich, '(a)') line
-   end do
-   j = j + 1
-   goto 10
-
-999 close (ich)
-   m = j - 1
-end
-
-!============================================================!
-! subroutine wr_cluster_cut
-! Cuts a cluster file and and writes the parts
-!
-! On Input: fname          - name of the coord file
-!           n1             - number of atoms fragment1
-!           n2             - number of atmos fragment2
-!           iter           - number of solvent molecules
-!           fname_solu_cut - name of outputfile fragment1
-!           fname_solv_cut - name of outputfile fragment2
-!
-!============================================================!
-
-subroutine wr_cluster_cut(fname_cluster, n1, n2, iter, fname_solu_cut, fname_solv_cut)
-   use iso_fortran_env, only: wp => real64
-   use strucrd
-
-   implicit none
-   integer, intent(in)         :: n1, n2, iter
-   real(wp)                    :: xyz1(3, n1)
-   real(wp)                    :: xyz2(3, n2*iter)
-   integer                     :: at1(n1), at2(n2*iter)
-   character(len=*), intent(in) :: fname_cluster, fname_solu_cut, fname_solv_cut
-   character(len=256)         :: atmp
-   character(len=2)           :: a2
-   integer                     :: ich, i, k, stat, io, io2
-
-   ich = 142
-   open (unit=ich, file=fname_cluster, iostat=stat)
-   read (ich, '(a)') atmp
-   k = 1
-   do i = 1, n1
-      read (ich, '(a)', iostat=io) atmp
-      if (io < 0) exit
-      atmp = adjustl(atmp)
-      call coordline(atmp, a2, xyz1(1:3, k), io2)
-      at1(k) = e2i(a2)
-      k = k + 1
-   end do
-   k = 1
-   do i = 1, n2*iter
-      read (ich, '(a)', iostat=io) atmp
-      if (io < 0) exit
-      atmp = adjustl(atmp)
-      call coordline(atmp, a2, xyz2(1:3, k), io2)
-      at2(k) = e2i(a2)
-      k = k + 1
-   end do
-
-   call wrc0(fname_solu_cut, n1, at1, xyz1)
-   call wrc0(fname_solv_cut, n2*iter, at2, xyz2)
-   close (ich)
-
-end subroutine wr_cluster_cut
-
-subroutine check_iff(neg_E)
-   use iso_fortran_env, only: wp => real64
-   use crest_data
-
-   implicit none
-   integer              :: io, ich
-   real(wp)             :: int_E
-   character(len=50)    :: tmp
-   logical, intent(out) :: neg_E
-
-   logical :: ex
-   character(len=*), parameter :: filename = 'xtbscreen.xyz'
-
-   neg_E = .false.
-   int_E = 0.0_wp
-
-   inquire (file=filename, exist=ex)
-   if (.not. ex) return
-
-   open (newunit=ich, file=filename, status="old", iostat=io)
-   if (io == 0) read (ich, '(a)', iostat=io)
-   if (io == 0) read (ich, '(a)', iostat=io) tmp
-   close (ich)
-   if (io /= 0) return
-
-   tmp = adjustl(tmp(11:))
-   read (tmp, *, iostat=io) int_E
-   neg_E = io == 0 .and. int_E < 0.0_wp
-
-end subroutine check_iff
-
-!----------------------------------------------------------------------------
-! write a wall potential in a file used as xtb input
-
-subroutine write_wall(env,n1,rabc1,rabc12,fname)
-  use iso_fortran_env, only : wp => real64
-  use crest_data
-
-  implicit none
-
-  type(systemdata)     :: env
-  integer, intent(in)  :: n1
-  real(wp),intent(in)  :: rabc1(3),rabc12(3)
-  character (len=8)    :: flag
-  character(len=*)    :: fname
-
-  open(unit=31,file=fname)
-  flag='$'
-  write(31,'(a,"wall")') trim(flag)
-  write(31,'(3x,"potential=polynomial")')
-  write(31,'(3x,"ellipsoid:",1x,3(g0,",",1x),"all")') rabc12
-  write(31,'(3x,"ellipsoid:",1x,3(g0,",",1x),"1-",i0)') rabc1,n1
-  if(env%constrain_solu) then
-    write(31,'("$fix")')
-    write(31,'(3x,"atoms: 1-",i0)') n1
-  end if
-  call write_cts(31,env%cts)
-  call write_cts_biasext(31,env%cts)
-  if(env%cts%used) then !Only, if user set constrians is an $end written
-     write(31,'(a)') '$end'
-  end if
-
-  close(31)
-
-end subroutine write_wall
-
-subroutine check_dock(neg_E)
-   use iso_fortran_env, only: wp => real64
-   use crest_data
-   use iomod, only: minigrep, grepval
-
-   implicit none
-   real(wp)             :: int_E
-   logical, intent(out) :: neg_E
-   logical :: ex
-   character(len=*), parameter :: filename = 'xtbscreen.xyz'
-
-   neg_E = .false.
-   int_E = 0.0_wp
-
-   call minigrep('xtb_dock.out', '  Lowest Interaction Energy: ********** kcal/mol', ex)
-   if (ex) return
-
-   call grepval('xtb_dock.out', 'Lowest Interaction Energy:', ex, int_E)
-
-   if (ex .and. int_E < 0.0_wp) neg_E = .true.
-
-end subroutine check_dock
-
-subroutine write_constraint(env,coord_name,fname)
-  use iso_fortran_env, only : wp => real64
-  use crest_data
-  use iomod
-
-  implicit none
-
-  type(systemdata)     :: env
-  character(len=*),intent(in)    :: fname, coord_name
-
-  call copysub(coord_name, 'coord.ref')
-  open(unit=31,file=fname)
-  call write_cts(31,env%cts)
-  call write_cts_biasext(31,env%cts)
-  if(env%cts%used) then !Only, if user set constrians is an $end written
-     write(31,'(a)') '$end'
-  end if
-
-  close(31)
-
-end subroutine write_constraint
diff --git a/src/qcg/volume.f90 b/src/qcg/volume.f90
index 01e726c9..11d402f8 100644
--- a/src/qcg/volume.f90
+++ b/src/qcg/volume.f90
@@ -22,603 +22,596 @@
 ! Jaroslav Skrivánek, Ming-Chya Wu
 ! Comput. Phys. Commun. 165(2005)59
 
-subroutine get_volume(zmol, rad)
-   use iso_fortran_env, wp => real64
-   use zdata
-   implicit none
-   type(Zmolecule), intent(inout) :: zmol
-   real(wp), intent(in)  :: rad(zmol%nat)
-   real(wp), allocatable :: xyz_rad(:, :)
-   integer, allocatable  :: neigh_list(:)
-   integer, allocatable  :: neigh_index(:)
-   integer, allocatable  :: neigh_type(:)
-   real(wp)              :: va_part(2)
-   integer               :: i
-
-   allocate (xyz_rad(zmol%nat, 4), neigh_list(zmol%nat), neigh_index(zmol%nat))
-   allocate (neigh_type(zmol%nat**2))
-
-   zmol%vtot = 0d0
-   zmol%atot = 0d0
+subroutine get_volume(mol,rad)
+  use crest_parameters
+  use qcg_coord_type
+  implicit none
+  type(coord_qcg),intent(inout) :: mol
+  real(wp),intent(in)  :: rad(mol%nat)
+  real(wp),allocatable :: xyz_rad(:,:)
+  integer,allocatable  :: neigh_list(:)
+  integer,allocatable  :: neigh_index(:)
+  integer,allocatable  :: neigh_type(:)
+  real(wp)              :: va_part(2)
+  integer               :: i
+
+  allocate (xyz_rad(mol%nat,4),neigh_list(mol%nat),neigh_index(mol%nat))
+  allocate (neigh_type(mol%nat**2))
+
+  mol%vtot = 0d0
+  mol%atot = 0d0
 
 !--- Copying Input
-   do i = 1, zmol%nat
-      xyz_rad(i, 1:3) = zmol%xyz(1:3, i)
-      xyz_rad(i, 4) = rad(i)
-   end do
+  do i = 1,mol%nat
+    xyz_rad(i,1:3) = mol%xyz(1:3,i)
+    xyz_rad(i,4) = rad(i)
+  end do
 
 !--- Checking neighbors (different to usual CREST neighbors to account for more atoms)
-   call create_neigh(zmol%nat, xyz_rad, neigh_list, &
-   &                               neigh_index, neigh_type)
+  call create_neigh(mol%nat,xyz_rad,neigh_list, &
+  &                               neigh_index,neigh_type)
 
 !--- Compute V and A
-   do i = 1, zmol%nat
-      call calcVA(i, xyz_rad, neigh_list, neigh_index, &
-      &                        neigh_type, zmol%nat, va_part)
-      zmol%vtot = zmol%vtot + va_part(1)
-      zmol%atot = zmol%atot + va_part(2)
-   end do
+  do i = 1,mol%nat
+    call calcVA(i,xyz_rad,neigh_list,neigh_index, &
+    &                        neigh_type,mol%nat,va_part)
+    mol%vtot = mol%vtot+va_part(1)
+    mol%atot = mol%atot+va_part(2)
+  end do
 
-   deallocate (xyz_rad, neigh_type, neigh_index)
-   deallocate (neigh_list)
+  deallocate (xyz_rad,neigh_type,neigh_index)
+  deallocate (neigh_list)
 
-   return
+  return
 end subroutine get_volume
 
-subroutine create_neigh(nat, xyz_rad, neigh_list, neigh_index, neigh_type)
-   use iso_fortran_env, wp => real64
-   implicit none
-
-   integer, intent(in)  :: nat
-   real(wp), intent(in) :: xyz_rad(nat, 4)
-   integer              :: neigh_list(nat), neigh_index(nat), neigh_type(nat**2)
-
-   integer              :: neigh_tmp(nat), dum(nat)
-   integer              :: i, j
-   real(wp)             :: x, y, z, d, ri, r
-
-   neigh_index = 0
-   neigh_index(1) = 1
-   neigh_list = 0
-   neigh_tmp = 0
-   do i = 1, nat
-      !--- Check, if there are neighbors and which
-      neigh_list(i) = 0
-      x = xyz_rad(i, 1)
-      y = xyz_rad(i, 2)
-      z = xyz_rad(i, 3)
-      r = xyz_rad(i, 4)
-      do j = 1, nat
-         if (j .NE. i) then
-            if (dabs(x - xyz_rad(j, 1)) .lt. r + xyz_rad(j, 4)) then
-               d = dsqrt((x - xyz_rad(j, 1))**2 + (y - xyz_rad(j, 2))**2 + (z - xyz_rad(j, 3))**2)
-               ri = xyz_rad(j, 4)
-               if (d .lt. r + ri) then
-                  if (d + r .LE. ri) then
-                     neigh_list(i) = -1
-                     exit
-                  elseif (d + ri .gt. r) then
-                     neigh_list(i) = neigh_list(i) + 1
-                     neigh_tmp(neigh_list(i)) = j
-                  end if
-               end if
+subroutine create_neigh(nat,xyz_rad,neigh_list,neigh_index,neigh_type)
+  use crest_parameters
+  implicit none
+
+  integer,intent(in)  :: nat
+  real(wp),intent(in) :: xyz_rad(nat,4)
+  integer              :: neigh_list(nat),neigh_index(nat),neigh_type(nat**2)
+
+  integer              :: neigh_tmp(nat),dum(nat)
+  integer              :: i,j
+  real(wp)             :: x,y,z,d,ri,r
+
+  neigh_index = 0
+  neigh_index(1) = 1
+  neigh_list = 0
+  neigh_tmp = 0
+  do i = 1,nat
+    !--- Check, if there are neighbors and which
+    neigh_list(i) = 0
+    x = xyz_rad(i,1)
+    y = xyz_rad(i,2)
+    z = xyz_rad(i,3)
+    r = xyz_rad(i,4)
+    do j = 1,nat
+      if (j .NE. i) then
+        if (abs(x-xyz_rad(j,1)) .lt. r+xyz_rad(j,4)) then
+          d = sqrt((x-xyz_rad(j,1))**2+(y-xyz_rad(j,2))**2+(z-xyz_rad(j,3))**2)
+          ri = xyz_rad(j,4)
+          if (d .lt. r+ri) then
+            if (d+r .LE. ri) then
+              neigh_list(i) = -1
+              exit
+            elseif (d+ri .gt. r) then
+              neigh_list(i) = neigh_list(i)+1
+              neigh_tmp(neigh_list(i)) = j
             end if
-         end if
-      end do
-      dum = neigh_list !Somhow the first entry in neigh_list is overwritten in the following do cycle
+          end if
+        end if
+      end if
+    end do
+    dum = neigh_list !Somhow the first entry in neigh_list is overwritten in the following do cycle
 
-      !--- No neighbors
-      if (neigh_list(i) .LE. 0) then
-         neigh_index(i + 1) = neigh_index(i)
+    !--- No neighbors
+    if (neigh_list(i) .LE. 0) then
+      neigh_index(i+1) = neigh_index(i)
       !--- Neighbors
-      else
-         if(i < nat) then
-            neigh_index(i + 1) = neigh_index(i) + neigh_list(i)
-         end if
-         do j = 1, neigh_list(i)
-            neigh_type(neigh_index(i) + j - 1) = neigh_tmp(j)
-         end do
+    else
+      if (i < nat) then
+        neigh_index(i+1) = neigh_index(i)+neigh_list(i)
       end if
-   end do
-   neigh_list = dum
+      do j = 1,neigh_list(i)
+        neigh_type(neigh_index(i)+j-1) = neigh_tmp(j)
+      end do
+    end if
+  end do
+  neigh_list = dum
 
-   return
+  return
 end subroutine create_neigh
 
-subroutine calcVA(num, xyz_rad, neigh_list, neigh_index, neigh_type, nat, va_part)
-   use iso_fortran_env, wp => real64
-   implicit none
-
-   integer, intent(in)   :: num, nat
-   real(wp), intent(in)  :: xyz_rad(nat, 4)
-   integer, intent(in)   :: neigh_list(nat), neigh_index(nat), neigh_type(nat**2)
-   real(wp), intent(out) :: va_part(2)
-   real(wp)              :: circles(nat, 4), single_sphere(nat, 4)
-   real(wp)              :: int_parts(nat**2, 3), av_part(2)
-   real(wp)              :: rad
-
-   integer               :: neigh_tmp(nat), nint_parts, npos
-   integer               :: i, j
-   real(wp), parameter   :: pi = 3.1415926540d0
-
-   !--- No neighbors
-   if (neigh_list(num) .eq. 0) then
-      va_part(1) = 4d0*pi*xyz_rad(num, 4)**3/3.d0
-      va_part(2) = 4d0*pi*xyz_rad(num, 4)**2
-   !--- Subset
-   elseif (neigh_list(num) .lt. 0) then
-      va_part(1) = 0d0
-      va_part(2) = 0d0
-   !--- Neighbors exist
-   else
-
-      neigh_tmp(1) = num
-
-      do i = 1, (neigh_list(num))
-         neigh_tmp(i + 1) = neigh_type(neigh_index(num) + i - 1)
-      end do
-      do i = 1, neigh_list(num) + 1
-         do j = 1, 4
-            single_sphere(i, j) = xyz_rad(neigh_tmp(i), j)
-         end do
+subroutine calcVA(num,xyz_rad,neigh_list,neigh_index,neigh_type,nat,va_part)
+  use crest_parameters
+  implicit none
+
+  integer,intent(in)   :: num,nat
+  real(wp),intent(in)  :: xyz_rad(nat,4)
+  integer,intent(in)   :: neigh_list(nat),neigh_index(nat),neigh_type(nat**2)
+  real(wp),intent(out) :: va_part(2)
+  real(wp)              :: circles(nat,4),single_sphere(nat,4)
+  real(wp)              :: int_parts(nat**2,3),av_part(2)
+  real(wp)              :: rad
+
+  integer               :: neigh_tmp(nat),nint_parts,npos
+  integer               :: i,j
+
+  !--- No neighbors
+  if (neigh_list(num) .eq. 0) then
+    va_part(1) = 4d0*pi*xyz_rad(num,4)**3/3.d0
+    va_part(2) = 4d0*pi*xyz_rad(num,4)**2
+    !--- Subset
+  elseif (neigh_list(num) .lt. 0) then
+    va_part(1) = 0d0
+    va_part(2) = 0d0
+    !--- Neighbors exist
+  else
+
+    neigh_tmp(1) = num
+
+    do i = 1, (neigh_list(num))
+      neigh_tmp(i+1) = neigh_type(neigh_index(num)+i-1)
+    end do
+    do i = 1,neigh_list(num)+1
+      do j = 1,4
+        single_sphere(i,j) = xyz_rad(neigh_tmp(i),j)
       end do
+    end do
 
-      va_part(1) = 0d0
-      va_part(2) = 0d0
+    va_part(1) = 0d0
+    va_part(2) = 0d0
 
-      call generate_integration_parts(single_sphere, circles, nat, neigh_list(num), int_parts, nint_parts)
+    call generate_integration_parts(single_sphere,circles,nat,neigh_list(num),int_parts,nint_parts)
 
-      npos = 0
-      do i = 1, (neigh_list(num))
-         if (circles(i, 4) .gt. 0) then
-            npos = npos + 1
-         end if
-      end do
-
-      rad = single_sphere(1, 4)
-      !--- Selective integration as overlap was found
-      if (npos .gt. 0) then
-         call integrate(circles, int_parts, nat, nint_parts, rad, single_sphere(1, 3), av_part)
-         va_part(1) = va_part(1) + av_part(1)
-         va_part(2) = va_part(2) + av_part(2)
-      !--- Complete integration
-      else
-         call integrate(circles, int_parts, nat, nint_parts, rad, single_sphere(1, 3), av_part)
-         va_part(1) = va_part(1) + av_part(1) + 4d0*pi*single_sphere(1, 4)**3/3d0
-         va_part(2) = va_part(2) + av_part(2) + 4d0*pi*single_sphere(1, 4)**2
+    npos = 0
+    do i = 1, (neigh_list(num))
+      if (circles(i,4) .gt. 0) then
+        npos = npos+1
       end if
-   end if
-
-   return
+    end do
+
+    rad = single_sphere(1,4)
+    !--- Selective integration as overlap was found
+    if (npos .gt. 0) then
+      call integrate(circles,int_parts,nat,nint_parts,rad,single_sphere(1,3),av_part)
+      va_part(1) = va_part(1)+av_part(1)
+      va_part(2) = va_part(2)+av_part(2)
+      !--- Complete integration
+    else
+      call integrate(circles,int_parts,nat,nint_parts,rad,single_sphere(1,3),av_part)
+      va_part(1) = va_part(1)+av_part(1)+4d0*pi*single_sphere(1,4)**3/3d0
+      va_part(2) = va_part(2)+av_part(2)+4d0*pi*single_sphere(1,4)**2
+    end if
+  end if
+
+  return
 end subroutine calcVA
 
-subroutine generate_integration_parts(single_sphere, circles, nat, num_neigh, int_parts, num_parts)
-
-   use iso_fortran_env, wp => real64
-   implicit none
-   real(wp), intent(in)  :: single_sphere(nat, 4)
-   real(wp), intent(out) :: circles(nat, 4)
-   integer, intent(in)   :: nat, num_neigh
-   real(wp), intent(out) :: int_parts(nat**2, 3)
-   integer, intent(out)  :: num_parts
-
-   integer               :: nna
-   real(wp)              :: int_partsnew(nat**2, 3), rad, x, y, a, b, c, d
-   integer               :: i, j, k
-   real(wp), parameter   :: pi = 3.1415926540d0
-
-   num_parts = 0
-
-   !--- Create circles first
-   rad = single_sphere(1, 4)
-   do i = 1, (num_neigh)
-      x = single_sphere(1, 1) - single_sphere(i + 1, 1)
-      y = single_sphere(1, 2) - single_sphere(i + 1, 2)
-      a = 8d0*rad**2*x
-      b = 8d0*rad**2*y
-      c = x**2 + y**2 + (single_sphere(1, 3) + rad - single_sphere(i + 1, 3))**2 - single_sphere(i + 1, 4)**2
-      d = 4d0*rad**2*(x**2 + y**2 + (single_sphere(1, 3) - rad - single_sphere(i + 1, 3))**2 - single_sphere(i + 1, 4)**2)
-      circles(i, 1) = -a/(2d0*c)
-      circles(i, 2) = -b/(2d0*c)
-      circles(i, 3) = dsqrt((a**2 + b**2 - 4d0*c*d)/(4d0*c**2))
-      if (c .gt. 0) then
-         circles(i, 4) = -1
-      else
-         circles(i, 4) = 1
+subroutine generate_integration_parts(single_sphere,circles,nat,num_neigh,int_parts,num_parts)
+  use crest_parameters
+  implicit none
+  real(wp),intent(in)  :: single_sphere(nat,4)
+  real(wp),intent(out) :: circles(nat,4)
+  integer,intent(in)   :: nat,num_neigh
+  real(wp),intent(out) :: int_parts(nat**2,3)
+  integer,intent(out)  :: num_parts
+
+  integer               :: nna
+  real(wp)              :: int_partsnew(nat**2,3),rad,x,y,a,b,c,d
+  integer               :: i,j,k
+
+  num_parts = 0
+
+  !--- Create circles first
+  rad = single_sphere(1,4)
+  do i = 1, (num_neigh)
+    x = single_sphere(1,1)-single_sphere(i+1,1)
+    y = single_sphere(1,2)-single_sphere(i+1,2)
+    a = 8d0*rad**2*x
+    b = 8d0*rad**2*y
+    c = x**2+y**2+(single_sphere(1,3)+rad-single_sphere(i+1,3))**2-single_sphere(i+1,4)**2
+    d = 4d0*rad**2*(x**2+y**2+(single_sphere(1,3)-rad-single_sphere(i+1,3))**2-single_sphere(i+1,4)**2)
+    circles(i,1) = -a/(2d0*c)
+    circles(i,2) = -b/(2d0*c)
+    circles(i,3) = sqrt((a**2+b**2-4d0*c*d)/(4d0*c**2))
+    if (c .gt. 0) then
+      circles(i,4) = -1
+    else
+      circles(i,4) = 1
+    end if
+  end do
+
+  !--- And than integration parts
+  !--- Only one circle
+  if (num_neigh .eq. 1) then
+    num_parts = 1
+    int_parts(1,1) = 1
+    int_parts(1,2) = 0d0
+    int_parts(1,3) = 2d0*pi*circles(1,4)
+    !--- More circles
+  else
+    do i = 1, (num_neigh)
+      call make_parts(i,circles,nat,num_neigh,nna,int_partsnew)
+      if (nna .gt. 0) then
+        do j = 1,nna
+          do k = 1,3
+            int_parts(num_parts+j,k) = int_partsnew(j,k)
+          end do
+        end do
+        num_parts = num_parts+nna
       end if
-   end do
-
-   !--- And than integration parts
-   !--- Only one circle
-   if (num_neigh .eq. 1) then
-      num_parts = 1
-      int_parts(1, 1) = 1
-      int_parts(1, 2) = 0d0
-      int_parts(1, 3) = 2d0*pi*circles(1, 4)
-   !--- More circles
-   else
-      do i = 1, (num_neigh)
-         call make_parts(i, circles, nat, num_neigh, nna, int_partsnew)
-         if (nna .gt. 0) then
-            do j = 1, nna
-               do k = 1, 3
-                  int_parts(num_parts + j, k) = int_partsnew(j, k)
-               end do
-            end do
-            num_parts = num_parts + nna
-         end if
-      end do
-   end if
-   return
+    end do
+  end if
+  return
 end subroutine generate_integration_parts
 
 !--- Create parts that are integratet later
-subroutine make_parts(num, circles, nat, num_neigh, no_arc, int_partsnew)
-   use iso_fortran_env, wp => real64
-   implicit none
-
-   integer, intent(in)   :: num
-   real(wp), intent(in)  :: circles(nat, 4)
-   integer, intent(in)   :: nat, num_neigh
-   real(wp), intent(out) :: int_partsnew(nat**2, 3)
-   integer, intent(out)  :: no_arc
-
-   integer               :: i, j, m, counter_angles, counter_no_angles, counter
-   real(wp)              :: c11, c12, c13, c21, c22, c23, dist, int11, int12, int21, int22, dum
-   real(wp)              :: angles(nat**2), anglesnew(nat**2)
-   logical               :: minmax
-   real(wp), parameter   :: pi = 3.1415926540d0
-
-   no_arc = 0
-   counter_angles = 0
-
-   c11 = circles(num, 1)
-   c12 = circles(num, 2)
-   c13 = circles(num, 3)
-   do i = 1, (num_neigh)
-      if (i .NE. num) then
-         c21 = circles(i, 1)
-         c22 = circles(i, 2)
-         c23 = circles(i, 3)
-         dist = dsqrt((c11 - c21)**2 + (c12 - c22)**2)
-         if ((dist .lt. c23 + c13) .and. (dabs(c23 - c13) .lt. dist)) then
-            !--- Two intersections
-            call intersection(num, i, nat, circles, int11, int12, int21, int22)
-            angles(counter_angles + 1) = int11
-            angles(counter_angles + 2) = int12
-            counter_angles = counter_angles + 2
-         end if
+subroutine make_parts(num,circles,nat,num_neigh,no_arc,int_partsnew)
+  use crest_parameters
+  implicit none
+
+  integer,intent(in)   :: num
+  real(wp),intent(in)  :: circles(nat,4)
+  integer,intent(in)   :: nat,num_neigh
+  real(wp),intent(out) :: int_partsnew(nat**2,3)
+  integer,intent(out)  :: no_arc
+
+  integer               :: i,j,m,counter_angles,counter_no_angles,counter
+  real(wp)              :: c11,c12,c13,c21,c22,c23,dist,int11,int12,int21,int22,dum
+  real(wp)              :: angles(nat**2),anglesnew(nat**2)
+  logical               :: minmax
+
+  no_arc = 0
+  counter_angles = 0
+
+  c11 = circles(num,1)
+  c12 = circles(num,2)
+  c13 = circles(num,3)
+  do i = 1, (num_neigh)
+    if (i .NE. num) then
+      c21 = circles(i,1)
+      c22 = circles(i,2)
+      c23 = circles(i,3)
+      dist = sqrt((c11-c21)**2+(c12-c22)**2)
+      if ((dist .lt. c23+c13).and.(abs(c23-c13) .lt. dist)) then
+        !--- Two intersections
+        call intersection(num,i,nat,circles,int11,int12,int21,int22)
+        angles(counter_angles+1) = int11
+        angles(counter_angles+2) = int12
+        counter_angles = counter_angles+2
       end if
-   end do
-   if (counter_angles .eq. 0) then
-      counter_no_angles = 0
-      do i = 1, (num_neigh)
-         if (i .NE. num) then
-
-            !--- Check overlapping circles
-            dist = dsqrt((circles(num, 1) + circles(num, 3) - circles(i, 1))**2 + &
-            &        (circles(num, 2) - circles(i, 2))**2)
-            if (dist .lt. circles(i, 3)) then
-               if (circles(i, 4) .gt. 0) then
-                  counter = 1
-               else
-                  counter = 0
-               end if
-            elseif (dist .gt. circles(i, 3)) then
-               if (circles(i, 4) .gt. 0) then
-                  counter = 0
-               else
-                  counter = 1
-               end if
+    end if
+  end do
+  if (counter_angles .eq. 0) then
+    counter_no_angles = 0
+    do i = 1, (num_neigh)
+      if (i .NE. num) then
+
+        !--- Check overlapping circles
+        dist = sqrt((circles(num,1)+circles(num,3)-circles(i,1))**2+ &
+        &        (circles(num,2)-circles(i,2))**2)
+        if (dist .lt. circles(i,3)) then
+          if (circles(i,4) .gt. 0) then
+            counter = 1
+          else
+            counter = 0
+          end if
+        elseif (dist .gt. circles(i,3)) then
+          if (circles(i,4) .gt. 0) then
+            counter = 0
+          else
+            counter = 1
+          end if
+        else
+          dist = sqrt((circles(num,1)-circles(i,1))**2+(circles(num,2)-circles(i,2))**2)
+          if (dist .lt. circles(i,3)) then
+            if (circles(i,4) .gt. 0) then
+              counter = 1
             else
-               dist = dsqrt((circles(num, 1) - circles(i, 1))**2 + (circles(num, 2) - circles(i, 2))**2)
-               if (dist .lt. circles(i, 3)) then
-                  if (circles(i, 4) .gt. 0) then
-                     counter = 1
-                  else
-                     counter = 0
-                  end if
-               else
-                  if (circles(i, 4) .gt. 0) then
-                     counter = 0
-                  else
-                     counter = 1
-                  end if
-               end if
+              counter = 0
             end if
-
-            counter_no_angles = counter_no_angles + counter
-         end if
-      end do
-      if (counter_no_angles .eq. (num_neigh - 1)) then
-         no_arc = 1
-         int_partsnew(1, 1) = num
-         int_partsnew(1, 2) = 0d0
-         int_partsnew(1, 3) = 2d0*pi*circles(num, 4)
-      end if
-   else
-      if (circles(num, 4) .gt. 0) then
-         minmax = .true.
-      else
-         minmax = .false.
-      end if
-      !--- Sort angles
-      do i = 1, (counter_angles - 1)
-         counter = i
-         dum = angles(i)
-         do j = i + 1, counter_angles
-            if (minmax) then
-               if (dum .gt. angles(j)) then
-                  counter = j
-                  dum = angles(j)
-               end if
+          else
+            if (circles(i,4) .gt. 0) then
+              counter = 0
             else
-               if (dum .lt. angles(j)) then
-                  counter = j
-                  dum = angles(j)
-               end if
+              counter = 1
             end if
-         end do
-         if (counter .NE. i) then
-            angles(counter) = angles(i)
-            angles(i) = dum
-         end if
-      end do
-
-      !--- Remove equals
-      m = 1
-      anglesnew(1) = angles(1)
-      do i = 2, counter_angles
-         if (dabs(angles(i) - angles(i - 1)) .gt. 1d-12) then
-            m = m + 1
-            anglesnew(m) = angles(i)
-         end if
-      end do
-      counter_angles = m
-      do i = 1, m
-         angles(i) = anglesnew(i)
-      end do
-      do i = 1, (counter_angles - 1)
-         counter_no_angles = 0
-         do j = 1, (num_neigh)
-            if (j .NE. num) then
-               c21 = c11 + c13*dcos((angles(i) + angles(i + 1))/2d0)
-               c22 = c12 + c13*dsin((angles(i) + angles(i + 1))/2d0)
-               !--- Check, if point is inside circle
-               dist = dsqrt((c21 - circles(j, 1))**2 + (c22 - circles(j, 2))**2)
-               if (dist .lt. circles(j, 3)) then
-                  if (circles(j, 4) .gt. 0) then
-                     counter_no_angles = counter_no_angles + 1
-                  end if
-               else
-                  if (circles(j, 4) .LE. 0) then
-                     counter_no_angles = counter_no_angles + 1
-                  end if
-               end if
+          end if
+        end if
 
-            end if
-         end do
-         if (counter_no_angles .eq. (num_neigh - 1)) then
-            no_arc = no_arc + 1
-            int_partsnew(no_arc, 1) = num
-            int_partsnew(no_arc, 2) = angles(i)
-            int_partsnew(no_arc, 3) = angles(i + 1) - angles(i)
-         end if
+        counter_no_angles = counter_no_angles+counter
+      end if
+    end do
+    if (counter_no_angles .eq. (num_neigh-1)) then
+      no_arc = 1
+      int_partsnew(1,1) = num
+      int_partsnew(1,2) = 0d0
+      int_partsnew(1,3) = 2d0*pi*circles(num,4)
+    end if
+  else
+    if (circles(num,4) .gt. 0) then
+      minmax = .true.
+    else
+      minmax = .false.
+    end if
+    !--- Sort angles
+    do i = 1, (counter_angles-1)
+      counter = i
+      dum = angles(i)
+      do j = i+1,counter_angles
+        if (minmax) then
+          if (dum .gt. angles(j)) then
+            counter = j
+            dum = angles(j)
+          end if
+        else
+          if (dum .lt. angles(j)) then
+            counter = j
+            dum = angles(j)
+          end if
+        end if
       end do
+      if (counter .NE. i) then
+        angles(counter) = angles(i)
+        angles(i) = dum
+      end if
+    end do
+
+    !--- Remove equals
+    m = 1
+    anglesnew(1) = angles(1)
+    do i = 2,counter_angles
+      if (abs(angles(i)-angles(i-1)) .gt. 1d-12) then
+        m = m+1
+        anglesnew(m) = angles(i)
+      end if
+    end do
+    counter_angles = m
+    do i = 1,m
+      angles(i) = anglesnew(i)
+    end do
+    do i = 1, (counter_angles-1)
       counter_no_angles = 0
-      do i = 1, (num_neigh)
-         if (i .NE. num) then
-            c21 = c11 + c13*dcos((angles(1) + 2d0*pi + angles(counter_angles))/2d0)
-            c22 = c12 + c13*dsin((angles(1) + 2d0*pi + angles(counter_angles))/2d0)
-            !--- Check, if point is inside circle
-            dist = dsqrt((c21 - circles(i, 1))**2 + (c22 - circles(i, 2))**2)
-            if (dist .lt. circles(i, 3)) then
-               if (circles(i, 4) .gt. 0) then
-                  counter_no_angles = counter_no_angles + 1
-               end if
-            else
-               if (circles(i, 4) .LE. 0) then
-                  counter_no_angles = counter_no_angles + 1
-               end if
+      do j = 1, (num_neigh)
+        if (j .NE. num) then
+          c21 = c11+c13*cos((angles(i)+angles(i+1))/2d0)
+          c22 = c12+c13*sin((angles(i)+angles(i+1))/2d0)
+          !--- Check, if point is inside circle
+          dist = sqrt((c21-circles(j,1))**2+(c22-circles(j,2))**2)
+          if (dist .lt. circles(j,3)) then
+            if (circles(j,4) .gt. 0) then
+              counter_no_angles = counter_no_angles+1
             end if
+          else
+            if (circles(j,4) .LE. 0) then
+              counter_no_angles = counter_no_angles+1
+            end if
+          end if
 
-         end if
+        end if
       end do
-      if (counter_no_angles .eq. (num_neigh - 1)) then
-         no_arc = no_arc + 1
-         int_partsnew(no_arc, 1) = num
-         int_partsnew(no_arc, 2) = angles(counter_angles)
-         int_partsnew(no_arc, 3) = angles(1) + circles(num, 4)*2d0*pi - angles(counter_angles)
+      if (counter_no_angles .eq. (num_neigh-1)) then
+        no_arc = no_arc+1
+        int_partsnew(no_arc,1) = num
+        int_partsnew(no_arc,2) = angles(i)
+        int_partsnew(no_arc,3) = angles(i+1)-angles(i)
       end if
-   end if
+    end do
+    counter_no_angles = 0
+    do i = 1, (num_neigh)
+      if (i .NE. num) then
+        c21 = c11+c13*cos((angles(1)+2d0*pi+angles(counter_angles))/2d0)
+        c22 = c12+c13*sin((angles(1)+2d0*pi+angles(counter_angles))/2d0)
+        !--- Check, if point is inside circle
+        dist = sqrt((c21-circles(i,1))**2+(c22-circles(i,2))**2)
+        if (dist .lt. circles(i,3)) then
+          if (circles(i,4) .gt. 0) then
+            counter_no_angles = counter_no_angles+1
+          end if
+        else
+          if (circles(i,4) .LE. 0) then
+            counter_no_angles = counter_no_angles+1
+          end if
+        end if
 
-   return
+      end if
+    end do
+    if (counter_no_angles .eq. (num_neigh-1)) then
+      no_arc = no_arc+1
+      int_partsnew(no_arc,1) = num
+      int_partsnew(no_arc,2) = angles(counter_angles)
+      int_partsnew(no_arc,3) = angles(1)+circles(num,4)*2d0*pi-angles(counter_angles)
+    end if
+  end if
+
+  return
 end subroutine make_parts
 
 !--- Computation of angles of two intersection points
-subroutine intersection(point1, point2, nat, circles, int11, int12, int21, int22)
-
-   use iso_fortran_env, wp => real64
-   implicit none
-   integer, intent(in)   :: point1, point2, nat
-   real(wp), intent(in)  :: circles(nat, 4)
-   real(wp), intent(out) :: int11, int12, int21, int22
-
-   real(wp)              :: c11, c12, c13, c21, c22, c23, f1, f2, f3, f4
-   real(wp), parameter   :: pi = 3.1415926540d0
-
-   c11 = circles(point1, 1)
-   c12 = circles(point1, 2)
-   c13 = circles(point1, 3)
-   c21 = circles(point2, 1)
-   c22 = circles(point2, 2)
-   c23 = circles(point2, 3)
-   if (dabs(c21 - c11) .lt. 1d-12) then
-      f1 = ((c13**2 - c23**2)/(c22 - c12) - (c22 - c12))/2d0
-      f2 = dsqrt(c23**2 - f1**2)
-      if (f1 .eq. 0) then
-         int21 = 0d0
-         int22 = pi
-      elseif (f1 .gt. 0) then
-         int21 = datan(dabs(f1/f2))
-         int22 = pi - int21
-      else
-         int21 = pi + datan(dabs(f1/f2))
-         int22 = 3d0*pi - int21
-      end if
-      f1 = f1 + c22 - c12
-      if (f1 .eq. 0) then
-         int11 = 0d0
-         int12 = pi
-      elseif (f1 .gt. 0) then
-         int11 = datan(dabs(f1/f2))
-         int12 = pi - int11
+subroutine intersection(point1,point2,nat,circles,int11,int12,int21,int22)
+  use crest_parameters
+  implicit none
+  integer,intent(in)   :: point1,point2,nat
+  real(wp),intent(in)  :: circles(nat,4)
+  real(wp),intent(out) :: int11,int12,int21,int22
+
+  real(wp)              :: c11,c12,c13,c21,c22,c23,f1,f2,f3,f4
+
+  c11 = circles(point1,1)
+  c12 = circles(point1,2)
+  c13 = circles(point1,3)
+  c21 = circles(point2,1)
+  c22 = circles(point2,2)
+  c23 = circles(point2,3)
+  if (abs(c21-c11) .lt. 1d-12) then
+    f1 = ((c13**2-c23**2)/(c22-c12)-(c22-c12))/2d0
+    f2 = sqrt(c23**2-f1**2)
+    if (f1 .eq. 0) then
+      int21 = 0d0
+      int22 = pi
+    elseif (f1 .gt. 0) then
+      int21 = atan(abs(f1/f2))
+      int22 = pi-int21
+    else
+      int21 = pi+atan(abs(f1/f2))
+      int22 = 3d0*pi-int21
+    end if
+    f1 = f1+c22-c12
+    if (f1 .eq. 0) then
+      int11 = 0d0
+      int12 = pi
+    elseif (f1 .gt. 0) then
+      int11 = atan(abs(f1/f2))
+      int12 = pi-int11
+    else
+      int11 = pi+atan(abs(f1/f2))
+      int12 = 3d0*pi-int11
+    end if
+  else
+    f3 = ((c13**2-c23**2-(c22-c12)**2)/(c21-c11)-(c21-c11))/2d0
+    f4 = (c12-c22)/(c21-c11)
+    f1 = (-f3*f4+sqrt((f4**2+1d0)*c23**2-f3**2))/(f4**2+1d0)
+    f2 = f3+f4*f1
+    if (f2 .eq. 0) then
+      if (f1 .gt. 0) then
+        int21 = pi/2d0
       else
-         int11 = pi + datan(dabs(f1/f2))
-         int12 = 3d0*pi - int11
+        int21 = -pi/2d0
       end if
-   else
-      f3 = ((c13**2 - c23**2 - (c22 - c12)**2)/(c21 - c11) - (c21 - c11))/2d0
-      f4 = (c12 - c22)/(c21 - c11)
-      f1 = (-f3*f4 + dsqrt((f4**2 + 1d0)*c23**2 - f3**2))/(f4**2 + 1d0)
-      f2 = f3 + f4*f1
-      if (f2 .eq. 0) then
-         if (f1 .gt. 0) then
-            int21 = pi/2d0
-         else
-            int21 = -pi/2d0
-         end if
-      elseif (f2 .gt. 0) then
-         int21 = datan(f1/f2)
+    elseif (f2 .gt. 0) then
+      int21 = atan(f1/f2)
+    else
+      int21 = pi+atan(f1/f2)
+    end if
+    f1 = f1+c22-c12
+    f2 = f2+c21-c11
+    if (f2 .eq. 0) then
+      if (f1 .gt. 0) then
+        int11 = pi/2d0
       else
-         int21 = pi + datan(f1/f2)
+        int11 = -pi/2d0
       end if
-      f1 = f1 + c22 - c12
-      f2 = f2 + c21 - c11
-      if (f2 .eq. 0) then
-         if (f1 .gt. 0) then
-            int11 = pi/2d0
-         else
-            int11 = -pi/2d0
-         end if
-      elseif (f2 .gt. 0) then
-         int11 = datan(f1/f2)
+    elseif (f2 .gt. 0) then
+      int11 = atan(f1/f2)
+    else
+      int11 = pi+atan(f1/f2)
+    end if
+    f1 = (-f3*f4-sqrt((f4**2+1d0)*c23**2-f3**2))/(f4**2+1d0)
+    f2 = f3+f4*f1
+    if (f2 .eq. 0) then
+      if (f1 .gt. 0) then
+        int22 = pi/2d0
       else
-         int11 = pi + datan(f1/f2)
+        int22 = -pi/2d0
       end if
-      f1 = (-f3*f4 - dsqrt((f4**2 + 1d0)*c23**2 - f3**2))/(f4**2 + 1d0)
-      f2 = f3 + f4*f1
-      if (f2 .eq. 0) then
-         if (f1 .gt. 0) then
-            int22 = pi/2d0
-         else
-            int22 = -pi/2d0
-         end if
-      elseif (f2 .gt. 0) then
-         int22 = datan(f1/f2)
+    elseif (f2 .gt. 0) then
+      int22 = atan(f1/f2)
+    else
+      int22 = pi+atan(f1/f2)
+    end if
+    f1 = f1+c22-c12
+    f2 = f2+c21-c11
+    if (f2 .eq. 0) then
+      if (f1 .gt. 0) then
+        int12 = pi/2d0
       else
-         int22 = pi + datan(f1/f2)
+        int12 = -pi/2d0
       end if
-      f1 = f1 + c22 - c12
-      f2 = f2 + c21 - c11
-      if (f2 .eq. 0) then
-         if (f1 .gt. 0) then
-            int12 = pi/2d0
-         else
-            int12 = -pi/2d0
-         end if
-      elseif (f2 .gt. 0) then
-         int12 = datan(f1/f2)
-      else
-         int12 = pi + datan(f1/f2)
-      end if
-   end if
-   if (int11 .lt. 0) int11 = int11 + 2d0*pi
-   if (int12 .lt. 0) int12 = int12 + 2d0*pi
-   if (int21 .lt. 0) int21 = int21 + 2d0*pi
-   if (int22 .lt. 0) int22 = int22 + 2d0*pi
-
-   return
+    elseif (f2 .gt. 0) then
+      int12 = atan(f1/f2)
+    else
+      int12 = pi+atan(f1/f2)
+    end if
+  end if
+  if (int11 .lt. 0) int11 = int11+2d0*pi
+  if (int12 .lt. 0) int12 = int12+2d0*pi
+  if (int21 .lt. 0) int21 = int21+2d0*pi
+  if (int22 .lt. 0) int22 = int22+2d0*pi
+
+  return
 end subroutine intersection
 
-subroutine integrate(circles, int_parts, nat, nint_parts, rad, z1, av_part)
-   use iso_fortran_env, wp => real64
-   implicit none
-
-   real(wp), intent(in)    :: circles(nat, 4), int_parts(nat**2, 3)
-   integer, intent(in)     :: nat, nint_parts
-   real(wp), intent(in)    :: rad, z1
-   real(wp), intent(inout) :: av_part(2)
-
-   integer                 :: i
-   real(wp)                :: x, y, z, pre_V, xz, yz, pre_A, f
-   real(wp)                :: pa, pd, p1, pb, pc, p2, v1, v2, v3, vJ1, vJ2, vJ3
-   real(wp)                :: d_v, d_a, part1, part2, part3, part4
-   real(wp), parameter     :: pi = 3.1415926540d0
-
-   av_part(1) = 0d0
-   av_part(2) = 0d0
-
-   do i = 1, nint_parts
-      x = circles(nint(int_parts(i, 1)), 1) !> int_parts is type real(wp) and therefore
-      y = circles(nint(int_parts(i, 1)), 2) !> should not be used as an array index?
-      z = circles(nint(int_parts(i, 1)), 3) !> added nint()
-      xz = x*z
-      yz = y*z
-      pre_V = (4d0*rad**2 + x**2 + y**2 + z**2)/2d0
-      pre_A = dsqrt(pre_V**2 - xz**2 - yz**2)
-      f = z**2 - pre_V
-      if (dabs(dabs(int_parts(i, 3)) - 2d0*pi) .lt. 1d-12) then
-         v1 = 2d0*pi/pre_A
-         v2 = 2d0*pi*pre_V/(pre_A**3)
-         v3 = pi*(2d0*pre_V**2 + xz**2 + yz**2)/(pre_A**5)
-         vJ1 = pi + f/2d0*v1
-         vJ2 = (v1 + f*v2)/4d0
-         vJ3 = (v2 + f*v3)/8d0
-         d_v = (128d0*vJ3*rad**7 + 8d0*vJ2*rad**5 + &
-         &  2d0*vJ1*rad**3)/3d0 - 8d0*rad**4*vJ2*(z1 + rad)
-         d_a = 2d0*vJ1*rad**2
-         if (int_parts(i, 3) .lt. 0) then
-            d_v = -d_v
-            d_a = -d_a
-         end if
-         av_part(1) = av_part(1) + d_v
-         av_part(2) = av_part(2) + d_a
+subroutine integrate(circles,int_parts,nat,nint_parts,rad,z1,av_part)
+  use crest_parameters
+  implicit none
+
+  real(wp),intent(in)    :: circles(nat,4),int_parts(nat**2,3)
+  integer,intent(in)     :: nat,nint_parts
+  real(wp),intent(in)    :: rad,z1
+  real(wp),intent(inout) :: av_part(2)
+
+  integer                 :: i
+  real(wp)                :: x,y,z,pre_V,xz,yz,pre_A,f
+  real(wp)                :: pa,pd,p1,pb,pc,p2,v1,v2,v3,vJ1,vJ2,vJ3
+  real(wp)                :: d_v,d_a,part1,part2,part3,part4
+
+  av_part(1) = 0d0
+  av_part(2) = 0d0
+
+  do i = 1,nint_parts
+    x = circles(nint(int_parts(i,1)),1) !> int_parts is type real(wp) and therefore
+    y = circles(nint(int_parts(i,1)),2) !> should not be used as an array index?
+    z = circles(nint(int_parts(i,1)),3) !> added nint()
+    xz = x*z
+    yz = y*z
+    pre_V = (4d0*rad**2+x**2+y**2+z**2)/2d0
+    pre_A = sqrt(pre_V**2-xz**2-yz**2)
+    f = z**2-pre_V
+    if (abs(abs(int_parts(i,3))-2d0*pi) .lt. 1d-12) then
+      v1 = 2d0*pi/pre_A
+      v2 = 2d0*pi*pre_V/(pre_A**3)
+      v3 = pi*(2d0*pre_V**2+xz**2+yz**2)/(pre_A**5)
+      vJ1 = pi+f/2d0*v1
+      vJ2 = (v1+f*v2)/4d0
+      vJ3 = (v2+f*v3)/8d0
+      d_v = (128d0*vJ3*rad**7+8d0*vJ2*rad**5+ &
+      &  2d0*vJ1*rad**3)/3d0-8d0*rad**4*vJ2*(z1+rad)
+      d_a = 2d0*vJ1*rad**2
+      if (int_parts(i,3) .lt. 0) then
+        d_v = -d_v
+        d_a = -d_a
+      end if
+      av_part(1) = av_part(1)+d_v
+      av_part(2) = av_part(2)+d_a
+    else
+      if (int_parts(i,3) .lt. 0) then
+        p2 = int_parts(i,2)+int_parts(i,3)
+        p1 = int_parts(i,2)
       else
-         if (int_parts(i, 3) .lt. 0) then
-            p2 = int_parts(i, 2) + int_parts(i, 3)
-            p1 = int_parts(i, 2)
-         else
-            p1 = int_parts(i, 2) + int_parts(i, 3)
-            p2 = int_parts(i, 2)
-         end if
-         v1 = 2d0*(pi/2d0 - datan((pre_V*dcos((p1 - p2)/2d0) + &
-         &   xz*dcos((p2 + p1)/2d0) + yz*dsin((p2 + p1)/2d0))/ &
-         &   (pre_A*dsin((p1 - p2)/2d0))))/pre_A
-         pa = dsin(p1)
-         pb = dcos(p1)
-         pc = dsin(p2)
-         pd = dcos(p2)
-         part1 = (-xz*pa + yz*pb)/(pre_V + xz*pb + yz*pa)**1
-         part2 = (-xz*pc + yz*pd)/(pre_V + xz*pd + yz*pc)**1
-         part3 = (-xz*pa + yz*pb)/(pre_V + xz*pb + yz*pa)**2
-         part4 = (-xz*pc + yz*pd)/(pre_V + xz*pd + yz*pc)**2
-         v2 = (part1 - part2 + pre_V*v1)/(pre_A**2)
-         v3 = (part3 - part4 + (part1 - part2)/pre_V + (2d0*pre_V**2 + xz**2 + yz**2)*v2/pre_V)/(2d0*pre_A**2)
-         vJ1 = ((p1 - p2) + f*v1)/2d0
-         vJ2 = (v1 + f*v2)/4d0
-         vJ3 = (v2 + f*v3)/8d0
-         d_v = (128d0*vJ3*rad**7 + 8d0*vJ2*rad**5 + &
-         &  2d0*vJ1*rad**3)/3d0 - 8d0*rad**4*vJ2*(z1 + rad)
-         d_a = 2d0*vJ1*rad**2
-         if (int_parts(i, 3) .lt. 0) then
-            d_v = -d_v
-            d_a = -d_a
-         end if
-         av_part(1) = av_part(1) + d_v
-         av_part(2) = av_part(2) + d_a
+        p1 = int_parts(i,2)+int_parts(i,3)
+        p2 = int_parts(i,2)
+      end if
+      v1 = 2d0*(pi/2d0-atan((pre_V*cos((p1-p2)/2d0)+ &
+      &   xz*cos((p2+p1)/2d0)+yz*sin((p2+p1)/2d0))/ &
+      &   (pre_A*sin((p1-p2)/2d0))))/pre_A
+      pa = sin(p1)
+      pb = cos(p1)
+      pc = sin(p2)
+      pd = cos(p2)
+      part1 = (-xz*pa+yz*pb)/(pre_V+xz*pb+yz*pa)**1
+      part2 = (-xz*pc+yz*pd)/(pre_V+xz*pd+yz*pc)**1
+      part3 = (-xz*pa+yz*pb)/(pre_V+xz*pb+yz*pa)**2
+      part4 = (-xz*pc+yz*pd)/(pre_V+xz*pd+yz*pc)**2
+      v2 = (part1-part2+pre_V*v1)/(pre_A**2)
+      v3 = (part3-part4+(part1-part2)/pre_V+(2d0*pre_V**2+xz**2+yz**2)*v2/pre_V)/(2d0*pre_A**2)
+      vJ1 = ((p1-p2)+f*v1)/2d0
+      vJ2 = (v1+f*v2)/4d0
+      vJ3 = (v2+f*v3)/8d0
+      d_v = (128d0*vJ3*rad**7+8d0*vJ2*rad**5+ &
+      &  2d0*vJ1*rad**3)/3d0-8d0*rad**4*vJ2*(z1+rad)
+      d_a = 2d0*vJ1*rad**2
+      if (int_parts(i,3) .lt. 0) then
+        d_v = -d_v
+        d_a = -d_a
       end if
-   end do
+      av_part(1) = av_part(1)+d_v
+      av_part(2) = av_part(2)+d_a
+    end if
+  end do
 
-   return
+  return
 end subroutine integrate
diff --git a/src/qmhelpers/CMakeLists.txt b/src/qmhelpers/CMakeLists.txt
index 76954b44..0fdb9eb6 100644
--- a/src/qmhelpers/CMakeLists.txt
+++ b/src/qmhelpers/CMakeLists.txt
@@ -21,6 +21,7 @@ list(APPEND srcs
   "${dir}/intpack.f90"
   "${dir}/lopt.f90"
   "${dir}/local.f90"
+  "${dir}/ir_spectrum.f90"
 )
 
 set(srcs ${srcs} PARENT_SCOPE)
diff --git a/src/qmhelpers/ir_spectrum.f90 b/src/qmhelpers/ir_spectrum.f90
new file mode 100644
index 00000000..b4372aff
--- /dev/null
+++ b/src/qmhelpers/ir_spectrum.f90
@@ -0,0 +1,83 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2025 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module ir_spectrum
+  use crest_parameters,only:wp,amutokg,metokg
+  use atmasses,only:ams
+  implicit none
+  private
+  public :: ir_intensities
+
+contains
+
+  subroutine ir_intensities(nat,at,nat3,evec,dipd,intens)
+!***********************************************************************
+!* Compute double-harmonic IR intensities from Cartesian dipole
+!* gradients projected onto normal mode eigenvectors.
+!* Intensities are returned in km/mol.
+!*
+!* Input:
+!*   nat   - number of atoms
+!*   at    - atomic numbers (nat)
+!*   nat3  - 3*nat
+!*   evec  - mass-weighted Hessian eigenvectors, shape (nat3,nat3),
+!*           columns are normal modes (output of dsyevd via frequencies())
+!*   dipd  - Cartesian dipole gradient ∂μ/∂x_i in a.u., shape (3,nat3)
+!* Output:
+!*   intens - IR intensities in km/mol, shape (nat3)
+!***********************************************************************
+    implicit none
+    integer,intent(in)   :: nat,nat3
+    integer,intent(in)   :: at(nat)
+    real(wp),intent(in)  :: evec(nat3,nat3)
+    real(wp),intent(in)  :: dipd(3,nat3)
+    real(wp),intent(out) :: intens(nat3)
+    !> conversion: |∂μ/∂Q|² in a.u. → km/mol
+    real(wp),parameter   :: au_to_kmmol = 1.7770969e+6_wp
+    real(wp),allocatable :: invmass(:)
+    real(wp) :: trdip(3),sum2,amutoau
+    integer  :: i,j,k,ii
+
+! ── inverse square root mass vector, one entry per Cartesian coordinate ──
+    amutoau = amutokg/metokg
+    allocate(invmass(nat3),source=0.0_wp)
+    do i = 1,nat
+      do j = 1,3
+        ii = (i-1)*3+j
+        invmass(ii) = 1.0_wp/sqrt(ams(at(i))*amutoau)
+      end do
+    end do
+
+! ── project dipole gradient onto each normal mode ────────────────────────
+    intens = 0.0_wp
+    do i = 1,nat3
+      do k = 1,3
+        sum2 = 0.0_wp
+        do j = 1,nat3
+          sum2 = sum2+dipd(k,j)*(evec(j,i)*invmass(j))
+        end do
+        trdip(k) = sum2
+      end do
+      intens(i) = au_to_kmmol*(trdip(1)**2+trdip(2)**2+trdip(3)**2)
+    end do
+
+    deallocate(invmass)
+  end subroutine ir_intensities
+
+end module ir_spectrum
diff --git a/src/qmhelpers/meson.build b/src/qmhelpers/meson.build
index 0716e307..9adba846 100644
--- a/src/qmhelpers/meson.build
+++ b/src/qmhelpers/meson.build
@@ -19,4 +19,5 @@ srcs += files(
   'intpack.f90',
   'lopt.f90',
   'local.f90',
+  'ir_spectrum.f90',
 )
diff --git a/src/quicksort.f90 b/src/quicksort.f90
deleted file mode 100644
index 69f18de4..00000000
--- a/src/quicksort.f90
+++ /dev/null
@@ -1,291 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2020 Philipp Pracht
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!================================================================================!
-
-!=============================================================!
-! classical quicksort algorithm, sort LOW-to-HIGH
-!=============================================================!
-recursive subroutine quicksort(n,arr)
-  implicit none
-  integer :: n,arr(n),i,j,k,m
-  integer :: pivot
-  integer,allocatable :: R(:),L(:)
-  integer :: rr,ll,rc,lc,pp
-
-  if (n .le. 1) return
-
-  pivot = arr(1)
-  if (arr(2) .lt. arr(1)) pivot = arr(2)
-  pp = 0
-  do i = 1,n
-    if (arr(i) .eq. pivot) pp = pp+1
-  end do
-
-  ll = 0
-  do i = 1,n
-    if (arr(i) .le. pivot) then
-      ll = ll+1
-    end if
-  end do
-  ll = ll-pp
-  rr = n-ll-pp
-  allocate (L(ll),R(rr))
-
-  lc = 0
-  rc = 0
-  do j = 1,n
-    if (arr(j) .lt. pivot) then
-      lc = lc+1
-      L(lc) = arr(j)
-    else if (arr(j) .gt. pivot) then
-      rc = rc+1
-      R(rc) = arr(j)
-    end if
-  end do
-
-  call quicksort(ll,L)
-  call quicksort(rr,R)
-
-  do i = 1,ll
-    arr(i) = L(i)
-  end do
-  do k = 1,pp
-    m = k+ll
-    arr(m) = pivot
-  end do
-  do j = 1,rr
-    m = j+ll+pp
-    arr(m) = R(j)
-  end do
-
-  deallocate (R,L)
-end subroutine quicksort
-
-!=============================================================!
-! classical quicksort algorithm, sort HIGH-to-LOW
-!=============================================================!
-recursive subroutine revquicksort(n,arr)
-  implicit none
-  integer :: n,arr(n),i,j,k,m
-  integer :: pivot
-  integer,allocatable :: R(:),L(:)
-  integer :: rr,ll,rc,lc,pp
-
-  if (n .le. 1) return
-
-  pivot = arr(1)
-  pp = 0
-  do i = 1,n
-    if (arr(i) .eq. pivot) pp = pp+1
-  end do
-
-  ll = 0
-  do i = 1,n
-    if (arr(i) .ge. pivot) then
-      ll = ll+1
-    end if
-  end do
-  ll = ll-pp
-  rr = n-ll-pp
-  allocate (L(ll),R(rr))
-
-  lc = 0
-  rc = 0
-  do j = 1,n
-    if (arr(j) .gt. pivot) then
-      lc = lc+1
-      L(lc) = arr(j)
-    else if (arr(j) .lt. pivot) then
-      rc = rc+1
-      R(rc) = arr(j)
-    end if
-  end do
-
-  call revquicksort(ll,L)
-  call revquicksort(rr,R)
-
-  do i = 1,ll
-    arr(i) = L(i)
-  end do
-  do k = 1,pp
-    m = k+ll
-    arr(m) = pivot
-  end do
-  do j = 1,rr
-    m = j+ll+pp
-    arr(m) = R(j)
-  end do
-
-  deallocate (R,L)
-end subroutine revquicksort
-
-!=============================================================!
-! other variant of quicksort algos
-!=============================================================!
-recursive subroutine qsort(a,first,last,ind)
-  implicit none
-  real*8 a(*),x,t
-  integer ind(*)
-  integer first,last
-  integer i,j,ii
-
-  x = a((first+last)/2)
-  i = first
-  j = last
-  do
-    do while (a(i) < x)
-      i = i+1
-    end do
-    do while (x < a(j))
-      j = j-1
-    end do
-    if (i >= j) exit
-    t = a(i); a(i) = a(j); a(j) = t
-    ii = ind(i); ind(i) = ind(j); ind(j) = ii
-    i = i+1
-    j = j-1
-  end do
-  if (first < i-1) call qsort(a,first,i-1,ind)
-  if (j+1 < last) call qsort(a,j+1,last,ind)
-end subroutine qsort
-
-recursive subroutine qqsort(a,first,last)
-  implicit none
-  real*8 a(*),x,t
-  integer first,last
-  integer i,j
-
-  x = a((first+last)/2)
-  i = first
-  j = last
-  do
-    do while (a(i) < x)
-      i = i+1
-    end do
-    do while (x < a(j))
-      j = j-1
-    end do
-    if (i >= j) exit
-    t = a(i); a(i) = a(j); a(j) = t
-    i = i+1
-    j = j-1
-  end do
-  if (first < i-1) call qqsort(a,first,i-1)
-  if (j+1 < last) call qqsort(a,j+1,last)
-end subroutine qqsort
-
-recursive subroutine maskqsort(a,first,last,mask)
-  implicit none
-  real*8 a(*),t
-  integer x
-  integer mask(*)
-  integer first,last
-  integer i,j,ii
-
-  x = mask((first+last)/2)
-  i = first
-  j = last
-  do
-    do while (mask(i) < x)
-      i = i+1
-    end do
-    do while (x < mask(j))
-      j = j-1
-    end do
-    if (i >= j) exit
-    t = a(i); a(i) = a(j); a(j) = t
-    ii = mask(i); mask(i) = mask(j); mask(j) = ii
-    i = i+1
-    j = j-1
-  end do
-  if (first < i-1) call maskqsort(a,first,i-1,mask)
-  if (j+1 < last) call maskqsort(a,j+1,last,mask)
-end subroutine maskqsort
-
-recursive subroutine matqsort(adim,nall,a,adum,first,last,mask)
-  implicit none
-  integer :: adim,nall
-  real*8 a(adim,nall),adum(adim)
-  integer x
-  integer mask(nall)
-  integer first,last
-  integer i,j,ii
-
-  x = mask((first+last)/2)
-  i = first
-  j = last
-  do
-    do while (mask(i) < x)
-      i = i+1
-    end do
-    do while (x < mask(j))
-      j = j-1
-    end do
-    if (i >= j) exit
-    adum(:) = a(:,i); a(:,i) = a(:,j); a(:,j) = adum(:)
-    ii = mask(i); mask(i) = mask(j); mask(j) = ii
-    i = i+1
-    j = j-1
-  end do
-  if (first < i-1) call matqsort(adim,nall,a,adum,first,i-1,mask)
-  if (j+1 < last) call matqsort(adim,nall,a,adum,j+1,last,mask)
-end subroutine matqsort
-
-recursive subroutine stringqsort(sdim,strs,first,last,mask)
-  implicit none
-  integer :: sdim
-  character(len=*) :: strs(sdim)
-  character(len=len(strs(1))) :: str
-  integer x
-  integer mask(sdim)
-  integer first,last
-  integer i,j,ii
-  x = mask((first+last)/2)
-  i = first
-  j = last
-  do
-    do while (mask(i) < x)
-      i = i+1
-    end do
-    do while (x < mask(j))
-      j = j-1
-    end do
-    if (i >= j) exit
-    str = strs(i); strs(i) = strs(j); strs(j) = str
-    ii = mask(i); mask(i) = mask(j); mask(j) = ii
-    i = i+1
-    j = j-1
-  end do
-  if (first < i-1) call stringqsort(sdim,strs,first,i-1,mask)
-  if (j+1 < last) call stringqsort(sdim,strs,j+1,last,mask)
-end subroutine stringqsort
-
-subroutine maskinvert(nall,mask)
-  implicit none
-  integer :: nall
-  integer :: mask(nall)
-  integer,allocatable :: imask(:)
-  integer :: i
-  allocate (imask(nall))
-  do i = 1,nall
-    imask(mask(i)) = i
-  end do
-  mask(:) = imask(:)
-  deallocate (imask)
-  return
-end subroutine maskinvert
diff --git a/src/readl.f90 b/src/readl.f90
deleted file mode 100644
index 82d0c633..00000000
--- a/src/readl.f90
+++ /dev/null
@@ -1,208 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2020 Stefan Grimme
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!================================================================================!
-
-!========================================================================================!
-subroutine readl(a1,x,n)
-  use iso_fortran_env,only:wp => real64
-  implicit real(wp) (a-h,o-z)
-  character(*) a1
-  dimension x(*)
-  i = 0
-  is = 1
-10 i = i+1
-  x(i) = readaa(a1,is,ib,ie)
-  if (ib .gt. 0.and.ie .gt. 0) then
-    is = ie
-    goto 10
-  end if
-  n = i-1
-  return
-end subroutine readl
-
-!========================================================================================!
-function readaa(a,istart,iend,iend2)
-  use iso_fortran_env,only:wp => real64
-  implicit real(wp) (a-h,o-z)
-  real(wp) readaa
-  character(*) a
-
-  NINE = ICHAR('9')
-  IZERO = ICHAR('0')
-  MINUS = ICHAR('-')
-  IDOT = ICHAR('.')
-  ND = ICHAR('D')
-  NE = ICHAR('E')
-  IBL = ICHAR(' ')
-
-  iend = 0
-  iend2 = 0
-  idig = 0
-  c1 = 0
-  c2 = 0
-  one = 1.d0
-  x = 1.d0
-  nl = len(a)
-  do j = istart,nl-1
-    n = ichar(a(j:j))
-    m = ichar(a(j+1:j+1))
-    if (n .le. nine.and.n .ge. izero.or.n .eq. idot) goto 20
-    if (n .eq. minus.and.(m .le. nine.and.m .ge. izero &
-       & .or.m .eq. idot)) goto 20
-  end do
-  readaa = 0.d0
-  return
-20 continue
-  iend = j
-  do i = j,nl
-    n = ichar(a(i:i))
-    if (n .le. nine.and.n .ge. izero) then
-      idig = idig+1
-      if (idig .gt. 10) goto 60
-      c1 = c1*10+n-izero
-    elseif (n .eq. minus.and.i .eq. j) then
-      one = -1.d0
-    elseif (n .eq. idot) then
-      goto 40
-    else
-      goto 60
-    end if
-  end do
-40 continue
-  idig = 0
-  do ii = i+1,nl
-    n = ichar(a(ii:ii))
-    if (n .le. nine.and.n .ge. izero) then
-      idig = idig+1
-      if (idig .gt. 10) goto 60
-      c2 = c2*10+n-izero
-      x = x/10
-    elseif (n .eq. minus.and.ii .eq. i) then
-      x = -x
-    else
-      goto 60
-    end if
-  end do
-  !
-  ! put the pieces together
-  !
-60 continue
-  readaa = one*(c1+c2*x)
-  do j = iend,nl
-    n = ichar(a(j:j))
-    iend2 = j
-    if (n .eq. ibl) return
-    if (n .eq. nd.or.n .eq. ne) goto 57
-  end do
-  return
-
-57 c1 = 0.0d0
-  one = 1.0d0
-  do i = j+1,nl
-    n = ichar(a(i:i))
-    iend2 = i
-    if (n .eq. ibl) goto 70
-    if (n .le. nine.and.n .ge. izero) c1 = c1*10.0d0+n-izero
-    if (n .eq. minus) one = -1.0d0
-  end do
-  continue
-70 readaa = readaa*10**(one*c1)
-  return
-end function readaa
-
-!========================================================================================!
-!cuts the at blanks and tabstops and returns all floats and strings in order of occurence
-subroutine cutline(line,floats,strings)
-  use iso_fortran_env,only:wp => real64
-  implicit none
-  real(wp) floats(*),num
-  character(len=128) line,str,stmp
-  character(len=80) strings(3)
-  character(len=1) digit
-  integer i,ty,cs,cf
-
-  stmp = ''
-  cs = 1
-  cf = 1
-  strings(:) = ''
-  do i = 1,len(trim(line))
-    digit = line(i:i)
-    if (digit .ne. ' '.and.digit .ne. char(9)) then  !should exclude tabstops and blanks, 9 is ascii code for tab
-      stmp = trim(stmp)//trim(digit)
-    elseif (stmp .ne. '') then
-      call checktype(stmp,num,str,ty)      !get type of string, 0=number, 1=character
-      if (ty .eq. 0) then
-        floats(cf) = num
-        cf = cf+1
-      elseif (ty .eq. 1) then
-        strings(cs) = trim(str)
-        cs = cs+1
-      else
-        write (*,*) 'Problem in checktype, must abort'
-        exit
-      end if
-      stmp = ''
-    end if
-    if (i .eq. len(trim(line))) then  !special case: end of line
-      call checktype(stmp,num,str,ty)
-      if (ty .eq. 0) then
-        floats(cf) = num
-        cf = cf+1
-      elseif (ty .eq. 1) then
-        strings(cs) = trim(str)
-        cs = cs+1
-      else
-        write (*,*) 'Problem in checktype, must abort'
-        exit
-      end if
-      stmp = ''
-    end if
-  end do
-end subroutine cutline
-
-!========================================================================================!
-!this checks the type of the string and returns it cast to real or as string.
-subroutine checktype(field,num,str,ty)
-  use iso_fortran_env,only:wp => real64
-  implicit none
-  character(len=*) field,str
-  real(wp) :: num
-  integer :: e,ty
-  logical :: is_num
-
-  ty = 99
-  str = ''
-  is_num = .false.
-  read (field,'(F10.5)',IOSTAT=e) num !cast string on real and get error code; 0 means success.
-  if (e .eq. 0) is_num = .true.
-  if (is_num) then
-    if (index(field,'.') .ne. 0) then  !check for integer/real
-      read (field,'(F30.16)') num
-      ty = 0
-    else                       !if integer, add .0 to string; otherwise cast to real does not work
-      str = trim(field)//'.0'
-      read (str,'(F30.16)') num
-      str = ''
-      ty = 0
-    end if
-  else
-    str = field
-    ty = 1
-  end if
-end subroutine checktype
-
diff --git a/src/restartlog.f90 b/src/restartlog.f90
index 3584d12b..b46c3fc6 100644
--- a/src/restartlog.f90
+++ b/src/restartlog.f90
@@ -17,414 +17,186 @@
 ! along with crest.  If not, see <https://www.gnu.org/licenses/>.
 !================================================================================!
 
-!> global variables to keep track of restart
+!> Lightweight restart checkpoint for conformational search runtypes.
+!> Records only which stage completed and which file was last written —
+!> no ensemble data is stored.
 
 module crest_restartlog
-  use crest_parameters
-  use crest_data
-  use miscdata, only: PSE
-  use iomod, only: command
+  use crest_parameters,only:wp,stdout
   implicit none
   private
 
-  !logical,parameter :: debug = .true.
-  logical,parameter :: debug = .false.
-  logical,parameter :: saveensembles = .true.
-
-!>--- tracking variables
-  integer :: restart_tracker = 0
-  integer :: restart_goal = 0
-
-  logical,allocatable :: last_processed(:)
-  character(len=300) :: last_dumped
-
-  !> a backup of the crest envrionment
-  type(systemdata),allocatable :: restart_env
-
-  !> backup of the last processed ensemble
-  character(len=300) :: last_file
-  integer :: last_nat = 0
-  integer :: last_nall = 0
-  integer,allocatable  :: last_at(:)
-  real(wp),allocatable :: last_xyz(:,:,:)
-  character(len=128),allocatable :: last_comments(:)
-
-!>--- routines/functions
-  public :: trackrestart
-  public :: restart_save_env
-  public :: trackensemble
-  interface trackensemble
-    module procedure :: trackensemble_comments
-    module procedure :: trackensemble_energy
-  end interface trackensemble
-  public :: restart_write_dummy
-
-  public :: dump_restart,read_restart
+  character(len=*),parameter,public :: restart_file = 'crest.restart'
+
+  !> All state needed to resume a conformational search.
+  type,public :: restart_data
+    integer  :: version   = 1
+    integer  :: runtype   = 0    !> crestver (crest_imtd=2 or crest_imtd2=22)
+    integer  :: main_iter = 0    !> env%nreset at checkpoint
+    integer  :: mtd_iter  = 0    !> last completed MTD iteration index
+    integer  :: nmetadyn  = 0    !> env%nmetadyn (trimmed after first MTD pass)
+    character(len=64)  :: stage        = 'none'
+    character(len=512) :: last_file    = ''   !> last CREGEN-sorted file written
+    real(wp) :: elowest   = 0.0_wp
+    real(wp) :: eprivious = 0.0_wp
+  end type restart_data
+
+  public :: write_restart_log
+  public :: read_restart_log
+  public :: restart_file_exists
+  public :: print_restart_info
 
 !========================================================================================!
 !========================================================================================!
 contains !> MODULE PROCEDURES START HERE
 !========================================================================================!
 !========================================================================================!
-!> Tracking routines to be called within the algos
 
-  function trackrestart(env) result(skip)
-!****************************************
-!* This function is to be called both
-!* to increment the restart tracker, and
-!* to check if a step needs to be skiped
-!****************************************
+  logical function restart_file_exists()
+!*************************************
+!* Returns .true. if crest.restart
+!* exists in the current directory.
+!*************************************
     implicit none
-    logical :: skip
-    type(systemdata),intent(in),optional :: env
-    skip = .false.
-    restart_tracker = restart_tracker+1
-    if (debug) write (stdout,*) '%%% RESTART_TRACKER =',restart_tracker
-
-    if (restart_tracker < restart_goal) skip = .true.
-    if (.not.skip.and.present(env)) then
-      call restart_save_env(env)
-      call dump_restart()
-    end if
-    if(restart_tracker == restart_goal-1)then
-      if (debug) write (stdout,*) '%%% RESTART_RESTORE %%%'
-      call restore_ensemble()
-    endif
-  end function trackrestart
-
-
-  subroutine trackensemble_comments(fname,nat,nall,at,xyz,comments)
-!*******************************************************
-!* This subroutine decides wether to track the ensemble
-!* Typically, this routine is called in CREGEN
-!*******************************************************
-     implicit none
-     character(len=*),intent(in) :: fname
-     integer,intent(in)  :: nat,nall
-     integer,intent(in)  :: at(nat)
-     real(wp),intent(in) :: xyz(3,nat,nall)
-     character(len=*),intent(in) :: comments(nall)
-
-    if (restart_tracker > restart_goal)then
-      call restart_save_ensemble(fname,nat,nall,at,xyz,comments)
-    if (debug) write (stdout,*) '%%% RESTART_ENSEMBLE = ',trim(fname)
-    endif
-  end subroutine trackensemble_comments
-
-  subroutine trackensemble_energy(fname,nat,nall,at,xyz,eread)
-!*******************************************************
-!* This subroutine decides wether to track the ensemble
-!* Typically, this routine is called in CREGEN
-!*******************************************************
-     implicit none
-     character(len=*),intent(in) :: fname
-     integer,intent(in)  :: nat,nall
-     integer,intent(in)  :: at(nat)
-     real(wp),intent(in) :: xyz(3,nat,nall)
-     real(wp),intent(in) :: eread(nall)
-     character(len=50),allocatable  :: comments(:)
-     integer :: i
-    if (restart_tracker > restart_goal)then
-      allocate(comments(nall))
-      do i=1,nall
-        write(comments(i),*) eread(i)
-      enddo
-      call restart_save_ensemble(fname,nat,nall,at,xyz,comments)
-      deallocate(comments)
-    if (debug) write (stdout,*) '%%% RESTART_ENSEMBLE = ',trim(last_file)
-    endif
-  end subroutine trackensemble_energy
-
-
-  subroutine restart_write_dummy(fname)
-!*******************************************************
-!* This subroutine produces a placeholder file with
-!* only one structure
-!*******************************************************
-     implicit none
-     character(len=*),intent(in) :: fname
-     integer :: i,ich
-     if (restart_tracker < restart_goal-1)then
-     if(.not.debug) write (stdout,'(a,a)') 'CREST_RESTART> writing DUMMY file ',trim(fname)
-      open(newunit=ich, file=trim(fname))   
-      write(ich,*) last_nat
-      write(ich,*) trim(last_comments(1))
-      do i=1,last_nat
-      write(ich,'(a2,3f20.10)') PSE(last_at(i)),last_xyz(1:3,i,1)
-      enddo
-      close(ich)
-      if (debug) write (stdout,*) '%%% RESTART_DUMMY = ',trim(fname)
-     endif
-  end subroutine restart_write_dummy
-
-
-  subroutine restore_ensemble()
-!*******************************************************
-!* This subroutine produces a placeholder file with
-!* only one structure
-!*******************************************************
-     implicit none
-     integer :: i,ich,j,k
-     character(len=:),allocatable :: fname
-     character(len=:),allocatable :: atmp
-     !if(index(last_file,crefile).ne.0)then
-     ! call command('rm -f '//crefile//'* 2>/dev/null')
-     ! fname = crefile//'_0.xyz'
-     !else
-      fname=trim(last_file)
-     !endif
-
-      if(.not.debug)then
-         atmp = 'CREST_RESTART> RESTORING file '//trim(fname)
-         k = len_trim(atmp)+2
-         write (stdout,'(a,/,a,/,a)') repeat(':',k),trim(atmp),repeat(':',k) 
-      endif
-      open(newunit=ich, file=trim(fname))
-      do j=1,last_nall
-      write(ich,*) last_nat
-      write(ich,*) trim(last_comments(j))
-      do i=1,last_nat
-      write(ich,'(a2,3f20.10)') PSE(last_at(i)),last_xyz(1:3,i,j)
-      enddo
-      enddo
-      close(ich)
-      if (debug) write (stdout,*) '%%% RESTORE_ENSEMBLE = ',trim(fname)
-  end subroutine restore_ensemble
-
-
-
-
+    inquire(file=restart_file,exist=restart_file_exists)
+  end function restart_file_exists
 
 !========================================================================================!
-!========================================================================================!
-!> DUMP to binary routines
 
-  subroutine dump_restart()
+  subroutine write_restart_log(runtype,stage,main_iter,mtd_iter,nmetadyn, &
+    &                          elowest,eprivious,last_file_in)
+!*************************************************************
+!* Write a text-based checkpoint to crest.restart.
+!* Called after each MTD iteration and after collectcre.
+!*
+!* Arguments:
+!*   runtype      - crestver constant (crest_imtd or crest_imtd2)
+!*   stage        - stage label: 'mtd_loop', 'post_collect', 'done'
+!*   main_iter    - env%nreset (MAINLOOP iteration counter)
+!*   mtd_iter     - last completed MTD iteration (0 for post-loop stages)
+!*   nmetadyn     - env%nmetadyn (may differ from initial after first pass)
+!*   elowest      - current lowest energy
+!*   eprivious    - previous lowest energy
+!*   last_file_in - last CREGEN-sorted file written to disk
+!*************************************************************
     implicit none
-    integer :: ich,i,j,k,l
-    character(len=250) :: atmp
-    if (debug) write (stdout,*) '%%% RESTART DEBUG dump summary'
-
-    !> DO NOT OVERWRITE IF WE HAVEN'T REACHED THE PREVIOUS RESTART ENTRY POINT
-    if( restart_tracker < restart_goal) return
-
-    open (newunit=ich,file='crest.restart',status='replace',form='unformatted')
-
-    write (ich) restart_tracker
-    if (debug) write (stdout,*) '%%% RESTART_TRACKER =',restart_tracker
-
-    if (allocated(restart_env)) then
-      atmp = restart_env%cmd
-      write (ich) atmp
-      if (debug) write (stdout,*) '%%% cmd: ',trim(atmp)
-
-      atmp = restart_env%inputcoords
-      write (ich) atmp
-      if (debug) write (stdout,*) '%%% inputcoords: ',trim(atmp)
-
-      write (ich) restart_env%eprivious
-      if (debug) write (stdout,*) '%%% eprivious: ',restart_env%eprivious
-
-      write (ich) restart_env%elowest
-      if (debug) write (stdout,*) '%%% elowest: ',restart_env%elowest
-
-      j = restart_env%ref%nat
-      write(ich) j
-      if (debug) write (stdout,*) '%%% ref natoms: ', j
-      do i=1,j
-        write(ich) restart_env%ref%at(i)
-      enddo
-      do i=1,j
-        write(ich) restart_env%ref%xyz(1:3,i)
-      enddo
-   
+    integer,intent(in)          :: runtype,main_iter,mtd_iter,nmetadyn
+    character(len=*),intent(in) :: stage,last_file_in
+    real(wp),intent(in)         :: elowest,eprivious
+    integer :: ich,io
+    open(newunit=ich,file=restart_file,status='replace',iostat=io)
+    if (io /= 0) then
+      write(stdout,'(a)') '**WARNING** could not write crest.restart'
+      return
     end if
-
-    call dump_last_ensemble(ich)
-    if (debug) write (stdout,'(1x,a,a)') '%%% ensemble: ',trim(last_file)
-    if (debug) write (stdout,*) '%%% nall: ',last_nall
-
-    close (ich)
-  end subroutine dump_restart
-
-  subroutine dump_last_ensemble(ich)
-!******************************************
-!* dump last saved ensemble as binary data
-!******************************************
-    implicit none
-    integer, intent(in) :: ich
-    integer :: nat,nall,i,j,k,l
-    write(ich) last_file
-    nat = last_nat
-    write(ich) nat
-    nall = last_nall
-    write(ich) nall
-    if(allocated(last_comments) .and. allocated(last_xyz))then
-    do k=1,nat
-      write(ich) last_at(k)
-    enddo
-    do i=1,nall
-      write(ich) last_comments(i)
-      do j=1,nat
-        write(ich) last_xyz(1:3,j,i)
-      enddo
-    enddo
-    endif
-  end subroutine dump_last_ensemble
+    write(ich,'(a)') '# CREST restart checkpoint - do not edit manually'
+    write(ich,'(a,1x,i0)') 'version',   1
+    write(ich,'(a,1x,i0)') 'runtype',   runtype
+    write(ich,'(a,1x,i0)') 'main_iter', main_iter
+    write(ich,'(a,1x,i0)') 'mtd_iter',  mtd_iter
+    write(ich,'(a,1x,i0)') 'nmetadyn',  nmetadyn
+    write(ich,'(a,1x,a)')  'stage',     trim(stage)
+    write(ich,'(a,1x,a)')  'last_file', trim(last_file_in)
+    write(ich,'(a,1x,f25.15)') 'elowest',   elowest
+    write(ich,'(a,1x,f25.15)') 'eprivious', eprivious
+    close(ich)
+  end subroutine write_restart_log
 
 !========================================================================================!
-!========================================================================================!
-!> read from binary subroutines
 
-  subroutine read_restart(env)
+  subroutine read_restart_log(rdat)
+!*************************************************************
+!* Read crest.restart into a restart_data object.
+!* Unknown keys are silently ignored for forward compatibility.
+!*
+!* Arguments:
+!*   rdat - restart_data object to populate
+!*************************************************************
     implicit none
-    type(systemdata),intent(inout) :: env
-    integer :: ich,i,j,k,l
-    character(len=250) :: atmp
-    real(wp) :: rdum,xyzdum(3)
-    integer :: idum
-    logical :: ex
-    integer,allocatable :: at(:) 
-    real(wp),allocatable :: xyz(:,:)
-    inquire(file='crest.restart', exist=ex)
-
-    if(.not.ex)then
-     write(stderr,'(a)') '**ERROR** while attempting to read crest.restart: file does not exist'
-     error stop
-    endif
-
-    open (newunit=ich,file='crest.restart',status='old',form='unformatted')
-    write(stdout,'(/,a)') repeat(":",80)
-    write(stdout,'(a)') 'READING crest.restart ...'
-    write(stdout,'(/,a)') '**WARNING**'
-    write(stdout,'(1x,a)') "It is a user responsibility to re-use an identical job setup,"
-    write(stdout,'(1x,a)') 'either via cmd or input file. The restart option only tracks'
-    write(stdout,'(1x,a)') 'structure information and a non-unique restart step ID'
-    write(stdout,'(a,/)') '**WARNING**'
-
-
-
-    read (ich) restart_goal
-    write(stdout,'(1x,a,i0)') 'Target restart step: ',restart_goal  
-
-    read (ich) atmp 
-    env%cmd = trim(atmp)
-    write(stdout,'(1x,a,2a)') 'Previous crest cmd: "',env%cmd,'"'
+    type(restart_data),intent(out) :: rdat
+    integer :: ich,io
+    character(len=512) :: line,key,val
+    integer :: pos
 
-    read (ich) atmp
-    env%inputcoords = trim(atmp)
-    write(stdout,'(1x,a,a)') 'Previous coord input file: ',env%inputcoords
-
-    read (ich) env%eprivious
-    read (ich) env%elowest
-    write(stdout,'(1x,a,f20.10)') 'Previous lowest energy: ',env%elowest
-
-    read (ich) j
-    write(stdout,'(1x,a,i0,a)') 'Original input coordinates for ',j,' atoms (Angström, CMA shifted): '
-    allocate(at(j))
-    do i=1,j
-      read(ich) at(i)
-    enddo
-    allocate(xyz(3,j))
-    do i=1,j
-      read(ich) xyzdum(1:3)
-      xyz(:,i) = xyzdum(:) 
-    enddo
-    write(stdout,'(a5,3a16)') 'at','X','Y','Z'
-    do i=1,j
-      write(stdout,'(a5,3f16.8)') trim(PSE(at(i))),xyz(1:3,i)*autoaa
-    enddo
-    env%ref%nat = j
-    call move_alloc(at, env%ref%at)
-    call move_alloc(xyz, env%ref%xyz)
-     
-
-    call read_last_ensemble(ich)
-    if(last_nat > 0 .and. last_nall > 0)then
-      write(stdout,'(1x,a,a)') 'Last processed ensemble file: ',trim(last_file)
-      write(stdout,'(1x,a,i0)') 'Number of saved structures: ',last_nall
-    endif
-
-
-    close (ich)
-    write(stdout,'(a)') 'FINISHED READING crest.restart ...'
-    write(stdout,'(a,/)') repeat(":",80)
-    !stop
-
-  end subroutine read_restart
-
-  subroutine read_last_ensemble(ich)
-!******************************************
-!* dump last saved ensemble as binary data
-!******************************************
-    implicit none
-    integer, intent(in) :: ich
-    integer :: nat,nall,i,j,k,l
-    read(ich) last_file
-    read(ich) nat
-    last_nat = nat
-    read(ich) nall
-    last_nall = nall
-    if(nat > 0 .and. nall > 0) then
-      allocate(last_at(nat))
-      allocate(last_xyz(3,nat,nall))
-      allocate(last_comments(nall)) 
-      do k=1,nat
-        read(ich) last_at(k)
-      enddo
-      do i=1,nall
-        read(ich) last_comments(i)
-        do j=1,nat
-          read(ich) last_xyz(1:3,j,i)
-        enddo
-      enddo
-    endif
-  end subroutine read_last_ensemble
+    rdat = restart_data()  !> initialise with defaults
 
+    open(newunit=ich,file=restart_file,status='old',iostat=io)
+    if (io /= 0) then
+      write(stdout,'(a)') '**WARNING** could not read crest.restart'
+      return
+    end if
 
+    do
+      read(ich,'(a)',iostat=io) line
+      if (io /= 0) exit
+      line = adjustl(line)
+      if (len_trim(line) == 0) cycle
+      if (line(1:1) == '#') cycle
+      pos = index(line,' ')
+      if (pos < 2) cycle
+      key = line(1:pos-1)
+      val = adjustl(line(pos+1:))
+      select case(trim(key))
+      case('version')
+        read(val,*,iostat=io) rdat%version
+      case('runtype')
+        read(val,*,iostat=io) rdat%runtype
+      case('main_iter')
+        read(val,*,iostat=io) rdat%main_iter
+      case('mtd_iter')
+        read(val,*,iostat=io) rdat%mtd_iter
+      case('nmetadyn')
+        read(val,*,iostat=io) rdat%nmetadyn
+      case('stage')
+        rdat%stage = trim(val)
+      case('last_file')
+        rdat%last_file = trim(val)
+      case('elowest')
+        read(val,*,iostat=io) rdat%elowest
+      case('eprivious')
+        read(val,*,iostat=io) rdat%eprivious
+      end select
+    end do
+    close(ich)
+  end subroutine read_restart_log
 
 !========================================================================================!
-!========================================================================================!
-!> some routines to create backup data
 
-  subroutine restart_save_env(env)
-!*************
-!* backup env
-!*************  
+  subroutine print_restart_info(rdat)
+!*****************************************************
+!* Print a summary of the restart checkpoint to stdout.
+!*****************************************************
     implicit none
-    type(systemdata),intent(in) :: env
-    if (.not.allocated(restart_env)) then
-      allocate (restart_env,source=env)
+    type(restart_data),intent(in) :: rdat
+    character(len=64) :: rtname
+    integer :: w
+    w = 57
+
+    select case(rdat%runtype)
+    case(2)
+      rtname = 'iMTD-GC'
+    case(22)
+      rtname = 'sMTD-iMTD (entropy)'
+    case default
+      write(rtname,'(a,i0)') 'runtype ',rdat%runtype
+    end select
+
+    write(stdout,*)
+    write(stdout,'(1x,a)') repeat(':',w)
+    write(stdout,'(1x,a,a,a)') ' RESTART DETECTED (',trim(restart_file),')'
+    write(stdout,'(1x,a,a)')   '  runtype  : ',trim(rtname)
+    write(stdout,'(1x,a,a)')   '  stage    : ',trim(rdat%stage)
+    if (rdat%stage == 'mtd_loop') then
+      write(stdout,'(1x,a,i0,a,i0,a)') '  MTD iter : ',rdat%mtd_iter, &
+        &  ' (MAINLOOP ',rdat%main_iter,')'
     end if
-    restart_env = env
-  end subroutine restart_save_env
-
-
-  subroutine restart_save_ensemble(fname,nat,nall,at,xyz,comments)
-!*********************************
-!* backup last processed ensemble
-!*********************************
-     implicit none
-     character(len=*),intent(in) :: fname
-     integer,intent(in)  :: nat,nall
-     integer,intent(in)  :: at(nat)
-     real(wp),intent(in) :: xyz(3,nat,nall)
-     character(len=*),intent(in) :: comments(nall)
-     integer :: i
-     if(.not.saveensembles) return
-     !> backup of the last processed ensemble
-     last_file = trim(fname)
-     last_nat = nat
-     last_nall = nall
-     if(.not.allocated(last_at)) allocate(last_at(nat))
-     last_at(:) = at(:)
-     if(allocated(last_xyz)) deallocate(last_xyz)
-     if(allocated(last_comments)) deallocate(last_comments)
-     allocate(last_xyz(3,nat,nall))
-     allocate(last_comments(nall))
-     last_xyz(:,:,:) = xyz(:,:,:)
-     last_comments(:) = comments(:)
-  end subroutine restart_save_ensemble
+    if (len_trim(rdat%last_file) > 0) then
+      write(stdout,'(1x,a,a)')   '  last file: ',trim(rdat%last_file)
+    end if
+    write(stdout,'(1x,a,f20.10)') '  elowest  : ',rdat%elowest
+    write(stdout,'(1x,a)') repeat(':',w)
+    write(stdout,*)
+  end subroutine print_restart_info
 
 !========================================================================================!
 !========================================================================================!
diff --git a/src/rotcompare.f90 b/src/rotcompare.f90
deleted file mode 100644
index 312d8dc5..00000000
--- a/src/rotcompare.f90
+++ /dev/null
@@ -1,170 +0,0 @@
-!===============================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2018-2020 Philipp Pracht
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!===============================================================================!
-
-!===============================================================================!
-! Routines for the comparison of two structures based
-! on their rotational constants.
-!===============================================================================!
-!--- formerly in "eqrot.f"
-
-logical function equalrot(i,j,nall,thr,rot)
-  implicit none
-  integer i,j,nall
-  real*8 rot(3,nall),r,r1,thr
-  equalrot = .false.
-  r1 = rot(1,i)**2+rot(2,i)**2+rot(3,i)**2
-  r = (rot(1,i)-rot(1,j))**2 &
- & +(rot(2,i)-rot(2,j))**2 &
- & +(rot(3,i)-rot(3,j))**2
-  !write(*,*) sqrt(r)/sqrt(r1)
-  if (sqrt(r)/sqrt(r1) .lt. thr) equalrot = .true.
-end function equalrot
-
-logical function equalrot2(i,j,nall,thr,rot)
-  implicit none
-  integer i,j,nall
-  real*8 rot(3,0:nall),r,r1,r2,thr
-  equalrot2 = .false.
-  r1 = rot(1,i)**2+rot(2,i)**2+rot(3,i)**2
-  r2 = rot(1,j)**2+rot(2,j)**2+rot(3,j)**2
-  r = (rot(1,i)-rot(1,j))**2 &
- & +(rot(2,i)-rot(2,j))**2 &
- & +(rot(3,i)-rot(3,j))**2
-  if (2.*sqrt(r)/(sqrt(r1)+sqrt(r2)) .lt. thr) equalrot2 = .true.
-end function equalrot2
-
-real*8 function rotdiff(i,j,nall,rot)
-  implicit none
-  integer i,j,nall
-  real*8 rot(3,nall),r,r1,r2
-  r1 = rot(1,i)**2+rot(2,i)**2+rot(3,i)**2
-  r2 = rot(1,j)**2+rot(2,j)**2+rot(3,j)**2
-  r = (rot(1,i)-rot(1,j))**2 &
- & +(rot(2,i)-rot(2,j))**2 &
- & +(rot(3,i)-rot(3,j))**2
-  rotdiff = 2.*sqrt(r)/(sqrt(r1)+sqrt(r2))
-end function rotdiff
-
-!- use an absolute value as threshold
-logical function equalrotall(i,j,nall,thr,rot)
-  implicit none
-  integer i,j,nall
-  real*8 rot(3,nall),thr
-  logical :: r1,r2,r3
-  equalrotall = .false.
-  r1 = abs(rot(1,i)-rot(1,j)) .le. thr
-  r2 = abs(rot(2,i)-rot(2,j)) .le. thr
-  r3 = abs(rot(3,i)-rot(3,j)) .le. thr
-  equalrotall = r1.and.r2.and.r3
-  return
-end function equalrotall
-
-!- use a relative value as threshold
-logical function equalrotallrel(i,j,nall,thr,rot)
-  implicit none
-  integer i,j,nall
-  real*8 rot(3,nall),thr
-  logical :: r1,r2,r3
-  equalrotallrel = .false.
-  r1 = abs((rot(1,i)/rot(1,j))-1.0d0) .le. thr
-  r2 = abs((rot(2,i)/rot(2,j))-1.0d0) .le. thr
-  r3 = abs((rot(3,i)/rot(3,j))-1.0d0) .le. thr
-  equalrotallrel = r1.and.r2.and.r3
-  return
-end function equalrotallrel
-
-logical function equalrotmean(i,j,nall,thr,rot)
-  implicit none
-  integer i,j,nall
-  real*8 rot(3,nall),r,thr
-  equalrotmean = .false.
-  r = abs(rot(1,i)-rot(1,j))
-  r = r+abs(rot(2,i)-rot(2,j))
-  r = r+abs(rot(3,i)-rot(3,j))
-  r = r/3.0d0
-  equalrotmean = r .le. thr
-  return
-end function equalrotmean
-
-!===========================================================!
-! anisotropy related functions
-
-! calculate rot.const. anisotropy for a single structure
-function rotaniso(i,nall,rot)
-  use iso_fortran_env,wp => real64
-  implicit none
-  real(wp) :: rotaniso
-  real(wp) :: rot(3,nall)
-  integer :: i,nall
-  real(wp) :: a,b,c,av
-  a = rot(1,i); b = rot(2,i); c = rot(3,i)
-  av = (a+b+c)/3.0_wp
-  rotaniso = sqrt((a-av)**2+(b-av)**2+(c-av)**2)
-  rotaniso = rotaniso/av
-  rotaniso = rotaniso/(3.0_wp*sqrt(2.0_wp/3.0_wp))
-  return
-end function rotaniso
-
-!the threshold used for the rotational constant comparison is
-!is modified based on the anisotropy of the rot. constants
-!the scaling function is an error function
-function bthrerf(bthr,aniso,bthrmax,bthrshift) result(thr)
-  use iso_fortran_env,wp => real64
-  implicit none
-  real(wp) :: bthr,bthrmax,bthrshift
-  real(wp) :: aniso
-  real(wp) :: thr
-  real(wp) :: a,b,c,d
-  thr = bthr
-  c = ((bthrmax*100.0_wp)-(bthr*100.0_wp))/2.0_wp
-  a = -erf(-2.5_wp)*c+(bthr*100.0_wp) ! the y-axis shift
-  b = 4.0_wp/0.8_wp ! x-axis range from bthr to bthrmax
-  d = bthrshift/0.15_wp
-  thr = erf(aniso*b-d)*c+a
-  thr = thr/100.0_wp
-  return
-end function bthrerf
-
-! compare each rotational constant with a modified bthr threshold
-! bthr is a relative value threshold
-logical function equalrotaniso(i,j,nall,rot,bthr,bthrmax,bthrshift)
-  use iso_fortran_env,wp => real64
-  implicit none
-  integer i,j,nall
-  real(wp) :: rot(3,nall)
-  real(wp) :: bthr
-  real(wp) :: bthrmax,bthrshift
-  real(wp) :: anisoi,anisoj,av
-  real(wp) :: thr
-  real(wp) :: rotaniso !this is a function
-  real(wp) :: bthrerf  !this is a function
-  logical :: r1,r2,r3
-  equalrotaniso = .false.
-  anisoi = rotaniso(i,nall,rot)
-  anisoj = rotaniso(j,nall,rot)
-  av = (anisoi+anisoj)/2.0d0
-  !av=min(anisoi,anisoj)
-  thr = bthrerf(bthr,av,bthrmax,bthrshift)
-  r1 = abs((rot(1,i)/rot(1,j))-1.0d0) .le. thr
-  r2 = abs((rot(2,i)/rot(2,j))-1.0d0) .le. thr
-  r3 = abs((rot(3,i)/rot(3,j))-1.0d0) .le. thr
-  equalrotaniso = r1.and.r2.and.r3
-  return
-end function equalrotaniso
-
diff --git a/src/sdfio.f90 b/src/sdfio.f90
deleted file mode 100644
index f166ae9f..00000000
--- a/src/sdfio.f90
+++ /dev/null
@@ -1,130 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2018-2020 Philipp Pracht
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!================================================================================!
-
-!---------------------------------------------------------------------------------
-! Routines for the handling of molecules in the chemoinformatical *.SDF format
-!---------------------------------------------------------------------------------
-subroutine inpsdf(env,fname)
-  use iso_fortran_env,only:wp => real64
-  use crest_data
-  use strucrd
-  implicit none
-  type(systemdata) :: env
-  character(len=*) :: fname
-  type(coord) :: mol
-  integer :: i
-  env%sdfformat = .true.
-  call checkcoordtype(fname,i)
-  if (any((/31,32/) == i)) then
-    call mol%open(fname)
-  else
-    error stop 'file not in sdf format'
-  end if
-  return
-end subroutine inpsdf
-
-subroutine new_wrsdfens(env,fname,oname,conf)
-  use iso_fortran_env,only:wp => real64
-  use iomod
-  use crest_data
-  use strucrd
-  use zdata,only:readwbo
-  implicit none
-  type(systemdata) :: env
-  character(len=*),intent(in) :: fname
-  character(len=*),intent(in) :: oname
-  logical,intent(in),optional :: conf
-  integer  :: nat,nall
-  integer,allocatable  :: at(:)
-  real(wp),allocatable :: eread(:)
-  real(wp),allocatable :: xyz(:,:,:)
-  real(wp),allocatable :: c0(:,:)
-  real(wp),allocatable :: wbo(:,:)
-  real(wp),allocatable :: icharges(:)
-  integer :: i,j,ich
-  real(wp) :: er
-  logical :: ex,loopwbo,atmchrg
-  character(len=120) :: sdfcomment
-  loopwbo = .false.
-  atmchrg = .false.
-  if (present(conf)) loopwbo = conf
-  !>--- read existing ensemble
-  call rdensembleparam(fname,nat,nall)
-  allocate (at(nat),eread(nat),xyz(3,nat,nall))
-  call rdensemble(fname,nat,nall,at,xyz,eread)
-  allocate (wbo(nat,nat),c0(3,nat),source=0.0_wp)
-  !>--- determine how to obtain wbos
-  wbo = 0.0_wp
-  inquire (file='wbo',exist=ex)
-  if (ex.and..not.loopwbo) then
-    call readwbo('wbo',nat,wbo)
-  elseif (.not.ex.and..not.loopwbo) then
-    call xtbsp(env,0) !> gfn0 singlepoint
-    call readwbo('wbo',nat,wbo)
-  end if
-  !>--- (optional) some special settings
-  if (env%properties == p_protonate) atmchrg = .true.
-
-  if (atmchrg) allocate (icharges(nat),source=0.0_wp)
-
-  !>--- open sdf output file
-  open (newunit=ich,file=oname)
-  do i = 1,nall
-    write (sdfcomment,'(a,i0,a,i0)') 'structure ',i,' of ',nall
-    c0(1:3,1:nat) = xyz(1:3,1:nat,i)
-    er = eread(i)
-    if (loopwbo) then
-      call wrxyz('tmpstruc.xyz',nat,at,c0)
-      call xtbsp2('tmpstruc.xyz',env) !> singlepoint for wbos
-      call readwbo('wbo',nat,wbo)
-    end if
-    if (atmchrg) then
-      if (env%properties == p_protonate) then
-        call set_prot_icharges(nat,wbo,icharges)
-      end if
-      call wrsdf(ich,nat,at,c0,er,env%chrg,wbo,sdfcomment,icharges)
-    else
-      call wrsdf(ich,nat,at,c0,er,env%chrg,wbo,sdfcomment)
-    end if
-  end do
-  close (ich)
-
-  if (allocated(icharges)) deallocate (icharges)
-  deallocate (c0,wbo,xyz,eread,at)
-
-contains
-  subroutine set_prot_icharges(nat,wbo,icharges)
-    !>--- special routine for protonation mode
-    !     find the atom on which the proton was set
-    !     and set its charge to 1. The added proton is
-    !     always the last in the list, k=nat
-    integer,intent(in) :: nat
-    real(wp),intent(in) :: wbo(nat,nat)
-    real(wp),intent(out) :: icharges(nat)
-    integer :: i,j,k
-    icharges = 0.0_wp
-    k = nat
-    do i = 1,nat
-      if (nint(wbo(i,k)) .ne. 0) then
-        icharges(i) = 1.0_wp
-      end if
-    end do
-    return
-  end subroutine set_prot_icharges
-end subroutine new_wrsdfens
diff --git a/src/select.f90 b/src/select.f90
index b64cbb0b..0b1553c2 100644
--- a/src/select.f90
+++ b/src/select.f90
@@ -49,42 +49,6 @@ subroutine mrec(molcount,xyz,nat,at,molvec)
   molcount = molcount-1
 end subroutine mrec
 
-!=================================================================!
-! subroutine mreclm
-! a variant of the mrec routine with less allocate statements
-! should be faster than the old version if several thousand
-! calls are done.
-!=================================================================!
-subroutine mreclm(molcount,nat,at,xyz,molvec,bond,rcov,cn)
-  use iso_fortran_env,only:wp => real64
-  use crest_cn_module
-  implicit none
-  integer :: molcount,nat
-  integer :: at(nat),molvec(nat)
-  real(wp) :: xyz(3,nat)
-  real(wp) :: cn(nat),bond(nat,nat)
-  real(wp) :: bref(nat,nat)
-  real(wp) :: rcov(*)
-  integer :: i
-  logical :: taken(nat)
-  molvec = 0
-  molcount = 1
-  taken = .false.
-  cn = 0.0d0
-  bond = 0.0d0
-  call calc_ncoord(nat,at,xyz,rcov,cn,400.0_wp,bond)
-  bref = bond
-  do i = 1,nat
-    if (.not.taken(i)) then
-      molvec(i) = molcount
-      taken(i) = .true.
-      call neighbours(i,xyz,at,taken,nat,cn,bond,molvec,molcount)
-      molcount = molcount+1
-    end if
-  end do
-  molcount = molcount-1
-  bond = bref
-end subroutine mreclm
 
 !==================================================================================!
 recursive subroutine neighbours(i,xyz,iat,taken,nat,cn,bond,molvec,molcnt)
diff --git a/src/sigterm.F90 b/src/sigterm.F90
new file mode 100644
index 00000000..21898c38
--- /dev/null
+++ b/src/sigterm.F90
@@ -0,0 +1,150 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2023-2024 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+subroutine creststop(io)
+  use crest_parameters
+  use crest_data
+  implicit none
+  integer,intent(in) :: io
+
+  call graceful_shutdowns()
+
+  select case (io)
+  case (status_normal)
+    write (stdout,*) 'CREST terminated normally.'
+  case default
+    write (stdout,*) 'CREST terminated abnormally.'
+  case (status_error)
+    write (stdout,*) 'CREST terminated with errors.'
+  case (status_ioerr)
+    write (stdout,*) 'CREST terminated with I/O errors.'
+  case (status_args)
+    write (stdout,*) 'CREST terminated due to invalid parameters.'
+  case (status_input)
+    write (stdout,*) 'CREST terminated due to failed input file read.'
+  case (status_config)
+    write (stdout,*) 'CREST terminated due to invalid configuration.'
+  case (status_failed)
+    write (stdout,*) 'CREST terminated with failures.'
+  case (status_safety)
+    write (stdout,*) 'Safety termination of CREST.'
+  end select
+  call exit(io)
+
+end subroutine creststop
+
+!================================================================================!
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC!
+!================================================================================!
+!&>
+#if defined(__INTEL_LLVM_COMPILER)
+  subroutine wsigint() bind(C,name="crest_wsigint") !> Ctrl+C
+#else
+  subroutine wsigint() !> Ctrl+C
+#endif
+    use crest_parameters,only:stderr,stdout
+    write (*,*)
+    write (stderr,'(" recieved SIGINT, trying to terminate CREST...")')
+    !call dump_restart()
+    call exit(130)
+    error stop
+  end subroutine wsigint
+
+#if defined(__INTEL_LLVM_COMPILER)
+  subroutine wsigquit() bind(C,name="crest_wsigquit") !> Ctrl+D
+#else
+  subroutine wsigquit() !> Ctrl+D
+#endif
+    use crest_parameters,only:stderr,stdout
+    write (*,*)
+    write (stderr,'(" recieved SIGQUIT, trying to terminate CREST...")')
+    !call dump_restart()
+    call exit(131)
+    error stop
+  end subroutine wsigquit
+
+#if defined(__INTEL_LLVM_COMPILER)
+  subroutine wsigterm() bind(C,name="crest_wsigterm") !> Recieved by the "kill" pid command
+#else
+  subroutine wsigterm() !> Recieved by the "kill" pid command
+#endif
+    use crest_parameters,only:stderr,stdout
+    write (stdout,*)
+    write (stderr,'(" recieved SIGTERM, trying to terminate CREST...")')
+    !call dump_restart()
+    call exit(143)
+    error stop
+  end subroutine wsigterm
+
+#if defined(__INTEL_LLVM_COMPILER)
+  subroutine wsigkill() bind(C,name="crest_wsigkill")
+#else
+  subroutine wsigkill()
+#endif
+    use crest_parameters,only:stderr,stdout
+    !call dump_restart()
+    call exit(137)
+    error stop 'CREST recieved SIGKILL.'
+  end subroutine wsigkill
+
+  subroutine initsignal()
+#if defined(__INTEL_LLVM_COMPILER)
+   ! ifx: libifport's SIGNAL intrinsic crashes with ifx procedure thunks.
+   ! Register handlers via ISO_C_BINDING → crest_install_signal() in signal.c.
+   use iso_c_binding,only:c_int,c_funloc,c_funptr
+   implicit none
+   interface
+     subroutine crest_install_signal(signum,handler) &
+       bind(C,name='crest_install_signal')
+       import :: c_int,c_funptr
+       integer(c_int),value :: signum
+       type(c_funptr),value :: handler
+     end subroutine
+     subroutine wsigint() bind(C,name='crest_wsigint')
+     end subroutine
+     subroutine wsigquit() bind(C,name='crest_wsigquit')
+     end subroutine
+     subroutine wsigterm() bind(C,name='crest_wsigterm')
+     end subroutine
+   end interface
+   call crest_install_signal(2_c_int,c_funloc(wsigint))
+   call crest_install_signal(3_c_int,c_funloc(wsigquit))
+   call crest_install_signal(15_c_int,c_funloc(wsigterm))
+   ! SIGKILL (9) cannot be caught; signal 69 is invalid — omit both.
+#else
+   external :: wSIGINT
+   external :: wSIGTERM
+   external :: wSIGKILL
+   external :: wSIGQUIT
+   call signal(2,wSIGINT)
+   call signal(3,wSIGQUIT)
+   call signal(9,wSIGKILL)
+   call signal(15,wSIGTERM)
+   call signal(69,wSIGINT)
+#endif
+  end subroutine initsignal
+
+!=============================================================!
+  subroutine graceful_shutdowns()
+    use mlip_sc
+    implicit none
+    call mlips_shutdown()
+  end subroutine graceful_shutdowns
+!&<
+
diff --git a/src/sigterm.f90 b/src/sigterm.f90
deleted file mode 100644
index e1d3a794..00000000
--- a/src/sigterm.f90
+++ /dev/null
@@ -1,116 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2023-2024 Philipp Pracht
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!================================================================================!
-
-subroutine creststop(io)
-  use crest_parameters
-  use crest_data
-  implicit none
-  integer,intent(in) :: io
-
-  select case(io)
-  case (status_normal)
-    write (stdout,*) 'CREST terminated normally.'
-  case default
-    write (stdout,*) 'CREST terminated abnormally.'
-  case ( status_error )
-    write (stdout,*) 'CREST terminated with errors.'
-  case ( status_ioerr )
-    write (stdout,*) 'CREST terminated with I/O errors.'
-  case ( status_args )
-    write (stdout,*) 'CREST terminated due to invalid parameters.'
-  case ( status_input )
-    write (stdout,*) 'CREST terminated due to failed input file read.'
-  case ( status_config )
-    write (stdout,*) 'CREST terminated due to invalid configuration.'
-  case ( status_failed )
-    write (stdout,*) 'CREST terminated with failures.'
-  case ( status_safety )
-    write (stdout,*) 'Safety termination of CREST.'
-  end select
-  call exit(io)
-
-end subroutine creststop
-
-!================================================================================!
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC!
-!================================================================================!
-
-subroutine wsigint !> Ctrl+C
-  use crest_parameters,only:stderr,stdout
-  use crest_restartlog,only:dump_restart
-  use ConfSolv_module
-  integer :: myunit,io
-  write (*,*)
-  write (stderr,'(" recieved SIGINT, trying to terminate CREST...")')
-  !call dump_restart()
-  call cs_shutdown(io)
-  call exit(130)
-  error stop
-end subroutine wsigint
-
-subroutine wsigquit !> Ctrl+D or Ctrl+\
-  use crest_parameters,only:stderr,stdout
-  use crest_restartlog,only:dump_restart
-  use ConfSolv_module
-  integer :: myunit,io
-  write (*,*)
-  write (stderr,'(" recieved SIGQUIT, trying to terminate CREST...")')
-  !call dump_restart()
-  call cs_shutdown(io)
-  call exit(131)
-  error stop
-end subroutine wsigquit
-
-subroutine wsigterm !> Recieved by the "kill" pid command
-  use crest_parameters,only:stderr,stdout
-  use crest_restartlog,only:dump_restart
-  use ConfSolv_module
-  integer :: io
-  write (stdout,*)
-  write (stderr,'(" recieved SIGTERM, trying to terminate CREST...")')
-  !call dump_restart()
-  call cs_shutdown(io)
-  call exit(143)
-  error stop
-end subroutine wsigterm
-
-subroutine wsigkill
-  use crest_parameters,only:stderr,stdout
-  use crest_restartlog,only:dump_restart
-  use ConfSolv_module
-  integer :: io
-  !call dump_restart()
-  call cs_shutdown(io)
-  call exit(137)
-  error stop 'CREST recieved SIGKILL.'
-end subroutine wsigkill
-
-subroutine initsignal()
-  external :: wSIGINT
-  external :: wSIGTERM
-  external :: wSIGKILL
-  external :: wSIGQUIT
-
-  call signal(2,wSIGINT)
-  call signal(3,wSIGQUIT)
-  call signal(9,wSIGKILL)
-  call signal(15,wSIGTERM)
-  call signal(69,wSIGINT)
-end subroutine initsignal
-
diff --git a/src/sorting/CMakeLists.txt b/src/sorting/CMakeLists.txt
new file mode 100644
index 00000000..979250be
--- /dev/null
+++ b/src/sorting/CMakeLists.txt
@@ -0,0 +1,44 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+#
+# crest is free software: you can redistribute it and/or modify it under
+# the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# crest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with crest.  If not, see <https://www.gnu.org/licenses/>.
+
+set(dir "${CMAKE_CURRENT_SOURCE_DIR}")
+
+list(APPEND srcs
+  "${dir}/canonical.f90"
+  "${dir}/ccegen_interface.f90"
+  "${dir}/ccegen_utils.f90"
+  "${dir}/ccegen.f90"
+  "${dir}/cregen_interfaces.f90"
+  "${dir}/cregen.f90"
+  "${dir}/cregen_utils.f90"
+  "${dir}/ensemblecomp.f90"
+  "${dir}/hungarian.f90"
+  "${dir}/irmsd_module.f90"
+  "${dir}/ls_rmsd.f90"
+  "${dir}/quicksort.f90"
+  "${dir}/rotcompare.f90"
+"${dir}/unionize.f90"
+  "${dir}/zdata.f90"
+  "${dir}/ztopology.f90"
+)
+
+set(srcs ${srcs} PARENT_SCOPE)
+
+
+
+
+
+
diff --git a/src/canonical.f90 b/src/sorting/canonical.f90
similarity index 71%
rename from src/canonical.f90
rename to src/sorting/canonical.f90
index 8c88a233..c1cd0a7d 100644
--- a/src/canonical.f90
+++ b/src/sorting/canonical.f90
@@ -2,7 +2,7 @@
 module canonical_mod
 !*************************************************************************
 !* Implementation of different algorithms for determining atom identities
-!* 
+!*
 !* A) Implementation of the CANGEN algorithm by Weininger et al.
 !* D.Weininger et al., J. Chem. Inf. Comput. Sci., 1989, 29, 97-101.
 !* doi.org/10.1021/ci00062a008
@@ -21,6 +21,7 @@ module canonical_mod
   use strucrd
   use adjacency
   use geo
+  use utilities,only:nth_prime
   implicit none
   private
 
@@ -50,12 +51,16 @@ module canonical_mod
     procedure :: deallocate => deallocate_canonical_sorter
     procedure :: shrink => shrink_canonical_sorter
     procedure :: init => init_canonical_sorter
+    procedure :: init_graph => init_canonical_graph
+    procedure :: init_connect => init_canonical_sorter_connect
     procedure :: update_ranks
     procedure :: update_invariants
     procedure :: iterate
     procedure :: rankprint
     procedure :: stereo => analyze_stereo
+    procedure :: hasstereo => has_stereo
     procedure :: compare => compare_canonical_sorter
+    procedure :: add_h_ranks
   end type canonical_sorter
 
   logical,parameter :: debug = .false.
@@ -107,7 +112,7 @@ end subroutine shrink_canonical_sorter
 
 !========================================================================================!
 
-  subroutine init_canonical_sorter(self,mol,wbo,invtype)
+  subroutine init_canonical_sorter(self,mol,wbo,invtype,heavy)
 !*****************************************************************
 !* Initializes the canonical_sorter and runs the CANGEN algorithm
 !*****************************************************************
@@ -116,15 +121,15 @@ subroutine init_canonical_sorter(self,mol,wbo,invtype)
     type(coord),intent(in) :: mol
     real(wp),intent(in),optional :: wbo(mol%nat,mol%nat)
     character(len=*),intent(in),optional :: invtype
+    logical,intent(in),optional :: heavy
     integer :: nodes
     integer,allocatable :: Amat(:,:) !> adjacency matrix for FULL molecule
     integer :: counth,countb,countbo
     real(wp) :: countbo2
-    real(wp),allocatable :: cn(:),Bmat(:,:)
-    integer :: i,j,k,l,ii,ati,atj,maxnei
-    integer,allocatable :: ichrgs(:),frag(:)
+    integer :: i,j,k,ii,ati
+    integer,allocatable :: ichrgs(:)
     character(len=:),allocatable :: myinvtype
-    logical :: use_icharges
+    logical :: use_icharges,include_H,anyH
 
 !>--- optional argument handling
     if (present(invtype)) then
@@ -132,70 +137,22 @@ subroutine init_canonical_sorter(self,mol,wbo,invtype)
     else
       myinvtype = 'cangen'
     end if
+    if (present(heavy)) then
+      include_H = .not.heavy
+    else
+      include_H = .false.
+    end if
+    anyH = any(mol%at(:) .eq. 1)
 
-!>--- all atoms of the full mol. graph are nodes
-    nodes = mol%nat
-
-!>--- map to heavy atom-only representation
-    k = 0
-    do i = 1,mol%nat
-      if (mol%at(i) .ne. 1) k = k+1
-    end do
-    self%nat = nodes
-    self%hatms = k
-    allocate (self%nmap(nodes))
-    allocate (self%hmap(k))
-    allocate (self%invariants(k),source=0_int64)
-    allocate (self%invariants0(k),source=0)
-    allocate (self%prime(k),source=2)
-    allocate (self%rank(k),source=1)
-    allocate (self%hadjac(k,k),source=0)
-
-!>--- determine number of subgraphs via CN
-    call mol%cn_to_bond(cn,Bmat,'cov')
-    call wbo2adjacency(nodes,Bmat,Amat,0.02_wp)
-    allocate (frag(nodes),source=0)
-    call setup_fragments(nodes,Amat,frag)
-    self%nfrag = maxval(frag(:),1)
-    deallocate (frag,cn,Bmat)
-
-!>--- get connectivity. Easiest is just via WBO (allocates Amat)
-!    call wbo2adjacency(nodes,wbo,Amat,0.02_wp)
-
-!>--- documment neighbour list
-    maxnei = 0
-    do i = 1,mol%nat
-      k = count(Amat(:,i) > 0)
-      if (k > maxnei) maxnei = k
-    end do
-    if (debug) write (stdout,*) 'maximum number of neighbours',maxnei
-    self%maxnei = maxnei
-    allocate (self%neigh(maxnei,mol%nat),source=0)
-
-!>--- fill rest of self
-    k = 0
-    do i = 1,nodes
-      l = 0
-      if (mol%at(i) .ne. 1) then
-        k = k+1
-        self%nmap(i) = k
-        self%hmap(k) = i
-      else
-        self%nmap(i) = 0
-      end if
-      do j = 1,nodes
-        if (Amat(j,i) > 0) then
-          l = l+1
-          self%neigh(l,i) = j
-        end if
-      end do
-    end do
-    do i = 1,k
-      do j = 1,i-1
-        self%hadjac(j,i) = Amat(self%hmap(j),self%hmap(i))
-        self%hadjac(i,j) = self%hadjac(j,i)
-      end do
-    end do
+!>--- build the molecular graph (heavy-atom map, neighbour list, adjacency).
+!>    Returns the full-molecule adjacency matrix Amat for the invariant setup.
+    if (present(wbo)) then
+      call self%init_graph(mol,include_H,Amat,wbo=wbo)
+    else
+      call self%init_graph(mol,include_H,Amat)
+    end if
+    nodes = self%nat
+    k = self%hatms
 
 !>--- get the first invatiants
     if (allocated(mol%qat)) then
@@ -222,13 +179,13 @@ subroutine init_canonical_sorter(self,mol,wbo,invtype)
         end do
         self%invariants0(i) = update_invariant0_apsp(self%invariants0(i),ati,counth)
       end do
-      self%invariants(:) = real(self%invariants0(:))
+      self%invariants(:) = int(self%invariants0(:))
 
     case default !> CANGEN
 
-      if(.not.present(wbo))then
+      if (.not.present(wbo)) then
         error stop 'CANGEN implementation requires wbo matrix as argument'
-      endif
+      end if
       do i = 1,k
         ii = self%hmap(i)
         ati = mol%at(ii)
@@ -239,7 +196,7 @@ subroutine init_canonical_sorter(self,mol,wbo,invtype)
           if (Amat(j,ii) .ne. 0) then
             if (mol%at(j) .eq. 1) then
               counth = counth+1 !> count H neighbours
-                 countbo2 = countbo2-wbo(j,ii) !> but NOT in total bond order
+              countbo2 = countbo2-wbo(j,ii) !> but NOT in total bond order
             end if
             countb = countb+1 !> count all neighbours
             !countbo2 = countbo2+wbo(j,ii)  !> sum the total bond order
@@ -264,8 +221,8 @@ subroutine init_canonical_sorter(self,mol,wbo,invtype)
       call debugprint(self,mol)
     end if
 !>--- start assignment
-    allocate (self%newrank(k),source=0) !> workspace
-    allocate (self%newinv(k),source=0_int64) !>workspace
+    if (.not.allocated(self%newrank)) allocate (self%newrank(k),source=0) !> workspace
+    if (.not.allocated(self%newinv)) allocate (self%newinv(k),source=0_int64) !>workspace
     call self%update_ranks()
     self%rank(:) = self%newrank(:)
     if (debug) then
@@ -276,8 +233,145 @@ subroutine init_canonical_sorter(self,mol,wbo,invtype)
       call debugprint(self,mol)
     end if
     call self%iterate(mol) !> iterate recursively until ranking doesn't change
+
+!>--- finally, if required, add H atoms
+    if (include_H.and.anyH) then
+      !> sinc H's will have been added with rank 1, shift all ranks
+      self%rank(:) = self%rank(:)-1
+      call self%add_h_ranks(mol)
+    end if
+
   end subroutine init_canonical_sorter
 
+!========================================================================================!
+
+  subroutine init_canonical_graph(self,mol,include_H,Amat,wbo)
+!*****************************************************************
+!* Builds only the molecular graph part of the canonical_sorter:
+!* the heavy-atom maps (nmap/hmap), the neighbour list (neigh),
+!* the heavy-atom adjacency (hadjac) and the fragment count. The
+!* CANGEN/APSP rank refinement is NOT run here.
+!*
+!* This is the common graph-setup shared by init_canonical_sorter
+!* and has_stereo (which self-fills the graph when only externally
+!* supplied ranks are available). The full-molecule adjacency matrix
+!* is returned in Amat for any subsequent invariant construction.
+!*
+!* self      : canonical_sorter whose graph fields get populated
+!* mol       : input structure
+!* include_H : whether hydrogens are treated as graph nodes/ranks
+!* Amat      : (out) full-molecule adjacency matrix
+!* wbo       : (optional) bond-order matrix; if absent, connectivity
+!*             is derived from coordination numbers
+!*****************************************************************
+    implicit none
+    class(canonical_sorter),intent(inout) :: self
+    type(coord),intent(in) :: mol
+    logical,intent(in) :: include_H
+    integer,allocatable,intent(out) :: Amat(:,:)
+    real(wp),intent(in),optional :: wbo(mol%nat,mol%nat)
+    integer :: nodes,i,j,k,l,maxnei
+    real(wp),allocatable :: cn(:),Bmat(:,:)
+    integer,allocatable :: frag(:)
+
+!>--- all atoms of the full mol. graph are nodes
+    nodes = mol%nat
+
+!>--- map to heavy atom-only representation
+    k = 0
+    do i = 1,mol%nat
+      if (mol%at(i) .ne. 1.or.include_h) k = k+1
+    end do
+    self%nat = nodes
+    self%hatms = k
+    if (.not.allocated(self%nmap)) allocate (self%nmap(nodes))
+    if (.not.allocated(self%hmap)) allocate (self%hmap(k))
+    if (.not.allocated(self%invariants)) allocate (self%invariants(k),source=0_int64)
+    if (.not.allocated(self%invariants0)) allocate (self%invariants0(k),source=0)
+    if (.not.allocated(self%prime)) allocate (self%prime(k),source=2)
+    if (.not.allocated(self%rank)) allocate (self%rank(k),source=1)
+    if (.not.allocated(self%hadjac)) allocate (self%hadjac(k,k),source=0)
+
+    if (present(wbo)) then
+!>--- get connectivity. Easiest is just via WBO (allocates Amat)
+      call wbo2adjacency(nodes,wbo,Amat,0.02_wp)
+    else
+!>--- determine number of subgraphs via CN
+      call mol%cn_to_bond(cn,Bmat,'cov')
+      call wbo2adjacency(nodes,Bmat,Amat,0.02_wp)
+      deallocate (Bmat,cn)
+    end if
+    allocate (frag(nodes),source=0)
+    call setup_fragments(nodes,Amat,frag)
+    self%nfrag = maxval(frag(:),1)
+    deallocate (frag)
+
+!>--- documment neighbour list
+    maxnei = 0
+    do i = 1,mol%nat
+      k = count(Amat(:,i) > 0)
+      if (k > maxnei) maxnei = k
+    end do
+    if (debug) write (stdout,*) 'maximum number of neighbours',maxnei
+    self%maxnei = maxnei
+    if (.not.allocated(self%neigh)) allocate (self%neigh(maxnei,mol%nat),source=0)
+
+!>--- fill rest of self
+    k = 0
+    do i = 1,nodes
+      l = 0
+      if (mol%at(i) .ne. 1.or.include_h) then
+        k = k+1
+        self%nmap(i) = k
+        self%hmap(k) = i
+      else
+        self%nmap(i) = 0
+      end if
+      do j = 1,nodes
+        if (Amat(j,i) > 0) then
+          l = l+1
+          self%neigh(l,i) = j
+        end if
+      end do
+    end do
+    !> H's excluded from hadjac, always
+    do i = 1,k
+      if (mol%at(self%hmap(i)) .eq. 1) cycle
+      do j = 1,i-1
+        if (mol%at(self%hmap(j)) .eq. 1) cycle
+        self%hadjac(j,i) = Amat(self%hmap(j),self%hmap(i))
+        self%hadjac(i,j) = self%hadjac(j,i)
+      end do
+    end do
+  end subroutine init_canonical_graph
+
+!========================================================================================!
+
+ subroutine init_canonical_sorter_connect(self,at,wbo,invtype,heavy)
+!*****************************************************************
+!* Initializes the canonical_sorter provided only atom types and
+!* connectivity. No CN calculation etc.
+!*****************************************************************
+    implicit none
+    !> IN-/OUTPUTS
+    class(canonical_sorter),intent(inout) :: self
+    integer,intent(in) :: at(:)
+    real(wp),intent(in) :: wbo(size(at,1),size(at,1))
+    character(len=*),intent(in),optional :: invtype
+    logical,intent(in),optional :: heavy
+    !> LOCAL
+    integer :: nat
+    type(coord) :: tmpmol
+
+    nat = size(at,1)
+    allocate(tmpmol%at(nat))
+    tmpmol%at(:) = at(:)
+    tmpmol%nat = nat
+
+    call self%init(tmpmol,wbo=wbo,invtype=invtype,heavy=heavy)
+end subroutine init_canonical_sorter_connect
+
+
 !========================================================================================!
 
   subroutine get_invariant0_apsp(hatms,hadjac,inv)
@@ -289,7 +383,7 @@ subroutine get_invariant0_apsp(hatms,hadjac,inv)
     real(wp),allocatable :: dist(:,:)
     real(wp),allocatable :: rinv(:),tmprinv(:)
     integer,allocatable  :: tmp(:,:)
-    integer :: i,j,k,l,maxdist,lpath
+    integer :: i,j,k,maxdist
     real(wp) :: maxrinv
     inv(:) = 1
 
@@ -377,7 +471,7 @@ subroutine update_ranks(self)
 !>---update ranks and primes
     implicit none
     class(canonical_sorter) :: self
-    integer :: maxrank,i,j,k,ii
+    integer :: maxrank,i,j,ii
     integer :: newrank,ngroup
     integer(int64) :: mincurr
     maxrank = maxval(self%rank,1)
@@ -418,7 +512,7 @@ subroutine update_invariants(self)
 !>---update invariants
     implicit none
     class(canonical_sorter) :: self
-    integer :: i,j,k,ii
+    integer :: i,j
     integer(int64) :: invprod
     do i = 1,self%hatms
       invprod = 1
@@ -463,7 +557,7 @@ subroutine analyze_stereo(self,mol)
     class(canonical_sorter) :: self
     type(coord),intent(in) :: mol
     integer :: i,ii,zero,nei,j,jj,maxrank
-    integer :: k,l,rs
+    integer :: k,rs
     integer,allocatable :: neiranks(:,:)
     real(wp) :: coords(3,4)
     logical,allocatable :: isstereo(:)
@@ -475,7 +569,7 @@ subroutine analyze_stereo(self,mol)
       zero = count(self%neigh(:,ii) == 0)
       nei = self%maxnei-zero
 !>--- consider only atoms with 4 unique (in terms of CANGEN ranks) neighbours as stereocenter
-      if (nei == 4) then 
+      if (nei == 4) then
         do j = 1,4
           jj = self%neigh(j,ii)
           if (mol%at(jj) == 1) then !> one hydrogen allowed
@@ -513,6 +607,59 @@ subroutine analyze_stereo(self,mol)
     deallocate (neiranks,isstereo)
   end subroutine analyze_stereo
 
+!===========================================================================================!
+
+  function has_stereo(self,mol) result(yesno)
+!*****************************************************************
+!* Reports whether the molecule has a (CANGEN-rank) stereocenter.
+!*
+!* Only the molecular graph (neighbour list, heavy-atom map) and a
+!* rank array are required. When the graph has not been initialized
+!* yet - e.g. because the ranks were supplied externally rather than
+!* computed via init - it is self-filled here from the connectivity,
+!* so callers can run the stereo check on provided ranks without a
+!* full canonical_sorter%init.
+!*****************************************************************
+    implicit none
+    logical :: yesno
+    class(canonical_sorter),intent(inout) :: self
+    type(coord),intent(in) :: mol
+    integer :: i,ii,zero,nei,j,jj,maxrank
+    integer,allocatable :: neiranks(:,:)
+    logical,allocatable :: isstereo(:)
+    integer,allocatable :: Amat(:,:)
+
+    !> self-fill the molecular graph if only ranks (but no graph) are present.
+    !> include_H=.true. keeps hmap/hatms consistent with full-molecule ranks.
+    if (.not.allocated(self%neigh)) then
+      call self%init_graph(mol,.true.,Amat)
+      if (allocated(Amat)) deallocate (Amat)
+    end if
+
+    allocate (isstereo(mol%nat),source=.false.)
+    allocate (neiranks(4,mol%nat),source=0)
+    maxrank = maxval(self%rank(:))
+    do i = 1,self%hatms
+      ii = self%hmap(i)
+      zero = count(self%neigh(:,ii) == 0)
+      nei = self%maxnei-zero
+!>--- consider only atoms with 4 unique (in terms of ranks) neighbours as stereocenter
+      if (nei == 4) then
+        do j = 1,4
+          jj = self%neigh(j,ii)
+          if (mol%at(jj) == 1) then !> one hydrogen allowed
+            neiranks(j,ii) = maxrank+1
+          else
+            neiranks(j,ii) = self%rank(jj)
+          end if
+        end do
+        isstereo(ii) = unique_neighbours(4,neiranks(:,ii))
+      end if
+    end do
+    yesno = any(isstereo(:))
+    deallocate (neiranks,isstereo)
+  end function has_stereo
+
 !========================================================================================!
 
   function compare_canonical_sorter(self,other) result(yesno)
@@ -569,51 +716,69 @@ function compare_canonical_sorter(self,other) result(yesno)
     return
   end function compare_canonical_sorter
 
-!========================================================================================!
 !========================================================================================!
 
-  function nth_prime(x) result(prime)
+  subroutine add_h_ranks(self,mol)
+!******************************************************************
+!* Mapps ranks of the heavy atoms back to the full molecule order
+!* And continues ranks for H atoms, based on neighbor list
+!******************************************************************
     implicit none
-    integer,intent(in) :: x
-    integer :: prime
-    integer :: c,num,i
-    logical :: is_prime
-    integer,parameter :: prime_numbers(100) = (/2,3,5,7,11,13,17,19,23,29, &
-    & 31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109, &
-    & 113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197, &
-    & 199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283, &
-    & 293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389, &
-    & 397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487, &
-    & 491,499,503,509,521,523,541/)
-    if (x <= 100) then
-      prime = prime_numbers(x)
-      return
+    class(canonical_sorter),intent(inout) :: self
+    type(coord),intent(in) :: mol
+    integer,allocatable :: rankmap(:)
+    integer :: i,ii,jj,maxrank,rr
+!>--- self%rank must already have the correct dimension!
+    if (size(self%rank,1) .ne. mol%nat) then
+      stop 'wrong dimension for adding H to canonical ranks!'
     end if
-    c = 0
-    num = 1
-    do while (c < x)
-      num = num+1
-      is_prime = .true.
-      do i = 2,int(sqrt(real(num)))
-        if (mod(num,i) == 0) then
-          is_prime = .false.
-          exit
-        end if
-      end do
-      if (is_prime) then
-        c = c+1
+
+!>--- otherwise, analyze and resize
+    maxrank = maxval(self%rank(:),1)
+
+!>--- cycle through atoms, assign ranks depending on neighbour list
+    allocate (rankmap(maxrank),source=0)
+    rr = 0
+    do i = 1,self%hatms
+      if (mol%at(i) .ne. 1) cycle
+      ii = self%neigh(1,i)
+      if(ii < 1)then
+        !> Edge-case: "unbound"" hydrogens (H⁺,H2, etc.), skip those here
+        cycle
+      endif
+      jj = self%rank(ii)
+      rankmap(jj) = 1
+    end do
+    do i = 1,maxrank
+      if (rankmap(i) .eq. 1) then
+        rr = rr+1
+        rankmap(i) = maxrank+rr
       end if
     end do
-    prime = num
-  end function nth_prime
+    !> new maxrank(+1)
+    maxrank = maxval(rankmap(:),1)
+    do i = 1,self%hatms
+      if (mol%at(i) .ne. 1) cycle
+      ii = self%neigh(1,i)
+      if(ii < 1)then 
+        !> again, taking care of the "unbound" H edge-case --> separate maxrank+1 for all of them
+        self%rank(i) = maxrank
+        cycle
+      endif 
+      jj = self%rank(ii)
+      self%rank(i) = rankmap(jj)
+    end do
+    deallocate (rankmap)
+  end subroutine add_h_ranks
 
+!========================================================================================!
 !========================================================================================!
 
   subroutine debugprint(can,mol)
     implicit none
     type(canonical_sorter) :: can
     type(coord)  :: mol
-    integer :: i,k,ii,ati
+    integer :: i,ii,ati
     write (stdout,'(a10,a5,a15,a10,a10)') 'heavy-atom','type','invariant','rank','prime'
     do i = 1,can%hatms
       ii = can%hmap(i)
@@ -626,7 +791,7 @@ subroutine rankprint(can,mol)
     implicit none
     class(canonical_sorter) :: can
     type(coord)  :: mol
-    integer :: i,k,ii,ati
+    integer :: i,ii,ati
     write (stdout,'(a10,a10,a12,a10,2x,a)') 'heavy-atom','type','invariant0','rank','neighbours'
     do i = 1,can%hatms
       ii = can%hmap(i)
@@ -641,7 +806,7 @@ function print_neighbours(mol,neigh) result(btmp)
     integer,intent(in) :: neigh(:)
     character(len=:),allocatable :: btmp
     character(len=20) :: atmp
-    integer :: i,j,k
+    integer :: i
     btmp = ''
     if (neigh(1) == 0) then
       btmp = ' ---'
@@ -683,7 +848,7 @@ function determineRS(coords) result(RS)
     real(wp),intent(inout) :: coords(3,4)
     real(wp) :: theta
     real(wp) :: vec(3),uec(3)
-    integer :: k,l,m,n
+    integer :: k,l
 
     k = 4
     !> rotate the highest prio atom onto z axis (0,0,1)
diff --git a/src/sorting/ccegen.f90 b/src/sorting/ccegen.f90
new file mode 100644
index 00000000..f00b0827
--- /dev/null
+++ b/src/sorting/ccegen.f90
@@ -0,0 +1,636 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2020 Philipp Pracht, Stefan Grimme
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+subroutine CCEGEN(env,pr,fname)
+  !*****************************************************************************
+  !* PCA-based clustering of a conformational ensemble.                        *
+  !* Performs SVD to extract principal components, then partitions structures  *
+  !* into representative clusters via k-means.                                 *
+  !*                                                                           *
+  !* Input:  env   - system data (method settings, thresholds)                 *
+  !*         pr    - printout flag                                             *
+  !*         fname - ensemble file name                                        *
+  !*****************************************************************************
+  use ccegen_utils
+  use crest_parameters,idp => dp
+  use crest_data
+  use zdata
+  use strucrd
+  use utilities
+  implicit none
+  type(systemdata) :: env
+  type(timer) :: ctimer
+  logical,intent(in)   :: pr
+  character(len=*),intent(in) :: fname
+  type(zmolecule) :: zmol
+  type(zequal) :: groups
+  type(zequal) :: subgroups
+  integer,allocatable :: inc(:)
+  logical :: heavyonly
+  integer :: i,j,k,l,ich,c
+  integer :: nat,nall
+  real(wp) :: dum,dum2
+  type(coord),allocatable :: mols(:)
+
+  character(len=:),allocatable :: measuretype
+
+  !>--- SVD params
+  integer :: ntaken
+  integer :: nallnew
+  real(wp),allocatable :: xyznew(:,:,:)
+  real(wp),allocatable :: measure(:,:)
+  integer :: mn,mm
+  real(wp),allocatable :: pc(:)
+  real(wp),allocatable :: pcvec(:,:)
+  real(wp),allocatable :: pcdum(:,:)
+  integer :: nbnd,ndied
+  integer,allocatable :: diedat(:,:)
+  real(wp),allocatable :: diedr(:)
+  real(wp) :: pcsum
+  real(wp) :: pcthr
+  real(wp) :: pcmin
+  integer :: pccap
+  integer :: npc
+  real(wp),allocatable :: geo(:,:)
+  integer,allocatable :: na(:),nb(:),nc(:)
+
+  !>--- clustering params
+  character(len=:),allocatable :: clusteralgo
+  integer :: nclust
+  integer :: nclustiter
+  integer :: nclustmin,nclustmax
+  integer,allocatable :: member(:)
+  real(ap),allocatable :: p(:),q(:)
+  real(sp),allocatable :: dist(:)
+  real(ap),allocatable :: centroid(:,:)
+  integer(idp) :: ndist,klong
+  real(wp) :: DBI,pSF,SSRSST,SSRSSTthr
+  real(wp) :: csthr
+  integer :: ncb,ancb
+  real(wp),allocatable :: eclust(:)
+  integer,allocatable :: clustbest(:),ind(:)
+  real(wp),allocatable :: statistics(:,:)
+  integer,allocatable :: clust_sizes(:)
+  logical,allocatable :: extrema(:,:)
+  logical :: autolimit
+  real(wp) :: fraclimit
+
+  real(wp) :: emin,erel
+
+  call ctimer%init(20)
+  if (pr) then
+    call largehead('Principal Component Analysis (PCA) and Clustering')
+    write (stdout,'(1x,a,a)') 'Input file: ',trim(fname)
+  end if
+
+! ── set threads ─────────────────────────────────────────────────────────────────
+  call cregen_setthreads(stdout,env,pr)
+
+! ── read ensemble ────────────────────────────────────────────────────────────────
+  call rdensemble(fname,nall,mols)
+  if (nall < 1) then
+    error stop "Ensemble is empty! must stop"
+  end if
+  nat = mols(1)%nat
+  if (nall == 1) then
+    if (pr) then
+      write (stdout,*) 'Only one structure in ensemble!'
+      write (stdout,*) 'Write structure to ',clusterfile,' and skip PCA parts'
+    end if
+    open (newunit=ich,file=clusterfile)
+    call mols(1)%append(ich)
+    close (ich)
+    deallocate (mols)
+    return
+  end if
+
+  heavyonly = .true.
+  measuretype = env%pcmeasure
+  clusteralgo = 'kmeans'
+  pcthr = env%pcthr
+  pcmin = env%pcmin
+  csthr = env%csthr
+  pccap = env%pccap
+  autolimit = .true.
+  fraclimit = 0.25d0
+
+  if (env%maxcluster == 0) then
+    call clustleveval(env,nclustmax,csthr,SSRSSTthr,pcthr)
+  end if
+
+! ── topology for reference structure ─────────────────────────────────────────────
+  if (env%wbotopo) then
+    env%wbofile = 'wbo'
+  else
+    env%wbofile = 'none given'
+  end if
+  call simpletopo(nat,mols(1)%at,mols(1)%xyz,zmol,pr,.false.,env%wbofile)
+  allocate (inc(zmol%nat),source=0)
+
+!===========================================================!
+  if (measuretype .ne. 'dihedral') then
+!===========================================================!
+    if (pr) then
+      write (stdout,*)
+      call smallhead('READING NUCLEAR EQUIVALENCIES')
+    end if
+    call readequals('anmr_nucinfo',zmol,groups)
+    if (pr) then
+      call groups%prsum(6)
+      write (stdout,'(1x,a)') 'Unlisted nuclei (groups) are unique.'
+    end if
+
+    if (pr) then
+      write (stdout,*)
+      call smallhead('ANALYZING EQUIVALENCIES')
+    end if
+    call distsubgr(zmol,groups,subgroups,inc,pr)
+
+    if (pr) then
+      write (stdout,*)
+      call smallhead('DETERMINE ATOMS TO INCLUDE IN PCA')
+    end if
+    call excludeFromRMSD(zmol,inc)
+    if (sum(inc) == 0) then
+      if (pr) then
+        write (stdout,*) 'WARNING: No atoms included in PCA'
+        write (stdout,*) 'Including more atoms ...'
+      end if
+      inc = 1
+      do i = 1,groups%ng
+        if (groups%grp(i)%nm > 1) then
+          write (stdout,*) groups%grp(i)%mem
+          do j = 1,groups%grp(i)%nm
+            k = groups%grp(i)%mem(j)
+            inc(k) = 0
+          end do
+        end if
+      end do
+    end if
+    if (env%pcaexclude) then
+      call excludeSelected(zmol,inc,env%atlist)
+    end if
+    if (heavyonly) then
+      call excludeLight(zmol,inc)
+    end if
+    if (pr) then
+      do i = 1,zmol%nat
+        if (inc(i) == 1) then
+          write (stdout,'(1x,a,a,i0,a,5x,a)') zmol%zat(i)%el,'(',i,')','taken'
+        end if
+      end do
+    end if
+    ntaken = sum(inc)
+    ! ── fallback: include all heavy atoms if too few were selected ──────────────
+    if (ntaken <= 3) then
+      do i = 1,zmol%nat
+        if (zmol%at(i) /= 1) then
+          inc(i) = 1
+          if (pr) write (stdout,'(1x,a,a,i0,a,5x,a)') zmol%zat(i)%el,'(',i,')','taken'
+        end if
+      end do
+    end if
+    ntaken = sum(inc)
+
+    call zmol%deallocate
+
+    ! ── for large ensembles, limit the number of structures considered ──────────
+    if (autolimit) then
+      if ((env%nclust /= 0).and.(env%nclust*100 < nall)) then
+        dum = float(nall)*fraclimit
+        dum2 = float(env%nclust)
+        nallnew = nint(max(dum,dum2))
+      else
+        nallnew = nall
+      end if
+    else
+      nallnew = nall
+    end if
+
+    allocate (xyznew(3,ntaken,nallnew))
+    do i = 1,nallnew
+      k = 0
+      do j = 1,nat
+        if (inc(j) == 1) then
+          k = k+1
+          xyznew(:,k,i) = mols(i)%xyz(:,j)
+        end if
+      end do
+    end do
+
+!===================================================!
+  else !measuretype=='dihedral'
+!===================================================!
+
+    if (autolimit) then
+      if ((env%nclust /= 0).and.(env%nclust*100 < nall)) then
+        dum = float(nall)*fraclimit
+        dum2 = float(env%nclust)
+        nallnew = nint(max(dum,dum2))
+      else
+        nallnew = nall
+      end if
+    else
+      nallnew = nall
+    end if
+
+    inc = 1
+    ntaken = sum(inc)
+
+    call zmol%countbonds()
+    nbnd = zmol%nb
+    allocate (diedat(4,zmol%nb),source=0)
+    call getdiederatoms(zmol,zmol%nat,inc,nbnd,diedat,ndied)
+    ntaken = ndied
+!==================================================!
+  end if
+!==================================================!
+
+! ── SVD: principal component analysis ────────────────────────────────────────────
+  if (ntaken > 3) then  !> requires at least 4 descriptors
+    call ctimer%start(1,'PCA')
+    if (pr) then
+      write (stdout,*)
+      call smallhead('PRINCIPAL COMPONENT ANALYSIS')
+    end if
+    mm = nallnew
+    select case (measuretype)
+    case ('cma','CMA','cmadist')
+      if (pr) then
+        write (stdout,'(1x,a)') 'Using CMA DISTANCES as descriptors:'
+      end if
+      !>-- all structures should have been shifted to the CMA by CREGEN;
+      !>   somewhat robust but provides less information than zmatrix
+      mn = min(ntaken,mm)
+      allocate (measure(mn,mm),pc(mn),pcvec(mm,mn))
+      do i = 1,mm
+        do j = 1,mn
+          measure(j,i) = xyznew(1,j,i)**2+ &
+       &                 xyznew(2,j,i)**2+ &
+       &                 xyznew(3,j,i)**2
+          measure(j,i) = sqrt(measure(j,i))
+        end do
+      end do
+    case ('cartesian','coords')
+      if (pr) then
+        write (stdout,'(1x,a)') 'Using CARTESIAN COORDINATES as descriptors:'
+      end if
+      !>-- REQUIRES PERFECT ALIGNMENT; not robust for flexible molecules
+      mn = min(ntaken*3,mm)
+      allocate (measure(mn,mm),pc(mn),pcvec(mm,mn))
+      do i = 1,mm
+        l = 0
+        do j = 1,ntaken
+          do k = 1,3
+            l = l+1
+            if (l > mn) exit
+            measure(l,i) = xyznew(k,j,i)
+          end do
+          if (l > mn) exit
+        end do
+      end do
+    case default !case( 'zmat','zmatrix' )
+      if (pr) then
+        write (stdout,'(1x,a)') 'Using ZMATRIX as descriptors (sin/cos of dihedrals):'
+      end if
+      !>-- dihedral angles, sin/cos transformed for periodicity
+      l = ntaken-3  !>-- first three dihedral angles are zero by convention
+      mn = min(mm,2*l)  !>-- two descriptors per dihedral, capped at structure count
+      if (mn < 2) then  !>-- need at least one dihedral angle (two descriptors)
+        if (pr) then
+          write (stdout,*) "Not enough descriptors for PCA!"
+          return
+        end if
+      end if
+      allocate (measure(mn,mm),pc(mn),pcvec(mm,mn))
+      allocate (geo(3,ntaken),source=0.0d0)
+      allocate (na(ntaken),nb(ntaken),nc(ntaken))
+      do i = 1,mm
+        na = 0; nb = 0; nc = 0
+        geo = 0.0d0
+        call xyzint(xyznew(1:3,1:ntaken,i),ntaken,na,nb,nc,radtodeg,geo)
+        do j = 1,mn/2
+          k = j+3
+          dum = geo(3,k)*degtorad
+          measure(2*j-1,i) = sin(dum)
+          measure(2*j,i) = cos(dum)
+        end do
+      end do
+      deallocate (nc,nb,na,geo)
+    case ('dihedral')
+      mn = min(mm,2*ntaken)
+      allocate (measure(mn,mm),diedr(ndied))
+      if (pr) then
+        write (stdout,'(1x,a)') 'Using DIHEDRAL ANGLES as descriptors (sin/cos transformed):'
+        do i = 1,ntaken
+          write (stdout,'(1x,a,4i6)') 'Atoms: ',diedat(1:4,i)
+        end do
+        write (stdout,*)
+      end if
+      do i = 1,mm
+        call calc_dieders(mols(i),ndied,diedat,diedr)
+        do j = 1,min(ntaken,mn/2)
+          measure(2*j-1,i) = sin(diedr(j))
+          measure(2*j,i) = cos(diedr(j))
+        end do
+      end do
+      if (allocated(diedat)) deallocate (diedat)
+      if (allocated(diedr)) deallocate (diedr)
+      allocate (pc(mn),pcvec(mm,mn))
+    end select
+    if (pr) then
+      write (stdout,*)
+      write (stdout,'(1x,a,i0,a,i0,a)') 'Performing SVD for ', &
+&          mm,' structures and ',mn,' props'
+    end if
+    call SVD_to_PC(measure,mm,mn,pc,pcvec,.false.)  !> MM >= MN required
+    call ctimer%stop(1)
+  else
+    write (stdout,*) 'There are not enough descriptors for a PCA!'
+    write (stdout,*) 'Taking all structures as representative and writing ',clusterfile
+    open (newunit=ich,file=clusterfile)
+    do i = 1,nall
+      call mols(i)%append(ich)
+    end do
+    close (ich)
+    return
+  end if
+
+  if (allocated(measure)) deallocate (measure)
+  if (allocated(xyznew)) deallocate (xyznew)
+  if (allocated(inc)) deallocate (inc)
+
+  ! ── normalize eigenvalues and select contributing PCs ──────────────────────────
+  pcsum = sum(pc)
+  pc = pc/pcsum
+  pcsum = 0.0d0
+  npc = 0
+  do i = 1,mn
+    if (pc(i) < pcmin) exit
+    pcsum = pcsum+pc(i)
+    npc = npc+1
+    if (pcsum .ge. pcthr) exit
+  end do
+  npc = min(npc,pccap)
+  pcsum = 0.0d0
+  do i = 1,npc
+    pcsum = pcsum+pc(i)
+  end do
+
+  if (pr) then
+    i = min(100,MM)
+    k = min(npc,6)
+    write (stdout,*)
+    call smallhead('EIGENVECTORS AND NORMALIZED EIGENVALUES OF SVD ANALYIS')
+    call PRMAT(6,pcvec,i,k,'Eigenvectors of principal components')
+    write (stdout,'(1x,a,i0,a)') 'NOTE: eigenvectors are only shown for the first ',i,' structures'
+    write (stdout,'(1x,a,i0,a)') '      and the first ',k,' contributing principal components.'
+    write (stdout,*)
+
+    write (stdout,*) mn,'principal component eigenvalues (normalized)'
+    write (stdout,*) pc
+    write (stdout,*)
+    write (stdout,'(1x,a,i0,a,f6.2,a)') 'The first ',npc,' components account for a total of ',100.d0*pcsum,'% of the'
+    write (stdout,'(1x,a)') 'ensembles unique structural features and are used for the clustering'
+  end if
+
+  !>-- rearrange eigenvectors: drop unused PCs and swap to (npc,mm) layout
+  allocate (pcdum(npc,mm))
+  do i = 1,mm
+    pcdum(1:npc,i) = pcvec(i,1:npc)
+  end do
+  call move_alloc(pcdum,pcvec)  !> pcvec shape changes from (mm,mn) to (npc,mm)
+
+! ── k-means clustering ───────────────────────────────────────────────────────────
+  if (pr) then
+    write (stdout,*)
+    call smallhead('CLUSTERING ANALYSIS OF PRINCIPAL COMPONENTS')
+  end if
+
+  allocate (member(mm),source=0)
+
+  !>-- packed distance matrix; split to avoid integer overflow for large mm
+  ndist = mm
+  ndist = ndist*(mm+1)
+  ndist = ndist/2
+  allocate (dist(ndist),source=0.0_sp)
+  allocate (p(npc),q(npc),source=0.0_ap)
+
+  do i = 1,mm
+    p(1:npc) = pcvec(1:npc,i)
+!$OMP PARALLEL PRIVATE ( j, klong, q, dum ) &
+!$OMP SHARED ( i, dist, npc, p, pcvec )
+!$OMP DO
+    do j = 1,i
+      q(1:npc) = pcvec(1:npc,j)
+      dum = eucdist(npc,p,q)
+      klong = lina(i,j)
+      dist(klong) = real(dum,sp)
+    end do
+!$OMP END DO
+!$OMP END PARALLEL
+  end do
+
+  if (pr) then
+    select case (clusteralgo)
+    case ('means','kmeans')
+      write (stdout,'(1x,a)') 'Using a MEANS cluster algorithm.'
+    end select
+    write (stdout,'(1x,a)') 'For a good review of cluster algorithms see'
+    write (stdout,'(1x,a)') 'JCTC, 2007, 3, 2312 (doi.org/10.1021/ct700119m)'
+    write (stdout,*)
+    write (stdout,'(1x,a)') 'DBI = Davies-Bouldin index'
+    write (stdout,'(1x,a)') 'pSF = pseudo F-statistic'
+    write (stdout,'(1x,a)') 'SSR/SST = ratio of explained and unexplained variation'
+    write (stdout,*)
+    write (stdout,'(1x,a8,4x,a14,4x,a14,4x,a14)') 'Nclust','DBI','pSF','SSR/SST'
+    write (stdout,'(1x,a8,4x,a14,4x,a14,4x,a14)') '------','-------------','-------------','-------------'
+  end if
+
+! ── cluster evaluation settings ──────────────────────────────────────────────────
+  if (env%maxcluster == 0) then
+    call clustleveval(env,nclustmax,csthr,SSRSSTthr,pcthr)
+    nclustmax = min(mm,nclustmax)
+  else
+    nclustmax = max(2,env%maxcluster)
+    nclustmax = min(mm,env%maxcluster)
+  end if
+  if (env%nclust == 0) then
+    nclustmin = 1
+  else
+    nclust = min(mm,env%nclust)
+    nclustmin = nclust
+    nclustmax = nclust
+  end if
+
+  allocate (statistics(3,nclustmax),source=0.0d0)
+  allocate (clust_sizes(nclustmax),source=0)
+  CLUSTERSIZES: do nclustiter = nclustmin,nclustmax
+
+    nclust = nclustiter
+    if (env%clustlev >= 10) then
+      dum = float(mm)/float(nclustmax)
+      dum2 = dum*float(nclustiter)
+      nclust = nint(dum2)
+    end if
+    clust_sizes(nclustiter) = nclust
+
+    allocate (centroid(npc,nclust),source=0.0_ap)
+    centroid = 0.0_ap
+
+    select case (clusteralgo)
+    case ('means','kmeans')
+      call ctimer%start(2,'k-Means clustering')
+      call kmeans(nclust,npc,mm,centroid,pcvec,ndist,dist,member)
+      call ctimer%stop(2)
+    end select
+
+    call ctimer%start(3,'statistics')
+    call cluststat(nclust,npc,mm,centroid,pcvec,member,DBI,pSF,SSRSST)
+    if (pr) then
+      write (stdout,'(1x,i8,4x,f14.6,4x,f14.6,4x,f14.6)') nclust,DBI,pSF,SSRSST
+    end if
+    call ctimer%stop(3)
+    deallocate (centroid)
+
+    statistics(1,nclustiter) = DBI
+    statistics(2,nclustiter) = pSF
+    statistics(3,nclustiter) = SSRSST
+
+    if (nclust == env%nclust) exit
+    if (SSRSST > SSRSSTthr) exit
+  end do CLUSTERSIZES
+  if (allocated(centroid)) deallocate (centroid)
+
+  write (stdout,*)
+  if (env%nclust == 0) then
+    if (pr) then
+      write (stdout,'(1x,a,i0,a)') 'Ensemble checked up to a partitioning into ',nclust,' clusters.'
+      write (stdout,'(1x,a)') 'Local MINIMA of the DBI indicate adequate cluster counts.'
+      write (stdout,'(1x,a)') 'Local MAXIMA of the pSF indicate adequate cluster counts.'
+      write (stdout,'(1x,a)') 'Higher SSR/SST vaules indicate more distinct clusters.'
+      write (stdout,'(1x,a)') 'Analyzing statistical values ...'
+    end if
+    k = min(nclustiter,nclustmax)  !> last completed iteration index
+    allocate (extrema(2,k))
+    call ctimer%start(3,'statistics')
+    call statanal(k,nclustmax,statistics,extrema,pr,clust_sizes)
+    if (pr) call statwarning(fname)
+    ! ── pick smallest cluster count with adequate SSR/SST ──────────────────────
+    do i = 2,k
+      if ((extrema(1,i).or.extrema(2,i)).and.(statistics(3,i) > csthr)) then
+        nclust = clust_sizes(i)
+        exit
+      end if
+    end do
+    call ctimer%stop(3)
+    deallocate (extrema)
+    if (pr) then
+      write (stdout,*)
+      write (stdout,'(1x,a,f4.2,a,i0)') 'Suggested (SSR/SST >',csthr,') cluster count: ',nclust
+    end if
+    allocate (centroid(npc,nclust),source=0.0_ap)
+    select case (clusteralgo)
+    case ('means','kmeans')
+      call ctimer%start(2,'k-Means clustering')
+      call kmeans(nclust,npc,mm,centroid,pcvec,ndist,dist,member)
+      call ctimer%stop(2)
+    end select
+    deallocate (centroid)
+  else
+    if (pr) then
+      write (stdout,'(1x,a,i0,a)') 'Ensemble partitioning into ',nclust,' clsuters.'
+    end if
+  end if
+  deallocate (statistics,clust_sizes)
+
+  deallocate (q,p,dist)
+  call PCA_grpwrite(nclust,npc,mm,pcvec,member)
+
+  ncb = nclust
+  ancb = ncb
+
+  if (ancb .le. 1) return
+
+  if (pr) then
+    write (stdout,*)
+    write (stdout,'(1x,a)') 'Representative structures'
+    write (stdout,'(1x,a6,1x,a6,3x,a6,1x,a16,1x,a16)') 'Nr.','conf.','clust.','Etot/Eh','Erel/ kcal/mol'
+    write (stdout,'(1x,a6,1x,a6,3x,a6,1x,a16,1x,a16)') '---','-----','------','-------','--------------'
+  end if
+  allocate (eclust(ncb),source=0.0d0)
+  allocate (clustbest(ncb),ind(ncb),source=0)
+  iiincb: do i = 1,ncb
+    do j = 1,mm
+      if (member(j) == i) then
+        eclust(i) = mols(j)%energy
+        clustbest(i) = j
+        cycle iiincb
+      end if
+    end do
+  end do iiincb
+  do i = 1,ncb
+    ind(i) = i
+    c = 0
+    do j = 1,mm
+      if (member(j) == i) then
+        c = c+1
+        if (mols(j)%energy < eclust(i)) then
+          eclust(i) = mols(j)%energy
+          clustbest(i) = j
+        end if
+      end if
+    end do
+    if (c == 0) then
+      clustbest(i) = -1  !> empty cluster, excluded from output
+      ancb = ancb-1
+    end if
+  end do
+  call qsort(eclust,1,ncb,ind)
+  emin = minval(eclust,1)
+  open (newunit=ich,file=clusterfile)
+  do i = 1,ncb
+    k = clustbest(ind(i))
+    if (k > 0) then
+      dum = mols(k)%energy
+      call mols(k)%append(ich)
+      if (pr) then
+        erel = (dum-emin)*autokcal
+        write (stdout,'(1x,i6,1x,i6,3x,i6,1x,f16.8,1x,f16.4)') i,k,member(k),dum,erel
+      end if
+    end if
+  end do
+  close (ich)
+  if (pr) then
+    write (stdout,'(/,1x,a)') '(The "clust." column refers to the cluster "ID")'
+    write (stdout,*)
+    write (stdout,'(1x,a,a,a,i0,a)') 'File ',clusterfile,' written with ',ancb,' representative structures.'
+    if (ancb < ncb) then
+      write (stdout,'(1x,a,i0,a)') '(',ncb-ancb,' clusters discarded due to cluster merge)'
+    end if
+  end if
+  if (allocated(mols)) deallocate (mols)
+
+  if (pr) then
+    write (stdout,*)
+    call ctimer%write(stdout,'PCA/k-Means clustering')
+  end if
+  call ctimer%clear()
+  return
+end subroutine CCEGEN
diff --git a/src/sorting/ccegen_interface.f90 b/src/sorting/ccegen_interface.f90
new file mode 100644
index 00000000..e5452073
--- /dev/null
+++ b/src/sorting/ccegen_interface.f90
@@ -0,0 +1,35 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2020 Philipp Pracht, Stefan Grimme
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module ccegen_interface
+!**********************************************************
+!* module to load an interface to the CCEGEN routine.    *
+!**********************************************************
+  implicit none
+  interface
+    subroutine CCEGEN(env,pr,fname)
+      use crest_parameters
+      use crest_data
+      implicit none
+      type(systemdata),intent(inout) :: env
+      logical,intent(in) :: pr
+      character(len=*),intent(in) :: fname
+    end subroutine CCEGEN
+  end interface
+end module ccegen_interface
diff --git a/src/sorting/ccegen_utils.f90 b/src/sorting/ccegen_utils.f90
new file mode 100644
index 00000000..4c0dc6cd
--- /dev/null
+++ b/src/sorting/ccegen_utils.f90
@@ -0,0 +1,703 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2020 Philipp Pracht, Stefan Grimme
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!> Internal utility routines for CCEGEN (PCA/k-means clustering of conformer ensembles)
+!
+module ccegen_utils
+!*************************************************************
+!* Internal utilities for the CCEGEN routine.                *
+!* Contains PCA helpers, k-means clustering routines,        *
+!* and statistical evaluation procedures.                    *
+!*************************************************************
+  implicit none
+  private
+
+  public :: clustleveval,PCA_grpwrite,excludeLight,excludeSelected,svd_to_pc, &
+  &         eucdist,kmeans,kmeans_seeds,kmeans_assign,kmeans_recenter, &
+  &         cluststat,statanal,statwarning,getdiederatoms,calc_dieders
+
+! ══════════════════════════════════════════════════════════════════════════════
+contains  !> MODULE PROCEDURES START HERE
+! ══════════════════════════════════════════════════════════════════════════════
+
+subroutine clustleveval(env,maxclust,csthr,SSRSSTthr,pcthr)
+  !*********************************************************
+  !* Set clustering level defaults for maxclust, csthr,    *
+  !* SSRSSTthr, and pcthr based on the clustering level.   *
+  !*********************************************************
+  use crest_parameters,idp => dp
+  use crest_data
+  implicit none
+  type(systemdata) :: env
+  integer :: clev
+  integer :: maxclust
+  real(wp) :: csthr
+  real(wp) :: SSRSSTthr
+  real(wp) :: pcthr
+
+  SSRSSTthr = 0.90d0
+
+  clev = env%clustlev
+  if (env%clustlev >= 10) then  !> incremental clustering mode
+    clev = env%clustlev-10
+  end if
+
+  select case (clev)
+  case (-1)  !-- loose
+    maxclust = 25
+    csthr = 0.80d0
+    pcthr = 0.80d0
+  case (1)   !-- tight
+    maxclust = 400
+    if (env%clustlev >= 10) maxclust = 50
+    csthr = 0.85d0
+    pcthr = 0.90d0
+  case (2)   !-- vtight
+    maxclust = 400
+    if (env%clustlev >= 10) maxclust = 100
+    csthr = 0.9d0
+    pcthr = 0.95d0
+    SSRSSTthr = 0.92d0
+  case default  !-- normal
+    maxclust = 100
+    if (env%clustlev >= 10) maxclust = 25
+    csthr = 0.80d0
+    pcthr = 0.85d0
+  end select
+
+  return
+end subroutine clustleveval
+
+subroutine PCA_grpwrite(nclust,npc,mm,pcvec,member)
+  !*************************************************************
+  !* Write the first two principal component projections and   *
+  !* cluster membership for each structure to cluster.order.   *
+  !*************************************************************
+  use crest_parameters,idp => dp
+  implicit none
+  integer,intent(in) :: nclust
+  integer,intent(in) :: npc,mm
+  real(wp),intent(in) :: pcvec(npc,mm)
+  integer,intent(in) :: member(mm)
+  integer :: ich,i
+  open (newunit=ich,file='cluster.order')
+  write (ich,'(4x,i0,4x,i0,4x,i0)') mm,nclust,npc
+  if (npc > 1) then
+    do i = 1,mm
+      write (ich,'(i8,1x,f16.8,1x,f16.8,1x,i8)') i,pcvec(1,i),pcvec(2,i),member(i)
+    end do
+  else
+    do i = 1,mm
+      write (ich,'(i8,1x,f16.8,1x,i8)') i,pcvec(1,i),member(i)
+    end do
+  end if
+  close (ich)
+  return
+end subroutine PCA_grpwrite
+
+subroutine excludeLight(zmol,inc)
+  !*******************************************
+  !* Zero out hydrogen atoms in the inc      *
+  !* array to exclude them from the PCA.     *
+  !*******************************************
+  use crest_parameters,idp => dp
+  use zdata
+  implicit none
+  type(zmolecule) :: zmol
+  integer :: inc(zmol%nat)
+  integer :: i
+  do i = 1,zmol%nat
+    if (zmol%at(i) == 1) then
+      inc(i) = 0
+    end if
+  end do
+  return
+end subroutine excludeLight
+
+subroutine excludeSelected(zmol,inc,atlist)
+  !*******************************************
+  !* Zero out user-specified atoms in inc    *
+  !* to exclude them from the PCA.           *
+  !*******************************************
+  use crest_parameters,idp => dp
+  use zdata
+  implicit none
+  type(zmolecule) :: zmol
+  integer :: inc(zmol%nat)
+  character(len=*) :: atlist
+  integer :: i,ncon
+  integer,allocatable :: inc2(:)
+  allocate (inc2(zmol%nat),source=0)
+  call parse_atlist_new(atlist,ncon,zmol%nat,zmol%at,inc2)
+  do i = 1,zmol%nat
+    if (inc2(i) == 1) inc(i) = 0
+  end do
+  deallocate (inc2)
+  return
+end subroutine excludeSelected
+
+subroutine svd_to_pc(measure,m,n,sig,U,pr)
+  !*************************************************************
+  !* Singular value decomposition via LAPACK DGEJSV.           *
+  !* Factorises X = U * diag(sig) * V^T after mean-centering.  *
+  !* The singular values (sig) are the principal components.   *
+  !* Requires M >= N.                                          *
+  !*                                                           *
+  !* Input:  measure(n,m) - descriptor matrix                  *
+  !* Output: sig(n)       - singular values (eigenvalues)      *
+  !*         U(m,n)       - left singular vectors              *
+  !*************************************************************
+  use crest_parameters,idp => dp
+  implicit none
+  integer :: n,m
+  real(wp) :: measure(n,m)
+  real(wp) :: sig(n)
+  real(wp) :: U(m,n)
+  integer :: i,j,info,lwork
+  real(wp),allocatable :: mean(:),tmp(:)
+  integer,allocatable :: ind(:)
+  real(wp),allocatable :: X(:,:),V(:,:),work(:)
+  integer,allocatable :: iwork(:)
+  logical :: pr
+  if (pr) then
+    write (stdout,*) m,' mesaurements'
+    write (stdout,*) n,' props'
+  end if
+  allocate (mean(n),ind(m),tmp(m))
+  lwork = max(2*M+N,6*N+2*N*N)
+  allocate (X(m,n),V(n,n),iwork(m+3*n),work(lwork))
+  mean = 0.0d0
+  do i = 1,m
+    do j = 1,n
+      mean(j) = mean(j)+measure(j,i)
+    end do
+  end do
+  mean = mean/float(m)
+  if (pr) write (stdout,*) mean
+  do i = 1,m
+    do j = 1,n
+      X(i,j) = (mean(j)-measure(j,i))
+    end do
+  end do
+  if (pr) then
+    call PRMAT(6,X,m,n,'X')
+  end if
+! ── LAPACKs' DGEJSV ──────────────────────────────────────────────────────────
+  call DGEJSV('C','U','V','N','N','N',  &
+ &              m,n,X,m,sig,U,m,V,n,    &
+ &              WORK,LWORK,IWORK,INFO)
+  if (pr) then
+    write (stdout,*) info
+    write (stdout,*) sig
+    call PRMAT(6,U**2,M,N,'U')
+    call PRMAT(6,V,N,N,'V')
+  end if
+  deallocate (work,iwork,V,X,tmp,ind,mean)
+  return
+end subroutine svd_to_pc
+
+function eucdist(ndim,p,q) result(dist)
+  !*******************************************
+  !* Euclidean distance between points p     *
+  !* and q in ndim-dimensional space.        *
+  !*******************************************
+  use crest_parameters,idp => dp
+  implicit none
+  real(ap) :: dist
+  integer :: ndim
+  real(ap) :: p(ndim)
+  real(ap) :: q(ndim)
+  integer :: i
+  dist = 0.0d0
+  do i = 1,ndim
+    dist = dist+(q(i)-p(i))**2
+  end do
+  dist = sqrt(dist)
+  return
+end function eucdist
+
+subroutine kmeans(nclust,npc,mm,centroid,pcvec,ndist,dist,member)
+  !*************************************************************
+  !* K-means clustering: iteratively assigns structures to the *
+  !* nearest centroid and recenters until convergence or       *
+  !* maxiter iterations are reached.                           *
+  !*************************************************************
+  use crest_parameters,idp => dp
+  implicit none
+  integer,intent(in) :: nclust
+  integer,intent(in) :: npc,mm
+  real(wp),intent(in) :: pcvec(npc,mm)
+  integer(idp),intent(in) :: ndist
+  real(sp),intent(in)   :: dist(ndist)
+  integer,intent(inout) :: member(mm)
+  real(ap),intent(inout):: centroid(npc,nclust)
+  integer,allocatable :: refmember(:)
+  integer :: iter
+  integer,parameter :: maxiter = 300
+
+  if (nclust .le. 1) return
+
+  allocate (refmember(mm),source=0)
+
+  call kmeans_seeds(nclust,npc,mm,centroid,pcvec,ndist,dist)
+
+  do iter = 1,maxiter
+    ! ── assign each structure to its nearest centroid ────────────────────────
+    member = 0
+    call kmeans_assign(nclust,npc,mm,centroid,pcvec,member)
+
+    if (all(member == refmember)) then
+      exit
+    else
+      refmember = member
+    end if
+    call kmeans_recenter(nclust,npc,mm,centroid,pcvec,member)
+  end do
+
+  deallocate (refmember)
+  return
+end subroutine kmeans
+
+subroutine kmeans_seeds(nclust,npc,mm,centroid,pcvec,ndist,dist)
+  !*************************************************************
+  !* Initialise k-means centroids by finding maximally         *
+  !* separated points in PC space (greedy farthest-first).     *
+  !*************************************************************
+  use crest_parameters,idp => dp
+  use utilities
+  implicit none
+  integer :: nclust,npc,mm
+  real(ap) :: centroid(npc,nclust)
+  real(wp) :: pcvec(npc,mm)
+  integer(idp) :: ndist
+  real(sp) :: dist(ndist)
+  real(sp) :: ddum
+  integer(idp) :: k,kiter
+  integer :: i,j,l,c
+  real(wp) :: distsum,maxdistsum
+  real(ap),allocatable :: p(:),q(:)
+  integer,allocatable :: taken(:)
+
+  ! ── seed 1 & 2: the two most distant structures ────────────────────────────
+  ddum = 0.0_sp
+  do kiter = 1,ndist
+    if (dist(kiter) > ddum) then
+      ddum = dist(kiter)
+      k = kiter
+    end if
+  end do
+  call revlin(k,j,i)  !> reverse of the lin index to get (i,j)
+
+  centroid(1:npc,1) = pcvec(1:npc,i)
+  centroid(1:npc,2) = pcvec(1:npc,j)
+
+  if (nclust .le. 2) return
+
+  ! ── seeds 3+: farthest point from all existing centroids ───────────────────
+  allocate (p(npc),q(npc),taken(nclust))
+  taken = 0
+  taken(1) = i
+  taken(2) = j
+  do i = 3,nclust
+    maxdistsum = 0.0d0
+    c = 0
+!$OMP PARALLEL PRIVATE ( l, q, p, j, distsum ) &
+!$OMP SHARED ( i, centroid, npc, mm, maxdistsum, pcvec, c, taken )
+!$OMP DO
+    do j = 1,mm
+      distsum = 0.0d0
+      p(1:npc) = pcvec(1:npc,j)
+      do l = 1,i-1
+        q(1:npc) = centroid(1:npc,l)
+        distsum = distsum+eucdist(npc,p,q)
+      end do
+      !$OMP CRITICAL
+      if (distsum .gt. maxdistsum) then
+        if (.not.any(taken == j)) then
+          maxdistsum = distsum
+          c = j
+          taken(i) = c
+        end if
+      end if
+      !$OMP END CRITICAL
+    end do
+!$OMP END DO
+!$OMP END PARALLEL
+    if (c == 0) then
+      exit
+    else
+      centroid(1:npc,i) = pcvec(1:npc,c)
+    end if
+  end do
+
+  deallocate (taken,q,p)
+
+  return
+end subroutine kmeans_seeds
+
+subroutine kmeans_assign(nclust,npc,mm,centroid,pcvec,member)
+  !*************************************************************
+  !* Assign each structure to the nearest centroid.            *
+  !*************************************************************
+  use crest_parameters,idp => dp
+  implicit none
+  integer :: nclust,npc,mm
+  real(ap) :: centroid(npc,nclust)
+  real(wp) :: pcvec(npc,mm)
+  integer :: member(mm)
+  integer :: i,j,c
+  real(ap),allocatable :: centdist(:)
+  real(ap),allocatable :: p(:),q(:)
+
+  allocate (centdist(nclust),source=0.0_ap)
+  allocate (p(npc),q(npc))
+!$OMP PARALLEL PRIVATE ( i, j, p, q, c, centdist ) &
+!$OMP SHARED ( mm, nclust, member, centroid, npc, pcvec )
+!$OMP DO
+  do i = 1,mm
+    p(1:npc) = pcvec(1:npc,i)
+    do j = 1,nclust
+      q(1:npc) = centroid(1:npc,j)
+      centdist(j) = eucdist(npc,p,q)
+    end do
+    c = minloc(centdist,1)
+    member(i) = c
+  end do
+!$OMP END DO
+!$OMP END PARALLEL
+  deallocate (q,p)
+  deallocate (centdist)
+  return
+end subroutine kmeans_assign
+
+subroutine kmeans_recenter(nclust,npc,mm,centroid,pcvec,member)
+  !*************************************************************
+  !* Recompute each centroid as the mean of its member         *
+  !* structures in PC space.                                   *
+  !*************************************************************
+  use crest_parameters,idp => dp
+  implicit none
+  integer :: nclust,npc,mm
+  real(ap) :: centroid(npc,nclust)
+  real(wp) :: pcvec(npc,mm)
+  integer :: member(mm)
+  integer :: i,j,c
+  real(ap),allocatable :: p(:),q(:)
+
+  allocate (p(npc),q(npc))
+  do i = 1,nclust
+    c = 0
+    p = 0.0d0
+    do j = 1,mm
+      if (member(j) == i) then
+        c = c+1
+        p(1:npc) = p(1:npc)+pcvec(1:npc,j)
+      end if
+    end do
+    if (c > 0) then
+      p = p/float(c)
+      centroid(1:npc,i) = p(1:npc)
+    else
+      p = 999.9d0
+    end if
+  end do
+  deallocate (q,p)
+
+  return
+end subroutine kmeans_recenter
+
+subroutine cluststat(nclust,npc,mm,centroid,pcvec,member,DBI,pSF,SSRSST)
+  !*************************************************************
+  !* Compute cluster quality metrics for a given partition:    *
+  !*   DBI    = Davies-Bouldin index (lower is better)         *
+  !*   pSF    = pseudo-F statistic (higher is better)          *
+  !*   SSRSST = SSR/SST ratio (higher means more distinct)     *
+  !*************************************************************
+  use crest_parameters,idp => dp
+  implicit none
+  integer,intent(in) :: nclust
+  integer,intent(in) :: npc,mm
+  real(wp),intent(in) :: pcvec(npc,mm)
+  integer,intent(in) :: member(mm)
+  real(ap),intent(in):: centroid(npc,nclust)
+  real(wp),intent(out) :: DBI,pSF,SSRSST
+  real(wp) :: SSE,SSR,SST
+  real(ap),allocatable :: p(:),q(:)
+  real(wp),allocatable :: compact(:)
+  real(wp),allocatable :: DBmat(:,:)
+  real(wp) :: d,Rij,maxDB,weight
+  integer :: i,c,k,c2
+
+  DBI = 0.0d0
+  pSF = 0.0d0
+  SSRSST = 0.0d0
+
+  if (nclust < 2) return
+
+  allocate (p(npc),q(npc))
+
+  ! ── sum of squares error (within-cluster) ──────────────────────────────────
+  SSE = 0.0d0
+  do c = 1,nclust
+    p(1:npc) = centroid(1:npc,c)
+    do i = 1,mm
+      if (member(i) == c) then
+        q(1:npc) = pcvec(1:npc,i)
+        d = eucdist(npc,p,q)
+        SSE = SSE+d**2
+      end if
+    end do
+  end do
+
+  ! ── total sum of squares (weighted centroid as global mean) ────────────────
+  SST = 0.0d0
+  p = 0.0d0
+  do c = 1,nclust
+    weight = real(count(member(:) == c,1),wp)/real(mm,wp)
+    p(1:npc) = p(1:npc)+centroid(1:npc,c)*weight
+  end do
+  do i = 1,mm
+    q(1:npc) = pcvec(1:npc,i)
+    d = eucdist(npc,p,q)
+    SST = SST+d**2
+  end do
+
+  SSR = SST-SSE
+  SSRSST = SSR/SST
+
+  ! ── pseudo-F statistic ─────────────────────────────────────────────────────
+  if (nclust > 1) then
+    pSF = (SSR/(float(nclust)-1.0d0))
+    if (mm == nclust) then
+      pSF = 0.0d0
+    else
+      pSF = pSF/(SSE/(float(mm)-float(nclust)))
+    end if
+  else
+    pSF = 0.0d0
+  end if
+
+  ! ── Davies-Bouldin index ───────────────────────────────────────────────────
+  allocate (compact(nclust),source=0.0d0)
+  do c = 1,nclust
+    p(1:npc) = centroid(1:npc,c)
+    k = 0
+    do i = 1,mm
+      if (member(i) == c) then
+        k = k+1
+        q(1:npc) = pcvec(1:npc,i)
+        d = eucdist(npc,p,q)
+        compact(c) = compact(c)+d
+      end if
+    end do
+    if (k > 0) then
+      compact(c) = compact(c)/float(k)
+    else
+      compact(c) = 0
+    end if
+  end do
+  allocate (DBmat(nclust,nclust),source=0.0d0)
+  do c = 1,nclust
+    p(1:npc) = centroid(1:npc,c)
+    do c2 = 1,nclust
+      if (c2 == c) cycle
+      q(1:npc) = centroid(1:npc,c2)
+      d = eucdist(npc,p,q)
+      Rij = (compact(c)+compact(c2))/d
+      DBmat(c,c2) = Rij
+    end do
+  end do
+  do c = 1,nclust
+    maxDB = maxval(DBmat(:,c),1)
+    DBI = DBI+maxDB
+  end do
+  DBI = DBI/float(nclust)
+  deallocate (DBmat)
+  deallocate (compact)
+
+  deallocate (q,p)
+  return
+end subroutine cluststat
+
+subroutine statanal(n,nmax,statistics,extrema,pr,clust_sizes)
+  !*************************************************************
+  !* Identify local minima of DBI and local maxima of pSF      *
+  !* across the tested cluster counts.                         *
+  !*************************************************************
+  use crest_parameters
+  implicit none
+  integer :: n,nmax
+  real(wp) :: statistics(3,nmax)
+  logical,intent(inout) :: extrema(2,n)
+  logical :: pr
+  integer,intent(in),optional :: clust_sizes(n)
+  real(wp) :: last,next,current
+  integer :: i,csize
+
+  extrema = .false.
+! ── identify local extrema of the DBI and pSF ────────────────────────────────
+  do i = 2,n-1
+    last = statistics(1,i-1)
+    next = statistics(1,i+1)
+    current = statistics(1,i)
+    if ((current < last).and.(current < next)) then
+      extrema(1,i) = .true.
+    end if
+    last = statistics(2,i-1)
+    next = statistics(2,i+1)
+    current = statistics(2,i)
+    if ((current > last).and.(current > next)) then
+      extrema(2,i) = .true.
+    end if
+  end do
+  !>-- boundary check: one-sided comparison for the last cluster count
+  if (n >= 2) then
+    if (statistics(1,n) < statistics(1,n-1)) extrema(1,n) = .true.
+    if (statistics(2,n) > statistics(2,n-1)) extrema(2,n) = .true.
+  end if
+
+  if (pr) then
+    write (stdout,*)
+    write (stdout,'(1x,a,/)') 'Suggestions for cluster sizes:'
+    do i = 1,n
+      if (extrema(1,i).or.extrema(2,i)) then
+        csize = i
+        if (present(clust_sizes)) csize = clust_sizes(i)
+        if (extrema(1,i).and.extrema(2,i)) then
+          write (stdout,'(1x,i8,''*'',3x,a,f8.4)') csize,'SSR/SST',statistics(3,i)
+        else
+          write (stdout,'(1x,i8,4x,a,f8.4)') csize,'SSR/SST',statistics(3,i)
+        end if
+      end if
+    end do
+    write (stdout,'(/,1x,a)') 'Cluster counts marked with a star (*) are reasonable'
+    write (stdout,'(1x,a)') 'suggestions according to BOTH the DBI and pSF.'
+  end if
+
+  return
+end subroutine statanal
+
+subroutine statwarning(fname)
+  !*************************************************************
+  !* Print a note about the arbitrary nature of clustering.    *
+  !*************************************************************
+  use crest_parameters
+  implicit none
+  character(len=*) :: fname
+  write (stdout,*)
+  write (stdout,'(1x,a)') '!---------------------------- NOTE ----------------------------!'
+  write (stdout,'(2x,a)') 'The partitioning of data (the ensemble) into clusters'
+  write (stdout,'(2x,a)') 'of similar characteristics (structures) is ARBITRARY'
+  write (stdout,'(2x,a)') 'and depends on many criteria (e.g. choice of PCs).'
+  write (stdout,'(2x,a)') 'The selected cluster count is the smallest reasonable'
+  write (stdout,'(2x,a)') 'number of clusters that can be formed according to'
+  write (stdout,'(2x,a)') 'the DBI and pSF values for the given data.'
+  write (stdout,*)
+  write (stdout,'(2x,a)') 'If other cluster sizes are desired, rerun CREST with'
+  write (stdout,'(2x,3a)') '"crest --sort ',trim(fname),' --cluster <number of clusters>"'
+  write (stdout,*)
+  write (stdout,'(2x,a)') 'Other default evaluation settings can be chosen with the'
+  write (stdout,'(2x,a)') 'keywords "loose","normal", and "tight" as <level> via'
+  write (stdout,'(2x,3a)') '"crest --sort ',trim(fname),' --cluster <level>"'
+  write (stdout,'(1x,a)') '!--------------------------------------------------------------!'
+end subroutine statwarning
+
+subroutine getdiederatoms(zmol,nat,inc,nb,diedat,ndied)
+  !*************************************************************
+  !* Extract dihedral angle atom quartets from the molecular   *
+  !* topology, skipping terminal, ignored, and methyl atoms.   *
+  !*************************************************************
+  use crest_parameters,idp => dp
+  use zdata
+  use strucrd
+  implicit none
+  type(zmolecule) :: zmol
+  integer :: nat
+  integer :: inc(nat)  !> 1 = include, 0 = ignore
+  integer :: nb
+  integer :: diedat(4,nb)
+  integer,intent(out) :: ndied
+  integer :: a,b,c,d
+  integer :: i,j,k
+
+  ndied = 0
+  do i = 1,nb
+    a = zmol%bondpairs(1,i)
+    b = zmol%bondpairs(2,i)
+    if (inc(a) == 0) cycle          !> ignored by user
+    if (inc(b) == 0) cycle          !> ignored by user
+    if (zmol%zat(a)%nei == 1) cycle !> terminal atom
+    if (zmol%zat(b)%nei == 1) cycle !> terminal atom
+    if (zmol%methyl(a)) cycle       !> methyl carbon
+    if (zmol%methyl(b)) cycle       !> methyl carbon
+    ! ── get one neighbour of a and one of b to form the quartet ──────────────
+    do j = 1,zmol%zat(a)%nei
+      c = zmol%zat(a)%ngh(j)
+      if (c == b) then
+        cycle
+      else
+        exit
+      end if
+    end do
+    do k = 1,zmol%zat(b)%nei
+      d = zmol%zat(b)%ngh(k)
+      if (d == a) then
+        cycle
+      else
+        exit
+      end if
+    end do
+    ndied = ndied+1
+    !> quartet layout: (1)=neighbour of a, (2)=a, (3)=b, (4)=neighbour of b
+    diedat(2,ndied) = a
+    diedat(3,ndied) = b
+    diedat(1,ndied) = c
+    diedat(4,ndied) = d
+  end do
+
+  return
+end subroutine getdiederatoms
+
+subroutine calc_dieders(mol,ndied,diedat,diedr)
+  !*****************************************************
+  !* Calculate dihedral angles for selected atom       *
+  !* quartets. Results are in radians (-pi, pi).       *
+  !*****************************************************
+  use crest_parameters,idp => dp
+  use strucrd
+  implicit none
+  type(coord),intent(in) :: mol
+  integer,intent(in) :: ndied
+  integer,intent(in) :: diedat(4,ndied)
+  real(wp),intent(out) :: diedr(ndied)
+  integer :: i
+
+  diedr = 0.0_wp
+  do i = 1,ndied
+    !> quartet: (1)=neighbour of a, (2)=a, (3)=b, (4)=neighbour of b
+    diedr(i) = mol%dihedral(diedat(1,i),diedat(2,i), &
+    &                       diedat(3,i),diedat(4,i))
+  end do
+
+  return
+end subroutine calc_dieders
+
+! ══════════════════════════════════════════════════════════════════════════════
+! ══════════════════════════════════════════════════════════════════════════════
+end module ccegen_utils
diff --git a/src/sorting/cregen.f90 b/src/sorting/cregen.f90
new file mode 100644
index 00000000..da2449f5
--- /dev/null
+++ b/src/sorting/cregen.f90
@@ -0,0 +1,2674 @@
+!===============================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2018-2026 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!===============================================================================!
+
+!=========================================================================================!
+!=========================================================================================!
+!> CREGEN - also see cregen_interfaces.f90 for importable interfaces
+!=========================================================================================!
+!=========================================================================================!
+
+subroutine newcregen(env,quickset,infile,structurelist)
+!****************************************************************************************
+!* The main CREGEN routine
+!*
+!* CREGEN is the universal ensemble sorting routine of CREST.
+!* This is a rewrite of the original routines since the old ones
+!* got a bit messy over time.
+!* The quickset variable can be used for some special runtypes:
+!*   quickset:  2   - do symmetry analysis
+!*              3   - switch off equivalency analysis
+!*              6,7 - energy sorting only with (7) or without (6) ewin energy cut-off
+!*              9   - no sorting, only check groups
+!*             12   - no topology check, turn ewin to infty
+!*             13   - no topology check, ewin and rmsd checking (msreact settings)
+!****************************************************************************************
+  use crest_parameters
+  use crest_data
+  use strucrd
+  use cregen_subroutines
+  implicit none
+  !> INPUT
+  type(systemdata),intent(inout) :: env   !> MAIN STORAGE OS SYSTEM DATA
+  integer,intent(in),optional :: quickset !> quick access to predefined CREGEN modes
+  character(len=*),intent(in),optional :: infile
+  type(coord),allocatable,intent(inout),optional :: structurelist(:)
+  !> LOCAL
+  integer :: simpleset
+  character(len=:),allocatable :: fname  !> input file
+  character(len=:),allocatable :: oname  !> sorted output file
+  character(len=:),allocatable :: cname  !> unique structure file
+!>--- ensemble arguments
+  integer :: nat                      !> number of atoms
+  integer :: nall                     !> number of structures
+  character(len=128),allocatable :: comments(:)
+  real(wp),allocatable :: er(:)       !> energies
+  type(coord),allocatable :: structures(:)  !> a list of structures using the coord type
+!>--- dummy ensemble arguments
+  integer :: nallref
+  integer :: nallnew
+!>--- sorting arguments
+  integer,allocatable :: gref(:),group(:)
+  integer :: ng
+  integer :: i,ii
+  integer,allocatable :: degen(:,:)
+
+!>--- float data
+  real(wp) :: ewin,rthr,bthr,pthr,ethr,athr
+  real(wp) :: T,couthr
+
+!>--- boolean data
+  logical :: ensembleinput = .false.
+  logical :: checkbroken
+  logical :: topocheck
+  logical :: checkez
+  logical :: sortE
+  logical :: sortRMSD
+  logical :: sortRMSD2
+  logical :: newfile
+  logical :: repairord
+  logical :: conffile
+  logical :: bonusfiles
+  logical :: anal
+  logical :: saveelow
+  logical :: userinput
+
+!>--- printout directions
+  integer :: prch  !> the main printout channel
+  logical :: pr1,pr2,pr3,pr4
+
+!====================================================================!
+!>  S E T T I N G S
+!====================================================================!
+  if (present(quickset)) then
+    simpleset = quickset
+  else
+    simpleset = 0
+  end if
+
+!>-- was an actual list of structures (rather than a file name) provided?
+  if (present(structurelist)) then
+    if (size(structurelist,1) > 0) ensembleinput = .true.
+  end if
+
+!>-- determine filenames and output channel
+  if (present(infile)) then
+    fname = trim(infile)
+    userinput = .true.
+  else
+    fname = trim(env%ensemblename)
+    userinput = .false.
+  end if
+  call cregen_files(env,fname,oname,cname,simpleset,userinput,ensembleinput,prch)
+
+!>-- determine which printouts are required
+  call cregen_prout(env,simpleset,pr1,pr2,pr3,pr4)
+
+!>-- determine which subroutines are required
+  call cregen_director(env,simpleset,checkbroken,sortE,sortRMSD,sortRMSD2, &
+  &  repairord,newfile,conffile,bonusfiles,anal,topocheck,checkez,saveelow)
+
+!>--- DATA SECTION
+  call cregen_filldata1(env,ewin,rthr,ethr,bthr,athr,pthr,T,couthr)
+  call cregen_filldata2(simpleset,ewin)
+
+!>--- setting the threads for OMP parallel usage
+  call cregen_setthreads(prch,env,.false.)
+
+!=====================================================================!
+!>  E N S E M B L E   P R O C E S S I N G
+!=====================================================================!
+
+!>--- read in the ensemble parameters
+  if (.not.ensembleinput) then
+    call rdensembleparam(fname,nat,nallref)
+  else
+    nat = structurelist(1)%nat
+    nallref = size(structurelist,1)
+  end if
+
+!>--- print a summary about the ensemble and thresholds
+  if (pr1) call cregen_pr1(prch,env,nat,nallref,rthr,bthr,pthr,ewin)
+
+!>--- allocate space and read in the ensemble
+  if (.not.ensembleinput) then
+    call rdensemble(fname,nallref,structures)
+  else
+    call move_alloc(structurelist,structures)
+  end if
+
+!>--- track ensemble for restart
+  !call trackensemble(fname,nat,nallref,at,xyz,comments)
+
+!> NOTE: We check topology and broken structures FIRST before
+!> sorting by the energy an making a cut, because chemical changes
+!> may produce isomers that are lower in energy at the given
+!> level of theory. We do not want that when looking for conformers specifically.
+
+!>--- check if the ensemble contains broken structures? i.e., fusion or dissociation
+  if (checkbroken) then
+    call cregen_discardbroken(prch,env,topocheck,structures,nall)
+  else
+    nall = nallref
+  end if
+
+!>--- compare neighbourlists to sort out chemically transformed structures
+  if (topocheck) then
+    call cregen_topocheck(prch,env,checkez,structures,nallnew)
+    nall = nallnew !> update
+!>--- if structures were discarded, resize xyz
+  end if
+  if (topocheck.or.checkbroken) then
+    write (prch,'(" number of reliable points",t35,":",i10)') nall
+  end if
+
+!>--- sort the ensemble by its energies and make a cut (EWIN)
+  if (sortE) then
+    call cregen_esort(prch,structures,nallnew,ewin=ewin)
+    nall = nallnew !> update
+  end if
+
+!>--- do the rotational constants and RMSD check
+  if (sortRMSD) then
+    call cregen_CRE_new(env,nall,structures,group,rthr, &
+    &                   ethr/autokcal,bthr,printlvl=2,ch=prch)
+!>--- get group info to degen
+    ng = group(0)
+    allocate (degen(3,ng))
+    call cregen_groupinfo(nall,ng,group,degen)
+  else
+    ng = nall
+    if (ng > 0) then
+      allocate (degen(3,ng))
+      do i = 1,ng
+        degen(1,i) = 1
+        degen(2,i) = i
+        degen(3,i) = i
+      end do
+    else
+      allocate (degen(3,1))
+      degen = 0
+    end if
+  end if
+
+!=====================================================================!
+!>  E N S E M B L E   O U T P U T
+!=====================================================================!
+
+!>--- align all structures to the first structure using the RMSD
+  call cregen_rmsdalign(nall,structures)
+
+!>--- write new file with ALL remaining structures
+  if (newfile) then
+    call cregen_file_wr(env,oname,structures)
+!>--- track ensemble for restart
+!    call trackensemble(oname,nat,nall,at,xyz,comments)
+  end if
+!>--- write a file containing only conformers (no rotamers)
+  if (conffile) then
+    call cregen_conffile(env,cname,structures,ng,degen)
+  end if
+  if (saveelow) then
+    env%elowest = structures(1)%energy
+!>-- and update reference geometry (in Bohr)
+    env%ref%xyz = structures(1)%xyz
+  end if
+
+!>--- additional files for entropy mode
+  if (bonusfiles) then
+    call cregen_bonusfiles(ng,degen)
+  end if
+
+!>--- several printouts
+  if (pr2.or.pr3.or.pr4) then
+    allocate (er(nall))
+    do ii = 1,nall
+      er(ii) = structures(ii)%energy
+    end do
+  end if
+
+  if (pr2) then
+    call cregen_pr2(prch,env,nall,ng,degen,er)
+    call cregen_econf_list(prch,nall,er,ng,degen)
+  end if
+  if (pr3) then !> alternative to pr2
+    call cregen_pr3(prch,oname,nall,er)
+  end if
+  if (pr4) then !> group data printout
+    call cregen_pr4(prch,fname,nall,group)
+  end if
+
+!>--- analyze nuclear equivalencies, e.g. for NMR and Entropy
+  if (anal) then
+    call cregen_EQUAL(prch,nall,structures,group,athr,.not.env%entropic)
+  end if
+
+!>-- in case we had a structurelist given, move the (sorted) memory space back there
+  if (ensembleinput) then
+    call move_alloc(structures,structurelist)
+  end if
+
+  if (newfile) then
+    write (prch,'(a,a)') 'Full ensemble file written to:    ',trim(oname)
+  end if
+  if (conffile) then
+    write (prch,'(a,a)') 'Unique-structure file written to: ',trim(cname)
+  end if
+
+!>--- deallocate data
+  if (prch .ne. stdout) then
+    close (prch)
+  end if
+  if (allocated(er)) deallocate (er)
+  if (allocated(degen)) deallocate (degen)
+  if (allocated(group)) deallocate (group)
+  return
+end subroutine newcregen
+
+!=========================================================================================!
+!=========================================================================================!
+!>  CREGEN DATA SECTION
+!=========================================================================================!
+!=========================================================================================!
+
+subroutine cregen_files(env,fname,oname,cname,simpleset,userinput,ensembleinput,iounit)
+!*************************************************************
+!* subroutine cregen_files
+!* handle all settings regarding input and output file names
+!* including where to print the cregen output
+!*************************************************************
+  use crest_parameters
+  use crest_data
+  use iomod
+  use utilities
+  implicit none
+  type(systemdata),intent(inout) :: env    !> MAIN STORAGE OS SYSTEM DATA
+  character(len=:),allocatable,intent(inout) :: fname  !> name of the ensemble to be read
+  character(len=:),allocatable,intent(inout) :: oname  !> output ensemble name (including rotamers)
+  character(len=:),allocatable,intent(inout) :: cname  !> output ensemble name (only conformers)
+  integer,intent(in) :: simpleset
+  logical,intent(in) :: userinput !> was an input file given via the optional subroutine arg?
+  logical,intent(in) :: ensembleinput !> was an structure list provided?
+  integer,intent(out) :: iounit
+  character(len=:),allocatable :: outfile
+  logical :: ex
+  !>--------------------------------------------------------------------
+  outfile = 'cregen.out.tmp'
+  if (env%cgf(6)) outfile = 'tmp'
+
+  !>-- the entire cregen output can be printed printed to a seperate file
+  !>   or to the terminal
+  call remove(outfile)
+  if (simpleset > 0) then
+    select case (simpleset)
+    case (6,7,9,12)
+      iounit = stdout
+    case default
+      open (newunit=iounit,file=outfile)
+    end select
+  else if (env%confgo.and..not. (env%properties .eq. -2).and..not.env%relax) then
+    iounit = stdout
+  else
+    open (newunit=iounit,file=outfile)
+  end if
+
+  if ((env%confgo.and.(index(trim(fname),'none selected') .eq. 0)) &
+  &    .OR.userinput.OR.ensembleinput) then
+    if (.not.userinput.and..not.ensembleinput) then
+      fname = trim(env%ensemblename)
+    end if
+    cname = 'crest_ensemble.xyz'
+    oname = trim(fname)//'.sorted'
+    if (env%fullcre) then
+      env%ensemblename = trim(oname)
+    end if
+  else !> internal mode for conformational search
+    fname = repeat(' ',256)  !> need initialization because checkname_xyz
+    oname = repeat(' ',256)  !> can't handle allocatable names
+    call checkname_xyz(crefile,fname,oname)
+    cname = conformerfile
+  end if
+  if (simpleset == 12) then !> MECP files
+    fname = "crest_mecp_search.xyz"
+    oname = "crest_mecp_search.xyz.sorted"
+    cname = "crest_ensemble.xyz"
+  end if
+  if (simpleset == 13) then !> MSREACT files
+    fname = "crest_unique_products.xyz"
+    oname = "crest_unique_products.sorted"
+    cname = "crest_msreact_products.xyz"
+  end if
+  if (simpleset == 15) then !> crossing files
+    call checkname_xyz('confcross',fname,oname)
+    cname = trim(fname)//'.unique'
+  end if
+
+  write (iounit,'(1x,a,a)') 'input  file name : ',trim(fname)
+  select case (simpleset)
+  case (9)
+    continue
+  case default
+    write (iounit,'(1x,a,a)') 'output file name : ',trim(oname)
+  end select
+
+  inquire (file=fname,exist=ex)
+  if (.not.ex.and..not.ensembleinput) then
+    write (stdout,'(a,a,a)') 'CREGEN> **WARNING** file ',trim(fname),' does not exist!'
+    error stop
+  end if
+
+  return
+end subroutine cregen_files
+
+!=========================================================================================!
+
+subroutine cregen_prout(env,simpleset,pr1,pr2,pr3,pr4)
+!***********************************************************
+!* subroutine cregen_prout
+!* handle all settings regarding which printouts are active
+!* (currently only those for default cregen runs)
+!***********************************************************
+  use crest_parameters
+  use crest_data
+  use iomod
+  implicit none
+  type(systemdata) :: env !> MAIN STORAGE OS SYSTEM DATA
+  integer,intent(in) :: simpleset
+  logical,intent(out) :: pr1,pr2,pr3,pr4
+
+  pr1 = .true.  !> threshold summary
+  pr2 = .true.  !> detailed energy/group list
+  pr3 = .false. !> plain energy list
+  pr4 = .false. !> group list printout
+
+  if (any(simpleset == (/6,7/)).or.env%esort) then
+    pr1 = .false.
+    pr2 = .false.
+    if (env%crestver .ne. crest_solv) pr3 = .true.
+  end if
+
+  if (simpleset == 9) then
+    pr1 = .true.
+    pr2 = .false.
+    pr3 = .false.
+    pr4 = .true.
+  end if
+
+  if (simpleset == 13) then
+    pr1 = .false.
+    pr2 = .false.
+    pr3 = .false.
+    pr4 = .false.
+  end if
+
+  return
+end subroutine cregen_prout
+
+!=========================================================================================!
+
+subroutine cregen_director(env,simpleset,checkbroken,sortE,sortRMSD,sortRMSD2, &
+        &  repairord,newfile,conffile,bonusfiles,anal,topocheck,checkez,saveelow)
+!**************************************************************
+!* subroutine cregen_director !IMPORTANT!
+!* handle which comparisons are required and which files shall
+!* be written
+!**************************************************************
+  use crest_parameters
+  use crest_data
+  use iomod
+  implicit none
+  type(systemdata) :: env    ! MAIN STORAGE OS SYSTEM DATA
+  integer,intent(in) :: simpleset
+  logical,intent(out) :: checkbroken
+  logical,intent(out) :: sortE,sortRMSD,sortRMSD2
+  logical,intent(out) :: repairord
+  logical,intent(out) :: newfile,conffile
+  logical,intent(out) :: bonusfiles
+  logical,intent(out) :: anal
+  logical,intent(out) :: topocheck
+  logical,intent(out) :: checkez
+  logical,intent(out) :: saveelow
+
+  checkbroken = .true. !> fragmentized structures are sorted out
+  sortE = .true.       !> sort based on energy
+  sortRMSD = .true.    !> sort based on RMSD
+  sortRMSD2 = .false.  !> check groups for whole ensemble
+  repairord = .true.   !> double-check the sorted Ensemble
+
+  newfile = .true.  !> sorted input file
+
+  conffile = .true. !> sorted unique structure file
+
+  saveelow = .true. !> save (overwrite) lowest structure to env%ref
+
+  topocheck = env%checktopo !> topology is compared to reference structure
+  checkez = env%checkiso    !> check for C=C cis/trans isomerizations
+  if (env%relax) then
+    topocheck = .false.
+  end if
+
+  bonusfiles = .false.
+  if (env%entropic.or.env%doNMR) then
+    bonusfiles = .true.
+  end if
+
+  anal = .false.
+  if (env%doNMR.or.env%cgf(3).or.simpleset == 2) then
+    anal = .true.
+  end if
+  if (simpleset == 3) then
+    anal = .false.
+  end if
+
+  if (any(simpleset == (/6,7/)).or.env%esort) then  !energy sorting only
+    checkbroken = .false.
+    sortE = .true.
+    sortRMSD = .false.
+    repairord = .false.
+    newfile = .true.
+    if ((env%crestver .eq. crest_solv).and.(.not.env%QCG)) then
+      conffile = .true. !Conffile is needed for confscript in QCG
+    else
+      conffile = .false.
+    end if
+    topocheck = .false.
+    checkez = .false.
+    bonusfiles = .false.
+    anal = .false.
+    saveelow = .false.
+  end if
+
+  if (simpleset == 9) then  !optpurge mode
+    checkbroken = .false.
+    sortE = .false.
+    sortRMSD = .false.
+    sortRMSD2 = .true.
+    repairord = .false.
+    newfile = .false.
+    conffile = .false.
+    topocheck = .false.
+    checkez = .false.
+    bonusfiles = .false.
+    anal = .false.
+  end if
+
+  !> MECP search final sorting
+  if (simpleset == 12) then
+    topocheck = .false.
+    checkez = .false.
+    bonusfiles = .false.
+    anal = .false.
+  end if
+
+  if (simpleset == 13) then  !msreact mode
+    checkbroken = .false.
+    sorte = .true.
+    sortRMSD = .true.
+    sortRMSD2 = .false.
+    repairord = .false.
+    newfile = .true.
+    conffile = .true.
+    topocheck = .false.
+    checkez = .false.
+    bonusfiles = .false.
+    anal = .false.
+
+  end if
+
+  return
+end subroutine cregen_director
+
+!=========================================================================================!
+
+subroutine cregen_filldata1(env,ewin,rthr,ethr,bthr,athr,pthr,T,couthr)
+!*******************************************************
+!* subroutine cregen_filldata1
+!* get important threshold from "opt" and "sys" objects
+!*******************************************************
+  use crest_parameters
+  use crest_data
+  implicit none
+  type(systemdata) :: env  !> MAIN STORAGE OS SYSTEM DATA
+  real(wp),intent(out) :: ewin,rthr,ethr,bthr,athr,pthr,T,couthr
+  !>--------------------------------------------------------------------
+  ewin = env%ewin      !> ensemble energy window in kcal/mol
+  rthr = env%rthr      !> RMSD thr in Ang
+  ethr = env%ethr      !> E threshold in kcal
+  bthr = env%bthr2     !> rot const thr (lower bound)
+  athr = env%athr      !> to det. int. rotation. equal atoms for NMR, CRITICAL!
+  pthr = env%pthr      !> population thr
+  T = env%tboltz       !> Temperature
+  couthr = env%couthr  !> coulomb sorting threshold
+  return
+end subroutine cregen_filldata1
+subroutine cregen_filldata2(simpleset,ewin)
+  use crest_parameters
+  use crest_data
+  implicit none
+  integer,intent(in) :: simpleset
+  real(wp),intent(out) :: ewin
+  if (any(simpleset == (/6,12/))) then
+    ewin = huge(ewin)
+  end if
+  return
+end subroutine cregen_filldata2
+
+!=========================================================================================!
+
+subroutine cregen_groupinfo(nall,ng,group,degen)
+!*************************************************************
+!* subroutine cregen_groupinfo
+!* get info about each conformer group and save it to "degen"
+!*************************************************************
+  implicit none
+  integer :: nall,ng
+  integer :: group(0:nall)
+  integer :: degen(3,ng)
+  integer :: i,j,k,a,b
+  do i = 1,ng
+    a = 0; b = 0; k = 0
+    do j = 1,nall
+      if (group(j) .eq. i) then
+        k = k+1
+        if (a == 0) a = j
+        b = j
+      end if
+    end do
+    degen(1,i) = k !>-- number of members in group i
+    degen(2,i) = a !>-- first member of group i
+    degen(3,i) = b !>-- last member of group i
+  end do
+  return
+end subroutine cregen_groupinfo
+
+!=========================================================================================!
+!=========================================================================================!
+!>  CREGEN SUBROUTINES
+!=========================================================================================!
+!=========================================================================================!
+
+subroutine cregen_discardbroken(ch,env,topocheck,structures,newnall)
+!**************************************************
+!* subroutine cregen_discardbroken
+!* analyze an ensemble and track broken structures
+!* to be discarded.
+!**************************************************
+  use crest_parameters
+  use crest_data
+  use strucrd
+  use adjacency
+  use cregen_utils
+  implicit none
+  !> INPUT
+  type(systemdata),intent(in) :: env    ! MAIN STORAGE OS SYSTEM DATA
+  integer,intent(in) :: ch ! printout channel
+  logical,intent(in) :: topocheck
+  type(coord),intent(inout),allocatable,target :: structures(:)
+  integer,intent(out) :: newnall
+  !> LOCAL
+  integer :: llan,nall,frag,frag0
+  real(wp) :: erj,cnorm
+  integer :: ii,jj
+  logical :: substruc
+  logical :: dissoc,distok,distok2
+  logical,allocatable :: broke(:)
+  type(coord) :: mol0
+  type(coord),pointer :: mol
+  type(coord),allocatable :: tmpstructures(:)
+
+  !>--- if we don't wish to include all atoms:
+  substruc = (structures(1)%nat .ne. env%rednat.and.env%subRMSD)
+  nall = size(structures,1)
+  !> Check fragments
+  call env%ref%to(mol0)
+  call cregen_calculate_fragments(mol0,nfrag=frag0)
+  write (ch,'(" # fragment in coord",t35,":",i10)') frag0
+
+  !>--- loop over the structures
+  allocate (broke(nall),source=.false.)
+  newnall = 0
+  llan = nall
+  do ii = 1,nall
+    mol => structures(ii)
+    erj = mol%energy
+    !if (substruc) then
+    !  !...
+    !end if
+
+    !>--- close contact checks
+    cnorm = sum(abs(mol%xyz))           !> clash check
+    distok = distcheck(mol%nat,mol%xyz) !> distance check
+    distok2 = (cnorm .gt. 1.0d-6)
+
+    !>--- further checks: dissociation?
+    dissoc = .false.
+    if (abs(erj) .gt. 1.0d-6.and. &
+    &   distok.and.distok2.and.topocheck) then
+      call cregen_calculate_fragments(mol,nfrag=frag)
+      dissoc = (frag .gt. frag0)
+    end if
+
+    if (dissoc.or.(.not.distok).or.(.not.distok2)) then
+      !>--- move broken structures to the end of the matrix
+      broke(ii) = .true.
+      !write(ch,*) 'removing structure',ii
+    else
+      newnall = newnall+1
+    end if
+  end do
+
+  !>--- sort the xyz array (only if structures have been discarded)
+  if (newnall .lt. nall) then
+    allocate (tmpstructures(newnall))
+    jj = 0
+    do ii = 1,nall
+      if (.not.broke(ii)) then
+        jj = jj+1
+        tmpstructures(jj) = structures(ii)
+      end if
+    end do
+    call move_alloc(tmpstructures,structures)
+    llan = nall-newnall
+    write (ch,'(" number of removed clashes",t35,":",i10)') llan
+  end if
+  !>--- otherwise the ensemble is ok
+  if (allocated(broke)) deallocate (broke)
+  return
+end subroutine cregen_discardbroken
+
+!=========================================================================================!
+
+subroutine cregen_topocheck(ch,env,checkez,structures,newnall)
+!*************************************************************
+!* subroutine cregen_topocheck
+!* analyze an ensemble and compare topology (neighbourlist)
+!* to the reference structure
+!*************************************************************
+  use crest_parameters
+  use crest_data
+  use strucrd
+  use miscdata,only:rcov
+  use utilities
+  use crest_cn_module
+  use quicksort_interface
+  use cregen_utils
+  implicit none
+  type(systemdata) :: env    ! MAIN STORAGE OS SYSTEM DATA
+  integer,intent(in) :: ch ! printout channel
+  logical,intent(in) :: checkez
+  type(coord),intent(inout),allocatable,target :: structures(:)
+  integer,intent(out) :: newnall
+  integer :: nat,nall,llan
+  real(wp),allocatable :: cn(:),bond(:,:)
+  integer,allocatable :: toporef(:)
+  integer,allocatable :: topo(:)
+  logical,allocatable :: neighmat(:,:)
+  integer :: nbonds
+  integer :: ii,jj,l
+  integer :: ntopo,ncc,ccfail
+  logical :: discard
+  integer,allocatable :: ezat(:,:)
+  real(wp),allocatable :: ezdihedref(:)
+  real(wp),allocatable :: ezdihed(:)
+  real(wp) :: winkeldiff
+
+  type(coord) :: mol0
+  type(coord),pointer :: mol
+  type(coord),allocatable :: tmpstructures(:)
+  logical,allocatable :: broke(:)
+
+  !>--- read the reference structure
+  call env%ref%to(mol0)
+  nat = mol0%nat
+  nall = size(structures,1)
+  call mol0%cn_to_bond(cn,bond)
+  !>--- calculate reference "topology"
+  if (allocated(env%excludeTOPO)) then
+    call bondtotopo(nat,mol0%at,bond,cn,ntopo,toporef,neighmat,excl=env%excludeTOPO)
+  else
+    call bondtotopo(nat,mol0%at,bond,cn,ntopo,toporef,neighmat)
+  end if
+
+  nbonds = sum(toporef)
+  write (ch,'(" # bonds in reference structure",t35,":",i10)') nbonds
+  !>--- if required, check for C=C bonds (based only on structure!)
+  if (checkez) then
+    call nezcc(nat,mol0%at,mol0%xyz,cn,ntopo,toporef,ncc)
+    if (ncc > 0) then
+      write (ch,'("  => # of C=C bonds : ",i0)') ncc
+      allocate (ezat(4,ncc))
+      allocate (ezdihedref(ncc),ezdihed(ncc),source=0.0d0)
+      call ezccat(nat,mol0%at,mol0%xyz,cn,ntopo,toporef,ncc,ezat)
+      call ezccdihed(nat,mol0%xyz,ncc,ezat,ezdihedref)
+      !do i=1,ncc
+      !  write(*,'(1x,a,4i4,a,f6.2)') 'C=C bond atoms:',ezat(1:4,i)," angle: ",ezdihedref(i)
+      !enddo
+    end if
+  end if
+
+  allocate (broke(nall),source=.false.)
+  !>--- loop over the structures
+  ccfail = 0
+  newnall = 0
+  llan = nall
+  do jj = 1,nall
+    !>--- generate topo and compare
+    discard = .false.
+    mol => structures(jj)
+    call mol%cn_to_bond(cn,bond)
+    if (allocated(env%excludeTOPO)) then
+      call bondtotopo(mol%nat,mol%at,bond,cn,ntopo,topo,neighmat,excl=env%excludeTOPO)
+    else
+      call bondtotopo(mol%nat,mol%at,bond,cn,ntopo,topo,neighmat)
+    end if
+    do l = 1,ntopo
+      if (toporef(l) .ne. topo(l)) then
+        discard = .true.   !> if there is any mismatch in neighbor lists
+        exit
+      end if
+    end do
+    !>--- get E/Z info of C=C, discard isomers
+    if (checkez.and..not.discard.and.ncc > 0) then
+      call ezccdihed(mol%nat,mol%xyz,ncc,ezat,ezdihed)
+      do l = 1,ncc
+        winkeldiff = ezdihedref(l)-ezdihed(l)
+        winkeldiff = abs(winkeldiff)
+        if (winkeldiff > 90.0_wp) then
+          discard = .true.
+          ccfail = ccfail+1
+          exit
+        end if
+      end do
+    end if
+
+    if (discard) then
+      broke(jj) = .true.
+    else
+      newnall = newnall+1
+    end if
+  end do
+
+  !>--- sort the xyz array (only if structures have been discarded)
+  if (newnall .lt. nall) then
+    llan = nall-newnall
+    write (ch,'(" number of topology mismatches",t35,":",i10)') llan
+    !>--- report the removals during a run
+    if (ch .ne. stdout) then
+      write (stdout,'("CREGEN> number of topology-based structure removals: ",i0)') llan
+    end if
+    if (checkez.and.ccfail > 0) then
+      write (ch,'(''  => discared due to E/Z isom.  : '',i0)') ccfail
+    end if
+    if (newnall >= 1) then
+      allocate (tmpstructures(newnall))
+      jj = 0
+      do ii = 1,nall
+        if (.not.broke(ii)) then
+          jj = jj+1
+          tmpstructures(jj) = structures(ii)
+        end if
+      end do
+      call move_alloc(tmpstructures,structures)
+    else
+      if (ch .ne. stdout) then
+        write (stdout,'("CREGEN> ** WARNING ** Full removal of ensemble! Falling back to reference structure.")')
+      end if
+      allocate (tmpstructures(1),source=mol0)
+      call move_alloc(tmpstructures,structures)
+    end if
+  end if
+  !>--- otherwise the ensemble is ok
+  if (allocated(ezdihedref)) deallocate (ezdihedref)
+  if (allocated(ezdihed)) deallocate (ezdihed)
+  if (allocated(ezat)) deallocate (ezat)
+  deallocate (cn,bond)
+  deallocate (neighmat)
+  deallocate (topo,toporef)
+  return
+end subroutine cregen_topocheck
+
+!=========================================================================================!
+
+subroutine cregen_esort(ch,structures,nallout,ewin)
+!**************************************************************
+!* subroutine cregen_esort
+!* sort the ensemble by energy and determine the new
+!* ensemble size within the energy threshold.
+!* On Input: ch - printout channel
+!*           structures - the list of structures
+!*           nallout - number of surviving structures
+!*           ewin - energy window in kcal/mol
+!* On Output: nallout - number of strucutres after cutoff
+!**************************************************************
+  use crest_parameters
+  use strucrd
+  use quicksort_interface
+  implicit none
+  integer,intent(in) :: ch
+  type(coord),intent(inout),allocatable :: structures(:)
+  integer,intent(out) :: nallout
+  real(wp),intent(in),optional :: ewin
+  integer :: nall,nat
+
+  real(wp),allocatable :: energies(:)
+  type(coord),allocatable :: tmpstructures(:)
+  integer :: ii,jj
+  real(wp) :: de,emax,frac
+
+  nall = size(structures,1)
+  nallout = nall
+  call ensemble_qsort(nall,structures,1,nall)
+
+  !>-- determine cut-off of energies (optional)
+  if (present(ewin)) then
+    write (ch,'(80("*"))')
+    allocate (energies(nall))
+    do ii = 1,nall
+      energies(ii) = structures(ii)%energy
+    end do
+
+    if (ewin < 9999.9_wp) then
+      write (ch,'(" sorting energy window (EWIN)",t32,":",1x,f9.4,a)') ewin,' / kcal/mol'
+    else
+      write (ch,'(" sorting energy window (EWIN)",t32,":",3x,a,a)') '+∞',' / kcal/mol'
+    end if
+    emax = maxval(energies(:),1)
+    de = (emax-energies(1))*autokcal
+    if (de .gt. ewin) then
+      nallout = 1 !> lowest is always taken
+      do ii = 2,nall
+        de = (energies(ii)-energies(1))*autokcal
+        if (de .lt. ewin) then
+          nallout = nallout+1
+        else
+          exit
+        end if
+      end do
+      frac = real(nall-nallout,wp)/real(nall,wp)
+      write (ch,'(" number of removed by energy",t32,":",3x,i10,a,f6.2,a)') &
+      &       (nall-nallout),' (',frac*100.d0,'%)'
+      write (ch,'(" number of remaining points",t32,":",3x,i10,a,f6.2,a)') &
+      &       nallout,' (', (1.0d0-frac)*100.d0,'%)'
+
+      allocate (tmpstructures(nallout))
+      do ii = 1,nallout
+        tmpstructures(ii) = structures(ii)
+      end do
+      call move_alloc(tmpstructures,structures)
+    else
+      nallout = nall
+    end if
+    write (ch,'(" reference state Etot",t32,":",2x,es14.6)') energies(1)
+    deallocate (energies)
+  end if
+
+  return
+end subroutine cregen_esort
+
+!=========================================================================================!
+!> The actual core of CREGEN: Conformer/Rotamer Classification
+!=========================================================================================!
+subroutine cregen_CRE_new(env,nall,structures,groups,rthresh,ethr,bthr, &
+    &                         printlvl,ch)
+!**************************************************************************************
+!* Re-ractored implementaiton of the original CREGEN workflow, classifying conformers
+!* according to their quaternion RMSD, rotational constants, energy,
+!* and pair-distance sum
+!* "structures" will be updated so that all true duplicates are pruned and
+!* molecules are clustered by their group. "group" and "nall" are also updated.
+!*
+!* Input arguments:
+!*         env - CREST systemdata
+!*        nall - total number of structures
+!*  structures - the structures
+!*      groups - group assignment for each structure (dimension 0:nall), group(0) = maxval(group(1:nall))
+!*      rthresh - RMSD threshold (in ANGSTRÖM) for conformer distinction
+!*        ethr - inter-conformer energy threshold (in HARTREE) for pre-sorting
+!*        bthr - rotational constant similarity threshold (percentage based)
+!*
+!* Optionals:
+!*    printlvl - integer to direct the print verbosity. (0=minimal, 1=verbose)
+!*          ch - integer for print channel
+!*
+!* Output:
+!*      groups - integer array assigning each structure to a group
+!*************************************************************************************
+  use crest_parameters
+  use crest_data
+  use rotaniso_mod
+  use axis_module
+  use strucrd
+  use canonical_mod
+  use irmsd_module
+  implicit none
+  !> INPUT
+  type(systemdata),intent(inout) :: env
+  integer,intent(inout) :: nall
+  type(coord),intent(inout),allocatable,target :: structures(:)
+  integer,intent(out),allocatable :: groups(:)
+  real(wp),intent(in) :: RTHRESH
+  real(wp),intent(in) :: ETHR
+  real(wp),intent(in) :: BTHR
+  integer,intent(in),optional :: printlvl
+  integer,intent(in),optional :: ch
+
+  !> LOCAL
+  integer :: i,ii,jj,kk,T,cc,nat,io,gg
+  integer :: gcount,ggcount,nallnew
+  integer :: prlvl,prch
+  type(rmsd_cache),allocatable :: rcaches(:)
+  type(coord),allocatable,target :: workmols(:)
+  type(canonical_sorter),allocatable :: sorters(:)
+  type(coord),pointer :: ref,mol
+  real(wp) :: rmsdval,RTHR,ediff,eii,avmom,rsq,frac
+  real(wp),allocatable :: rot(:,:)
+  real(wp),allocatable :: xyz_aa(:,:)
+  integer,allocatable :: prune_table(:)
+  real(wp),allocatable :: enuc(:)
+  logical :: l1,l2
+  character(len=:),allocatable :: tmpstr
+  logical :: heavy,substruc
+  logical,allocatable :: mask(:)
+  integer,allocatable :: tmpgroups(:),double(:)
+  type(coord),allocatable :: tmpstructures(:)
+  !type(progress_state) :: ps
+
+  !> defaults that are practically never touched
+  real(wp),parameter :: bthrmax = 0.025_wp
+  real(wp),parameter :: bthrshift = 0.5_wp
+  real(wp),parameter :: enuc_thr = 1.0d-3
+
+  logical,parameter :: debug = .false.
+
+!>--- handle optional arguments
+  if (present(printlvl)) then
+    prlvl = printlvl
+  else
+    prlvl = 1
+  end if
+
+  if (present(ch)) then
+    prch = ch
+  else
+    prch = stdout
+  end if
+
+!>--- set up parallelization
+!     ...
+  T = 1 !> doing it serial for now
+
+!>--- set up parameters (NOTE, we are working with BOHR internally)
+  RTHR = RTHRESH*aatoau
+
+!>--- reference structure (the first one) for some setup
+  ref => structures(1)
+  nat = ref%nat
+
+!>--- print some sorting data
+  if (prlvl > 0) then
+    tmpstr = 'Info for CREGEN sorting:'
+    if (prlvl > 1.and.prch == stdout) then
+      !  call printc(style(S_BOLD)//fg(YELLOW,bright=.true.)//trim(tmpstr)//reset())
+    else
+      write (prch,'(a)') 'Info for CREGEN sorting:'
+    end if
+    !write (prch,'(2x,a,i10)') 'number of structures     :',nall
+    write (prch,'(2x,a,t32,a,f10.5,a)') 'RTHR (RMSD threshold)',':',RTHR*autoaa,' Å'
+    write (prch,'(2x,a,t32,a,es10.2,a)') 'ETHR (energy threshold)',':',ETHR,' Ha'
+    write (prch,'(2x,a,t32,a,f10.2,a)') 'BTHR (rot. threshold)',':',BTHR*100,' %'
+    !write (prch,'(2x,a,i9)') 'OpenMP threads           :',T
+  end if
+
+!>--- mask setup: We may not include all atoms in the checks
+  heavy = env%heavyrmsd
+  substruc = (nat .ne. env%rednat.and.env%subRMSD.and.allocated(env%includeRMSD))
+  if (heavy.or.substruc) then
+    allocate (mask(nat),source=.false.)
+  end if
+  if (heavy) then
+    do ii = 1,nat
+      if (structures(1)%at(ii) .ne. 1) mask(ii) = .true.
+    end do
+  end if
+  if (substruc) then
+    do ii = 1,nat
+      mask(ii) = (env%includeRMSD(ii) .eq. 1)
+    end do
+  end if
+  if ((heavy.or.substruc).and.(prlvl > 0)) then
+    write (prch,'(" Heavy/masked atoms",t32,":",i10," / ",i0)') count(mask),nat
+  end if
+
+  if (prlvl > 0) then
+    tmpstr = "Starting calculations..."
+    if (prlvl > 1.and.prch == stdout) then
+      !  call printc(style(S_BOLD)//fg(YELLOW,bright=.true.)//trim(tmpstr)//reset())
+    else
+      write (stdout,'(a)') trim(tmpstr)
+    end if
+  end if
+!>--- allocate work cache
+  if (prlvl > 0) then
+    write (prch,'(a)',advance='no') 'Allocating RMSD work cache ... '
+    flush (prch)
+  end if
+  allocate (rcaches(T))
+  allocate (workmols(T))
+  do i = 1,T
+    mol => workmols(i)
+    allocate (mol%at(ref%nat))
+    allocate (mol%xyz(3,ref%nat))
+    nullify (mol)
+    call rcaches(i)%allocate(ref%nat)
+  end do
+  if (prlvl > 0) then
+    write (prch,'(a)') 'done.'
+  end if
+
+!> ----------------------------------------------
+!> PRE-PROCESSING for more efficient sorting
+!> ----------------------------------------------
+  !> prune_table keeps track of which structure to compare to
+  !> so for a  list of structures (1...j...k...nall), the entry
+  !> prune_table(k) = j, tells us structure k is compared to all
+  !> structures j up to k-1. The table is initialized to 1, so
+  !> the full comparison list is used.
+  allocate (prune_table(nall),source=1)
+  !> conveniently, we can use the energy threshold to set a better
+  !> comparison table, as in the original CREGEN routine.
+  do ii = 1,nall
+    eii = structures(ii)%energy
+    do jj = 1,ii
+      ediff = abs(eii-structures(jj)%energy)
+      if (ediff <= ETHR) then
+        prune_table(ii) = jj
+        exit
+      end if
+    end do
+  end do
+
+  !> Prepare axis comparison
+  !> axis alignment and rotational constant calculation
+  allocate (rot(3,nall),source=0.0_wp)
+  allocate (xyz_aa(3,nat),source=0.0_wp)
+  do ii = 1,nall
+    mol => structures(ii)
+    call axis(mol%nat,mol%at,mol%xyz) !> all coordinates to CMA
+    xyz_aa = mol%xyz*autoaa
+    call axis(mol%nat,mol%at,xyz_aa,rot(1:3,ii),avmom) !> B_0 in MHz
+  end do
+
+  !> Scaled sum of atom-atom-distances (empirical measure)
+  allocate (enuc(nall),source=0.0_wp)
+  do ii = 1,nall
+    mol => structures(ii)
+    do jj = 1,mol%nat-1
+      do kk = jj+1,mol%nat
+        rsq = (mol%xyz(1,jj)-mol%xyz(1,kk))**2 &
+          &  +(mol%xyz(2,jj)-mol%xyz(2,kk))**2 &
+          &  +(mol%xyz(3,jj)-mol%xyz(3,kk))**2+1.d-12
+        enuc(ii) = enuc(ii)+real(mol%at(jj)*mol%at(kk),wp)/rsq
+      end do
+    end do
+  end do
+
+!> --------------------------------------------
+!> pre-processing end
+!> --------------------------------------------
+
+!>--- run the checks
+  if (prlvl > 0) then
+    write (prch,'(a,6x,a)',advance='no') 'Running CREGEN checks','... '
+    flush (prch)
+    if (prlvl > 1.and.prch == stdout) then
+      !  write (stdout,*)
+      !  call progress_init(ps,width=50,prefix=" ↳", &
+      !    & suffix="",show_time=.true.,show_eta=.false.)
+      !  call progress_update(ps,0,nall)
+    else
+      write (stdout,'(a)',advance='no') 'CREGEN> running RMSDs ...'
+      flush (stdout)
+    end if
+  end if
+  allocate (groups(nall),source=0)
+  gcount = maxval(groups(:))
+  do ii = 1,nall
+!>--- find next unassigned conformer and assign a new group
+    if (groups(ii) .ne. 0) cycle
+    gcount = gcount+1
+    groups(ii) = gcount
+
+!>--- Then, cross-check all other unassigned conformers
+    cc = 1  !> again, serial implementation for now
+    ! !$omp parallel &
+    ! !$omp shared(nall, nat, groups, sorters, rcaches, rot) &
+    ! !$omp shared(workmols, structures, ii, prune_table,heavy,substruc,mask) &
+    ! !$omp private(jj,rmsdval,cc,io, l1, l2)
+    ! !$omp do schedule(dynamic)
+    do jj = ii+1,nall
+      !cc = omp_get_thread_num()+1
+      if (groups(jj) .ne. 0) cycle
+      if (ii < prune_table(jj)) cycle
+      workmols(cc)%nat = structures(jj)%nat
+      workmols(cc)%at(:) = structures(jj)%at(:)
+      workmols(cc)%xyz(:,:) = structures(jj)%xyz(:,:)
+      !if (heavy.or.substruc) then
+      !  rmsdval = rmsd(structures(ii),workmols(cc),mask=mask,&
+      !    &       scratch=rcaches(cc)%xyzscratch,ccache=rcaches(cc)%ccache)
+      !else
+      !  rmsdval = rmsd(structures(ii),workmols(cc), &
+      !    &       scratch=rcaches(cc)%xyzscratch,ccache=rcaches(cc)%ccache)
+      !end if
+      !if (rmsdval < RTHR) then
+      !> only "true" duplicates will have tiny RMSD, assign negative gcount for pruning
+      !  groups(jj) = -gcount
+      !else
+      l1 = equalrotaniso(ii,jj,nall,rot,BTHR,bthrmax,bthrshift)
+      l2 = (2.0_wp*abs(enuc(ii)-enuc(jj))/(enuc(ii)+enuc(jj))) .lt. enuc_thr
+      if (l1.and.l2) groups(jj) = gcount
+      !end if
+    end do
+    if (prlvl > 1) then
+      !  call progress_update(ps,ii,nall)
+    end if
+    ! !$omp end do
+    ! !$omp end parallel
+  end do
+
+!> for all groups run RMSD checks
+  gcount = maxval(groups(1:nall))
+  do gg = 1,gcount
+    do ii = 1,nall
+      if (groups(ii) .ne. gg) cycle
+      do jj = ii+1,nall
+        kk = groups(jj)
+        if (kk .ne. gg.or.kk < 0) cycle
+
+        workmols(cc)%nat = structures(jj)%nat
+        workmols(cc)%at(:) = structures(jj)%at(:)
+        workmols(cc)%xyz(:,:) = structures(jj)%xyz(:,:)
+        if (heavy.or.substruc) then
+          rmsdval = rmsd(structures(ii),workmols(cc),mask=mask,&
+            &       scratch=rcaches(cc)%xyzscratch,ccache=rcaches(cc)%ccache)
+        else
+          rmsdval = rmsd(structures(ii),workmols(cc), &
+            &       scratch=rcaches(cc)%xyzscratch,ccache=rcaches(cc)%ccache)
+        end if
+        if (rmsdval < RTHR) then
+          !> only "true" duplicates will have tiny RMSD, assign negative gcount for pruning
+          groups(jj) = -gg
+        end if
+      end do
+    end do
+  end do
+
+  if (prlvl > 0) then
+    !if (prlvl > 1 .and.prch == stdout) then
+    if (prlvl > 1 .and.prch == stdout) then
+      !  call progress_update(ps,nall,nall)
+      !  call progress_finish(ps)
+      write (prch,'(a)') 'done.'
+    else
+      write (stdout,'(a)') ' done.'
+    end if
+  end if
+
+!> finally, resizing the ensemble with remaining unique conformers+rotamers
+!> Note, structures are grouped by assigned group and within group are ordered
+!> with increasing energy (because the initial ensemble was energy-sorted)
+  if (prlvl > 0) then
+    write (prch,'(a,6x,a)',advance='no') 'Discarding duplicates','...'
+    flush (prch)
+  end if
+  gcount = maxval(groups(1:nall))
+  nallnew = count(groups(1:nall) > 0)
+  allocate (tmpstructures(nallnew))
+  allocate (tmpgroups(0:nallnew),source=0)
+  allocate (double(nallnew),source=0)
+  cc = 0
+  do ii = 1,gcount
+    do jj = 1,nall
+      ggcount = groups(jj)
+      if (ggcount .eq. ii.and.ggcount > 0) then
+        cc = cc+1
+        tmpstructures(cc) = structures(jj)
+        tmpgroups(cc) = ggcount
+        do kk = 1,cc-1
+          if (tmpgroups(kk) .eq. ggcount) then
+            double(cc) = kk
+            exit
+          end if
+        end do
+      end if
+    end do
+  end do
+  tmpgroups(0) = gcount
+  call move_alloc(tmpgroups,groups)
+  call move_alloc(tmpstructures,structures)
+  if (prlvl > 0) then
+    write (prch,'(a)') ' done.'
+    frac = real(nall-nallnew,wp)/real(nall,wp)
+    write (prch,'(1x,a,t40,a,i10,a,f6.2,a)') &
+    &      "number of doubles removed by rot/RMSD",":",nall-nallnew,' (',frac*100.d0,'%)'
+    write (prch,'(1x,a,t40,a,i10,a,f6.2,a)') &
+    &      "number of unique structures remaining",":",nallnew,' (', (1.0d0-frac)*100.d0,'%)'
+    frac = real(gcount,wp)/real(nallnew,wp)
+    write (prch,'(1x,a,t40,a,i10,a,f6.2,a,i0,a)') &
+    &      "number of unique conformers identified",":",gcount,' (', (frac)*100.d0,'% of ',nallnew,')'
+  end if
+  nall = nallnew
+
+  !>-- for ENSO write a file with duplicate info (if required)
+  call enso_duplicates(env,nall,double)
+
+  if (allocated(prune_table)) deallocate (prune_table)
+  if (allocated(mask)) deallocate (mask)
+  if (allocated(enuc)) deallocate (enuc)
+  if (allocated(rot)) deallocate (rot)
+  if (allocated(prune_table)) deallocate (prune_table)
+end subroutine cregen_CRE_new
+
+!=========================================================================================!
+
+subroutine cregen_irmsd_all(nall,structures,printlvl,iinversion)
+!********************************************
+!* Proof-of-concept routine to run all
+!* pairs of RMSD for an array of structures
+!********************************************
+  use crest_parameters
+  use crest_data
+  use strucrd
+  use axis_module
+  use canonical_mod
+  use irmsd_module
+  use utilities,only:lin
+  implicit none
+  !> INPUT
+  integer,intent(in) :: nall
+  type(coord),intent(inout),target :: structures(nall)
+  integer,intent(in),optional :: printlvl
+  integer,intent(in),optional :: iinversion
+  !> LOCAL
+  integer :: i,j,ii,jj,T,nallpairs,cc,nat
+  integer :: prlvl,iunit
+  type(rmsd_cache),allocatable :: rcaches(:)
+  type(coord),allocatable,target :: workmols(:)
+  type(canonical_sorter),allocatable :: sorters(:)
+  real(wp),allocatable :: rmsds(:)
+  type(coord),pointer :: ref,mol
+  type(coord) :: molloc
+  real(wp) :: rmsdval,runtime
+  logical :: stereocheck
+  type(timer) :: profiler
+
+  logical,parameter :: debug = .false.
+  real(wp),allocatable :: debugrmsds(:)
+
+  !> for implementing OpenMP parallelism
+  T = 1
+
+  !> print level
+  if (present(printlvl)) then
+    prlvl = printlvl
+  else
+    prlvl = 0
+  end if
+
+  !> set up timer
+  call profiler%init(3)
+
+  !> prepare workspace
+  nallpairs = (nall*(nall+1))/2
+  allocate (rmsds(nallpairs),source=0.0_wp)
+  if (debug) then
+    allocate (debugrmsds(nallpairs),source=0.0_wp)
+  end if
+
+  allocate (rcaches(T))
+  ref => structures(1)
+  nat = ref%nat
+  allocate (workmols(T))
+  do i = 1,T
+    mol => workmols(i)
+    allocate (mol%at(ref%nat))
+    allocate (mol%xyz(3,ref%nat))
+    nullify (mol)
+    call rcaches(i)%allocate(ref%nat)
+  end do
+
+  !> set up ranks for each structure
+  call profiler%start(1)
+  allocate (sorters(nall))
+  if (prlvl > 0) then
+    write (stdout,'(a)',advance='no') 'CREGEN> Setting up canonical atom ranks ... '
+    flush (stdout)
+  end if
+  do ii = 1,nall
+    mol => structures(ii)
+    call axis(mol%nat,mol%at,mol%xyz)
+    call sorters(ii)%init(mol,invtype='apsp+',heavy=.false.)
+    !call sorters(ii)%add_h_ranks(mol)
+    if (ii == 1) then
+      stereocheck = .not. (sorters(ii)%hasstereo(ref))
+    end if
+    call sorters(ii)%shrink()
+  end do
+  call profiler%stop(1)
+  if (prlvl > 0) then
+    call profiler%write_timing(stdout,1,'done.',.true.)
+    runtime = (profiler%get(1)/real(nall,wp))*1000.0_wp
+    write (stdout,'(a,f0.3,a)') 'CREGEN> Corresponding to approximately ',runtime, &
+    &                       ' ms per processed structure'
+  end if
+
+  !> allow user to set inversion check (false rotamers)
+  if (present(iinversion)) then
+    select case (iinversion)
+    case (0)
+      continue
+    case (1)
+      stereocheck = .true.
+    case (2)
+      stereocheck = .false.
+    end select
+    if (prlvl > 1) then
+      write (stdout,'(a,l2)') 'CREGEN> Check for false rotamers (geometry inversion)? -->',stereocheck
+    end if
+  end if
+
+  !> And finally, run the RMSD checks
+  call profiler%start(2)
+  if (prlvl > 0) then
+    write (stdout,*)
+    write (stdout,'(a)',advance='no') 'CREGEN> Running all pair RMSDs ... '
+    flush (stdout)
+  end if
+  cc = 1
+  do ii = 1,nall
+    rcaches(cc)%stereocheck = stereocheck
+    rcaches(cc)%rank(1:nat,1) = sorters(ii)%rank(1:nat)
+    do jj = ii+1,nall
+      workmols(cc)%nat = structures(jj)%nat
+      workmols(cc)%at(:) = structures(jj)%at(:)
+      workmols(cc)%xyz(:,:) = structures(jj)%xyz(:,:)
+      !molloc = structures(jj)
+      rcaches(cc)%rank(:,2) = sorters(jj)%rank(:)
+      call min_rmsd(structures(ii),workmols(cc), &
+      &        rcache=rcaches(cc),rmsdout=rmsdval)
+      rmsds(lin(ii,jj)) = rmsdval
+    end do
+  end do
+  call profiler%stop(2)
+  if (prlvl > 0) then
+    call profiler%write_timing(stdout,2,'done.',.true.)
+    !write (stdout,'(a)',advance='yes') 'done.'
+    runtime = (profiler%get(2)/real(nallpairs,wp))*1000.0_wp
+    write (stdout,'(a,f0.3,a)') 'CREGEN> Corresponding to approximately ',runtime, &
+    &                       ' ms per processed RMSD'
+
+  end if
+
+  if (debug) then
+    !> RMSD without permutation
+    do ii = 1,nall
+      do jj = ii+1,nall
+        rmsdval = rmsd(structures(ii),structures(jj))
+        debugrmsds(lin(ii,jj)) = rmsdval
+      end do
+    end do
+  end if
+
+  if (prlvl > 1) then
+    write (stdout,'(a)') 'CREGEN> Writing cregen_rmsds.csv with RMSDs in Angström'
+    open (newunit=iunit,file='cregen_rmsds.csv')
+    if (debug) then
+      write (iunit,'(a,3(",",a))') 'A','B','rmsd','rmsdref'
+      do ii = 1,nall
+        do jj = ii+1,nall
+          write (iunit,'(i0,",",i0,2(",",f0.7))') &
+          & min(ii,jj),max(ii,jj),rmsds(lin(ii,jj))*autoaa,debugrmsds(lin(ii,jj))*autoaa
+        end do
+      end do
+    else
+      write (iunit,'(a,",",a,",",a)') 'A','B','rmsd'
+      do ii = 1,nall
+        do jj = ii+1,nall
+          write (iunit,'(i0,",",i0,",",f0.7)') min(ii,jj),max(ii,jj),rmsds(lin(ii,jj))*autoaa
+        end do
+      end do
+    end if
+    close (iunit)
+  end if
+
+  deallocate (sorters)
+  deallocate (workmols)
+  deallocate (rcaches)
+  deallocate (rmsds)
+end subroutine cregen_irmsd_all
+
+!=========================================================================================!
+
+subroutine cregen_irmsd_sort(env,nall,structures,groups,allcanon,printlvl)
+!*******************************************************
+!* Proof-of-concept routine to analyze an
+!* ensemble only via the iRMSD procedure.
+!* Conformers are identified by the rthr threshold only
+!*******************************************************
+  use crest_parameters
+  use crest_data
+  use iomod,only:to_str
+  use strucrd
+  use axis_module
+  use canonical_mod
+  use irmsd_module
+  use utilities,only:lin
+  use quicksort_interface
+  use omp_lib
+  implicit none
+  !> INPUT
+  type(systemdata),intent(inout) :: env
+  integer,intent(in) :: nall
+  type(coord),intent(inout),target :: structures(nall)
+  integer,intent(inout) :: groups(nall)
+  logical,intent(in),optional :: allcanon
+  integer,intent(in),optional :: printlvl
+
+  !> LOCAL
+  integer :: i,j,ii,jj,T,Tn,nallpairs,cc,nat,k
+  integer :: gcount
+  integer :: prlvl,iunit
+  type(rmsd_cache),allocatable :: rcaches(:)
+  type(coord),allocatable,target :: workmols(:)
+  type(canonical_sorter),allocatable :: sorters(:)
+  real(wp),allocatable :: rmsds(:)
+  type(coord),pointer :: ref,mol
+  type(coord) :: molloc
+  real(wp) :: rmsdval,runtime,RTHR,ETHR,ediff
+  logical :: stereocheck,individual_IDs
+  type(timer) :: profiler
+  integer :: ng
+  integer,allocatable :: group(:),degen(:,:)
+  real(wp),allocatable :: er(:)
+  type(coord),allocatable :: structures_new(:)
+
+  logical,parameter :: debug = .false.
+
+!>--- handle optional arguments
+  if (present(allcanon)) then
+    individual_IDs = .not.allcanon
+  else
+    individual_IDs = .false.
+  end if
+  if (present(printlvl)) then
+    prlvl = printlvl
+  else
+    prlvl = 1
+  end if
+
+!>--- set up parallelization
+  call new_ompautoset(env,'max',nall,T,Tn)
+
+!>--- set up timer
+  call profiler%init(3)
+
+!>--- set up parameters (note we are working with BOHR internally)
+  RTHR = env%rthr*aatoau
+  ETHR = env%ethr/autokcal
+
+!>--- print some sorting data
+  if (prlvl > 0) then
+    write (stdout,'(a)') 'CREGEN> Info for iRMSD sorting:'
+    write (stdout,'(2x,a,t32,a,i10)') 'number of structures',':',nall
+    write (stdout,'(2x,a,t32,a,f10.5,a)') 'RTHR (RMSD threshold)',':',RTHR*autoaa,' Å'
+    write (stdout,'(2x,a,t32,a,es10.2,a)') 'ETHR (energy threshold)',':',ETHR,' Ha'
+    write (stdout,'(2x,a,t32,a,i10)') 'OpenMP threads',':',T
+    write (stdout,'(2x,a,t32,a,a10)') 'Individual atom IDs?',':',to_str(individual_IDs)
+    write (stdout,'(2x,a,t32,a)',advance='no') 'False rotamer check?',':'
+    select case (env%iinversion)
+    case (0)
+      write (stdout,'(a10)') 'auto'
+    case (1)
+      write (stdout,'(a10)') 'on'
+    case (2)
+      write (stdout,'(a10)') 'off'
+    end select
+    write (stdout,*)
+  end if
+
+!>--- sorting by energy
+  write (stdout,'(a)',advance='no') 'CREGEN> Sorting ensemble by energy ... '
+  flush (stdout)
+  call ensemble_qsort(nall,structures,1,nall)
+  write (stdout,'(a)') 'done.'
+
+!>--- Set up atom identities (either for all, or just the first structure)
+  if (individual_IDs) then
+    allocate (sorters(nall))
+  else
+    allocate (sorters(1))
+  end if
+  if (prlvl > 0) then
+    write (stdout,'(a)',advance='no') 'CREGEN> Setting up canonical atom ranks ... '
+    flush (stdout)
+    call profiler%start(1)
+  end if
+  ref => structures(1)
+  !$omp parallel &
+  !$omp shared(sorters, structures, stereocheck) &
+  !$omp private(mol,ii)
+  !$omp do schedule(dynamic)
+  do ii = 1,nall
+    mol => structures(ii)
+    call axis(mol%nat,mol%at,mol%xyz)
+    if (individual_IDs.or.ii == 1) then
+      call sorters(ii)%init(mol,invtype='apsp+',heavy=.false.)
+    end if
+    if (ii == 1) then
+      stereocheck = .not. (sorters(ii)%hasstereo(ref))
+    end if
+    if (individual_IDs.or.ii == 1) then
+      call sorters(ii)%shrink()
+    end if
+  end do
+  !$omp end do
+  !$omp end parallel
+  if (prlvl > 0) then
+    call profiler%stop(1)
+    call profiler%write_timing(stdout,1,'done.',.true.)
+    runtime = (profiler%get(1)/real(nall,wp))*1000.0_wp
+    write (stdout,'(1x,a,f0.3,a)') '* Corresponding to approximately ',runtime, &
+    &                       ' ms per processed RMSD'
+    write (stdout,*)
+  end if
+
+  !>--- allow user to set inversion check (false rotamers)
+  select case (env%iinversion)
+  case (0)
+    continue
+  case (1)
+    stereocheck = .true.
+  case (2)
+    stereocheck = .false.
+  end select
+  if (prlvl > 1) then
+    write (stdout,'(a,l2)') 'CREGEN> Check for false rotamers (geometry inversion)? -->',stereocheck
+  end if
+
+!>--- allocate work cache
+  if (prlvl > 0) then
+    write (stdout,'(a)',advance='no') 'CREGEN> Allocating iRMSD work cache ... '
+    flush (stdout)
+  end if
+  allocate (rcaches(T))
+  ref => structures(1)
+  nat = ref%nat
+  allocate (workmols(T))
+  do i = 1,T
+    mol => workmols(i)
+    allocate (mol%at(ref%nat))
+    allocate (mol%xyz(3,ref%nat))
+    nullify (mol)
+    call rcaches(i)%allocate(ref%nat)
+    rcaches(i)%stereocheck = stereocheck
+  end do
+  if (prlvl > 0) then
+    write (stdout,'(a)') 'done.'
+    write (stdout,*)
+  end if
+
+!>--- run the checks
+  if (prlvl > 0) then
+    write (stdout,'(a)',advance='no') 'CREGEN> Running all-pair iRMSDs ... '
+    flush (stdout)
+    call profiler%start(2)
+  end if
+  gcount = maxval(groups(:))
+  do ii = 1,nall
+!>--- find next unassigned conformer and assign a new group
+    if (groups(ii) .ne. 0) cycle
+    gcount = gcount+1
+    groups(ii) = gcount
+
+!>--- Then, cross-check all other unassigned conformers
+    !$omp parallel &
+    !$omp shared(nall, nat, groups, individual_IDs, sorters, rcaches) &
+    !$omp shared(workmols, structures, ii, ETHR) &
+    !$omp private(jj,rmsdval,cc,ediff)
+    !$omp do schedule(dynamic)
+    do jj = ii+1,nall
+      cc = omp_get_thread_num()+1
+      if (groups(jj) .ne. 0) cycle
+      ediff = abs(structures(ii)%energy-structures(jj)%energy)
+      if (ediff > ETHR) cycle
+      if (individual_IDs) then
+        rcaches(cc)%rank(1:nat,1) = sorters(ii)%rank(1:nat)
+        rcaches(cc)%rank(1:nat,2) = sorters(jj)%rank(1:nat)
+      else
+        rcaches(cc)%rank(1:nat,1) = sorters(1)%rank(1:nat)
+        rcaches(cc)%rank(1:nat,2) = sorters(1)%rank(1:nat)
+      end if
+      workmols(cc)%nat = structures(jj)%nat
+      workmols(cc)%at(:) = structures(jj)%at(:)
+      workmols(cc)%xyz(:,:) = structures(jj)%xyz(:,:)
+      call min_rmsd(structures(ii),workmols(cc), &
+      &        rcache=rcaches(cc),rmsdout=rmsdval)
+      if (rmsdval < RTHR) groups(jj) = gcount
+    end do
+    !$omp end do
+    !$omp end parallel
+  end do
+  if (prlvl > 0) then
+    call profiler%stop(2)
+    call profiler%write_timing(stdout,2,'done.',.true.)
+    write (stdout,*)
+  end if
+
+  if (debug) then
+    write (*,*) 'assigned groups, and count'
+    do ii = 1,maxval(groups(:))
+      write (*,*) ii,count(groups(:) == ii)
+    end do
+  end if
+
+  allocate (group(0:nall),source=0)
+  allocate (structures_new(nall))
+  ng = maxval(groups(:))
+  k = 0
+  do ii = 1,ng
+    do jj = 1,nall
+      if (groups(jj) == ii) then
+        k = k+1
+        group(k) = ii
+        structures_new(k) = structures(jj)
+      end if
+    end do
+  end do
+  group(0) = maxval(groups(:))
+  allocate (degen(3,ng))
+  call cregen_groupinfo(nall,ng,group,degen)
+  allocate (er(nall))
+  do ii = 1,nall
+    er(ii) = structures_new(ii)%energy
+    structures(ii) = structures_new(ii)
+  end do
+  if (prlvl > 0) then
+    call cregen_pr2(stdout,env,nall,ng,degen,er)
+    call cregen_econf_list(stdout,nall,er,ng,degen)
+  end if
+  if (prlvl > 1) then
+    write (stdout,'(a,a)') 'Unique-structure file written to: ',ensemblefile
+    block
+      use cregen_subroutines,only:cregen_conffile
+      call cregen_conffile(env,ensemblefile,structures,ng,degen)
+    end block
+  end if
+
+end subroutine cregen_irmsd_sort
+
+!=========================================================================================!
+
+subroutine cregen_EQUAL(ch,nall,structures,group,athr,rotfil)
+!****************************************************************
+!* subroutine cregen_EQUAL
+!* subroutine for the generation of nuclear equivalencies
+!* On Input: ch - printout channel
+!*           nall - number of structures
+!*           structures  - the list of structures
+!*           group - to which group does every strucutre belong
+!*           athr  - threshold for equivalency comparison
+!*           rotfil - wirte anmr_rotamer file?
+!* On Output: resorted xyz and comments
+!****************************************************************
+  use crest_parameters,id => dp
+  use crest_data
+  use strucrd
+  use miscdata,only:rcov
+  use crest_cn_module
+  use utilities
+  implicit none
+  integer,intent(in) :: ch
+  integer,intent(in) :: nall
+  type(coord),intent(in) :: structures(nall)
+  integer,intent(inout) :: group(0:nall)
+  real(wp),intent(in) :: athr
+  logical,intent(in) :: rotfil
+  integer,allocatable :: at(:)
+  real(wp),allocatable :: cdum(:,:)
+  integer :: ng,n,nat
+  integer :: i,j,k,l
+  logical :: ex
+
+  !>--- arrays and variable for the analysis
+  integer :: gmax
+  integer,allocatable :: glist(:,:)
+  integer :: current
+  real(wp) :: dum
+  real(wp) :: shortest_distance
+  integer,allocatable :: equiv(:,:,:)
+  integer,allocatable :: pair(:),pre(:),nb(:,:)
+  logical,allocatable :: vis(:)
+  real(wp),allocatable :: metric(:,:)
+  real(wp),allocatable :: dist(:,:,:)
+  integer,allocatable :: relat(:,:)
+  real(wp),allocatable :: tmp2(:)
+  integer :: m,m1,m2,s1,s2,iat,j1,k2
+
+  !>-- further NMR-mode related data
+  integer,allocatable :: nmract(:)
+  integer,allocatable :: elist(:,:),flist(:,:)
+  integer,allocatable :: jnd(:)
+  real(wp),allocatable :: sd(:,:),jfake(:),cn(:)
+
+  character(len=:),allocatable :: atmp
+  integer :: ig,ir,irr,nr
+
+!>--- infer from structure list
+  nat = structures(1)%nat
+  allocate (at(nat))
+  at(:) = structures(1)%at(:)
+
+!>--- variable declarations
+  n = nat       !> other variable name for number of atoms
+  ng = group(0) !> number of different groups (conformers)
+  gmax = 0      !> max number of
+  do i = 1,ng
+    k = 0
+    do j = 1,nall
+      if (group(j) == i) k = k+1
+    end do
+    if (k .gt. gmax) gmax = k
+  end do
+  allocate (glist(0:gmax,ng),source=0)
+  do i = 1,ng
+    k = 0
+    do j = 1,nall
+      if (group(j) == i) then
+        k = k+1
+        glist(k,i) = j !> the k-th member of group i is structure j
+      end if
+    end do
+    glist(0,i) = k !> number of members in group i
+  end do
+
+!>---distance neighbor list
+  allocate (cdum(3,nat))
+
+!>--- set up the "pair" array --> how many bonds are between two nuclei?
+  allocate (pair(n*(n+1)/2),metric(n,n),vis(n),pre(n),nb(200,n))
+  !cdum(1:3,1:n) = xyz(1:3,1:n,1) / bohr
+  cdum(1:3,1:n) = structures(1)%xyz(1:3,1:n)
+  call neighdist(n,at,cdum,nb,metric)
+  k = 0
+  pair = 0
+  do i = 1,n-1
+    do j = i+1,n
+!>---the shortest bond path
+      current = j
+      dum = shortest_distance(n,i,j,nb,metric,vis,pre)
+      k = 0
+      do while (pre(current) /= 0)
+        current = pre(current)
+        k = k+1
+      end do !> End loop: while precessor(current) /= 0
+      pair(lin(j,i)) = k  !> # of bonds between i and j
+    end do
+  end do
+  deallocate (nb,pre,vis,metric)
+
+  allocate (tmp2(n),relat(0:n,n))
+  allocate (equiv(0:n,n,0:nall),dist(n,n,nall))
+  equiv = 0
+!>-- (costly) symmetry analyis of all rotamers for NMR. this is complicated stuff also
+!>   and the end of the program where this is completed...
+  do i = 1,nall
+    !call distance(n,xyz(:,:,i),dist(:,:,i)) !> distance matrix
+    call distance(n,structures(i)%xyz(:,:),dist(:,:,i)) !> distance matrix
+    do j = 1,n
+      do k = 1,n
+        tmp2(k) = dist(k,j,i)*dble(at(k))  !> the distance of j to all atoms * Z to distinguish
+      end do
+      call qqsort(tmp2,1,n)
+      dist(1:n,j,i) = tmp2(1:n)
+    end do
+  end do
+  write (ch,*) 'compare nuclear equivalencies ...'
+  do i = 1,ng
+    m = glist(0,i)
+    if (m .lt. 2) cycle  !> det equivalent atoms in each group
+    relat = 0
+    do m1 = 1,m
+!$OMP PARALLEL PRIVATE ( m2, s1, s2 ) SHARED ( relat )
+!$OMP DO
+      do m2 = 1,m1-1        !> compare all members
+        s1 = glist(m1,i)    !> struc 1
+        s2 = glist(m2,i)    !> struc 2
+        call compare(n,nall,s1,s2,dist,athr,relat) !> athr is distance vector equivalence threshold
+      end do
+!$OMP END DO
+!$OMP END PARALLEL
+    end do
+    equiv(0:n,1:n,i) = relat(0:n,1:n)
+  end do
+  deallocate (dist)
+!>-- symmetrize result i.e. if iat is in list of jat, jat must be in list of iat
+!>   done again at the end of this part
+  do i = 1,ng
+    do j1 = 1,n
+      m1 = equiv(0,j1,i)
+      do k = 1,m1
+        iat = equiv(k,j1,i)
+!>-- is atom j1 in the list of atom iat?
+        ex = .false.
+        m2 = equiv(0,iat,i)
+        do k2 = 1,m2
+          if (j1 .eq. equiv(k2,iat,i)) ex = .true.
+        end do
+        if (.not.ex) then
+          equiv(0,iat,i) = equiv(0,iat,i)+1
+          equiv(equiv(0,iat,i),iat,i) = j1
+        end if
+      end do
+    end do
+  end do
+
+!>-- inlcude equivalence info from the other conformers as well i.e.
+!>   assume that all conformers have the same chemical equivalencies
+!>   the result is put into equiv(:,:,0)
+  equiv(0:n,1:n,0) = equiv(0:n,1:n,1)
+  ILOOP: do i = 2,ng
+    JLOOP: do j = 1,n
+      m2 = equiv(0,j,0)      !> end of list of lowest
+      MLOOP: do m = 1,equiv(0,j,i)  !> list of higher
+        k = equiv(m,j,i)    !> in the one in the higher list
+        M1LOOP: do m1 = 1,m2
+          if (equiv(m1,j,0) .eq. k) then !> already there?
+            cycle MLOOP
+          end if
+        end do M1LOOP
+        equiv(0,j,0) = equiv(0,j,0)+1 !> append
+        equiv(equiv(0,j,0),j,0) = k
+      end do MLOOP
+    end do JLOOP
+  end do ILOOP
+
+!>--- NMR part and writeout
+!> get NMR-active nuclei
+  allocate (nmract(86))
+  call cregen_nmract(ch,nmract)
+
+  allocate (elist(n,n),flist(n,n))
+  ig = 0
+  atmp = 'anmr_nucinfo'
+  open (unit=3,file=atmp)
+  write (ch,'(''::::::::::: conformer group all :::::::::::'')')
+  write (3,*) n
+!cccccccccccccccccc
+!> chem eq. first
+!cccccccccccccccccc
+  elist = 0
+  do i = 1,n
+    m = equiv(0,i,ig)
+    do k = 1,m
+      l = equiv(k,i,ig)
+      elist(l,i) = 1
+    end do
+    elist(i,i) = 1
+  end do
+  do i = 1,n
+    do j = 1,equiv(0,i,ig)
+      k = equiv(j,i,ig)
+      elist(1:n,k) = elist(1:n,k)+elist(1:n,i)
+    end do
+  end do
+!>---  prepare write out
+  do i = 1,n
+    k = 1
+    equiv(1,i,ig) = i
+    elist(i,i) = 0
+    do j = 1,n
+      if (elist(j,i) .ne. 0) then
+        k = k+1
+        equiv(k,i,ig) = j
+      end if
+    end do
+    equiv(0,i,ig) = k
+  end do
+  write (ch,*) 'chemical equivalencies (mag.active nuclei):'
+
+  allocate (jnd(n))
+  jnd = 1
+  do j = 1,n
+    m = equiv(0,j,ig)
+    write (3,'(3x,i0,3x,i0)') j,m
+    do l = 1,m
+      if (l .ne. m) then
+        write (3,'(1x,i0)',advance='no') equiv(l,j,ig)  ! include the atom ie if there are no equiv.
+      else
+        write (3,'(1x,i0)',advance='yes') equiv(l,j,ig)
+      end if
+    end do
+    if (nmract(at(j)) .eq. 0) cycle
+    if (m .gt. 1.and.jnd(j) .eq. 1) then  ! just print
+      write (ch,'(''reference atom'',i4,'' # :'',i2)') equiv(1,j,ig),m
+      do k = 1,m
+        jnd(equiv(k,j,ig)) = 0
+      end do
+    end if
+  end do
+!cccccccccccccccccc
+!> mag eq.
+!cccccccccccccccccc
+!> make a check list of atoms for the mag. eq.
+  elist = 0
+  flist = 1
+  do i = 1,n
+    m = equiv(0,i,ig) !> the following lines fill the equiv list
+    do k = 1,m
+      l = equiv(k,i,ig)
+      elist(l,i) = 1
+    end do
+    elist(i,i) = 1
+  end do
+  flist = elist
+
+  do i = 1,n
+    m = equiv(0,i,ig)
+    do k = 1,m
+      l = equiv(k,i,ig)
+      if (l .eq. i) cycle
+      do j = 1,n
+        if (flist(j,i) .eq. 1.or.nmract(at(j)) .eq. 0) cycle !> don't check non-magnetic nuclei
+!c              write(*,*) l,j,pair(lin(i,j)),pair(lin(l,j)) !> and chem. equiv. ones (ie in the same
+        if (pair(lin(i,j)) .ne. pair(lin(l,j))) elist(l,i) = 0 !> group
+      end do
+    end do
+  end do
+!>---  symmetrize
+  do i = 1,n
+    k = 1
+    equiv(1,i,ig) = i
+    elist(i,i) = 0
+    do j = 1,n
+      if (elist(j,i) .ne. 0) then
+        k = k+1
+        equiv(k,i,ig) = j
+      end if
+    end do
+    equiv(0,i,ig) = k
+  end do
+  do i = 1,n
+    do j = 1,equiv(0,i,ig)
+      k = equiv(j,i,ig)
+      elist(1:n,k) = elist(1:n,k)+elist(1:n,i)
+    end do
+  end do
+!>---  prepare write out
+  do i = 1,n
+    k = 1
+    equiv(1,i,ig) = i
+    elist(i,i) = 0
+    do j = 1,n
+      if (elist(j,i) .ne. 0) then
+        k = k+1
+        equiv(k,i,ig) = j
+      end if
+    end do
+    if (k .gt. 2) then
+      equiv(0,i,ig) = k    !> CH3 etc
+    else
+      equiv(0,i,ig) = 1    !> this makes CH2-CH2 not mag. equiv.
+    end if
+  end do
+  jnd = 1
+  write (ch,*) 'magnetic equivalencies:'
+  do j = 1,n
+    m = equiv(0,j,ig)
+    write (3,*) j,m
+    write (3,'(20i5)') (equiv(l,j,ig),l=1,m)  !> include the atom ie if there are no equiv.
+    if (nmract(at(j)) .eq. 0) cycle
+    if (m .gt. 1.and.jnd(j) .eq. 1) then  !> just print
+      write (ch,'(''reference atom'',i4,'' # :'',i2)') equiv(1,j,ig),m
+      do k = 1,m
+        jnd(equiv(k,j,ig)) = 0
+      end do
+    end if
+  end do
+  close (3)
+
+!ccccccccccccccccccccc
+!c J averaging matrix
+!ccccccccccccccccccccc
+  if (rotfil) then
+    allocate (jfake(n*(n+1)/2),sd(n,n),cn(n))
+    atmp = 'anmr_rotamer'
+    open (unit=112,file=atmp,form='unformatted')
+    write (112) ng
+    jfake = 0
+    do ig = 1,ng       !> all conf groups
+      nr = glist(0,ig) !> how many rotamers?
+      write (112) nr
+      do ir = 1,nr
+        irr = glist(ir,ig)
+        call distance(n,structures(irr)%xyz(:,:),sd)   !> distance matrix
+        cdum(1:3,1:n) = structures(irr)%xyz(1:3,1:n)
+        call calculate_CN(n,at,cdum,cn)
+        do i = 1,n-1
+          do j = i+1,n
+            jfake(lin(j,i)) = cn(i)*cn(j)*sqrt(dble(at(i)*at(j))) &
+       &    /(dble(pair(lin(j,i)))*sd(j,i)**5) !> the approx. "J" is topologically equivalent to J
+            !> R^3 was wrong in one case because Hs were artificially paired
+            !> R^5 seems to be save
+          end do
+        end do
+        write (112) jfake(1:n*(n+1)/2)  !> read by anmr
+      end do
+    end do
+    close (112)
+    deallocate (cn)
+    deallocate (sd,jfake)
+  end if
+
+  if (allocated(jnd)) deallocate (jnd)
+  if (allocated(elist)) deallocate (elist)
+  if (allocated(flist)) deallocate (flist)
+  if (allocated(equiv)) deallocate (equiv)
+  if (allocated(dist)) deallocate (dist)
+  if (allocated(relat)) deallocate (relat)
+  if (allocated(tmp2)) deallocate (tmp2)
+  if (allocated(pair)) deallocate (pair)
+  if (allocated(glist)) deallocate (glist)
+
+  return
+end subroutine cregen_EQUAL
+
+!=========================================================================================!
+
+subroutine cregen_nmract(ch,nmract)
+!***************************************
+!* utility routine to fill nmract array
+!***************************************
+  use crest_parameters
+  use utilities
+  implicit none
+  integer :: nmract(86)
+  character(len=:),allocatable :: atmp
+  logical :: fail
+  integer :: io,i
+  real(wp) :: xx(10)
+  integer :: ch,ich2
+
+  nmract = 0 !reset
+  !>--- get NMR active nuclei
+  atmp = '.anmrrc'  ! <--- name of the .anmrrc written by ENSO
+  call getanmrrc(atmp,fail)
+  if (fail) then  !>--- there is no .anmrrc from ENSO
+    !write(ch,*)'NMR mode.'
+    nmract = 0       ! all nuclei inactive
+    nmract(1) = 1  ! H active
+    !nmract(6) = 1  ! C active
+    nmract(9) = 1  ! F active
+    nmract(15) = 1  ! P active
+  else          !>--- there IS a .anmrrc, and it is used.
+    write (ch,*) 'NMR mode. Reading <',trim(atmp),'> for atomic NMR data'
+    open (newunit=ich2,file=atmp)
+    read (ich2,'(a)') atmp
+    read (ich2,'(a)') atmp
+    if (index(atmp,'ENSO') .ne. 0) then
+      read (ich2,'(a)') atmp
+    end if
+    do
+      read (ich2,*,iostat=io) i,xx(1:2),nmract(i)
+      if (io < 0) exit
+    end do
+    close (ich2)
+  end if
+
+  return
+end subroutine cregen_nmract
+
+!=========================================================================================!
+!=========================================================================================!
+
+subroutine cregen_file_wr(env,fname,structures)
+!*********************************************************************
+!* write the output ensemble file with all structures (rotamer file)
+!*********************************************************************
+  use crest_parameters
+  use crest_data
+  use strucrd
+  use utilities,only:boltz
+  implicit none
+  type(systemdata),intent(inout) :: env
+  character(len=*),intent(in) :: fname
+  type(coord),intent(inout) :: structures(:)
+  integer :: nat,nall
+  character(len=128) :: newcomment
+
+  integer :: ich,ii
+  real(wp) :: eref,T
+  real(wp),allocatable :: er(:),erel(:),p(:)
+  character(len=40),allocatable :: origin(:)
+
+  nall = size(structures,1)
+  allocate (er(nall),erel(nall),p(nall))!,origin(nall))
+  eref = structures(1)%energy
+  do ii = 1,nall
+    er(ii) = structures(ii)%energy
+    erel(ii) = (er(ii)-eref)*autokcal
+    !if (env%trackorigin) then
+    !  call getorigin(comments(i),origin(i))
+    !end if
+  end do
+  T = env%tboltz
+  call boltz(nall,T,erel,p)
+
+  open (newunit=ich,file=fname)
+  do ii = 1,nall
+    !if (env%trackorigin) then
+    !write (newcomment,'(a,f10.8,1x,a)') 'population=',p(ii),trim(origin(ii))
+    !else
+    write (newcomment,'(a,f10.8)') 'population=',p(ii)
+    !end if
+    structures(ii)%comment = trim(newcomment)
+    call structures(ii)%append(ich)
+  end do
+  close (ich)
+  !deallocate (origin,p,erel,er)
+  if (allocated(origin)) deallocate (origin)
+  deallocate (p,erel,er)
+  return
+end subroutine cregen_file_wr
+
+!=========================================================================================!
+
+subroutine cregen_conffile(env,cname,structures,ng,degen)
+!*********************************
+!* write the output ensemble file
+!*********************************
+  use crest_parameters,only:wp,bohr
+  use crest_data
+  use strucrd
+  use iomod
+  use utilities
+  implicit none
+  type(systemdata),intent(inout) :: env
+  character(len=*),intent(in) :: cname
+  type(coord),intent(inout) :: structures(:)
+  integer,intent(in) :: ng
+  integer,intent(in) :: degen(3,ng)
+  integer :: nat,nall
+  integer :: ich,ich3,ichenso
+  integer :: i,k,ii
+  real(wp),allocatable :: er(:)
+
+  nall = size(structures,1)
+  allocate (er(nall))
+  do ii = 1,nall
+    er(ii) = structures(ii)%energy
+    if (allocated(structures(ii)%comment)) &
+    &  deallocate (structures(ii)%comment)
+  end do
+  if (env%enso) then
+    open (newunit=ichenso,file='enso.tags')
+  end if
+  call structures(1)%write('crest_best.xyz')
+  open (newunit=ich,file=trim(cname))
+  do ii = 1,ng
+    k = degen(2,ii)
+    if (k <= 0.or.k > nall) cycle
+    call structures(k)%append(ich)
+    if (env%enso) write (ichenso,'(2x,f18.8)') er(k)
+  end do
+  close (ich)
+  if (env%enso) then
+    close (ichenso)
+  end if
+  deallocate (er)
+
+  call remove('cre_members')
+  open (newunit=ich3,file='cre_members')
+  write (ich3,'(3x,i0)') ng
+  do i = 1,ng
+    k = degen(1,i)
+    write (ich3,'(3x,i8,1x,i10,1x,i10)') &
+    &   k,degen(2,i),degen(3,i)
+  end do
+  close (ich3)
+
+  return
+end subroutine cregen_conffile
+
+!=========================================================================================!
+
+subroutine cregen_rmsdalign(nall,structures)
+!*****************************************************
+!* Algin all structures in an array to the first one
+!* in the ensemble, based on the heavy-atom RMSD
+!*****************************************************
+  use crest_parameters
+  use irmsd_module
+  use strucrd
+  implicit none
+  integer,intent(in) :: nall
+  type(coord),intent(inout) :: structures(nall)
+  integer :: ii,nat
+  logical,allocatable :: mask(:)
+
+  nat = structures(1)%nat
+  allocate (mask(nat),source=.false.)
+  do ii = 1,nat
+    if (structures(1)%at(ii) > 1) mask(ii) = .true.
+  end do
+
+  do ii = 2,nall
+    call rmsd_align(structures(1),structures(ii),mask=mask)
+  end do
+
+  return
+end subroutine cregen_rmsdalign
+
+!=========================================================================================!
+
+subroutine cregen_bonusfiles(ng,degen)
+!*****************************************
+!* write the time tag and degeneracy file
+!*****************************************
+  use crest_parameters,only:wp,bohr
+  use crest_data
+  implicit none
+  integer :: ng
+  integer :: degen(3,ng)
+  integer :: i,ich
+
+  !>--- how many rotamers per conformer
+  open (newunit=ich,file='cre_degen')
+  write (ich,'(3x,i0)') ng
+  do i = 1,ng
+    write (ich,'(3x,i0,2x,i0)') i,degen(1,i)
+  end do
+  close (ich)
+
+  return
+end subroutine cregen_bonusfiles
+
+!=========================================================================================!
+!=========================================================================================!
+!>  CREGEN PRINTOUTS
+!=========================================================================================!
+!=========================================================================================!
+subroutine cregen_setthreads(ch,env,pr)
+  use crest_parameters
+  use crest_data
+  use omp_lib
+  implicit none
+  type(systemdata) :: env
+  integer :: ch
+  logical :: pr
+  !integer :: TID,OMP_GET_NUM_THREADS,OMP_GET_THREAD_NUM,
+  integer :: TID,nproc,T,Tn
+!>---- setting the threads for OMP parallel usage
+  if (env%autothreads) then
+    call new_ompautoset(env,'max',0,T,Tn)
+!$OMP PARALLEL PRIVATE(TID)
+    TID = OMP_GET_THREAD_NUM()
+    IF (TID .EQ. 0.and.pr) THEN
+      nproc = OMP_GET_NUM_THREADS()
+      write (ch,*) '============================='
+      write (ch,*) ' # threads =',nproc
+      write (ch,*) '============================='
+    END IF
+!$OMP END PARALLEL
+  end if
+  return
+end subroutine cregen_setthreads
+
+subroutine cregen_pr1(ch,env,nat,nall,rthr,bthr,pthr,ewin)
+  use crest_parameters
+  use crest_data
+  implicit none
+  integer :: ch
+  type(systemdata) :: env
+  integer :: nat
+  integer :: nall
+  real(wp) :: rthr,bthr,pthr,ewin
+  logical :: substruc
+  substruc = (nat .ne. env%rednat.and.env%subRMSD)
+  write (ch,'(80("*"))')
+  write (ch,'(" number of atoms",t35,":",i10)') nat
+  if (substruc) then
+    write (ch,'(" atoms included in RMSD",t35,":",i10)') env%rednat
+  end if
+  write (ch,'(" number of points on xyz file",t35,":",i10)') nall
+  !write (ch,'('' RMSD threshold                 :'',f9.4)') rthr
+  !write (ch,'('' Bconst threshold               :'',f9.4)') bthr
+  !write (ch,'('' population threshold           :'',f9.4)') pthr
+  return
+end subroutine cregen_pr1
+
+subroutine enso_duplicates(env,nall,double)
+  use crest_parameters
+  use crest_data
+  implicit none
+  type(systemdata) :: env
+  integer :: nall
+  integer :: double(nall)
+  integer :: i,j,ich
+
+  if (.not.env%ENSO.or..not.env%confgo) return
+
+  j = sum(double)
+  open (newunit=ich,file='cregen.enso')
+  if (j .gt. 0) then
+    do i = 1,nall
+      if (double(i) .gt. 0) then
+        write (ich,*) i,double(i)
+      end if
+    end do
+  else
+    write (ich,*) "ALL UNIQUE"
+  end if
+
+  return
+end subroutine enso_duplicates
+
+subroutine create_anmr_dummy(nat)
+  implicit none
+  integer :: nat
+  integer :: i,ich
+
+  open (newunit=ich,file='anmr_nucinfo')
+  write (ich,*) nat
+  do i = 1,nat
+    write (ich,'(3x,i0,3x,i0)') i,1
+    write (ich,'(3x,i0)') i
+  end do
+  do i = 1,nat
+    write (ich,*) i,1
+    write (ich,'(i5)') i
+  end do
+  close (ich)
+  return
+end subroutine create_anmr_dummy
+
+subroutine cregen_pr2(ch,env,nall,ng,degen,er)
+  use crest_parameters
+  use crest_data
+  use strucrd
+  use iomod,only:touch,remove
+  use utilities,only:boltz
+  implicit none
+  integer,intent(in) :: ch
+  type(systemdata),intent(inout) :: env
+  integer,intent(in) :: nall
+  integer,intent(in) :: ng
+  integer,intent(in) :: degen(3,ng)
+  real(wp),intent(in) :: er(nall)
+  integer :: ich,chref,och,och2
+  integer :: i,j,k
+  real(wp),allocatable :: erel(:),egrp(:)
+  real(wp),allocatable :: p(:),pg(:),paccu(:)
+  real(wp) :: eref,T
+  character(len=40),allocatable :: origin(:)
+  integer :: a,b
+  logical :: ex,abbrev,print_placeholder
+  real(wp) :: A0,eav,g,s,ss,beta,elow
+  integer,parameter :: printlimit = 100
+
+  allocate (origin(nall),erel(nall),p(nall))
+  eref = minval(er,1)
+  env%elowest = eref
+  do i = 1,nall
+    !er(i) = grepenergy(comments(i))
+    erel(i) = (er(i)-eref)*autokcal
+    !if (env%trackorigin) then
+    !  call getorigin(comments(i),origin(i))
+    !else
+    origin(i) = ''
+    !end if
+  end do
+  T = env%tboltz
+  call boltz(nall,T,erel,p)
+  allocate (pg(ng),source=0.0_wp)
+  allocate (paccu(0:nall),source=0.0_wp)
+  do i = 1,ng
+    a = degen(2,i)
+    b = degen(3,i)
+    do j = a,b
+      pg(i) = pg(i)+p(j)
+      paccu(j) = paccu(j-1)+p(j)
+    end do
+  end do
+
+  och = ch
+  abbrev = nall > printlimit
+
+  !>-- really long energy list
+  write (och,'(80("*"))')
+  write (och,'(1x,a8,1x,a8,(1x,a16),(1x,a8),(1x,a12),1x,a9,1x,a5)') &
+  &      '  ','ΔE','Etot','weight','conf.weight','conformer',''
+  write (och,'(a8,1x,a8,(1x,a16),(1x,a8),(1x,a12),1x,a9,1x,a5,1x,a6)') &
+  &        'id ','kcal/mol','hartree','p(i)','p(group)','group','degen','origin'
+  write (och,'(4x,4("-"),1x,8("-"),(1x,16("-")),(1x,8("-")),(1x,12("-")),1x,9("-"),1x,5("-"),1x,6("-"))')
+  if (abbrev) then
+    call remove('cregen.full')
+    open (newunit=och2,file='cregen.full',status='replace')
+    write (och2,'(1x,a8,1x,a8,(1x,a16),(1x,a8),(1x,a12),1x,a9,1x,a5)') &
+    &      '  ','ΔE','Etot','weight','conf.weight','conformer',''
+    write (och2,'(a8,1x,a8,(1x,a16),(1x,a8),(1x,a12),1x,a9,1x,a5,1x,a6)') &
+    &        'id ','kcal/mol','hartree','p(i)','p(group)','group','degen','origin'
+    write (och2,'(4x,4("-"),1x,8("-"),(1x,16("-")),(1x,8("-")),(1x,12("-")),1x,9("-"),1x,5("-"),1x,6("-"))')
+  else
+    call remove('cregen.full')
+  end if
+
+  print_placeholder = .true.
+  k = 0
+  do i = 1,ng
+    k = k+1
+    a = degen(2,i)
+    b = degen(3,i)
+    if (k <= printlimit.or.k > nall-10) then
+      write (och,'(i8,1x,f8.4,1x,f16.6,(1x,f8.5),(1x,f12.5),1x,i9,1x,i5,a)') &
+      &     a,erel(a),er(a),p(a),pg(i),i,degen(1,i),trim(origin(a))
+    else if (print_placeholder) then
+      print_placeholder = .false.
+      write (och,'(5x,"...",1x,"<skipped due to ensemble length, see file cregen.full> ...")')
+    end if
+    if (abbrev) then
+      write (och2,'(i8,1x,f8.4,1x,f16.6,(1x,f8.5),(1x,f12.5),1x,i9,1x,i5,a)') &
+      &     a,erel(a),er(a),p(a),pg(i),i,degen(1,i),trim(origin(a))
+    end if
+    do j = a+1,b
+      k = k+1
+      if (k <= printlimit.or.k > nall-10) then
+        write (och,'(i8,1x,f8.4,1x,f16.6,1x,f8.5,1x,a12,1x,a9,1x,a5,1x,a)') &
+               & k,erel(j),er(j),p(j),'.','.','.',trim(origin(j))
+      else if (print_placeholder) then
+        print_placeholder = .false.
+        write (och,'(5x,"...",1x,"<skipped due to ensemble length, see file cregen.full> ...")')
+      end if
+      if (abbrev) then
+        write (och2,'(i8,1x,f8.4,1x,f16.6,1x,f8.5,1x,a12,1x,a9,1x,a5,1x,a)') &
+               & k,erel(j),er(j),p(j),'.','.','.',trim(origin(j))
+      end if
+    end do
+  end do
+
+  if (abbrev) close (och2)
+
+  !>-- file for the '-compare' mode
+  if (env%compareens) then
+    open (newunit=ich,file='.cretrack')
+    write (ich,'(5x,i0)') ng
+    do i = 1,ng
+      write (ich,'(1x,i8,1x,i7,1x,i7)') i,degen(2,i),degen(3,i)
+    end do
+    close (ich)
+  end if
+
+  !>-- some ensemble data, entropy and G (including all structures)
+  A0 = 0
+  eav = 0
+  do i = 1,nall
+    A0 = A0+p(i)*log(p(i)+1.d-12)
+    eav = eav+p(i)*erel(i)
+  end do
+  beta = 1.0d0/(T*8.314510/4.184/1000.+1.d-14)
+  g = (1.0d0/beta)*A0
+  s = -1000.0d0*4.184*g/T
+  ss = -1000.0d0*g/T
+
+  write (och,'(80("*"))')
+  write (och,'("Statistics for *THIS* ensemble:")')
+  write (och,'(35("-"))')
+  write (och,'(" Number of groups & total",t42,":",2x, i0,", ",i0)') ng,nall
+  write (och,'(" Temperature used for populations",t42,":",2x,F9.2," K")') T
+  write (och,'(" Energy of lowest structure",t42,":",2x,es14.6)') eref
+  !>---- elow printout in between routines
+  if (.not.env%confgo) then
+    write (stdout,'("CREGEN> E lowest :",f20.10,a)') eref,' Ha'
+  end if
+  write (och,'(" Ensemble average energy (kcal/mol)",t42,":",2x,F14.8)') eav
+  if (env%QCG) then
+    write (och,'(" Ensemble entropy (cal/mol K)",t42,":",2x,F14.8)') ss
+  else
+    write (och,'(" Ensemble entropy (J/mol K, cal/mol K)",t42,":",2x,2F9.3)') s,ss
+  end if
+  write (och,'(" Ensemble free energy (kcal/mol)",t42,":",2x,F14.8)') g
+  write (och,'(" Population of lowest strucure",t42,":",2x,F9.3," %")') pg(1)*100.d0
+  write (och,'(" Highest population & group",t42,":",2x,F9.3," %, ",i0)') maxval(pg,1)*100.d0,maxloc(pg,1)
+
+  j = min(10,ng)
+  i = degen(3,j)
+  write (och,'(" Accum.population of lowest 10 groups",t42,":",2x,F9.3," %")') paccu(i)*100.d0
+  do i = 1,ng
+    j = degen(3,i)
+    if (paccu(j) >= 0.5_wp) exit
+  end do
+  write (och,'(" 50% accum.population for groups",t42,":",6x,"1 - ",i0)') i
+  do i = 1,ng
+    j = degen(3,i)
+    if (paccu(j) >= 0.95_wp) exit
+  end do
+  write (och,'(" 95% accum.population for groups",t42,":",6x,"1 - ",i0)') i
+
+  !>-- some ensemble data, entropy and G (including only unique conformers)
+  allocate (egrp(ng),source=0.0_wp)
+  do i = 1,ng
+    a = degen(2,i)
+    egrp(i) = (er(a)-eref)*autokcal
+  end do
+  call boltz(ng,T,egrp,pg)
+  A0 = 0
+  do i = 1,ng
+    A0 = A0+pg(i)*log(pg(i)+1.d-12)
+  end do
+  deallocate (egrp)
+  beta = 1.0d0/(T*8.314510/4.184/1000.+1.d-14)
+  g = (1.0d0/beta)*A0
+  ss = -1000.0d0*g/T
+  env%emtd%sapprox = ss  !> save for entropy mode
+
+  write (och,'(80("*"))')
+
+  deallocate (paccu,pg)
+  deallocate (p,erel,origin)
+  return
+end subroutine cregen_pr2
+
+subroutine cregen_econf_list(ch,nall,er,ng,degen)
+  use crest_parameters
+  implicit none
+  integer,intent(in) :: ch
+  integer,intent(in) :: nall
+  real(wp),intent(in) :: er(nall)
+  integer,intent(in) :: ng
+  integer,intent(in) :: degen(3,ng)
+  integer :: ich2,i,j
+  real(wp) :: eref,ewrt
+
+  write (ch,'(a,i0)') 'Number of unique conformers for further calculation: ',ng
+  write (ch,'(a)') 'List of relative energies (kcal/mol) saved as "crest.energies"'
+  open (newunit=ich2,file='crest.energies')
+  eref = minval(er,1)
+  do i = 1,ng
+    j = degen(2,i)
+    ewrt = er(j)-eref
+    ewrt = ewrt*autokcal
+    write (ich2,'(i10,1x,f12.4,es20.10)') i,ewrt,er(i)
+  end do
+  close (ich2)
+
+  return
+end subroutine cregen_econf_list
+
+subroutine cregen_pr3(ch,infile,nall,er)
+  use crest_parameters
+  use strucrd
+  implicit none
+  integer,intent(in) :: ch
+  character(len=*),intent(in) :: infile
+  integer,intent(in) :: nall
+  real(wp),intent(in) :: er(nall)
+  real(wp) :: dE,eref
+  integer :: i
+  write (ch,*)
+  write (ch,'(a)') '====================================================='
+  write (ch,'(a)') '============== ordered structure list ==============='
+  write (ch,'(a)') '====================================================='
+  write (ch,'(a,a,a)') ' written to file <',trim(infile),'>'
+  write (ch,*)
+  write (ch,'(a10,4x,a15,a25)') 'structure','ΔE(kcal/mol)','Etot(Eh)'
+  eref = minval(er,1)
+  !write (ch,'(''   structure    ΔE(kcal/mol)    Etot(Eh)'')')
+  do i = 1,nall
+    dE = (er(i)-eref)*autokcal
+    write (ch,'(i10,3x,F15.4,F25.10)') i,dE,er(i)
+  end do
+  write (ch,*)
+  return
+end subroutine cregen_pr3
+
+subroutine cregen_pr4(ch,infile,nall,group)
+  use crest_parameters
+  use strucrd
+  implicit none
+  integer :: ch
+  character(len=*) :: infile
+  integer :: nall
+  integer :: group(0:nall)
+  integer :: i,ich
+  integer :: maxgroup
+  !write(ch,*) group(1:nall)
+  maxgroup = group(0)
+  write (ch,'(1x,i0,a,i0,a,a,a)') maxgroup,' unique groups for ', &
+  &    nall,' structures in file <',trim(infile),'>'
+  open (newunit=ich,file='.groups')
+  write (ich,'(5x,i0,3x,i0)') nall,maxgroup
+  do i = 1,nall
+    write (ich,'(2x,i10,2x,i10)') i,group(i)
+  end do
+  close (ich)
+  return
+end subroutine cregen_pr4
+
+!=========================================================================================!
+!=========================================================================================!
+!> END OF CREGEN FILE
+!=========================================================================================!
+!=========================================================================================!
diff --git a/src/sorting/cregen_interfaces.f90 b/src/sorting/cregen_interfaces.f90
new file mode 100644
index 00000000..5072e6b8
--- /dev/null
+++ b/src/sorting/cregen_interfaces.f90
@@ -0,0 +1,165 @@
+
+!=========================================================================================!
+!=========================================================================================!
+!> Interfaces for use CREGEN (and related)
+!=========================================================================================!
+!=========================================================================================!
+
+module cregen_interface
+!*******************************************************
+!* module to load an interface to the newcregen routine
+!* mandatory to handle the optional input arguments
+!*******************************************************
+  use unionize_module
+  implicit none
+  interface
+    subroutine newcregen(env,quickset,infile,structurelist)
+      use crest_parameters
+      use crest_data
+      use crest_restartlog
+      use strucrd
+      implicit none
+      type(systemdata),intent(inout) :: env
+      integer,intent(in),optional :: quickset
+      character(len=*),intent(in),optional :: infile
+      type(coord),allocatable,intent(inout),optional :: structurelist(:)
+    end subroutine newcregen
+
+    subroutine cregen_irmsd_all(nall,structures,printlvl,iinversion)
+      use strucrd
+      implicit none
+      !> INPUT
+      integer,intent(in) :: nall
+      type(coord),intent(inout),target :: structures(nall)
+      integer,intent(in),optional :: printlvl
+      integer,intent(in),optional :: iinversion
+    end subroutine cregen_irmsd_all
+
+    subroutine cregen_irmsd_sort(env,nall,structures,groups,allcanon,printlvl)
+      use crest_data
+      use strucrd
+      implicit none
+      !> INPUT
+      type(systemdata),intent(inout) :: env
+      integer,intent(in) :: nall
+      type(coord),intent(inout),target :: structures(nall)
+      integer,intent(inout) :: groups(nall)
+      logical,intent(in),optional :: allcanon
+      integer,intent(in),optional :: printlvl
+    end subroutine cregen_irmsd_sort
+
+  end interface
+!>--- Additional Related RE-EXPORTS
+  public :: unionizeEnsembles
+end module cregen_interface
+
+!=========================================================================================!
+!=========================================================================================!
+!> Interfaces for routines used WITHIN CREGEN
+!=========================================================================================!
+!=========================================================================================!
+
+module cregen_subroutines
+!*************************************
+!* interfaces for cregen subroutines
+!*************************************
+  implicit none
+  interface
+
+    subroutine cregen_files(env,fname,oname,cname,simpleset,userinput,ensembleinput,iounit)
+      use crest_data
+      implicit none
+      type(systemdata),intent(inout) :: env
+      character(len=:),allocatable,intent(inout) :: fname
+      character(len=:),allocatable,intent(inout) :: oname
+      character(len=:),allocatable,intent(inout) :: cname
+      integer,intent(in) :: simpleset
+      logical,intent(in) :: userinput
+      logical,intent(in) :: ensembleinput
+      integer,intent(out) :: iounit
+    end subroutine cregen_files
+
+    subroutine cregen_discardbroken(ch,env,topocheck,structures,newnall)
+      use crest_data
+      use strucrd
+      use cregen_utils
+      type(systemdata),intent(in) :: env
+      integer,intent(in) :: ch
+      logical,intent(in) :: topocheck
+      type(coord),intent(inout),allocatable,target :: structures(:)
+      integer,intent(out) :: newnall
+    end subroutine cregen_discardbroken
+
+    subroutine cregen_topocheck(ch,env,checkez,structures,newnall)
+      use crest_data
+      use strucrd
+      use cregen_utils
+      implicit none
+      type(systemdata) :: env
+      integer,intent(in) :: ch
+      logical,intent(in) :: checkez
+      type(coord),intent(inout),allocatable,target :: structures(:)
+      integer,intent(out) :: newnall
+    end subroutine cregen_topocheck
+
+    subroutine cregen_esort(ch,structures,nallout,ewin)
+      use crest_parameters
+      use strucrd
+      use quicksort_interface
+      implicit none
+      integer,intent(in) :: ch
+      type(coord),intent(inout),allocatable :: structures(:)
+      integer,intent(out) :: nallout
+      real(wp),intent(in),optional :: ewin
+    end subroutine cregen_esort
+
+    subroutine cregen_CRE_new(env,nall,structures,groups,rthresh,ethr,bthr, &
+    &                         printlvl,ch)
+      use crest_parameters
+      use crest_data
+      use strucrd
+      implicit none
+      type(systemdata),intent(inout) :: env
+      integer,intent(inout) :: nall
+      type(coord),intent(inout),allocatable,target :: structures(:)
+      integer,intent(out),allocatable :: groups(:)
+      real(wp),intent(in) :: RTHRESH
+      real(wp),intent(in) :: ETHR
+      real(wp),intent(in) :: BTHR
+      integer,intent(in),optional :: printlvl
+      integer,intent(in),optional :: ch
+    end subroutine cregen_CRE_new
+
+    subroutine cregen_rmsdalign(nall,structures)
+      use crest_parameters
+      use irmsd_module
+      use strucrd
+      implicit none
+      integer,intent(in) :: nall
+      type(coord),intent(inout) :: structures(nall)
+    end subroutine cregen_rmsdalign
+
+    subroutine cregen_file_wr(env,fname,structures)
+      use crest_parameters
+      use crest_data
+      use strucrd
+      use utilities,only:boltz
+      implicit none
+      type(systemdata),intent(inout) :: env
+      character(len=*),intent(in) :: fname
+      type(coord),intent(inout) :: structures(:)
+    end subroutine cregen_file_wr
+
+    subroutine cregen_conffile(env,cname,structures,ng,degen)
+      use crest_parameters
+      use crest_data
+      use strucrd
+      implicit none
+      type(systemdata),intent(inout) :: env
+      character(len=*),intent(in) :: cname
+      type(coord),intent(inout) :: structures(:)
+      integer,intent(in) :: ng
+      integer,intent(in) :: degen(3,ng)
+    end subroutine cregen_conffile
+  end interface
+end module cregen_subroutines
diff --git a/src/sorting/cregen_utils.f90 b/src/sorting/cregen_utils.f90
new file mode 100644
index 00000000..ae2f4a38
--- /dev/null
+++ b/src/sorting/cregen_utils.f90
@@ -0,0 +1,282 @@
+
+module cregen_utils
+!*****************************************
+!* Module that implements a utility routines
+!* mainly used in CREGEN
+!*****************************************
+  use crest_parameters
+  use strucrd
+  use adjacency
+  use axis_module
+  use internals_mod
+  use utilities
+  implicit none
+  public
+
+  real(wp),parameter :: bigval = huge(bigval)
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  subroutine cregen_calculate_fragments(mol,frag,nfrag)
+!*******************************************************
+!* Assign each atom in a molecule to a fragment
+!* based on CN connectivity
+!* The fragment assignment array and the total number
+!* of fragments are both optional return arguments
+!*******************************************************
+    class(coord),intent(in) :: mol
+    integer,intent(out),allocatable,optional :: frag(:)
+    integer,intent(out),optional :: nfrag
+    integer,allocatable :: tmp(:),A(:,:)
+    real(wp),allocatable :: cn(:),bond(:,:)
+    integer :: nat
+
+    call mol%cn_to_bond(cn,bond)
+    nat = mol%nat
+    allocate (A(nat,nat),source=0)
+    call wbo2adjacency(mol%nat,bond,A,0.01_wp)
+    call setup_fragments(mol%nat,A,tmp)
+    if (present(nfrag)) then
+      nfrag = maxval(tmp,1)
+    end if
+    if (present(frag)) then
+      call move_alloc(tmp,frag)
+    end if
+  end subroutine cregen_calculate_fragments
+
+  logical function distcheck(n,xyz)
+    integer,intent(in) :: n
+    real(wp),intent(in) :: xyz(3,n)
+    real(wp) :: rij(3)
+    integer :: i,j
+    distcheck = .true.
+    do i = 1,n-1
+      do j = i+1,n
+        rij = xyz(:,j)-xyz(:,i)
+        if (sum(rij*rij) .lt. 1.d-3) then
+          distcheck = .false.
+          return
+        end if
+      end do
+    end do
+    return
+  end function distcheck
+
+!================================================================================!
+!================================================================================!
+!> Simplified "topology"-related routines
+!================================================================================!
+!================================================================================!
+
+  subroutine bondtotopo(nat,at,bond,cn,ntopo,topo,neighbourmat,excl)
+    !********************************************************************
+    !* generate the topo array for a given structure
+    !* This includes some empirical hacks for use in CREGEN
+    !********************************************************************
+    integer,intent(in)  :: nat
+    integer,intent(in) :: at(nat)
+    real(wp),intent(inout) :: bond(nat,nat)
+    real(wp),intent(in) :: cn(nat)
+    integer,intent(inout)  :: ntopo
+    integer,intent(inout),allocatable :: topo(:)
+    real(wp),allocatable :: cn2(:)
+    logical,intent(inout),allocatable :: neighbourmat(:,:)
+    logical,intent(in),optional :: excl(nat)
+    integer :: i,j,k,l
+    integer :: icn
+    real(wp) :: rcn
+
+    ntopo = nat*(nat+1)/2
+    if (.not.allocated(topo)) allocate (topo(ntopo),source=0)
+    if (.not.allocated(neighbourmat)) allocate (neighbourmat(nat,nat))
+    allocate (cn2(nat),source=0.0_wp)
+    topo(1:ntopo) = 0
+    neighbourmat(:,:) = .false.
+
+    !--- some heuristic rules and CN array setup
+    do i = 1,nat
+      cn2(i) = cn(i)
+      rcn = real(floor(cn(i)),wp)
+      select case (at(i)) !additional empirical topology rules
+        ! case( 5 ) !B
+        !   if( nint(cn(i)) > 4) cn2(i)=4.0_wp
+        ! case( 9,17,35,53 ) !F,Cl,Br,I
+        !   cn2(i) = min(cn(i),1.0_wp)
+      case (6) !C
+        if ((cn(i)-rcn) < 0.7_wp) then
+          cn2(i) = rcn
+        end if
+      end select
+      !-- extreme CN cases
+      if (nint(cn(i)) > 8) cn2(i) = 8.0_wp
+      !empirical: rounding down up to .6 is better for topo setup
+      if ((cn(i)-rcn) < 0.6_wp) then
+        cn2(i) = rcn
+      end if
+    end do
+    !--- build the topology
+    do i = 1,nat
+      icn = nint(cn2(i))
+      do k = 1,icn
+        j = maxloc(bond(:,i),1)
+        bond(j,i) = 0.0d0
+        if (i .eq. j) cycle
+        neighbourmat(i,j) = .true. !--important: not automatically (i,j)=(j,i)
+        if (present(excl)) then
+          if (excl(i).or.excl(j)) neighbourmat(i,j) = .false.
+        end if
+      end do
+    end do
+    do i = 1,nat
+      do j = 1,nat
+        if (i == j) cycle
+        l = lin(i,j)
+        !-- only save matching topology --> prevent high CN failures
+        if (neighbourmat(i,j).and.neighbourmat(j,i)) then
+          topo(l) = 1
+        else
+          ! special case for carbon (because the carbon CN is typically correct)
+          ! this helps, e.g. with eta-coordination in ferrocene
+          ! (used, except if both are carbon)
+          if (.not. (at(i) == 6.and.at(j) == 6)) then
+            if (at(i) == 6.and.neighbourmat(i,j)) topo(l) = 1
+            if (at(j) == 6.and.neighbourmat(j,i)) topo(l) = 1
+          end if
+        end if
+      end do
+    end do
+    deallocate (cn2)
+    return
+  end subroutine bondtotopo
+
+  subroutine nezcc(nat,at,xyz,cn,ntopo,topo,ncc)
+    !***************************************************
+    !* Check how many (potential) C=C bonds are present
+    !* Expecting xyz in BOHR
+    !***************************************************
+    integer,intent(in)  :: nat
+    integer,intent(in)  :: at(nat)
+    real(wp),intent(in) :: xyz(3,nat)
+    real(wp),intent(in) :: cn(nat)
+    integer,intent(in)  :: ntopo
+    integer,intent(in)  :: topo(ntopo)
+    integer,intent(out) :: ncc
+    real(wp) :: dist
+    integer :: l
+    integer :: ci,cj
+    real(wp),parameter :: distcc = 1.384_wp*aatoau
+    ncc = 0
+    do ci = 1,nat
+      do cj = 1,ci-1
+        if (ci == cj) cycle
+        l = lin(ci,cj)
+        if (topo(l) == 0) cycle
+        if (at(ci) == 6.and.at(cj) == 6.and. &
+        &  nint(cn(ci)) == 3.and.nint(cn(cj)) == 3) then
+          dist = (xyz(1,ci)-xyz(1,cj))**2+ &
+          &    (xyz(2,ci)-xyz(2,cj))**2+ &
+          &    (xyz(3,ci)-xyz(3,cj))**2
+          dist = sqrt(dist)
+          if (dist < distcc) then
+            ncc = ncc+1
+          end if
+        end if
+      end do
+    end do
+    return
+  end subroutine nezcc
+  subroutine ezccat(nat,at,xyz,cn,ntopo,topo,ncc,ezat)
+    !********************************************************
+    !* Check which atoms can be used for C=C dihedral angles
+    !* Expecting xyz in BOHR
+    !********************************************************
+    integer,intent(in)  :: nat
+    integer,intent(in)  :: at(nat)
+    real(wp),intent(in) :: xyz(3,nat)
+    real(wp),intent(in) :: cn(nat)
+    integer,intent(in)  :: ntopo
+    integer,intent(in)  :: topo(ntopo)
+    integer,intent(in)  :: ncc
+    integer,intent(out) :: ezat(4,ncc)
+    real(wp) :: dist
+    integer :: i,j,k,l
+    integer :: ci,cj
+    real(wp),parameter :: distcc = 1.384_wp*aatoau
+    if (ncc < 1) return
+    k = 0
+    do ci = 1,nat
+      do cj = 1,ci-1
+        if (ci == cj) cycle
+        l = lin(ci,cj)
+        if (topo(l) == 0) cycle
+        if (at(ci) == 6.and.at(cj) == 6.and. &
+        &  nint(cn(ci)) == 3.and.nint(cn(cj)) == 3) then
+          dist = (xyz(1,ci)-xyz(1,cj))**2+ &
+          &    (xyz(2,ci)-xyz(2,cj))**2+ &
+          &    (xyz(3,ci)-xyz(3,cj))**2
+          dist = sqrt(dist)
+          if (dist < distcc) then
+            k = k+1
+            ezat(2,k) = ci
+            ezat(3,k) = cj
+            !>-- get a neighbour for ci
+            do i = 1,nat
+              if (i == cj.or.i == ci) cycle
+              l = lin(ci,i)
+              if (topo(l) == 1) then
+                ezat(1,k) = i
+                exit
+              end if
+            end do
+            !>-- get a neighbour for cj
+            do j = 1,nat
+              if (j == cj.or.j == ci) cycle
+              l = lin(cj,j)
+              if (topo(l) == 1) then
+                ezat(4,k) = j
+                exit
+              end if
+            end do
+          end if
+        end if
+      end do
+    end do
+    return
+  end subroutine ezccat
+  subroutine ezccdihed(nat,xyz,ncc,ezat,ezdihed)
+    !********************************************************
+    !* Check which atoms can be used for C=C dihedral angles
+    !********************************************************
+    integer,intent(in)  :: nat
+    real(wp),intent(in) :: xyz(3,nat)
+    integer,intent(in)  :: ncc
+    integer,intent(in) :: ezat(4,ncc)
+    real(wp),intent(out) :: ezdihed(ncc)
+    integer :: i,k
+    integer :: a,b,c,d
+    real(wp) :: winkel
+    if (ncc < 1) return
+    k = 0
+    do i = 1,ncc
+      a = ezat(1,i)
+      b = ezat(2,i)
+      c = ezat(3,i)
+      d = ezat(4,i)
+      call DIHED2(xyz,a,b,c,d,winkel) !>-- from intmodes.f
+      winkel = abs(winkel*(180.0_wp/pi))
+      if (winkel > 180.0_wp) then
+        winkel = 360.0_wp-winkel
+      end if
+      ezdihed(i) = winkel
+    end do
+    return
+  end subroutine ezccdihed
+
+!========================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!========================================================================================!
+end module cregen_utils
diff --git a/src/sorting/ensemblecomp.f90 b/src/sorting/ensemblecomp.f90
new file mode 100644
index 00000000..e47dda5c
--- /dev/null
+++ b/src/sorting/ensemblecomp.f90
@@ -0,0 +1,344 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2018-2020 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+!================================================================================!
+! ENSEMBLE COMPARISON FUNCTION.
+! To use execute:
+!   crest --compare <ensemble1> <ensemble2>
+!================================================================================!
+subroutine compare_ensembles(env)
+  !***********************************************************************
+  !* Compare two molecular ensembles via iRMSD.                          *
+  !* Reads both ensembles into coord arrays, sorts by energy, and        *
+  !* computes iRMSD comparisons for the lowest structures using          *
+  !* OMP-parallel permutation-invariant RMSD.                            *
+  !* Per-structure tracking: group ID + best RMSD, O(ncomp1+ncomp2).     *
+  !***********************************************************************
+  use crest_parameters
+  use crest_data
+  use strucrd
+  use quicksort_interface
+  use axis_module
+  use canonical_mod
+  use irmsd_module
+  use iomod
+  use omp_lib
+  use term_ui
+  implicit none
+
+  type(systemdata),intent(inout) :: env
+
+  type(coord),allocatable :: strucs1(:),strucs2(:)
+  type(coord),allocatable :: workmols(:)
+  type(rmsd_cache),allocatable :: rcaches(:)
+  type(canonical_sorter),allocatable :: sorters(:)
+  real(wp),allocatable :: rmat(:,:),rmat_1d(:)
+
+  !> per-structure best match and RMSD
+  real(wp),allocatable :: best_rmsd_a(:),best_rmsd_b(:)
+  integer,allocatable :: best_partner_a(:),best_partner_b(:)
+
+  integer :: nall1,nall2,ncomp1,ncomp2,nat
+  integer :: i,j,k,cc,T,Tn,npairs,ich
+  integer :: nmatch_a,nmatch_b,pn1,pn2,pcount
+  real(wp) :: RTHR,rmsdval,erel1,erel2,min_1,min_2,min_tot
+  logical :: ex,stereocheck,first,store_rmat
+
+  type(progress_state) :: pbar
+
+  external :: PRMAT
+
+! ── cleanup previous output files ───────────────────────────────────
+  call compens_cleanup()
+
+! ── validate input files ────────────────────────────────────────────
+  inquire (file=env%ensemblename,exist=ex)
+  if (.not.ex) then
+    write (stdout,'(2x,a,a,a)') 'File <',trim(env%ensemblename),'> does not exist!'
+    error stop
+  end if
+  inquire (file=env%ensemblename2,exist=ex)
+  if (.not.ex) then
+    write (stdout,'(2x,a,a,a)') 'File <',trim(env%ensemblename2),'> does not exist!'
+    error stop
+  end if
+
+! ── read ensembles into coord arrays ────────────────────────────────
+  write (stdout,'(1x,a,a,a)',advance='no') 'Reading ensemble <',trim(env%ensemblename),'> ...'
+  flush (stdout)
+  call rdensemble(env%ensemblename,nall1,strucs1)
+  write (stdout,'(1x,i0,a)') nall1,' structures.'
+
+  write (stdout,'(1x,a,a,a)',advance='no') 'Reading ensemble <',trim(env%ensemblename2),'> ...'
+  flush (stdout)
+  call rdensemble(env%ensemblename2,nall2,strucs2)
+  write (stdout,'(1x,i0,a)') nall2,' structures.'
+  write (stdout,*)
+
+! ── validate compatibility ──────────────────────────────────────────
+  nat = strucs1(1)%nat
+  if (strucs1(1)%nat /= strucs2(1)%nat) then
+    write (stdout,'(a)') "Nat1 /= Nat2 : Number of atoms of the two ensembles don't match!"
+    write (stdout,'(a)') "You are trying to compare two different molecules!"
+    error stop "exit."
+  end if
+  do i = 1,nat
+    if (strucs1(1)%at(i) /= strucs2(1)%at(i)) then
+      write (stdout,'(a)') "The ordering of atoms apparently is different between the two ensembles!"
+      write (stdout,'(a)') "This way it is impossible to calculate RMSDs!"
+      error stop "exit."
+    end if
+  end do
+
+! ── sort each ensemble by energy ────────────────────────────────────
+  call ensemble_qsort(nall1,strucs1,1,nall1)
+  call ensemble_qsort(nall2,strucs2,1,nall2)
+
+! ── select lowest structures ────────────────────────────────────────
+  ncomp1 = min(nall1,env%maxcompare)
+  ncomp2 = min(nall2,env%maxcompare)
+  npairs = ncomp1*ncomp2
+
+  call smallhead('Comparing the Ensembles')
+  write (stdout,'(2x,a,a,a,i0,a,i0,a)') &
+    'Ensemble A <',trim(env%ensemblename),'> : ', &
+    nall1,' structures, using ',ncomp1,' lowest'
+  write (stdout,'(2x,a,a,a,i0,a,i0,a)') &
+    'Ensemble B <',trim(env%ensemblename2),'> : ', &
+    nall2,' structures, using ',ncomp2,' lowest'
+
+! ── set up OMP parallelization ──────────────────────────────────────
+  call new_ompautoset(env,'max',0,T,Tn)
+  write (stdout,'(2x,a,i0)') 'OpenMP threads: ',T
+
+! ── set up RMSD threshold (in Bohr) ────────────────────────────────
+  RTHR = env%rthr*aatoau
+  write (stdout,'(2x,a,f8.4,a)') 'RMSD threshold: ',env%rthr,' Å'
+  write (stdout,'(2x,a,i0)') 'Total comparisons: ',npairs
+  write (stdout,*)
+
+! ── set up canonical sorter and axis-align structures ───────────────
+  write (stdout,'(1x,a)',advance='no') 'Setting up iRMSD infrastructure ...'
+  flush (stdout)
+
+  allocate (sorters(1))
+  call axis(nat,strucs1(1)%at,strucs1(1)%xyz)
+  call sorters(1)%init(strucs1(1),invtype='apsp+',heavy=.false.)
+  stereocheck = .not.(sorters(1)%hasstereo(strucs1(1)))
+  call sorters(1)%shrink()
+
+  select case (env%iinversion)
+  case (1)
+    stereocheck = .true.
+  case (2)
+    stereocheck = .false.
+  end select
+
+  do i = 1,ncomp1
+    call axis(nat,strucs1(i)%at,strucs1(i)%xyz)
+  end do
+  do i = 1,ncomp2
+    call axis(nat,strucs2(i)%at,strucs2(i)%xyz)
+  end do
+
+! ── allocate per-thread work caches ─────────────────────────────────
+  allocate (rcaches(T))
+  allocate (workmols(T))
+  do i = 1,T
+    allocate (workmols(i)%at(nat))
+    allocate (workmols(i)%xyz(3,nat))
+    call rcaches(i)%allocate(nat)
+    rcaches(i)%stereocheck = stereocheck
+  end do
+  write (stdout,'(1x,a)') 'done.'
+
+! ── allocate per-structure tracking (O(ncomp1+ncomp2)) ──────────────
+  store_rmat = (ncomp1 <= 20.and.ncomp2 <= 20)
+  allocate (best_rmsd_a(ncomp1),source=huge(1.0_wp))
+  allocate (best_rmsd_b(ncomp2),source=huge(1.0_wp))
+  allocate (best_partner_a(ncomp1),source=0)
+  allocate (best_partner_b(ncomp2),source=0)
+  if (store_rmat) then
+    allocate (rmat(ncomp1,ncomp2),source=0.0_wp)
+  end if
+
+! ── compute iRMSDs (OMP parallel) with progress bar ────────────────
+  pcount = 0
+  call progress_init(pbar,total=npairs,prefix=' iRMSD ')
+
+  !$omp parallel &
+  !$omp shared(strucs1,strucs2,rmat,store_rmat) &
+  !$omp shared(best_rmsd_a,best_rmsd_b,best_partner_a,best_partner_b) &
+  !$omp shared(sorters,rcaches,workmols,npairs,ncomp2,nat,RTHR,pbar) &
+  !$omp private(k,i,j,cc,rmsdval)
+  !$omp do schedule(dynamic)
+  do k = 1,npairs
+    cc = omp_get_thread_num()+1
+    i = (k-1)/ncomp2+1
+    j = mod(k-1,ncomp2)+1
+    rcaches(cc)%rank(1:nat,1) = sorters(1)%rank(1:nat)
+    rcaches(cc)%rank(1:nat,2) = sorters(1)%rank(1:nat)
+    workmols(cc)%nat = nat
+    workmols(cc)%at(:) = strucs2(j)%at(:)
+    workmols(cc)%xyz(:,:) = strucs2(j)%xyz(:,:)
+    call min_rmsd(strucs1(i),workmols(cc),rcache=rcaches(cc),rmsdout=rmsdval)
+    if (store_rmat) rmat(i,j) = rmsdval
+    if (rmsdval < RTHR) then
+      !$omp critical
+      if (rmsdval < best_rmsd_a(i)) then
+        best_rmsd_a(i) = rmsdval
+        best_partner_a(i) = j
+      end if
+      if (rmsdval < best_rmsd_b(j)) then
+        best_rmsd_b(j) = rmsdval
+        best_partner_b(j) = i
+      end if
+      !$omp end critical
+    end if
+    !$omp atomic
+    pcount = pcount+1
+    !$omp end atomic
+    if (cc == 1) call progress_update(pbar,pcount,npairs)
+  end do
+  !$omp end do
+  !$omp end parallel
+
+  call progress_update(pbar,npairs,npairs,force=.true.)
+  call progress_finish(pbar)
+  write (stdout,*)
+
+! ── print RMSD matrix (only for small matrices) ────────────────────
+  if (store_rmat) then
+    pn1 = ncomp1
+    pn2 = ncomp2
+    allocate (rmat_1d(pn1*pn2))
+    do j = 1,pn2
+      do i = 1,pn1
+        rmat_1d((j-1)*pn1+i) = rmat(i,j)*autoaa
+      end do
+    end do
+    call PRMAT(stdout,rmat_1d,pn1,pn2,'RMSD (Angstrom)')
+    deallocate (rmat_1d,rmat)
+  end if
+
+! ── correlation printout ────────────────────────────────────────────
+  min_1 = strucs1(1)%energy
+  min_2 = strucs2(1)%energy
+  min_tot = min(min_1,min_2)
+
+  call smallhead('Correlation between Structures')
+  write (stdout,'(2x,a,30x,a)') 'Ensemble A','Ensemble B'
+  write (stdout,'(2x,a4,2x,a14,10x,a4,2x,a14,3x,a8)') &
+    '#','Erel/kcal','#','Erel/kcal','RMSD/Å'
+  write (stdout,'(2x,a)') repeat('-',62)
+
+  do i = 1,ncomp1
+    erel1 = (strucs1(i)%energy-min_1)*autokcal
+    if (best_partner_a(i) > 0) then
+      j = best_partner_a(i)
+      erel2 = (strucs2(j)%energy-min_2)*autokcal
+      write (stdout,'(2x,i4,2x,f14.5,2x,a5,2x,i4,2x,f14.5,3x,f8.4)') &
+        i,erel1,'<--->',j,erel2,best_rmsd_a(i)*autoaa
+    else
+      write (stdout,'(2x,i4,2x,f14.5)') i,erel1
+    end if
+  end do
+
+  write (stdout,'(2x,a)') repeat('-',62)
+
+  nmatch_a = count(best_partner_a > 0)
+  nmatch_b = count(best_partner_b > 0)
+  write (stdout,'(2x,i0,a,i0,a)') nmatch_a,' of ',ncomp1, &
+    ' structures in A have a match in B'
+  write (stdout,'(2x,i0,a,i0,a)') nmatch_b,' of ',ncomp2, &
+    ' structures in B have a match in A'
+
+  first = .true.
+  do i = 1,ncomp1
+    if (best_partner_a(i) == 0) then
+      if (first) then
+        write (stdout,'(2x,a)',advance='no') 'Unmatched in A:'
+        first = .false.
+      end if
+      write (stdout,'(1x,i0)',advance='no') i
+    end if
+  end do
+  if (.not.first) write (stdout,*)
+
+  first = .true.
+  do j = 1,ncomp2
+    if (best_partner_b(j) == 0) then
+      if (first) then
+        write (stdout,'(2x,a)',advance='no') 'Unmatched in B:'
+        first = .false.
+      end if
+      write (stdout,'(1x,i0)',advance='no') j
+    end if
+  end do
+  if (.not.first) write (stdout,*)
+
+! ── write output files ──────────────────────────────────────────────
+  open (newunit=ich,file='energy_1.dat')
+  do i = 1,ncomp1
+    write (ich,'(2x,f10.5,2x,f14.8)') &
+      (strucs1(i)%energy-min_tot)*autokcal,strucs1(i)%energy
+  end do
+  close (ich)
+
+  open (newunit=ich,file='energy_2.dat')
+  do i = 1,ncomp2
+    write (ich,'(2x,f10.5,2x,f14.8)') &
+      (strucs2(i)%energy-min_tot)*autokcal,strucs2(i)%energy
+  end do
+  close (ich)
+
+  open (newunit=ich,file='rmsdmatch.dat')
+  do i = 1,ncomp1
+    if (best_partner_a(i) > 0) then
+      write (ich,'(2x,i6,i6,f10.4)') i,best_partner_a(i),best_rmsd_a(i)*autoaa
+    end if
+  end do
+  close (ich)
+
+! ── cleanup ─────────────────────────────────────────────────────────
+  if (allocated(rmat)) deallocate (rmat)
+  if (allocated(best_rmsd_a)) deallocate (best_rmsd_a)
+  if (allocated(best_rmsd_b)) deallocate (best_rmsd_b)
+  if (allocated(best_partner_a)) deallocate (best_partner_a)
+  if (allocated(best_partner_b)) deallocate (best_partner_b)
+  if (allocated(rcaches)) deallocate (rcaches)
+  if (allocated(workmols)) deallocate (workmols)
+  if (allocated(sorters)) deallocate (sorters)
+  if (allocated(strucs1)) deallocate (strucs1)
+  if (allocated(strucs2)) deallocate (strucs2)
+
+end subroutine compare_ensembles
+
+!---------------------------------------------------------------------------------------
+subroutine compens_cleanup()
+  !***********************************************
+  !* Remove output files from a previous run.    *
+  !***********************************************
+  use iomod
+  implicit none
+  call remove('energy_1.dat')
+  call remove('energy_2.dat')
+  call remove('rmsdmatch.dat')
+end subroutine compens_cleanup
+
diff --git a/src/sorting/hungarian.f90 b/src/sorting/hungarian.f90
new file mode 100644
index 00000000..54b89cc4
--- /dev/null
+++ b/src/sorting/hungarian.f90
@@ -0,0 +1,590 @@
+module hungarian_module
+!************************************************************
+!* Implementations of 
+!* A) The Hungarian (Kuhn-Munkres) Algorithm
+!*    in O(n³) time (Edmons & Karp / Tomizawa).
+!*
+!* B) A Rectengular linear assignment problem algorithm
+!*    (LSAP) accodring to 
+!*    D.F. Crouse, IEEE Trans. Aerosp. Electron. Syst.,
+!*    2016, 52, 1679-1696, doi: 10.1109/TAES.2016.140952
+!*
+!* Implemented in single precision with a cache to
+!* circumvent repeated memory allocation.
+!*
+!* Also includes some wrappers for standalone use
+!************************************************************
+  use iso_fortran_env,sp => real32,wp => real64
+  implicit none
+  private
+
+  public :: hungarian
+  interface hungarian
+    module procedure hungarian_cached
+    module procedure hungarian_wrap_int
+    module procedure hungarian_wrap_sp
+    module procedure hungarian_wrap_wp
+  end interface hungarian
+
+  public :: lsap
+  interface lsap
+    module procedure lsap_cached
+    module procedure lsap_wrap_int
+    module procedure lsap_wrap_sp
+    module procedure lsap_wrap_wp
+  end interface lsap
+
+  real(sp),parameter,private :: inf = huge(1.0_sp) !> Use huge intrinsic for large numbers
+  integer,parameter,private  :: infi = huge(1) !> Use huge intrinsic for large numbers
+
+  public :: assignment_cache
+  type :: assignment_cache
+    integer :: J,W
+    real(sp),allocatable :: Cost(:)  !> Cost(J*W), 1D for more efficient memory access
+    !> Hungarian algo related
+    real(sp),allocatable :: answers(:) !> answers(J)
+    integer,allocatable  :: job(:)     !> job(W+1)
+    real(sp),allocatable :: ys(:)      !> ys(J)
+    real(sp),allocatable :: yt(:)      !> yt(W+1)
+    real(sp),allocatable :: Ct(:,:)    !> Ct(W,J)
+    real(sp),allocatable :: min_to(:)  !> min_to(W+1)
+    integer,allocatable  :: prv(:)     !> prv(W+1)
+    logical,allocatable  :: in_Z(:)    !> in_Z(W+1)
+    !> LSAP related
+    integer,allocatable  :: a(:),b(:)   !> a(J), b(J)
+    real(sp),allocatable :: u(:),v(:)   !> u(J), v(W)
+    real(sp),allocatable :: shortestPathCosts(:) !> ...(W)
+    integer,allocatable  :: path(:),remaining(:) !> path(W), remaining(W)
+    integer,allocatable  :: col4row(:),row4col(:) !> col4row(J), row4col(W)
+    logical,allocatable  :: SR(:),SC(:)     !> SR(J), SC(W)
+  contains
+    procedure :: allocate => allocate_assignment_cache
+    procedure :: deallocate => deallocate_assignment_cache
+  end type assignment_cache
+
+  interface ckmin
+  !  module procedure ckmin_int
+    module procedure ckmin_sp
+  end interface ckmin
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  subroutine allocate_assignment_cache(self,J,W,lsapcache)
+    implicit none
+    integer,intent(in) :: J
+    integer,intent(in) :: W
+    class(assignment_cache),intent(inout) :: self
+    logical,intent(in),optional :: lsapcache
+    logical :: yesno
+    yesno = .false.
+    if (present(lsapcache)) yesno = lsapcache
+
+    !> Store dimensions
+    self%J = J
+    self%W = W
+    if (J > W) then
+      error stop 'linear assignment problems require rectengular matrices!'
+    end if
+    allocate (self%Cost(J*W))
+
+    !> Allocate arrays based on input dimensions & algo type
+    if (.not.yesno) then
+      !> Hungarian algo cache:
+      allocate (self%answers(J))
+      allocate (self%job(W+1))
+      !> Allocate workspace arrays
+      allocate (self%ys(J))
+      allocate (self%yt(W+1))
+      allocate (self%Ct(W,J))
+      allocate (self%min_to(W+1))
+      allocate (self%prv(W+1))
+      allocate (self%in_Z(W+1))
+    else
+      !> LSAP cache
+      allocate (self%a(J),self%b(J))
+      allocate (self%u(J),self%v(W),self%shortestPathCosts(W))
+      allocate (self%path(W),self%col4row(J),self%row4col(W))
+      allocate (self%SR(J),self%SC(W),self%remaining(W))
+    end if
+  end subroutine allocate_assignment_cache
+
+  subroutine deallocate_assignment_cache(self)
+    implicit none
+    class(assignment_cache),intent(inout) :: self
+    ! Deallocate arrays if they are allocated
+    if (allocated(self%Cost)) deallocate (self%Cost)
+    if (allocated(self%answers)) deallocate (self%answers)
+    if (allocated(self%job)) deallocate (self%job)
+    if (allocated(self%ys)) deallocate (self%ys)
+    if (allocated(self%yt)) deallocate (self%yt)
+    if (allocated(self%Ct)) deallocate (self%Ct)
+    if (allocated(self%min_to)) deallocate (self%min_to)
+    if (allocated(self%prv)) deallocate (self%prv)
+    if (allocated(self%in_Z)) deallocate (self%in_Z)
+    if (allocated(self%a)) deallocate (self%a)
+    if (allocated(self%b)) deallocate (self%b)
+    if (allocated(self%u)) deallocate (self%u)
+    if (allocated(self%v)) deallocate (self%v)
+    if (allocated(self%shortestPathCosts)) deallocate (self%shortestPathCosts)
+    if (allocated(self%path)) deallocate (self%path)
+    if (allocated(self%col4row)) deallocate (self%col4row)
+    if (allocated(self%row4col)) deallocate (self%row4col)
+    if (allocated(self%SR)) deallocate (self%SR)
+    if (allocated(self%SC)) deallocate (self%SC)
+    if (allocated(self%remaining)) deallocate (self%remaining)
+  end subroutine deallocate_assignment_cache
+
+!========================================================================================!
+
+  !logical function ckmin_int(a,b) result(yesno)
+  !  !> Helper function to compute the minimum and update
+  !  integer,intent(inout) :: a
+  !  integer,intent(in) :: b
+  !  yesno = .false.
+  !  if (b < a) then
+  !    a = b
+  !    yesno = .true.
+  !  end if
+  !end function ckmin_int
+
+  logical function ckmin_sp(a,b) result(yesno)
+    !> Helper function to compute the minimum and update
+    real(sp),intent(inout) :: a
+    real(sp),intent(in) :: b
+    yesno = .false.
+    if (b < a) then
+      a = b
+      yesno = .true.
+    end if
+  end function ckmin_sp
+
+  subroutine hungarian_cached(cache,J,W)
+    !****************************************************************
+    !* Hungarian algorithm implementation to solve an assignment
+    !* problem in O(n³) time.
+    !* This implementation refers to a cache, which is created
+    !* to avoid repeated memory allocation.
+    !* Passing J and W explicitly enables reuse of memory
+    !* for smaller sub-problems (i.e. cache%J >= J, W accoridingly)
+    !* Unfortunately, this algorithm has problems with
+    !* assignments of equal cost.
+    !*
+    !* Inputs (all within cache, except J and W):
+    !*   C(J, W) - Cost matrix of dimensions J-by-W,
+    !*             where C(jj, ww) is the cost to assign
+    !*             jj-th job to ww-th worker
+    !*   J       - Number of jobs
+    !*   W       - Number of workers
+    !* Outputs (all within cache):
+    !*   answers(J) - Vector of length J, where answers(jj) is
+    !*                the minimum cost to assign the first jj
+    !*                jobs to distinct workers
+    !*   job(W+1)   - Vector where job(ww) is the job assigned to
+    !*                the ww-th worker (or -1 if no job is assigned)
+    !****************************************************************
+    integer,intent(in) :: J
+    integer,intent(in) :: W
+    type(assignment_cache),intent(inout) :: cache
+    integer  :: jj_cur,ww_cur,jj,ww_next,ww
+    real(sp) :: delta
+
+    !> IMPORTANT: associate to have shorter variable names
+    associate (C => cache%Cost, &
+              & answers => cache%answers, &
+              & job => cache%job, &
+              & ys => cache%ys, &
+              & yt => cache%yt, &
+              & Ct => cache%Ct, &
+              & min_to => cache%min_to, &
+              & prv => cache%prv, &
+              & in_Z => cache%in_Z)
+
+      job = -1
+      ys = 0
+      yt = 0
+      !Ct = transpose(reshape(C,[J,W]))
+
+      do jj_cur = 1,J   !> O(n¹)
+        ww_cur = W+1
+        job(ww_cur) = jj_cur
+        min_to = inf
+        prv = -1
+        in_Z = .false.
+
+        do while (job(ww_cur) /= -1)  !> O(n¹) -> O(n²)
+          in_Z(ww_cur) = .true.
+          jj = job(ww_cur)
+          delta = inf
+          do ww = 1,W !> O(n²) -> O(n³)
+            if (.not.in_Z(ww)) then
+              !if (ckmin(min_to(ww),Ct(ww,jj)-ys(jj)-yt(ww))) then
+              if (ckmin(min_to(ww),C(jj+(ww-1)*J)-ys(jj)-yt(ww))) then
+                prv(ww) = ww_cur
+              end if
+              if (ckmin(delta,min_to(ww))) then
+                ww_next = ww
+              end if
+            end if
+          end do
+
+          do ww = 1,W+1
+            if (in_Z(ww)) then
+              ys(job(ww)) = ys(job(ww))+delta
+              yt(ww) = yt(ww)-delta
+            else
+              min_to(ww) = min_to(ww)-delta
+            end if
+          end do
+          ww_cur = ww_next
+        end do
+
+        !> Update assignments along alternating path
+        do while (ww_cur /= W+1)
+          job(ww_cur) = job(prv(ww_cur))
+          ww_cur = prv(ww_cur)
+        end do
+
+        answers(jj_cur) = -yt(W+1)
+      end do
+
+    end associate
+  end subroutine hungarian_cached
+
+!========================================================================================!
+
+  subroutine hungarian_wrap_int(C,J,W,answers,job)
+    !*********************************************
+    !* Wrapper for integer precision
+    !*********************************************
+    implicit none
+    integer,intent(in) :: J
+    integer,intent(in) :: W
+    integer,intent(in) :: C(J,W)
+    integer,intent(out) :: answers(J)
+    integer,intent(out) :: job(W+1)
+    type(assignment_cache) :: cache
+
+    call cache%allocate(J,W)
+    cache%Cost(1:J*W) = reshape(real(C(1:J,1:W),sp),[J*W])
+    call hungarian_cached(cache,J,W)
+
+    answers(1:J) = nint(cache%answers(1:J))
+    job(1:W+1) = cache%job(1:W+1)
+    call cache%deallocate()
+  end subroutine hungarian_wrap_int
+
+  subroutine hungarian_wrap_sp(C,J,W,answers,job)
+    !*********************************************
+    !* Wrapper for single precision
+    !*********************************************
+    implicit none
+    integer,intent(in) :: J
+    integer,intent(in) :: W
+    real(sp),intent(in) :: C(J,W)
+    real(sp),intent(out) :: answers(J)
+    integer,intent(out) :: job(W+1)
+    type(assignment_cache) :: cache
+
+    call cache%allocate(J,W)
+    cache%Cost(1:J*W) = reshape(C(1:J,1:W),[J*W])
+    call hungarian_cached(cache,J,W)
+
+    answers(1:J) = cache%answers(1:J)
+    job(1:W+1) = cache%job(1:W+1)
+    call cache%deallocate()
+  end subroutine hungarian_wrap_sp
+
+  subroutine hungarian_wrap_wp(C,J,W,answers,job)
+    !*********************************************
+    !* Wrapper for double precision
+    !*********************************************
+    implicit none
+    integer,intent(in) :: J
+    integer,intent(in) :: W
+    real(wp),intent(in) :: C(J,W)
+    real(wp),intent(out) :: answers(J)
+    integer,intent(out) :: job(W+1)
+    type(assignment_cache) :: cache
+
+    call cache%allocate(J,W)
+    cache%Cost(1:J*W) = reshape(real(C(1:J,1:W),sp),[J*W])
+    call hungarian_cached(cache,J,W)
+
+    answers(1:J) = real(cache%answers(1:J),wp)
+    job(1:W+1) = cache%job(1:W+1)
+    call cache%deallocate()
+  end subroutine hungarian_wrap_wp
+
+!========================================================================================!
+!========================================================================================!
+
+!****************************************************************
+!* The following implements an alternative algorithm capable
+!* to better handle assignments with equivalent costs
+!* The algorithm follows
+!*   D.F. Crouse, IEEE Trans. Aerosp. Electron. Syst.,
+!*   2016, 52, 1679-1696, doi: 10.1109/TAES.2016.140952
+!*
+!* The source code is a free Fortran-adaptation
+!* of the C++ lsap algorithm in SciPy
+!****************************************************************
+
+  function augmenting_path(nr,nc,cost,u,v,path,row4col, &
+                          &  shortestPathCosts,i,SR,SC, &
+                          &  remaining,minValue) result(sink)
+    implicit none
+    integer,intent(in) :: nr              !> Number of columns (jobs)
+    integer,intent(in) :: nc              !> Number of columns (workers)
+    real(sp),intent(in) :: cost(:)        !> Cost matrix (1D, nr*nc length)
+    real(sp),intent(inout) :: u(:)        !> Dual variables for rows (jobs)
+    real(sp),intent(inout) :: v(:)        !> Dual variables for columns (workers)
+    integer,intent(inout) :: path(:)      !> Path array
+    integer,intent(inout) :: row4col(:)   !> Array storing which row is assigned to which column
+    real(sp),intent(inout) :: shortestPathCosts(:) !> Array for storing shortest path costs
+    integer,intent(inout) :: i            !> Current row being processed
+    logical,intent(inout) :: SR(:)        !> Boolean array for rows
+    logical,intent(inout) :: SC(:)        !> Boolean array for columns
+    integer,intent(inout) :: remaining(:) !> Array of remaining columns to be processed
+    real(sp),intent(inout) :: minValue    !> Minimum value of the path cost
+    integer :: sink                       !> The resulting sink (column) from the augmenting path
+    integer :: num_remaining,indx,j,it
+    real(sp) :: lowest,r
+
+    minValue = 0.0_sp
+    num_remaining = nc
+
+    !> Initialize the remaining array in reverse order
+    do it = 1,nc
+      remaining(it) = nc-(it-1)
+    end do
+
+    !> Initialize SR, SC, and shortestPathCosts
+    SR = .false.
+    SC = .false.
+    shortestPathCosts = inf  !> Set to a very large value
+
+    !> Start finding the shortest augmenting path
+    sink = -1
+    do while (sink == -1)
+      indx = -1
+      lowest = inf
+      SR(i) = .true.
+
+      do it = 1,num_remaining
+        j = remaining(it)
+        r = minValue+cost(i+((j-1)*nr))-u(i)-v(j)
+        if (r < shortestPathCosts(j)) then
+          path(j) = i
+          shortestPathCosts(j) = r
+        end if
+
+        !> Choose the smallest cost or a new sink node
+        if (shortestPathCosts(j) < lowest.or. &
+            (shortestPathCosts(j) == lowest.and.row4col(j) == -1)) then
+          lowest = shortestPathCosts(j)
+          indx = it
+        end if
+      end do
+
+      minValue = lowest
+      if (minValue == inf) then  !> Infeasible cost matrix
+        sink = -1
+        return
+      end if
+
+      j = remaining(indx)
+      if (row4col(j) == -1) then
+        sink = j
+      else
+        i = row4col(j)
+      end if
+
+      SC(j) = .true.
+
+      remaining(indx) = remaining(num_remaining)
+      num_remaining = num_remaining-1
+    end do
+  end function augmenting_path
+
+  subroutine swap(x,y)
+    implicit none
+    integer,intent(inout) :: x,y
+    integer :: temp
+    temp = x
+    x = y
+    y = temp
+  end subroutine swap
+
+  subroutine lsap_cached(lcache,nr,nc,maximize,iostatus)
+    implicit none
+    type(assignment_cache),intent(inout) :: lcache
+    integer,intent(in) :: nr,nc
+    logical,intent(in) :: maximize
+    integer :: iostatus
+    integer :: curRow,currowtmp,i,j,jj,sink
+    real(sp) :: minValue
+    !> error codes
+    integer,parameter :: RECTANGULAR_LSAP_TRANSPOSED = 1
+    integer,parameter :: RECTANGULAR_LSAP_INFEASIBLE = 2
+
+    !> use associates to offload allocation outside the routine
+    associate (cost => lcache%Cost, &
+             & a => lcache%a,b => lcache%b, &
+             & u => lcache%u,v => lcache%v, &
+             & shortestPathCosts => lcache%shortestPathCosts, &
+             & path => lcache%path,col4row => lcache%col4row,row4col => lcache%row4col, &
+             & remaining => lcache%remaining,SR => lcache%SR,SC => lcache%SC)
+
+      !> Handle trivial inputs
+      if (nr == 1.or.nc == 1) then
+        a(1) = 1
+        b(1) = 1
+        iostatus = 0
+        return
+      end if
+
+      !> Determine if we need to transpose the matrix
+      !> Let the user handle that outside the call
+      if (nc < nr) then
+        iostatus = RECTANGULAR_LSAP_TRANSPOSED
+        return
+      end if
+
+      !> Negate the cost matrix for maximization
+      if (maximize) then
+        cost = -cost
+      end if
+
+      !> Initialize
+      u(:) = 0.0_sp
+      v(:) = 0.0_sp
+      col4row(:) = -1
+      row4col(:) = -1
+      path(:) = -1
+
+      !> Iteratively build the solution
+      do curRow = 1,nr
+        curRowtmp = curRow
+        !> Call augmenting_path routine
+        sink = augmenting_path(nr,nc,cost,u,v,path,row4col,  &
+                              & shortestPathCosts,curRowtmp, &
+                              & SR,SC,remaining,minValue)
+        if (sink < 0) then
+          iostatus = RECTANGULAR_LSAP_INFEASIBLE
+          return
+        end if
+
+        !> Update dual variables
+        u(curRow) = u(curRow)+minValue
+        do i = 1,nr
+          if (SR(i).and.i /= curRow) then
+            u(i) = u(i)+minValue-shortestPathCosts(col4row(i))
+          end if
+        end do
+
+        do j = 1,nc
+          if (SC(j)) then
+            v(j) = v(j)-minValue+shortestPathCosts(j)
+          end if
+        end do
+
+        !> Augment previous solution
+        j = sink
+        do jj=1,nc+1  !> avoid infinite loop
+          i = path(j)
+          row4col(j) = i
+          call swap(col4row(i),j)
+          if (i == curRow) exit
+        end do
+      end do
+
+      !> Finalize the assignment
+      do i = 1,nr
+        a(i) = i
+        b(i) = col4row(i)
+      end do
+
+      iostatus = 0
+    end associate
+  end subroutine lsap_cached
+
+!========================================================================================!
+
+  subroutine lsap_wrap_int(C,J,W,a,b)
+    !*********************************************
+    !* Wrapper for integer precision
+    !*********************************************
+    implicit none
+    integer,intent(in) :: J
+    integer,intent(in) :: W
+    integer,intent(in) :: C(J,W)
+    integer,intent(out),allocatable :: a(:)
+    integer,intent(out),allocatable :: b(:)
+    type(assignment_cache) :: cache
+    integer :: io
+
+    call cache%allocate(J,W,.true.)
+    cache%Cost(1:J*W) = reshape(real(C(1:J,1:W),sp), [J*W])
+    call lsap_cached(cache,J,W,.false.,io)
+
+    allocate(a(J), b(J))
+    a(1:J) = cache%a(1:J)
+    b(1:J) = cache%b(1:J)
+    call cache%deallocate()
+  end subroutine lsap_wrap_int
+
+
+  subroutine lsap_wrap_sp(C,J,W,a,b)
+    !*********************************************
+    !* Wrapper for single precision
+    !*********************************************
+    implicit none
+    integer,intent(in) :: J
+    integer,intent(in) :: W
+    real(sp),intent(in) :: C(J,W)
+    integer,intent(out),allocatable :: a(:)
+    integer,intent(out),allocatable :: b(:)
+    type(assignment_cache) :: cache
+    integer :: io
+
+    call cache%allocate(J,W,.true.)
+    cache%Cost(1:J*W) = reshape(C(1:J,1:W), [J*W])
+    call lsap_cached(cache,J,W,.false.,io)
+
+    allocate(a(J), b(J))
+    a(1:J) = cache%a(1:J)
+    b(1:J) = cache%b(1:J)
+    call cache%deallocate()
+  end subroutine lsap_wrap_sp
+
+
+  subroutine lsap_wrap_wp(C,J,W,a,b)
+    !*********************************************
+    !* Wrapper for double precision
+    !*********************************************
+    implicit none
+    integer,intent(in) :: J
+    integer,intent(in) :: W
+    real(wp),intent(in) :: C(J,W)
+    integer,intent(out),allocatable :: a(:)
+    integer,intent(out),allocatable :: b(:)
+    type(assignment_cache) :: cache
+    integer :: io
+
+    call cache%allocate(J,W,.true.)
+    cache%Cost(1:J*W) = reshape(real(C(1:J,1:W),sp), [J*W])
+    call lsap_cached(cache,J,W,.false.,io)
+
+    allocate(a(J), b(J))
+    a(1:J) = cache%a(1:J)
+    b(1:J) = cache%b(1:J)
+    call cache%deallocate()
+  end subroutine lsap_wrap_wp
+
+!========================================================================================!
+!========================================================================================!
+end module hungarian_module
diff --git a/src/sorting/irmsd_module.f90 b/src/sorting/irmsd_module.f90
new file mode 100644
index 00000000..99eda70c
--- /dev/null
+++ b/src/sorting/irmsd_module.f90
@@ -0,0 +1,1437 @@
+
+module irmsd_module
+!*****************************************
+!* Module that implements a more
+!* modern interface to calculating RMSDs
+!*****************************************
+  use crest_parameters
+  use strucrd
+  use hungarian_module
+  use axis_module
+  implicit none
+  private
+
+  public :: rmsd,irmsd
+  public :: min_rmsd
+
+  public :: rmsd_align
+  public :: checkranks,fallbackranks
+  public :: setup_irmsd_ranks
+  public :: molatomsort
+
+  real(wp),parameter :: bigval = huge(bigval)
+
+  public :: rmsd_core_cache
+  type :: rmsd_core_cache
+!*************************************
+!* Memory cache for rmsd_core routine
+!*************************************
+    real(wp),allocatable :: x(:,:)
+    real(wp),allocatable :: y(:,:)
+    real(wp),allocatable :: xi(:)
+    real(wp),allocatable :: yi(:)
+    real(wp),allocatable :: xyzscratch(:,:,:)
+  contains
+    procedure :: allocate => allocate_rmsd_core_cache
+  end type rmsd_core_cache
+
+  public :: rmsd_cache
+  type :: rmsd_cache
+!****************************************************
+!* cache implementation to avoid repeated allocation
+!* and enable shared-memory parallelism
+!****************************************************
+    logical :: initialized = .false.
+    real(wp),allocatable :: xyzscratch(:,:,:)
+    integer,allocatable :: rank(:,:)
+    integer,allocatable :: best_order(:,:)
+    integer,allocatable :: current_order(:)
+    integer,allocatable :: target_order(:)
+    integer,allocatable :: order_bkup(:,:)
+    integer,allocatable :: iwork(:)
+    integer,allocatable :: iwork2(:,:)
+    logical,allocatable :: assigned(:)  !> atom-wise
+    logical,allocatable :: rassigned(:) !> rank-wise
+    logical,allocatable :: lwork(:)
+
+    integer :: nranks = 0
+    integer,allocatable :: ngroup(:)
+    logical :: stereocheck = .false.
+    integer,allocatable :: proxy_topo_ref(:,:)
+    integer,allocatable :: proxy_topo(:,:)
+
+    type(rmsd_core_cache),allocatable :: ccache
+    type(assignment_cache),allocatable :: acache
+  contains
+    procedure :: allocate => allocate_rmsd_cache
+    procedure :: check_proxy_topo
+    procedure :: initialize => initialize_rmsd_cache
+  end type rmsd_cache
+
+  real(wp),parameter :: inf = huge(1.0_wp)
+  real(wp),parameter :: imat(3,3) = reshape([1.0_wp,0.0_wp,0.0_wp,  &
+                                    &        0.0_wp,1.0_wp,0.0_wp,  &
+                                    &        0.0_wp,0.0_wp,1.0_wp], &
+                                    &        [3,3])
+
+  real(wp),parameter :: Rx180(3,3) = reshape([1.0_wp,0.0_wp,0.0_wp,     &
+                                     &          0.0_wp,-1.0_wp,0.0_wp,  &
+                                     &          0.0_wp,0.0_wp,-1.0_wp], &
+                                     &          [3,3])
+
+  real(wp),parameter :: Ry180(3,3) = reshape([-1.0_wp,0.0_wp,0.0_wp,    &
+                                     &          0.0_wp,1.0_wp,0.0_wp,   &
+                                     &          0.0_wp,0.0_wp,-1.0_wp], &
+                                     &          [3,3])
+
+  !real(wp),parameter :: Rz180(3,3) = reshape([-1.0_wp,0.0_wp,0.0_wp,   &
+  !                                   &          0.0_wp,-1.0_wp,0.0_wp, &
+  !                                   &          0.0_wp,0.0_wp,1.0_wp], &
+  !                                   &          [3,3])
+
+  real(wp),parameter :: Rx90(3,3) = reshape([ &
+                                     &    1.0_wp,0.0_wp,0.0_wp, &
+                                     &    0.0_wp,0.0_wp,1.0_wp, &
+                                     &    0.0_wp,-1.0_wp,0.0_wp &
+                                     &    ], [3,3])
+  real(wp),parameter :: Rx90T(3,3) = transpose(Rx90)
+
+  real(wp),parameter :: Ry90(3,3) = reshape([ &
+                                     &    0.0_wp,0.0_wp,-1.0_wp, &
+                                     &    0.0_wp,1.0_wp,0.0_wp,  &
+                                     &    1.0_wp,0.0_wp,0.0_wp   &
+                                     &    ], [3,3])
+  real(wp),parameter :: Ry90T(3,3) = transpose(Ry90)
+
+  real(wp),parameter :: Rz90(3,3) = reshape([ &
+                                     &    0.0_wp,1.0_wp,0.0_wp,  &
+                                     &   -1.0_wp,0.0_wp,0.0_wp,  &
+                                     &    0.0_wp,0.0_wp,1.0_wp   &
+                                     &    ], [3,3])
+  real(wp),parameter :: Rz90T(3,3) = transpose(Rz90)
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  subroutine allocate_rmsd_core_cache(self,nat,scratch)
+    implicit none
+    class(rmsd_core_cache),intent(inout) :: self
+    integer,intent(in) :: nat
+    logical,intent(in),optional :: scratch
+    if (allocated(self%x)) deallocate (self%x)
+    if (allocated(self%y)) deallocate (self%y)
+    if (allocated(self%xi)) deallocate (self%xi)
+    if (allocated(self%yi)) deallocate (self%yi)
+    allocate (self%xi(nat),source=0.0_wp)
+    allocate (self%yi(nat),source=0.0_wp)
+    allocate (self%x(3,nat),source=0.0_wp)
+    allocate (self%y(3,nat),source=0.0_wp)
+    if(present(scratch))then
+      if(scratch)then
+        if(allocated(self%xyzscratch)) deallocate(self%xyzscratch)
+        allocate(self%xyzscratch(3,nat,2),source=0.0_wp)
+      endif
+    endif
+  end subroutine allocate_rmsd_core_cache
+
+  subroutine allocate_rmsd_cache(self,nat)
+    implicit none
+    class(rmsd_cache),intent(inout) :: self
+    integer,intent(in) :: nat
+    if (allocated(self%xyzscratch)) deallocate (self%xyzscratch)
+    if (allocated(self%rank)) deallocate (self%rank)
+    if (allocated(self%best_order)) deallocate (self%best_order)
+    if (allocated(self%current_order)) deallocate (self%current_order)
+    if (allocated(self%target_order)) deallocate (self%target_order)
+    if (allocated(self%order_bkup)) deallocate (self%order_bkup)
+    if (allocated(self%iwork)) deallocate (self%iwork)
+    if (allocated(self%iwork2)) deallocate (self%iwork2)
+    if (allocated(self%assigned)) deallocate (self%assigned)
+    if (allocated(self%rassigned)) deallocate (self%rassigned)
+    if (allocated(self%lwork)) deallocate (self%lwork)
+    if (allocated(self%ngroup)) deallocate (self%ngroup)
+    if (allocated(self%proxy_topo_ref)) deallocate (self%proxy_topo_ref)
+    if (allocated(self%proxy_topo)) deallocate (self%proxy_topo)
+    if (allocated(self%ccache)) deallocate (self%ccache)
+    if (allocated(self%acache)) deallocate (self%acache)
+    allocate (self%assigned(nat),source=.false.)
+    allocate (self%rassigned(nat),source=.false.)
+    allocate (self%best_order(nat,3),source=0)
+    allocate (self%current_order(nat),source=0)
+    allocate (self%target_order(nat),source=0)
+    allocate (self%order_bkup(nat,32),source=0)
+    allocate (self%iwork(nat),source=0)
+    allocate (self%iwork2(nat,2),source=0)
+    allocate (self%rank(nat,2),source=0)
+    self%nranks = 0
+    allocate (self%ngroup(nat),source=0)
+    allocate (self%proxy_topo(nat,2),source=0)
+    allocate (self%proxy_topo_ref(nat,2),source=0)
+    allocate (self%xyzscratch(3,nat,2),source=0.0_wp)
+    allocate (self%ccache)
+    allocate (self%acache)
+    call self%ccache%allocate(nat)
+    call self%acache%allocate(nat,nat,.true.) !> assume we are only using the LSAP implementation
+  end subroutine allocate_rmsd_cache
+
+  subroutine initialize_rmsd_cache(self,nat)
+    implicit none
+    class(rmsd_cache) :: self
+    integer,intent(in) :: nat
+
+    if (.not.self%initialized) then
+      call self%allocate(nat)
+      self%initialized = .true.
+    else if (size(self%xyzscratch,2) .ne. nat) then
+      call self%allocate(nat)
+      self%initialized = .true.
+    end if
+  end subroutine initialize_rmsd_cache
+
+!========================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!========================================================================================!
+
+  function rmsd(ref,mol,mask,scratch,rotmat,gradient,ccache) result(rmsdval)
+    !************************************************************************
+    !* function rmsd
+    !* Calculate the molecular RMSD via a quaternion algorithm
+    !*
+    !* Optional arguments are
+    !*   mask - boolean array to select a substructure for RMSD calculation
+    !*   scratch - workspace to create the substructures
+    !*   rotmat  - rotation matrix as return argument
+    !*   gradient - Cartesian gradient of the RMSD
+    !************************************************************************
+    implicit none
+    real(wp) :: rmsdval
+    type(coord),intent(in) :: ref
+    type(coord),intent(in) :: mol
+    !> OPTIONAL arguments
+    logical,intent(in),optional :: mask(ref%nat)
+    real(wp),intent(inout),target,optional :: scratch(3,ref%nat,2)
+    real(wp),intent(out),optional :: rotmat(3,3)
+    real(wp),intent(out),target,optional :: gradient(3,ref%nat)
+    type(rmsd_core_cache),intent(inout),optional,target :: ccache
+    !> variables
+    type(rmsd_core_cache),allocatable,target :: ccachetmp
+    type(rmsd_core_cache),pointer :: ccptr
+    real(wp) :: Udum(3,3)
+    real(wp),target :: gdum(3,3)
+    integer :: nat,getrotmat
+    logical :: calc_u
+    real(wp),allocatable,target :: tmpscratch(:,:,:)
+    logical :: getgrad
+    real(wp),pointer :: grdptr(:,:)
+    real(wp),pointer :: scratchptr(:,:,:)
+    integer :: ic,k
+
+    !> initialize to large value
+    rmsdval = bigval
+    !> check structure consistency
+    if (mol%nat .ne. ref%nat) return
+
+    !> get rotation matrix?
+    getrotmat = 0
+    calc_u = .false.
+    if (present(rotmat)) then
+      getrotmat = 1
+      calc_u = .true.
+    end if
+
+    !> get gradient?
+    if (present(gradient)) then
+      getgrad = .true.
+      gradient(:,:) = 0.0_wp
+      grdptr => gradient
+    else
+      getgrad = .false.
+      grdptr => gdum
+    end if
+
+    !> use present cache?
+    if (present(ccache)) then
+      ccptr => ccache
+    else
+      allocate (ccachetmp)
+      call ccachetmp%allocate(ref%nat)
+      ccptr => ccachetmp
+    end if
+
+!>--- substructure?
+    if (present(mask)) then
+      nat = count(mask(:))
+      !> scratch workspace to use?
+      if (present(scratch)) then
+        scratchptr => scratch
+      else if(allocated(ccptr%xyzscratch))then
+        scratchptr => ccptr%xyzscratch
+      else
+        allocate (tmpscratch(3,nat,2))
+        scratchptr => tmpscratch
+      end if
+
+      !> do the mapping
+      k = 0
+      do ic = 1,ref%nat
+        if (mask(ic)) then
+          k = k+1
+          scratchptr(1:3,k,1) = mol%xyz(1:3,ic)
+          scratchptr(1:3,k,2) = ref%xyz(1:3,ic)
+        end if
+      end do
+
+      !> calculate
+      call rmsd_core(nat,scratchptr(1:3,1:nat,1),scratchptr(1:3,1:nat,2), &
+      &          calc_u,Udum,rmsdval,getgrad,grdptr(1:3,:),ccptr)
+
+      !> go backwards through gradient (if necessary) to restore atom order
+      if (getgrad) then
+        k = nat
+        do ic = nat,1,-1
+          if (mask(ic)) then
+            grdptr(1:3,ic) = grdptr(1:3,k)
+            grdptr(1:3,k) = 0.0_wp
+            k = k-1
+          end if
+        end do
+      end if
+
+      nullify (scratchptr)
+      if (allocated(tmpscratch)) deallocate (tmpscratch)
+
+    else
+!>--- standard calculation (quaternion algorithm, no mask)
+      call rmsd_core(ref%nat,mol%xyz,ref%xyz, &
+      &          calc_u,Udum,rmsdval,getgrad,grdptr(1:3,:),ccptr)
+    end if
+
+    !> pass on rotation matrix if asked for
+    if (calc_u) rotmat = Udum
+
+  end function rmsd
+
+!========================================================================================!
+
+  subroutine rmsd_core(nat,xyz1,xyz2,calc_u,U,error,calc_g,grad,ccache)
+    !**********************************************************
+    !* Rewrite or RMSD code with modified memory management
+    !* Adapted from ls_rmsd, and using some of its subroutines
+    !* The goal is to offload memory allocation to outside
+    !* the routine in case it is repeadetly called
+    !**********************************************************
+    use ls_rmsd,only:dstmev,rotation_matrix
+    implicit none
+    integer,intent(in) :: nat
+    real(wp),intent(in) :: xyz1(3,nat)
+    real(wp),intent(in) :: xyz2(3,nat)
+    logical,intent(in) :: calc_u
+    real(wp),dimension(3,3),intent(out) :: U
+    real(wp),intent(out) :: error
+    logical,intent(in) :: calc_g
+    real(wp),intent(inout) :: grad(:,:)
+    type(rmsd_core_cache),intent(inout) :: ccache
+
+    !> LOCAL
+    integer :: i,j
+    real(wp) :: x_center(3)
+    real(wp) :: y_center(3)
+    real(wp) :: x_norm,y_norm,lambda
+    real(wp) :: Rmatrix(3,3)
+    real(wp) :: S(4,4)
+    real(wp) :: q(4)
+    real(wp) :: tmp(3),rnat
+    integer :: io
+
+    !> associate
+    associate (x => ccache%x,y => ccache%y,xi => ccache%xi,yi => ccache%yi)
+
+      !> make copies of the original coordinates
+      x(1:3,1:nat) = xyz1(1:3,1:nat)
+      y(1:3,1:nat) = xyz2(1:3,1:nat)
+
+      !> calculate the barycenters, centroidal coordinates, and the norms
+      x_norm = 0.0_wp
+      y_norm = 0.0_wp
+      rnat = 1.0_wp/real(nat,wp)
+      do i = 1,3
+        xi(:nat) = x(i,1:nat)
+        yi(:nat) = y(i,1:nat)
+        x_center(i) = sum(xi(1:nat))*rnat
+        y_center(i) = sum(yi(1:nat))*rnat
+        xi(1:nat) = xi(1:nat)-x_center(i)
+        yi(1:nat) = yi(1:nat)-y_center(i)
+        x(i,1:nat) = xi(1:nat)
+        y(i,1:nat) = yi(1:nat)
+        x_norm = x_norm+dot_product(xi,xi)
+        y_norm = y_norm+dot_product(yi,yi)
+      end do
+
+      !> calculate the R matrix
+      do i = 1,3
+        do j = 1,3
+          Rmatrix(i,j) = dot_product(x(i,1:nat),y(j,1:nat))
+        end do
+      end do
+
+      !> S matrix
+      S(1,1) = Rmatrix(1,1)+Rmatrix(2,2)+Rmatrix(3,3)
+      S(2,1) = Rmatrix(2,3)-Rmatrix(3,2)
+      S(3,1) = Rmatrix(3,1)-Rmatrix(1,3)
+      S(4,1) = Rmatrix(1,2)-Rmatrix(2,1)
+
+      S(1,2) = S(2,1)
+      S(2,2) = Rmatrix(1,1)-Rmatrix(2,2)-Rmatrix(3,3)
+      S(3,2) = Rmatrix(1,2)+Rmatrix(2,1)
+      S(4,2) = Rmatrix(1,3)+Rmatrix(3,1)
+
+      S(1,3) = S(3,1)
+      S(2,3) = S(3,2)
+      S(3,3) = -Rmatrix(1,1)+Rmatrix(2,2)-Rmatrix(3,3)
+      S(4,3) = Rmatrix(2,3)+Rmatrix(3,2)
+
+      S(1,4) = S(4,1)
+      S(2,4) = S(4,2)
+      S(3,4) = S(4,3)
+      S(4,4) = -Rmatrix(1,1)-Rmatrix(2,2)+Rmatrix(3,3)
+
+      !> Calculate eigenvalues and eigenvectors, and
+      !> take the maximum eigenvalue lambda and the corresponding eigenvector q.
+      call dstmev(S,lambda,q,io)
+      if (io /= 0) then
+        error = -1.0_wp
+        return
+      end if
+
+      if (calc_u.or.calc_g) then
+        !> reset
+        U(:,:) = Imat(:,:)
+        !> convert quaternion q to rotation matrix U
+        call rotation_matrix(q,U)
+      end if
+
+      !> RMS Deviation
+      error = sqrt(max(0.0_wp, ((x_norm+y_norm)-2.0_wp*lambda))*rnat)
+
+      if (calc_g) then
+        !> Gradient of the error of xyz1 w.r.t xyz2
+        do i = 1,nat
+          do j = 1,3
+            tmp(:) = matmul(transpose(U(:,:)),y(:,i))
+            grad(j,i) = ((x(j,i)-tmp(j))/error)*rnat
+          end do
+        end do
+      end if
+
+    end associate
+  end subroutine rmsd_core
+
+!========================================================================================!
+  subroutine rmsd_align(ref,mol,mask)
+    !********************************************************
+    !* Routine to align the structure "mol"
+    !* to a reference structure "ref"
+    !* via the quternion RMSD
+    !*  Input:
+    !*     ref - reference structure
+    !*    mask - (optional) only consider specific atoms
+    !*  In/Output:
+    !*     mol - structure to have it's coordinates aligned
+    !********************************************************
+
+    implicit none
+    type(coord),intent(in) :: ref
+    type(coord),intent(inout) :: mol
+    logical,intent(in),optional :: mask(:)
+
+    real(wp) :: Umat(3,3),tmp
+    real(wp) :: cref(3),cmol(3),shift(3)
+    integer :: ii,jj,nn
+
+    !> barycenter shift
+    cref(:) = 0.0_wp
+    cmol(:) = 0.0_wp
+    shift(:) = 0.0_wp
+    do ii = 1,ref%nat
+      if (present(mask)) then
+        if (mask(ii)) then
+          cref(:) = cref(:)+ref%xyz(:,ii)
+          cmol(:) = cmol(:)+mol%xyz(:,ii)
+        end if
+      else
+        cref(:) = cref(:)+ref%xyz(:,ii)
+        cmol(:) = cmol(:)+mol%xyz(:,ii)
+      end if
+    end do
+    nn = ref%nat
+    if (present(mask)) nn = count(mask)
+    shift = cref-cmol
+    shift = shift/nn
+    do ii = 1,mol%nat
+      mol%xyz(:,ii) = mol%xyz(:,ii)+shift(:)
+    end do
+
+    Umat(:,:) = 0.0_wp
+    tmp = rmsd(ref,mol,mask=mask,rotmat=Umat)
+
+    mol%xyz = matmul(Umat,mol%xyz)
+
+  end subroutine rmsd_align
+
+!========================================================================================!
+
+  subroutine min_rmsd(ref,mol,rcache,rmsdout,align,topocheck,io)
+    !****************************************************************************
+    !* Main routine to determine minium RMSD considering atom permutation
+    !* Input
+    !*   ref  - the reference structure
+    !*   mol  - the structure to be matched to ref
+    !* Optinal arguments
+    !*   rcache    - memory cache
+    !*   rmsdout   - the calculated RMSD scalar
+    !*   align     - quarternion-align mol in the last stage
+    !*   topocheck - check molecule topology? if absent, doing check is default
+    !*   io        - return status
+    !****************************************************************************
+    implicit none
+    !> IN & OUTPUT
+    type(coord),intent(in) :: ref
+    type(coord),intent(inout) :: mol
+    type(rmsd_cache),intent(inout),optional,target :: rcache
+    real(wp),intent(out),optional :: rmsdout
+    logical,intent(in),optional :: align
+    logical,intent(in),optional :: topocheck
+    integer,intent(out),optional :: io
+
+    !> LOCAL
+    type(rmsd_cache),pointer :: cptr
+    type(rmsd_cache),allocatable,target :: local_rcache
+    integer :: nat,ii,rnk,dumpunit,uniquenesscase,ioloc
+    integer :: nunique
+    real(wp) :: calc_rmsd
+    real(wp) :: tmprmsd_sym(32)
+    real(wp) :: rotmat(3,3),rotconst(3),shift(3)
+    logical :: topocheck_l = .true.
+    logical,parameter :: debug = .false.
+
+!>--- defaults
+    ioloc = 0
+
+!>--- Initialization
+    if (present(rcache)) then
+      cptr => rcache
+    else
+      write (stdout,*) "WARNING: No iRMSD-cache provided. Attempting to fall back to atom types for sorting ranks."
+      allocate (local_rcache)
+      if (ref%nat .ne. mol%nat) then
+        error stop 'Unequal molecule size in min_rmsd()'
+      end if
+      nat = max(ref%nat,mol%nat)
+      call local_rcache%allocate(nat)
+      call fallbackranks(ref,mol,nat,local_rcache%rank)
+      cptr => local_rcache
+    end if
+    if (present(topocheck)) then
+      topocheck_l = topocheck
+    end if
+    cptr%nranks = maxval(cptr%rank(:,1))
+
+!>-- Consistency (topology) check
+    if (topocheck_l) then
+      ioloc = cptr%check_proxy_topo(ref,mol)
+      if (ioloc > 0) then
+        write (stdout,'(1x,a)') "WARNING: Different atom topologies detected in min_rmsd(), can't restore an atom order!"
+        if (present(rmsdout)) then
+          if (ioloc > 2) then !> topo check identified at least the same system size and maxrank --> quaternion RMSD may be feasible
+            write (stdout,'(10x,a)') "Falling back to quaternion RMSD without reordering atoms. Values may be nonsensical."
+            rmsdout = rmsd(ref,mol,ccache=cptr%ccache)
+          else
+            rmsdout = huge(rmsdout)
+          end if
+        end if
+        if (present(io)) io = ioloc
+        return
+      end if
+    end if
+
+!>--- First sorting, to at least restore rank order (only if that's not the case!)
+    if (.not.all(cptr%rank(:,1) .eq. cptr%rank(:,2))) then
+      call rank_2_order(ref%nat,cptr%rank(:,1),cptr%target_order)
+      call rank_2_order(mol%nat,cptr%rank(:,2),cptr%current_order)
+      if (debug) then
+        write (*,*) 'current order & rank & target order'
+        do ii = 1,mol%nat
+          write (*,*) cptr%current_order(ii),cptr%rank(ii,2),cptr%target_order(ii)
+        end do
+      end if
+      call molatomsort(mol,mol%nat,cptr%current_order,cptr%target_order,cptr%iwork)
+      cptr%rank(:,2) = cptr%rank(:,1) !> since the ranks must be equal now!
+      if (debug) then
+        write (*,*) 'sorted order & rank'
+        do ii = 1,mol%nat
+          write (*,*) cptr%current_order(ii),cptr%rank(ii,2)
+        end do
+      end if
+    end if
+
+!>--- Count symmetry equivalent groups and assign all unique atoms immediately
+!     Note, the rank can be zero if we only are looking at heavy atoms
+    if (all(cptr%ngroup(:) .eq. 0)) then
+      do ii = 1,ref%nat
+        rnk = cptr%rank(ii,1)
+        if (rnk > 0) then
+          cptr%ngroup(rnk) = cptr%ngroup(rnk)+1
+        end if
+      end do
+    end if
+    !> assignment reset
+    cptr%assigned(:) = .false.
+    cptr%rassigned(:) = .false.
+    cptr%rassigned(cptr%nranks+1:) = .true. !> skip unneeded allocation space
+    do ii = 1,ref%nat
+      cptr%iwork(ii) = ii         !> also init iwork
+      cptr%target_order(ii) = ii  !> also init target_order
+      rnk = cptr%rank(ii,2)
+      if (rnk < 1) then
+        cptr%assigned(ii) = .true.
+        cycle
+      end if
+      if (cptr%ngroup(rnk) .eq. 1) then
+        cptr%assigned(ii) = .true.
+        cptr%rassigned(rnk) = .true.
+      end if
+    end do
+    if (debug) then
+      write (*,*) 'rank & # members'
+      do ii = 1,mol%nat
+        if (cptr%ngroup(ii) > 0) then
+          write (*,*) ii,cptr%ngroup(ii)
+        end if
+      end do
+    end if
+
+!>--- Perform the desired symmetry operations, align with rotational axis, run LSAP algo
+!>    Since the rotational axis alignment can be a bit arbitrary w.r.t 180° rotations
+!>    we need to check these as well.
+    if (debug) then
+      open (newunit=dumpunit,file='debugirmsd.xyz')
+      call ref%append(dumpunit)
+    end if
+
+!>--- Check how many indices are unique
+    cptr%lwork = unique_rank_mask(cptr%rank(:,1))
+    nunique = count(cptr%lwork)
+
+!> --------------------------------------------------------
+!> SUBSTRUCTURE-BASED ALIGNMENT with enough unique indices
+!> --------------------------------------------------------
+
+    !> The logic here is: if we have enough unique atoms
+    !> we can align the molecule with them and identify
+    !> symmetry equivalent atoms via LSAP in those thereafter
+    IF (nunique >= 3) then
+      !> mol still needs a first alignment and CMA shift
+      call CMAtrf(mol%nat,mol%nat,mol%at,mol%xyz)
+
+      tmprmsd_sym(:) = inf
+      tmprmsd_sym(1) = rmsd(ref,mol,cptr%lwork, &
+        &                   cptr%xyzscratch,rotmat=rotmat, &
+        &                   ccache=cptr%ccache)
+      mol%xyz = matmul(rotmat,mol%xyz)
+      call min_rmsd_iterate_through_groups(ref,mol,cptr,tmprmsd_sym(1))
+      cptr%order_bkup(:,1) = cptr%iwork(:)
+      if (cptr%stereocheck) then
+        mol%xyz(3,:) = -mol%xyz(3,:)
+
+        tmprmsd_sym(2) = rmsd(ref,mol,cptr%lwork, &
+          &                   cptr%xyzscratch,rotmat=rotmat, &
+          &                   ccache=cptr%ccache)
+        mol%xyz = matmul(rotmat,mol%xyz)
+        call min_rmsd_iterate_through_groups(ref,mol,cptr,tmprmsd_sym(2))
+        cptr%order_bkup(:,2) = cptr%iwork(:)
+        mol%xyz(3,:) = -mol%xyz(3,:)
+      end if
+
+      ii = minloc(tmprmsd_sym,1)
+      if (ii == 2) then
+        !> if the non-mirrored check was lower, revert the mirroring
+        mol%xyz(3,:) = -mol%xyz(3,:)
+      end if
+!> ----------------------------------------------------
+    ELSE
+!> ----------------------------------------------------
+!> ROTATIONAL AXIS ALIGNMENT AND LSAP CHECKS - START
+!> ----------------------------------------------------
+
+      !> initialize to huge
+      tmprmsd_sym(:) = inf
+      !> initial alignment of mol
+      call axis(mol%nat,mol%at,mol%xyz,rotconst)
+      call min_rmsd_rotcheck_unique(rotconst,uniquenesscase)
+
+      !> Running the checks and check of uniqueness of rotational axes
+      call min_rmsd_rotcheck_permute(ref,mol,cptr,tmprmsd_sym,1,uniquenesscase)
+      if (debug) then
+        write (*,*) 'Total LSAP cost:',minval(tmprmsd_sym(1:16))
+        call mol%append(dumpunit)
+      end if
+
+      !> mirror z and re-run the same checks (i.e. the false rotamer inversion)
+      if (cptr%stereocheck) then
+        mol%xyz(3,:) = -mol%xyz(3,:)  !> mirror z
+        call axis(mol%nat,mol%at,mol%xyz) !> align
+
+        !> Running the checks
+        call min_rmsd_rotcheck_permute(ref,mol,cptr,tmprmsd_sym,2,uniquenesscase)
+        if (debug) then
+          write (*,*) 'Total LSAP cost (inverted):',minval(tmprmsd_sym(17:32))
+          call mol%append(dumpunit)
+        end if
+        mol%xyz(3,:) = -mol%xyz(3,:)  !> restore z
+      end if
+
+!>--- select the best match among the ones after symmetry operations and use its ordering
+      ii = minloc(tmprmsd_sym(1:32),1)
+      if (debug) then
+        write (*,*) 'final alignment:',ii,"/ 32"
+      end if
+      if (ii > 16) then
+        mol%xyz(3,:) = -mol%xyz(3,:)
+        if (debug) write (*,*) 'inverting'
+      end if
+      if ((ii > 4.and.ii < 9).or.(ii > 20.and.ii < 25)) then
+        if (uniquenesscase == 1) mol%xyz = matmul(Rx90,mol%xyz)
+        if (uniquenesscase == 2) mol%xyz = matmul(Rz90,mol%xyz)
+        if (uniquenesscase == 3) mol%xyz = matmul(Rz90,mol%xyz)
+        if (debug) write (*,*) '90° tilt'
+      else if ((ii > 8.and.ii < 13).or.(ii > 24.and.ii < 29)) then
+        mol%xyz = matmul(Ry90,mol%xyz)
+      else if ((ii > 12.and.ii < 17).or.(ii > 28)) then
+        mol%xyz = matmul(Rx90,mol%xyz)
+      end if
+      select case (ii) !> 180° rotations
+      case (1,5,9,13,17,21,25,29)
+        continue
+      case (2,6,10,14,18,22,26,30)
+        mol%xyz = matmul(Rx180,mol%xyz)
+        if (debug) write (*,*) '180°x'
+      case (3,7,11,15,19,23,27,31)
+        mol%xyz = matmul(Rx180,mol%xyz)
+        mol%xyz = matmul(Ry180,mol%xyz)
+        if (debug) write (*,*) '180°x, 180°y'
+      case (4,8,12,16,20,24,28,32)
+        mol%xyz = matmul(Ry180,mol%xyz)
+        if (debug) write (*,*) '180°y'
+      end select
+!> ----------------------------------------------------
+!> rotational axis alignment and LSAP checks - END
+!> ----------------------------------------------------
+    END IF
+    cptr%current_order(:) = cptr%order_bkup(:,ii)
+!> ----------------------------------------------------
+
+    if (debug) then
+      write (*,*) 'Determined remapping'
+      do ii = 1,mol%nat
+        write (*,*) cptr%current_order(ii),'-->',cptr%target_order(ii)
+      end do
+    end if
+
+    call molatomsort(mol,mol%nat,cptr%current_order,cptr%target_order,cptr%iwork)
+    if (debug) then
+      call mol%append(dumpunit)
+      close (dumpunit)
+    end if
+
+!>--- final RMSD with fully restored atom order
+    if (present(align)) then
+      calc_rmsd = rmsd(ref,mol,scratch=cptr%xyzscratch,ccache=cptr%ccache,rotmat=rotmat)
+      if (align) then
+        mol%xyz = matmul(rotmat,mol%xyz)
+      end if
+    else
+      calc_rmsd = rmsd(ref,mol,scratch=cptr%xyzscratch,ccache=cptr%ccache)
+    end if
+
+    if (present(rmsdout)) rmsdout = calc_rmsd
+    if (present(io)) io = ioloc
+  end subroutine min_rmsd
+
+  function irmsd(ref,mol,rcache, &
+  & iinversion,align,topocheck,allcanon,io) result(rmsdval)
+!***************************************************************
+!* irmsd function
+!* Standalone implementation to compare two structures
+!* with the iRMSD method analog to the rmsd function
+!* the optional rcache will get allocated if it not already is.
+!*
+!* Externally supplied per-atom ranks (ref%id / mol%id, allocated only
+!* when a full valid set was provided) are used directly via
+!* setup_irmsd_ranks; otherwise the canonical ranking is recomputed.
+!***************************************************************
+    implicit none
+
+    type(coord),intent(inout) :: mol,ref
+    integer,intent(in),optional :: iinversion
+    type(rmsd_cache),intent(inout),optional,target :: rcache
+    logical,intent(in),optional :: align
+    logical,intent(in),optional :: topocheck
+    logical,intent(in),optional :: allcanon
+    integer,intent(out),optional :: io
+    real(wp) :: rmsdval
+    !> LOCAL
+    type(rmsd_cache),pointer :: cptr
+    type(rmsd_cache),allocatable,target :: local_rcache
+    logical :: align_l = .true.
+    logical :: topocheck_l = .true.
+    logical :: allcanon_l = .false.
+    integer :: io_l = 0
+    real(wp) ::tmpd(3),tmpdist
+    integer :: i,ich
+    logical :: mirror
+    logical,parameter :: debug = .false.
+
+    !> move ref to CMA and align rotational axes
+    call axis(ref%nat,ref%at,ref%xyz)
+
+    !> optional args
+    if (present(align)) align_l = align
+    if (present(topocheck)) topocheck_l = topocheck
+    if (present(allcanon)) allcanon_l = allcanon
+    if (present(rcache)) then
+      cptr => rcache
+    else
+      allocate (local_rcache)
+      cptr => local_rcache
+    end if
+    call cptr%initialize(ref%nat)
+    !call rcache%allocate(ref%nat)
+
+    !> determine the per-atom ranks (provided ids or recomputed) and the
+    !> false-enantiomer flag, then apply the inversion override
+    call setup_irmsd_ranks(ref,mol,cptr%rank,cptr%stereocheck,allcanon=allcanon_l)
+    if (present(iinversion)) then
+      select case (iinversion)
+      case (0)
+        mirror = .true.
+      case (1)
+        mirror = .true.
+        cptr%stereocheck = .true.
+      case (2)
+        mirror = .false.
+        cptr%stereocheck = .false.
+      end select
+    end if
+
+    call min_rmsd(ref,mol,rcache=cptr,rmsdout=rmsdval, &
+    &    align=align_l,topocheck=topocheck_l,io=io_l)
+
+    if (present(io)) io = io_l
+
+    return
+  end function irmsd
+
+!========================================================================================!
+
+  subroutine setup_irmsd_ranks(ref,mol,ranks,stereocheck,allcanon)
+!**************************************************************
+!* Determine the per-atom ranks used for iRMSD matching of the
+!* ref/mol pair, plus the false-enantiomer (stereocheck) flag.
+!*
+!* Externally supplied ranks (coord%id, allocated only when a full
+!* valid set was provided) are used directly; any side lacking them
+!* is canonicalized on the fly. If the resulting pair fails the
+!* consistency check, any side that came from provided ids is
+!* recomputed and the check repeated; if it still fails, the ranks
+!* fall back to atom types.
+!*
+!* ref,mol     : the two structures (may carry %id)
+!* ranks       : (out) (nat,2) ranks for ref (col 1) and mol (col 2)
+!* stereocheck : (out) .true. if false enantiomers should be considered
+!* allcanon    : (optional) if .true., skip canonical ranks entirely and
+!*               use atom types (legacy 'allcanon' behavior)
+!**************************************************************
+    use canonical_mod
+    implicit none
+    type(coord),intent(in) :: ref,mol
+    integer,intent(out) :: ranks(:,:)
+    logical,intent(out) :: stereocheck
+    logical,intent(in),optional :: allcanon
+    !> LOCAL
+    type(canonical_sorter) :: canref,canmol
+    integer,allocatable :: r1(:),r2(:)
+    logical :: allcanon_l,ref_provided,mol_provided,refstereo
+
+    allcanon_l = .false.
+    if (present(allcanon)) allcanon_l = allcanon
+
+    if (allcanon_l) then
+      call fallbackranks(ref,mol,ref%nat,ranks)
+      stereocheck = .false.
+      return
+    end if
+
+    ref_provided = allocated(ref%id)
+    mol_provided = allocated(mol%id)
+
+    !> reference ranks (and the stereo flag derived from them)
+    allocate (r1(ref%nat))
+    if (ref_provided) then
+      r1(:) = ref%id(:)
+      canref%rank = ref%id              !> seed ranks; hasstereo self-fills the graph
+      refstereo = canref%hasstereo(ref)
+      call canref%deallocate()
+    else
+      call canref%init(ref,invtype='apsp+',heavy=.false.)
+      r1(:) = canref%rank(:)
+      refstereo = canref%hasstereo(ref)
+      call canref%shrink()
+    end if
+
+    !> mobile ranks
+    allocate (r2(mol%nat))
+    if (mol_provided) then
+      r2(:) = mol%id(:)
+    else
+      call canmol%init(mol,invtype='apsp+',heavy=.false.)
+      r2(:) = canmol%rank(:)
+      call canmol%shrink()
+    end if
+
+    !> if provided ranks do not reconcile, recompute the provided side(s)
+    if (.not.checkranks(ref%nat,r1,r2).and. (ref_provided.or.mol_provided)) then
+      if (ref_provided) then
+        call canref%deallocate()
+        call canref%init(ref,invtype='apsp+',heavy=.false.)
+        r1(:) = canref%rank(:)
+        refstereo = canref%hasstereo(ref)
+        call canref%shrink()
+      end if
+      if (mol_provided) then
+        call canmol%deallocate()
+        call canmol%init(mol,invtype='apsp+',heavy=.false.)
+        r2(:) = canmol%rank(:)
+        call canmol%shrink()
+      end if
+    end if
+
+    !> use the (reconciled) ranks, else fall back to atom types
+    if (checkranks(ref%nat,r1,r2)) then
+      ranks(:,1) = r1(:)
+      ranks(:,2) = r2(:)
+    else
+      call fallbackranks(ref,mol,ref%nat,ranks)
+    end if
+    stereocheck = .not.refstereo
+
+    deallocate (r1,r2)
+  end subroutine setup_irmsd_ranks
+
+!========================================================================================!
+
+  subroutine min_rmsd_iterate_through_groups(ref,mol,rcache,val)
+    implicit none
+    type(coord),intent(in) :: ref
+    type(coord),intent(inout) :: mol
+    type(rmsd_cache),intent(inout),target :: rcache
+    real(wp),intent(out) :: val
+    integer :: rr,ii
+    real(wp) :: val0
+    type(assignment_cache),pointer :: aptr
+    logical,parameter :: debug = .false.
+
+    !> reset val
+    val = 0.0_wp
+
+    if (debug) then
+      write (*,*) '# ranks:',rcache%nranks
+    end if
+    aptr => rcache%acache
+    do rr = 1,rcache%nranks
+      if (rcache%rassigned(rr)) cycle
+
+      !> LSAP wrapper that computes the relevant Cost matrix for the atoms of rank rr
+      call compute_linear_sum_assignment( &
+      &        ref,mol,rcache%rank,rcache%ngroup,rr, &
+      &        rcache%iwork2,aptr,val0)
+
+      do ii = 1,rcache%ngroup(rr)
+        rcache%iwork(rcache%iwork2(ii,1)) = rcache%iwork2(ii,2)
+      end do
+
+      !> add up the total LSAP cost (of considered ranks)
+      !> we need this if we have to decide on a mapping in case of false enantiomers
+      val = val+val0
+    end do
+
+  end subroutine min_rmsd_iterate_through_groups
+
+!========================================================================================!
+
+  subroutine min_rmsd_rotcheck_unique(rot,uniquenesscase,thr)
+    !*******************************************************
+    !* Based on the rotational constants, determine what we
+    !* need to do with the molecule in the following
+    !*******************************************************
+    implicit none
+    real(wp),intent(in) :: rot(3)
+    integer,intent(out) :: uniquenesscase
+    real(wp),intent(in),optional :: thr
+    logical :: unique(3)
+    integer :: nunique
+
+    uniquenesscase = 0
+    call uniqueax(rot,unique,thr)
+
+    nunique = count(unique,1)
+    select case (nunique)
+    case (3) !> 3 unique principal axes
+      uniquenesscase = 0
+    case (1) !> one unique principal axis
+      if (unique(1)) uniquenesscase = 1 !> A unique (long axis)
+      if (unique(3)) uniquenesscase = 2 !> C unique (short axis)
+    case (0) !> rotationally ambiguous system
+      uniquenesscase = 3
+    end select
+  end subroutine min_rmsd_rotcheck_unique
+
+!=======================================================================================!
+
+  subroutine min_rmsd_rotcheck_permute(ref,mol,cptr,values,step,uniquenesscase)
+    implicit none
+    type(coord),intent(in) :: ref
+    type(coord),intent(inout) :: mol
+    type(rmsd_cache),intent(inout),target :: cptr
+    real(wp),intent(inout) :: values(:)
+    integer,intent(in) :: step,uniquenesscase
+    integer :: ii,debugunit2
+    real(wp) :: vals(16),dum
+    logical,parameter :: debug = .false.
+
+    !> reset val
+    vals(:) = inf
+
+    if (debug) then
+      open (newunit=debugunit2,file='rotdebug.xyz')
+      call ref%append(debugunit2)
+    end if
+
+    ALIGNLOOP: do ii = 1,4
+      call min_rmsd_iterate_through_groups(ref,mol,cptr,dum)
+      vals(1+4*(ii-1)) = dum
+      if (debug) call mol%append(debugunit2)
+      cptr%order_bkup(:,1+4*(ii-1)+16*(step-1)) = cptr%iwork(:)
+
+      mol%xyz = matmul(Rx180,mol%xyz)
+      call min_rmsd_iterate_through_groups(ref,mol,cptr,dum)
+      vals(2+4*(ii-1)) = dum
+      if (debug) call mol%append(debugunit2)
+      cptr%order_bkup(:,2+4*(ii-1)+16*(step-1)) = cptr%iwork(:)
+
+      mol%xyz = matmul(Ry180,mol%xyz)
+      call min_rmsd_iterate_through_groups(ref,mol,cptr,dum)
+      vals(3+4*(ii-1)) = dum
+      if (debug) call mol%append(debugunit2)
+      cptr%order_bkup(:,3+4*(ii-1)+16*(step-1)) = cptr%iwork(:)
+
+      mol%xyz = matmul(Rx180,mol%xyz)
+      call min_rmsd_iterate_through_groups(ref,mol,cptr,dum)
+      vals(4+4*(ii-1)) = dum
+      if (debug) call mol%append(debugunit2)
+      cptr%order_bkup(:,4+4*(ii-1)+16*(step-1)) = cptr%iwork(:)
+
+      mol%xyz = matmul(Ry180,mol%xyz) !> restore
+
+      !exit ALIGNLOOP
+      select case (uniquenesscase)
+      case (0) !> 3 Unique moments of inertia
+        exit ALIGNLOOP
+      case (1) !> only one unique moment of inertia (A)
+        if (ii == 2) then
+          mol%xyz = matmul(Rx90T,mol%xyz)
+          exit ALIGNLOOP
+        end if
+        mol%xyz = matmul(Rx90,mol%xyz)
+      case (2) !> only one unique moment of inertia (C)
+        if (ii == 2) then
+          mol%xyz = matmul(Rz90T,mol%xyz)
+          exit ALIGNLOOP
+        end if
+        mol%xyz = matmul(Rz90,mol%xyz)
+      case (3)
+        if (ii == 1) then
+          mol%xyz = matmul(Rz90,mol%xyz)
+        else if (ii == 2) then
+          mol%xyz = matmul(Rz90T,mol%xyz)
+          mol%xyz = matmul(Ry90,mol%xyz)
+        else if (ii == 3) then
+          mol%xyz = matmul(Ry90T,mol%xyz)
+          mol%xyz = matmul(Rx90,mol%xyz)
+        else
+          mol%xyz = matmul(Rx90T,mol%xyz)
+          exit ALIGNLOOP
+        end if
+      end select
+
+    end do ALIGNLOOP
+
+    if (debug) then
+      close (debugunit2)
+      write (*,*) 'vals:',vals(:)
+    end if
+
+    do ii = 1,16
+      values(ii+16*(step-1)) = vals(ii)
+    end do
+  end subroutine min_rmsd_rotcheck_permute
+
+!========================================================================================!
+
+  subroutine fallbackranks(ref,mol,nat,ranks)
+    !*****************************************************************
+    !* If we are doing ranks on-the-fly (i.e. without canonical algo)
+    !* we can fall back to just using the atom types
+    !*****************************************************************
+    implicit none
+    type(coord),intent(in) :: ref,mol
+    integer,intent(in) :: nat
+    integer,intent(inout) :: ranks(nat,2)
+
+    integer,allocatable :: typemap(:),rtypemap(:)
+    integer :: k,ii
+    allocate (typemap(nat),source=0)
+    k = 0
+    do ii = 1,ref%nat
+      if (.not.any(typemap(:) .eq. ref%at(ii))) then
+        k = k+1
+        typemap(k) = ref%at(ii)
+      end if
+    end do
+    do ii = 1,mol%nat
+      if (.not.any(typemap(:) .eq. mol%at(ii))) then
+        k = k+1
+        typemap(k) = mol%at(ii)
+      end if
+    end do
+    k = maxval(typemap(:))
+    allocate (rtypemap(k),source=0)
+    do ii = 1,nat
+      if (typemap(ii) == 0) cycle
+      rtypemap(typemap(ii)) = ii
+    end do
+    !> assign
+    do ii = 1,ref%nat
+      ranks(ii,1) = rtypemap(ref%at(ii))
+    end do
+    do ii = 1,mol%nat
+      ranks(ii,2) = rtypemap(mol%at(ii))
+    end do
+    deallocate (rtypemap)
+    deallocate (typemap)
+  end subroutine fallbackranks
+
+!========================================================================================!
+
+  subroutine compute_linear_sum_assignment(ref,mol,ranks, &
+                        & ngroups,targetrank,iwork2,acache,val0)
+    !**************************************************************
+    !* Run the linear assignment algorithm on the desired subset
+    !* of atoms (via rank and targetrank)
+    !**************************************************************
+    implicit none
+    !> IN & OUTPUT
+    type(coord),intent(in) :: ref
+    type(coord),intent(inout) :: mol
+    integer,intent(in) :: ranks(:,:)
+    integer,intent(in) :: ngroups(:)
+    integer,intent(in) :: targetrank
+    integer,intent(inout) :: iwork2(:,:)
+    type(assignment_cache),intent(inout),optional,target :: acache
+    real(wp),intent(out) :: val0
+
+    !> LOCAL
+    type(assignment_cache),pointer :: aptr
+    type(assignment_cache),allocatable,target :: local_acache
+    integer :: nat,i,j,ii,jj,rnknat,iostatus
+    real(sp) :: dists(3)
+
+    logical,parameter :: debug = .false.
+
+    val0 = 0.0_wp
+
+    if (present(acache)) then
+      aptr => acache
+    else
+      allocate (local_acache)
+      if (ref%nat .ne. mol%nat) then
+        error stop 'Unequal molecule size in compute_linear_sum_assignment()'
+      end if
+      nat = max(ref%nat,mol%nat)
+      call local_acache%allocate(nat,nat,.true.)
+      aptr => local_acache
+    end if
+
+    !> Compute the cost matrix, which is simply the distance matrix
+    !> between the two molecules.
+    !> To avoid computational overhead we can skip the square root.
+    !> It won't affect the result
+    !> Also, since aptr%Cost is a flattened matrix, we only fill
+    !> the first rnknat**2 entries
+    rnknat = ngroups(targetrank)
+    ii = 0
+    do i = 1,ref%nat
+      if (ranks(i,1) .ne. targetrank) cycle
+      ii = ii+1
+      iwork2(ii,1) = i !> mapping using the first column of iwork2
+      jj = 0
+      do j = 1,mol%nat
+        if (ranks(j,2) .ne. targetrank) cycle
+        jj = jj+1
+        dists(:) = real((ref%xyz(:,i)-mol%xyz(:,j))**2,sp) !> use i and j
+        aptr%Cost(jj+(ii-1)*rnknat) = sum(dists)
+      end do
+    end do
+
+    if (debug) then
+      write (*,*) 'target rank',targetrank,'# atoms',rnknat
+    end if
+
+    call lsap(aptr,rnknat,rnknat,.false.,iostatus)
+
+    !> paasing back the determined order as second column of iwork2
+    if (iostatus == 0) then
+      if (debug) then
+        do i = 1,rnknat
+          write (*,*) iwork2(aptr%a(i),1),'-->',iwork2(aptr%b(i),1)
+        end do
+      end if
+      do i = 1,rnknat
+        jj = aptr%a(i)
+        ii = aptr%b(i)
+        if (ii == -1.or.jj == -1) cycle  !> cycle bad assignments
+        val0 = val0+aptr%Cost(jj+(ii-1)*rnknat)
+        iwork2(i,2) = iwork2(aptr%b(i),1)
+      end do
+    else
+      !> in the unlikely case we have a failure of the LSAP
+      !> we do just a 1:1 mapping, just so that the algo doesn't crash
+      iwork2(1:rnknat,2) = iwork2(1:rnknat,1)
+    end if
+
+  end subroutine compute_linear_sum_assignment
+
+!========================================================================================!
+
+  subroutine rank_2_order(nat,rank,order)
+    implicit none
+    integer,intent(in) :: nat
+    integer,intent(in) :: rank(nat)
+    integer,intent(out) :: order(nat)
+    integer :: ii,jj,k,maxrank
+    order(:) = 0
+    maxrank = maxval(rank(:))
+    k = 0
+    do ii = 1,maxrank
+      do jj = 1,nat
+        if (rank(jj) == ii) then
+          k = k+1
+          order(jj) = k
+        end if
+      end do
+    end do
+  end subroutine rank_2_order
+
+!========================================================================================!
+
+  function checkranks(nat,ranks1,ranks2) result(yesno)
+    !***********************************************************************
+    !* Check two rank arrays to see if we have the same amount of
+    !* atoms in the same ranks (a condition to bein able to work with them)
+    !***********************************************************************
+    implicit none
+    logical :: yesno
+    integer,intent(in) :: nat
+    integer,intent(in) :: ranks1(nat)
+    integer,intent(in) :: ranks2(nat)
+    integer :: ii,jj,maxrank1,maxrank2
+    integer :: count1,count2
+    yesno = .false.
+
+    maxrank1 = maxval(ranks1)
+    maxrank2 = maxval(ranks2)
+    !> different maxranks, so we can't have the same and return
+    if (maxrank1 .ne. maxrank2) return
+
+    do ii = 1,maxrank1
+      count1 = 0
+      count2 = 0
+      do jj = 1,nat
+        if (ranks1(jj) .eq. ii) count1 = count1+1
+        if (ranks2(jj) .eq. ii) count2 = count2+1
+      end do
+      !> not the same amount of atoms in rank ii, return from function
+      if (count1 .ne. count2) return
+    end do
+
+    !> if we reach this point we can assume the given ranks are o.k.
+    yesno = .true.
+  end function checkranks
+
+!========================================================================================!
+  function unique_rank_mask(ranks) result(mask)
+    !*********************************************
+    !* Takes a rank array and creates a mask that
+    !* contains .true. if the respective rank
+    !* appears only a single time
+    !*********************************************
+    implicit none
+    integer,intent(in) :: ranks(:)
+    logical,allocatable :: mask(:)
+    integer :: ii,jj,n,k,rii
+    n = size(ranks,1)
+    allocate (mask(n),source=.false.)
+    do ii = 1,n
+      rii = ranks(ii)
+      k = count(ranks == rii)
+      if (k == 1) mask(ii) = .true.
+    end do
+  end function unique_rank_mask
+
+!========================================================================================!
+
+  subroutine molatomsort(mol,n,current_order,target_order,index_map)
+    implicit none
+    type(coord),intent(inout) :: mol
+    integer,intent(in) :: n
+    integer,intent(inout) :: current_order(n)
+    integer,intent(in) :: target_order(n)
+    integer,intent(inout) :: index_map(n)
+    integer :: i,j,correct_atom,current_position
+
+    !> Step 1: Create a mapping from target_order to current_order positions
+    do i = 1,n
+      index_map(current_order(i)) = i
+    end do
+
+    !> Step 2: Restore the target order
+    do i = 1,n
+      correct_atom = target_order(i)
+      current_position = index_map(correct_atom)
+
+      if (i /= current_position) then
+        !> Swap atoms i and current_position in molecule
+        call mol%swap(i,current_position)
+
+        !> Update the index map since the atoms have been swapped
+        index_map(current_order(i)) = current_position
+        index_map(current_order(current_position)) = i
+
+        !> Update the current_order array to reflect the swap
+        j = current_order(i)
+        current_order(i) = current_order(current_position)
+        current_order(current_position) = j
+      end if
+    end do
+  end subroutine molatomsort
+
+!==========================================================================================!
+
+  function check_proxy_topo(self,ref,mol) result(io)
+    !******************************************************
+    !* Attempt to compare the "topology" for the molecules ref and mol
+    !* Assumes that ranks have been computed already.
+    !* Checks are in order (cheap to expensive):
+    !*   1) system size
+    !*   2) max rank
+    !*   3) joint sorted ranks and atom types
+    !* Returns "io" with value 0 if successfull, or a number indatinc faliure condition
+    implicit none
+    class(rmsd_cache) :: self
+    type(coord),intent(in) :: ref
+    type(coord),intent(in) :: mol
+    integer :: io
+    integer :: n1,n2,m1,m2
+
+    io = 0
+
+    !> Check 1
+    n1 = ref%nat
+    n2 = mol%nat
+    if (n1 .ne. n2) then
+      io = 1
+      return
+    end if
+
+    !> Check 2
+    m1 = maxval(self%rank(:,1))
+    m2 = maxval(self%rank(:,2))
+    if (m1 .ne. m2) then
+      io = 2; return
+    end if
+
+    !> Check 3
+    self%proxy_topo_ref(:,1) = ref%at(:)
+    self%proxy_topo_ref(:,2) = self%rank(:,1)
+    call qsortm(self%proxy_topo_ref,2,self%iwork)
+
+    self%proxy_topo(:,1) = mol%at(:)
+    self%proxy_topo(:,2) = self%rank(:,2)
+    call qsortm(self%proxy_topo,2,self%iwork)
+    if (.not.all(self%proxy_topo .eq. self%proxy_topo_ref)) then
+      io = 3
+      return !> some difference in the sorting, return before setting passing to true
+    end if
+
+    !> All checks passed, io should still be 0
+  end function check_proxy_topo
+
+  recursive subroutine qsorti(v,ix,l,r)
+    !*********************
+    !* idx'ed quicksort
+    !*********************
+    integer,intent(in) :: v(:)
+    integer,intent(inout) :: ix(:)
+    integer,intent(in) :: l,r
+    integer :: i,j,p,t,n
+    if (l >= r) return
+    p = v(ix((l+r)/2))
+    n = size(v,1)
+    i = l; j = r
+    do
+      do while (v(ix(i)) < p); i = i+1; end do
+      do while (v(ix(j)) > p); j = j-1; end do
+      if (i <= j) then
+        t = ix(i); ix(i) = ix(j); ix(j) = t
+        i = min(i+1,n); j = max(j-1,1)
+      else
+        exit
+      end if
+    end do
+    if (l < j) call qsorti(v,ix,l,j)
+    if (i < r) call qsorti(v,ix,i,r)
+  end subroutine qsorti
+
+  subroutine qsortm(a,k,ix)
+    !************************************
+    !* matrix wrapper to qsorti
+    !* order is reflected to all columns
+    !************************************
+    integer,intent(inout) :: a(:,:)
+    integer,intent(in) :: k
+    integer :: n,i
+    integer,intent(inout) :: ix(size(a,1))
+    n = size(a,1)
+    do i = 1,n
+      ix(i) = i
+    end do
+    call qsorti(a(:,k),ix,1,n)
+    a = a(ix,:)
+  end subroutine qsortm
+
+!========================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!========================================================================================!
+end module irmsd_module
diff --git a/src/ls_rmsd.f90 b/src/sorting/ls_rmsd.f90
similarity index 99%
rename from src/ls_rmsd.f90
rename to src/sorting/ls_rmsd.f90
index 54bedcc6..25585e10 100644
--- a/src/ls_rmsd.f90
+++ b/src/sorting/ls_rmsd.f90
@@ -95,7 +95,7 @@ subroutine rmsd(n,coord1,coord2,option,U,x_center,y_center, &
     real(dp),dimension(3,3) :: Rmatrix
     real(dp),dimension(4,4) :: S
     real(dp),dimension(4) :: q
-    real(dp) :: tmp(3)
+    real(dp) :: tmp(3),ndble
     integer :: io
 
     ! make copies of the original coordinates
@@ -105,11 +105,12 @@ subroutine rmsd(n,coord1,coord2,option,U,x_center,y_center, &
     ! calculate the barycenters, centroidal coordinates, and the norms
     x_norm = 0.0_dp
     y_norm = 0.0_dp
+    ndble = 1.0_dp / dble(n) 
     do i = 1,3
       xi(:) = x(i,:)
       yi(:) = y(i,:)
-      x_center(i) = sum(xi(1:n)) / dble(n)
-      y_center(i) = sum(yi(1:n)) / dble(n)
+      x_center(i) = sum(xi(1:n)) * ndble
+      y_center(i) = sum(yi(1:n)) * ndble
       xi(:) = xi(:) - x_center(i)
       yi(:) = yi(:) - y_center(i)
       x(i,:) = xi(:)
diff --git a/src/sorting/meson.build b/src/sorting/meson.build
new file mode 100644
index 00000000..8640db2d
--- /dev/null
+++ b/src/sorting/meson.build
@@ -0,0 +1,34 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+#
+# crest is free software: you can redistribute it and/or modify it under
+# the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# crest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with crest.  If not, see <https://www.gnu.org/licenses/>.
+
+srcs += files(
+  'canonical.f90',
+  'ccegen_interface.f90',
+  'ccegen_utils.f90',
+  'ccegen.f90',
+  'cregen_interfaces.f90',
+  'cregen.f90',
+  'cregen_utils.f90',
+  'ensemblecomp.f90',
+  'hungarian.f90',
+  'irmsd_module.f90',
+  'ls_rmsd.f90',
+  'quicksort.f90',
+  'rotcompare.f90',
+'unionize.f90',
+  'zdata.f90',
+  'ztopology.f90',
+)
diff --git a/src/sorting/quicksort.f90 b/src/sorting/quicksort.f90
new file mode 100644
index 00000000..f89cea13
--- /dev/null
+++ b/src/sorting/quicksort.f90
@@ -0,0 +1,398 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2020-2024 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module quicksort_interface
+!********************************************************
+!* module to load an interface to the quicksort routines
+!* mandatory to handle optional input arguments
+!********************************************************
+  implicit none
+  interface
+    recursive subroutine quicksort(n,arr)
+      implicit none
+      integer :: n,arr(n)
+    end subroutine quicksort
+
+    recursive subroutine qsort(a,first,last,ind)
+      use iso_fortran_env,only:wp => real64
+      implicit none
+      real(wp) :: a(*)
+      integer :: ind(*)
+      integer :: first,last
+    end subroutine qsort
+
+    recursive subroutine qqsort(a,first,last)
+      use iso_fortran_env,only:wp => real64
+      implicit none
+      real(wp) :: a(*)
+      integer :: first,last
+    end subroutine qqsort
+
+    recursive subroutine qqsorti(a,first,last)
+      implicit none
+      integer :: a(*)
+      integer :: first,last
+    end subroutine qqsorti
+
+    recursive subroutine maskqsort(a,first,last,mask)
+      use iso_fortran_env,only:wp => real64
+      implicit none
+      real(wp) :: a(*)
+      integer :: first,last
+      integer :: mask(*)
+    end subroutine maskqsort
+
+    recursive subroutine matqsort(adim,nall,a,adum,first,last,mask)
+      use iso_fortran_env,only:wp => real64
+      implicit none
+      integer  :: adim,nall
+      real(wp) :: a(adim,nall),adum(adim)
+      integer :: first,last
+      integer :: mask(nall)
+    end subroutine matqsort
+
+    recursive subroutine stringqsort(sdim,slen,strs,first,last,mask)
+      implicit none
+      integer,intent(in) :: sdim,slen
+      character(len=slen) :: strs(sdim)
+      integer :: first,last
+      integer :: mask(sdim)
+    end subroutine stringqsort
+
+    subroutine maskinvert(nall,mask)
+      implicit none
+      integer :: nall
+      integer :: mask(nall)
+    end subroutine maskinvert
+
+    recursive subroutine ensemble_qsort(nall,structures,first,last,mask)
+      use crest_parameters
+      use strucrd,only:coord
+      implicit none
+      integer,intent(in) :: nall
+      type(coord),intent(inout) :: structures(nall)
+      integer,intent(in) :: first,last
+      integer,intent(inout),optional :: mask(nall)
+    end subroutine ensemble_qsort
+
+  end interface
+end module quicksort_interface
+
+!=============================================================!
+! classical quicksort algorithm, sort LOW-to-HIGH
+!=============================================================!
+recursive subroutine quicksort(n,arr)
+  implicit none
+  integer :: n,arr(n),i,j,k,m
+  integer :: pivot
+  integer,allocatable :: R(:),L(:)
+  integer :: rr,ll,rc,lc,pp
+
+  if (n .le. 1) return
+
+  pivot = arr(1)
+  if (arr(2) .lt. arr(1)) pivot = arr(2)
+  pp = 0
+  do i = 1,n
+    if (arr(i) .eq. pivot) pp = pp+1
+  end do
+
+  ll = 0
+  do i = 1,n
+    if (arr(i) .le. pivot) then
+      ll = ll+1
+    end if
+  end do
+  ll = ll-pp
+  rr = n-ll-pp
+  allocate (L(ll),R(rr))
+
+  lc = 0
+  rc = 0
+  do j = 1,n
+    if (arr(j) .lt. pivot) then
+      lc = lc+1
+      L(lc) = arr(j)
+    else if (arr(j) .gt. pivot) then
+      rc = rc+1
+      R(rc) = arr(j)
+    end if
+  end do
+
+  call quicksort(ll,L)
+  call quicksort(rr,R)
+
+  do i = 1,ll
+    arr(i) = L(i)
+  end do
+  do k = 1,pp
+    m = k+ll
+    arr(m) = pivot
+  end do
+  do j = 1,rr
+    m = j+ll+pp
+    arr(m) = R(j)
+  end do
+
+  deallocate (R,L)
+end subroutine quicksort
+
+!=============================================================!
+! other variant of quicksort algos
+!=============================================================!
+recursive subroutine qsort(a,first,last,ind)
+  use iso_fortran_env,only:wp => real64
+  implicit none
+  real(wp) :: a(*)
+  real(wp) :: x,t
+  integer :: ind(*)
+  integer :: first,last,i,j,ii
+
+  x = a((first+last)/2)
+  i = first
+  j = last
+  do
+    do while (a(i) < x)
+      i = i+1
+    end do
+    do while (x < a(j))
+      j = j-1
+    end do
+    if (i >= j) exit
+    t = a(i); a(i) = a(j); a(j) = t
+    ii = ind(i); ind(i) = ind(j); ind(j) = ii
+    i = i+1
+    j = j-1
+  end do
+  if (first < i-1) call qsort(a,first,i-1,ind)
+  if (j+1 < last) call qsort(a,j+1,last,ind)
+end subroutine qsort
+
+recursive subroutine qqsort(a,first,last)
+  use iso_fortran_env,only:wp => real64
+  implicit none
+  real(wp) :: a(*)
+  real(wp) :: x,t
+  integer :: first,last,i,j
+
+  x = a((first+last)/2)
+  i = first
+  j = last
+  do
+    do while (a(i) < x)
+      i = i+1
+    end do
+    do while (x < a(j))
+      j = j-1
+    end do
+    if (i >= j) exit
+    t = a(i); a(i) = a(j); a(j) = t
+    i = i+1
+    j = j-1
+  end do
+  if (first < i-1) call qqsort(a,first,i-1)
+  if (j+1 < last) call qqsort(a,j+1,last)
+end subroutine qqsort
+
+recursive subroutine qqsorti(a,first,last)
+  implicit none
+  integer :: a(*)
+  integer :: x,t
+  integer :: first,last,i,j
+
+  x = a((first+last)/2)
+  i = first
+  j = last
+  do
+    do while (a(i) < x)
+      i = i+1
+    end do
+    do while (x < a(j))
+      j = j-1
+    end do
+    if (i >= j) exit
+    t = a(i); a(i) = a(j); a(j) = t
+    i = i+1
+    j = j-1
+  end do
+  if (first < i-1) call qqsorti(a,first,i-1)
+  if (j+1 < last) call qqsorti(a,j+1,last)
+end subroutine qqsorti
+
+recursive subroutine maskqsort(a,first,last,mask)
+  use iso_fortran_env,only:wp => real64
+  implicit none
+  real(wp) :: a(*)
+  real(wp) :: t
+  integer :: x,first,last,i,j,ii
+  integer :: mask(*)
+
+  x = mask((first+last)/2)
+  i = first
+  j = last
+  do
+    do while (mask(i) < x)
+      i = i+1
+    end do
+    do while (x < mask(j))
+      j = j-1
+    end do
+    if (i >= j) exit
+    t = a(i); a(i) = a(j); a(j) = t
+    ii = mask(i); mask(i) = mask(j); mask(j) = ii
+    i = i+1
+    j = j-1
+  end do
+  if (first < i-1) call maskqsort(a,first,i-1,mask)
+  if (j+1 < last) call maskqsort(a,j+1,last,mask)
+end subroutine maskqsort
+
+recursive subroutine matqsort(adim,nall,a,adum,first,last,mask)
+  use iso_fortran_env,only:wp => real64
+  implicit none
+  integer  :: adim,nall
+  real(wp) :: a(adim,nall),adum(adim)
+  integer :: x,first,last,i,j,ii
+  integer :: mask(nall)
+
+  x = mask((first+last)/2)
+  i = first
+  j = last
+  do
+    do while (mask(i) < x)
+      i = i+1
+    end do
+    do while (x < mask(j))
+      j = j-1
+    end do
+    if (i >= j) exit
+    adum(:) = a(:,i); a(:,i) = a(:,j); a(:,j) = adum(:)
+    ii = mask(i); mask(i) = mask(j); mask(j) = ii
+    i = i+1
+    j = j-1
+  end do
+  if (first < i-1) call matqsort(adim,nall,a,adum,first,i-1,mask)
+  if (j+1 < last) call matqsort(adim,nall,a,adum,j+1,last,mask)
+end subroutine matqsort
+
+recursive subroutine stringqsort(sdim,slen,strs,first,last,mask)
+  implicit none
+  integer,intent(in) :: sdim,slen
+  character(len=slen) :: strs(sdim)
+  character(len=slen) :: str
+  integer :: x,first,last,i,j,ii
+  integer :: mask(sdim)
+  x = mask((first+last)/2)
+  i = first
+  j = last
+  do
+    do while (mask(i) < x)
+      i = i+1
+    end do
+    do while (x < mask(j))
+      j = j-1
+    end do
+    if (i >= j) exit
+    str = strs(i); strs(i) = strs(j); strs(j) = str
+    ii = mask(i); mask(i) = mask(j); mask(j) = ii
+    i = i+1
+    j = j-1
+  end do
+  if (first < i-1) call stringqsort(sdim,slen,strs,first,i-1,mask)
+  if (j+1 < last) call stringqsort(sdim,slen,strs,j+1,last,mask)
+end subroutine stringqsort
+
+subroutine maskinvert(nall,mask)
+  implicit none
+  integer :: nall
+  integer :: mask(nall)
+  integer,allocatable :: imask(:)
+  integer :: i
+  allocate (imask(nall))
+  do i = 1,nall
+    imask(mask(i)) = i
+  end do
+  mask(:) = imask(:)
+  deallocate (imask)
+  return
+end subroutine maskinvert
+
+!========================================================================================!
+
+recursive subroutine ensemble_qsort(nall,structures,first,last,mask)
+  use crest_parameters
+  use strucrd,only:coord
+  implicit none
+  integer,intent(in) :: nall
+  type(coord),intent(inout) :: structures(nall)
+  integer,intent(in) :: first,last
+  integer,intent(inout),optional :: mask(nall)
+
+  !> LOCAL
+  type(coord),allocatable :: tmpmol
+  integer :: i,j,mm,ii
+  real(wp) :: ee
+
+  if (present(mask)) then
+!>--- sort according to a given mask (reference order)
+    mm = mask((first+last)/2)
+    i = first
+    j = last
+    do
+      do while (mask(i) < mm)
+        i = i+1
+      end do
+      do while (mm < mask(j))
+        j = j-1
+      end do
+      if (i >= j) exit
+      ii = mask(i); mask(i) = mask(j); mask(j) = ii
+      allocate (tmpmol)
+      tmpmol = structures(i); structures(i) = structures(j); structures(j) = tmpmol
+      deallocate (tmpmol)
+      i = i+1
+      j = j-1
+    end do
+    if (first < i-1) call ensemble_qsort(nall,structures,first,i-1,mask)
+    if (j+1 < last) call ensemble_qsort(nall,structures,j+1,last,mask)
+
+  else
+!>--- standard, sort according to energy of structures
+    ee = structures((first+last)/2)%energy
+    i = first
+    j = last
+    do
+      do while (structures(i)%energy < ee)
+        i = i+1
+      end do
+      do while (ee < structures(j)%energy)
+        j = j-1
+      end do
+      if (i >= j) exit
+      allocate (tmpmol)
+      tmpmol = structures(i); structures(i) = structures(j); structures(j) = tmpmol
+      deallocate (tmpmol)
+      i = i+1
+      j = j-1
+    end do
+    if (first < i-1) call ensemble_qsort(nall,structures,first,i-1)
+    if (j+1 < last) call ensemble_qsort(nall,structures,j+1,last)
+  end if
+end subroutine ensemble_qsort
+
diff --git a/src/sorting/rotcompare.f90 b/src/sorting/rotcompare.f90
new file mode 100644
index 00000000..11c2fadf
--- /dev/null
+++ b/src/sorting/rotcompare.f90
@@ -0,0 +1,138 @@
+!===============================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2018-2020 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!===============================================================================!
+
+module rotaniso_mod
+  use crest_parameters
+  implicit none
+  public
+
+contains
+
+  function rotaniso(rot) result(aniso)
+!***********************************************************
+!* calculate rot.const. anisotropy for a single structure
+!***********************************************************
+    implicit none
+    real(wp) :: aniso
+    real(wp),intent(in) :: rot(3)
+    real(wp) :: a,b,c,av
+    a = rot(1); b = rot(2); c = rot(3)
+    !av = (a+b+c)/3.0_wp
+    !aniso = sqrt((a-av)**2+(b-av)**2+(c-av)**2)
+    !aniso = rotaniso/av
+    !aniso = rotaniso/(3.0_wp*sqrt(2.0_wp/3.0_wp))
+
+    !> the following is identical to the commented out part
+    aniso = sqrt(a**2+b**2+c**2-a*b-a*c-b*c)/(a+b+c)
+    return
+  end function rotaniso
+
+  function bthrerf(bthr,aniso,bthrmax,bthrshift) result(thr)
+!***************************************************************
+!* the threshold used for the rotational constant comparison is
+!* is modified based on the anisotropy of the rot. constants
+!* the scaling function is an error function
+!***************************************************************
+    implicit none
+    real(wp) :: bthr,bthrmax,bthrshift
+    real(wp) :: aniso
+    real(wp) :: thr
+    real(wp) :: a,b,c,d
+    thr = bthr
+    c = ((bthrmax*100.0_wp)-(bthr*100.0_wp))/2.0_wp
+    a = -erf(-2.5_wp)*c+(bthr*100.0_wp) ! the y-axis shift
+    b = 4.0_wp/0.8_wp ! x-axis range from bthr to bthrmax
+    d = bthrshift/0.15_wp
+    thr = erf(aniso*b-d)*c+a
+    thr = thr/100.0_wp
+    return
+  end function bthrerf
+
+  logical function equalrotaniso(i,j,nall,rot,bthr,bthrmax,bthrshift)
+!*********************************************************************
+!* compare each rotational constant with a modified bthr threshold
+!* bthr is a relative value (fraction) threshold
+!*********************************************************************
+    implicit none
+    integer i,j,nall
+    real(wp) :: rot(3,nall)
+    real(wp) :: bthr
+    real(wp) :: bthrmax,bthrshift
+    real(wp) :: anisoi,anisoj,av
+    real(wp) :: thr
+    logical :: r1,r2,r3
+    equalrotaniso = .false.
+    anisoi = rotaniso(rot(:,i))
+    anisoj = rotaniso(rot(:,j))
+    av = (anisoi+anisoj)/2.0d0
+    !av=min(anisoi,anisoj)
+    thr = bthrerf(bthr,av,bthrmax,bthrshift)
+    r1 = abs((rot(1,i)/rot(1,j))-1.0d0) .le. thr
+    r2 = abs((rot(2,i)/rot(2,j))-1.0d0) .le. thr
+    r3 = abs((rot(3,i)/rot(3,j))-1.0d0) .le. thr
+    equalrotaniso = r1.and.r2.and.r3
+    return
+  end function equalrotaniso
+
+end module rotaniso_mod
+
+!===============================================================================!
+! LEGACY Routines for the comparison of two structures based
+! on their rotational constants.
+!===============================================================================!
+
+logical function equalrot(i,j,nall,thr,rot)
+  implicit none
+  integer i,j,nall
+  real*8 rot(3,nall),r,r1,thr
+  equalrot = .false.
+  r1 = rot(1,i)**2+rot(2,i)**2+rot(3,i)**2
+  r = (rot(1,i)-rot(1,j))**2 &
+ & +(rot(2,i)-rot(2,j))**2 &
+ & +(rot(3,i)-rot(3,j))**2
+  !write(*,*) sqrt(r)/sqrt(r1)
+  if (sqrt(r)/sqrt(r1) .lt. thr) equalrot = .true.
+end function equalrot
+
+real*8 function rotdiff(i,j,nall,rot)
+  implicit none
+  integer i,j,nall
+  real*8 rot(3,nall),r,r1,r2
+  r1 = rot(1,i)**2+rot(2,i)**2+rot(3,i)**2
+  r2 = rot(1,j)**2+rot(2,j)**2+rot(3,j)**2
+  r = (rot(1,i)-rot(1,j))**2 &
+ & +(rot(2,i)-rot(2,j))**2 &
+ & +(rot(3,i)-rot(3,j))**2
+  rotdiff = 2.*sqrt(r)/(sqrt(r1)+sqrt(r2))
+end function rotdiff
+
+!- use an absolute value as threshold
+logical function equalrotall(i,j,nall,thr,rot)
+  implicit none
+  integer i,j,nall
+  real*8 rot(3,nall),thr
+  logical :: r1,r2,r3
+  equalrotall = .false.
+  r1 = abs(rot(1,i)-rot(1,j)) .le. thr
+  r2 = abs(rot(2,i)-rot(2,j)) .le. thr
+  r3 = abs(rot(3,i)-rot(3,j)) .le. thr
+  equalrotall = r1.and.r2.and.r3
+  return
+end function equalrotall
+
diff --git a/src/sorting/unionize.f90 b/src/sorting/unionize.f90
new file mode 100644
index 00000000..87b88c1f
--- /dev/null
+++ b/src/sorting/unionize.f90
@@ -0,0 +1,178 @@
+!================================================================================!
+! This file is part of crest.
+!
+! Copyright (C) 2025 Philipp Pracht
+!
+! crest is free software: you can redistribute it and/or modify it under
+! the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! crest is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU Lesser General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License
+! along with crest.  If not, see <https://www.gnu.org/licenses/>.
+!================================================================================!
+
+module unionize_module
+  use crest_parameters
+  use strucrd,only:coord
+  use axis_module
+  use irmsd_module
+  use canonical_mod
+  use quicksort_interface,only:ensemble_qsort
+  implicit none
+  private
+
+!  logical,parameter :: debug = .true.
+  logical,parameter :: debug = .false.
+
+  public :: unionizeEnsembles
+
+!========================================================================================!
+!========================================================================================!
+contains  !> MODULE PROCEDURES START HERE
+!========================================================================================!
+!========================================================================================!
+
+  subroutine unionizeEnsembles(nin,inputs,nmerge,newmols,rthr,ethr)
+!***************************************************************************
+!* Merge two ensembles into a new one
+!* We asume "inputs" is our reference into which "newmols" shall be merged.
+!* "inputs" must be an allocatable list of structures and is OVERWRITTEN
+!* by the new list.
+!* Setting rthr and ethr to zero (or omitting the arguments)
+!* will lead to every structure being identified as unique and
+!* append it to the output ensemble.
+!***************************************************************************
+    implicit none
+    integer,intent(inout) :: nin
+    type(coord),allocatable,intent(inout) :: inputs(:)
+    integer,intent(in) :: nmerge
+    type(coord),intent(in),target :: newmols(nmerge)
+    real(wp),intent(in),optional :: rthr,ethr
+    !> LOCAL
+    integer :: nout
+    type(coord),allocatable :: structures(:)
+    logical :: dupe,broken
+    integer :: i,j,k,l,nat,ntaken,first,last
+    type(canonical_sorter) :: newsort,refsort
+    real(wp) :: rthr_ref,ethr_ref
+    real(wp) :: rmsdval,deltaE
+    type(coord),pointer :: mol
+    logical :: topocheck
+    type(rmsd_cache),allocatable :: rcache   !> similarity check cache (iRMSD)
+    integer,allocatable :: similarto(:)
+
+    nout = 0
+    dupe = .false.
+    broken = .false.
+    topocheck = .true.
+    nat = newmols(1)%nat
+    if (present(ethr)) then
+      ethr_ref = ethr
+    else
+      ethr_ref = 0.0_wp
+    end if
+    if (present(rthr)) then
+      rthr_ref = rthr
+    else
+      rthr_ref = 0.0_wp
+    end if
+!>--- allocate mapping
+    allocate (similarto(nmerge),source=0)
+
+    !>--- we can skip the sorting if "inputs" is empty
+    if (nin .ne. 0) then
+!>--- Prepare comparison data storage
+      if (debug) write (*,*)
+      if (.not.allocated(rcache)) then
+        if (debug) write (*,*) "allocating RCACHE"
+        !$omp critical
+        allocate (rcache)
+        call rcache%allocate(nat)
+        !$omp end critical
+      end if
+      !$omp critical
+      call refsort%init(inputs(1),invtype='apsp+',heavy=.false.)
+      call newsort%init(newmols(1),invtype='apsp+',heavy=.false.)
+      !$omp end critical
+
+!>--- double loop to count duplicates
+      COMPAREOUTER: do i = 1,nin
+        COMPAREINNER: do j = 1,nmerge
+          if (similarto(j) .ne. 0) cycle COMPAREINNER
+          mol => newmols(j)
+          !> Energy difference
+          deltaE = (mol%energy-inputs(i)%energy)*autokcal
+          !> we can skip some comparisons if the energy difference is too large
+          if (abs(deltaE) .gt. ethr) cycle COMPAREINNER
+
+          !> Geometry difference (permutation-invariant RMSD)
+          if (topocheck) then
+            rcache%rank(1:nat,1) = newsort%rank(1:nat)
+            rcache%rank(1:nat,2) = refsort%rank(1:nat)
+          end if
+          call min_rmsd(mol,inputs(i), &
+          &        rcache=rcache,rmsdout=rmsdval)
+
+          if (debug) write (*,'(a,es15.4,a,es15.4,a)') 'RMSD=',rmsdval*autoaa, &
+          &          ' Å, delta E=',deltaE,' kcal/mol'
+
+          !> Check
+          if (abs(deltaE) .lt. ethr_ref.and.rmsdval*autoaa .lt. rthr_ref) then
+            dupe = .true.
+            similarto(j) = i
+            if (deltaE < 0.0_wp) then
+              !> if the energy is lower, we replace the molecule (better conformation)
+              inputs(i) = mol
+            end if
+            exit COMPAREINNER
+          end if
+        end do COMPAREINNER
+      end do COMPAREOUTER
+      nullify (mol)
+      !$omp critical
+      call newsort%deallocate()
+      call refsort%deallocate()
+      !$omp end critical
+    end if
+
+    ntaken = count(similarto(:) .eq. 0)
+    nout = nin+ntaken
+
+!>--- after having checked the molecules, allocate new (output) space
+    allocate (structures(nout))
+    k = 0
+    if (nin .ne. 0) then
+      do i = 1,nin
+        k = k+1
+        structures(k) = inputs(i)
+      end do
+    end if
+    do i = 1,nmerge
+      if (similarto(i) .eq. 0) then
+        k = k+1
+        structures(k) = newmols(i)
+      end if
+    end do
+
+!>--- for good measure, sort by energy again
+    first = 1
+    last = nout
+    call ensemble_qsort(nout,structures,first,last)
+
+!>-- overwrite "inputs"
+    nin = nout
+    if(allocated(inputs)) deallocate(inputs)
+    call move_alloc(structures,inputs)
+
+  end subroutine unionizeEnsembles
+
+!=========================================================================================!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<!
+!=========================================================================================!
+end module unionize_module
diff --git a/src/zdata.f90 b/src/sorting/zdata.f90
similarity index 97%
rename from src/zdata.f90
rename to src/sorting/zdata.f90
index c204467a..e87fad47 100644
--- a/src/zdata.f90
+++ b/src/sorting/zdata.f90
@@ -161,22 +161,6 @@ module zdata
     integer,allocatable :: map(:)
     integer,allocatable :: revmap(:)
 
-    !>--- QCG information
-    integer   :: nmol          !> number of molecules
-    real(wp)  :: cma(3)        !> center of mass
-    real(wp)  :: aniso         !> anisotropy factor
-    real(wp)  :: ell_abc(3)    !> ellipsoid axis
-    real(wp)  :: atot          !> surface area
-    real(wp)  :: vtot          !> volume
-    real(wp)  :: rtot          !> radius
-    real(wp)  :: mass          !> mass
-    real(wp)  :: gt            !> gibbs free energy
-    real(wp)  :: ht            !> enthalpy
-    real(wp)  :: svib          !> vibrational entropy
-    real(wp)  :: srot          !> rotational entropy
-    real(wp)  :: stra          !> translational entropy
-    real(wp)  :: eax(3)        !> molecular axis
-
     !>--- procedures to be used with the zmol type
   contains
     procedure :: wrtable => wrtable          !> write CNs and neighbours
diff --git a/src/ztopology.f90 b/src/sorting/ztopology.f90
similarity index 85%
rename from src/ztopology.f90
rename to src/sorting/ztopology.f90
index b9660697..ae666d6e 100644
--- a/src/ztopology.f90
+++ b/src/sorting/ztopology.f90
@@ -123,6 +123,7 @@ subroutine simpletopo(n,at,xyz,zmol,verbose,getrings,wbofile)
   use zdata
   use miscdata,only:rcov
   use crest_cn_module
+  use cregen_utils,only:bondtotopo
   implicit none
   type(zmolecule)  :: zmol
   type(zmolecule)  :: zfrag
@@ -264,166 +265,27 @@ subroutine simpletopo(n,at,xyz,zmol,verbose,getrings,wbofile)
   return
 end subroutine simpletopo
 
-!===================================================!
-!> generate the topo array for a given structure
-!===================================================!
-subroutine bondtotopo(nat,at,bond,cn,ntopo,topo,neighbourmat)
-  use iso_fortran_env,only:wp => real64
-  use utilities
-  integer,intent(in)  :: nat
-  integer,intent(in) :: at(nat)
-  real(wp),intent(inout) :: bond(nat,nat)
-  real(wp),intent(in) :: cn(nat)
-  integer,intent(in)  :: ntopo
-  integer,intent(out) :: topo(ntopo)
-  real(wp),allocatable :: cn2(:)
-  logical,intent(inout) :: neighbourmat(nat,nat)
-  integer :: i,j,k,l
-  integer :: icn,rcn
-  allocate (cn2(nat),source=0.0_wp)
-  topo = 0
-  neighbourmat = .false.
-  !>--- some heuristic rules and CN array setup
-  do i = 1,nat
-    cn2(i) = cn(i)
-    rcn = floor(cn(i))
-    select case (at(i)) !additional empirical topology rules
-      ! case( 5 ) !B
-      !   if( nint(cn(i)) > 4) cn2(i)=4.0_wp
-      ! case( 9,17,35,53 ) !F,Cl,Br,I
-      !   cn2(i) = min(cn(i),1.0_wp)
-    case (6) !C
-      if ((cn(i)-rcn) < 0.7_wp) then
-        cn2(i) = rcn
-      end if
-    end select
-    !-- extreme CN cases
-    if (nint(cn(i)) > 8) cn2(i) = 8.0_wp
-    !empirical: rounding down up to .6 is better for topo setup
-    if ((cn(i)-rcn) < 0.6_wp) then
-      cn2(i) = rcn
-    end if
-  end do
-  !>--- build the topology
-  do i = 1,nat
-    icn = nint(cn2(i))
-    do k = 1,icn
-      j = maxloc(bond(:,i),1)
-      bond(j,i) = 0.0d0
-      if (i .eq. j) cycle
-      neighbourmat(i,j) = .true. !--important: not automatically (i,j)=(j,i)
-    end do
-  end do
-  do i = 1,nat
-    do j = 1,nat
-      if (i == j) cycle
-      l = lin(i,j)
-      !>-- only save matching topology --> prevent high CN failures
-      if (neighbourmat(i,j).and.neighbourmat(j,i)) then
-        topo(l) = 1
-      else
-        !> special case for carbon (because the carbon CN is typically correct)
-        !> this helps, e.g. with eta-coordination in ferrocene
-        !> (used, except if both are carbon)
-        if (.not. (at(i) == 6.and.at(j) == 6)) then
-          if (at(i) == 6.and.neighbourmat(i,j)) topo(l) = 1
-          if (at(j) == 6.and.neighbourmat(j,i)) topo(l) = 1
-        end if
-      end if
-    end do
-  end do
-  deallocate (cn2)
-  return
-end subroutine bondtotopo
-
-subroutine bondtotopo_excl(nat,at,bond,cn,ntopo,topo,neighbourmat,excl)
-  use iso_fortran_env,only:wp => real64
-  use utilities
-  integer,intent(in)  :: nat
-  integer,intent(in) :: at(nat)
-  real(wp),intent(inout) :: bond(nat,nat)
-  real(wp),intent(in) :: cn(nat)
-  integer,intent(in)  :: ntopo
-  integer,intent(out) :: topo(ntopo)
-  real(wp),allocatable :: cn2(:)
-  logical,intent(inout) :: neighbourmat(nat,nat)
-  logical,intent(in) :: excl(nat)
-  integer :: i,j,k,l
-  integer :: icn,rcn
-  allocate (cn2(nat),source=0.0_wp)
-  topo = 0
-  neighbourmat = .false.
-  !--- some heuristic rules and CN array setup
-  do i = 1,nat
-    cn2(i) = cn(i)
-    rcn = floor(cn(i))
-    select case (at(i)) !additional empirical topology rules
-      ! case( 5 ) !B
-      !   if( nint(cn(i)) > 4) cn2(i)=4.0_wp
-      ! case( 9,17,35,53 ) !F,Cl,Br,I
-      !   cn2(i) = min(cn(i),1.0_wp)
-    case (6) !C
-      if ((cn(i)-rcn) < 0.7_wp) then
-        cn2(i) = rcn
-      end if
-    end select
-    !-- extreme CN cases
-    if (nint(cn(i)) > 8) cn2(i) = 8.0_wp
-    !empirical: rounding down up to .6 is better for topo setup
-    if ((cn(i)-rcn) < 0.6_wp) then
-      cn2(i) = rcn
-    end if
-  end do
-  !--- build the topology
-  do i = 1,nat
-    icn = nint(cn2(i))
-    do k = 1,icn
-      j = maxloc(bond(:,i),1)
-      bond(j,i) = 0.0d0
-      if (i .eq. j) cycle
-      neighbourmat(i,j) = .true. !--important: not automatically (i,j)=(j,i)
-      if (excl(i).or.excl(j)) neighbourmat(i,j) = .false.
-    end do
-  end do
-  do i = 1,nat
-    do j = 1,nat
-      if (i == j) cycle
-      l = lin(i,j)
-      !-- only save matching topology --> prevent high CN failures
-      if (neighbourmat(i,j).and.neighbourmat(j,i)) then
-        topo(l) = 1
-      else
-        ! special case for carbon (because the carbon CN is typically correct)
-        ! this helps, e.g. with eta-coordination in ferrocene
-        ! (used, except if both are carbon)
-        if (.not. (at(i) == 6.and.at(j) == 6)) then
-          if (at(i) == 6.and.neighbourmat(i,j)) topo(l) = 1
-          if (at(j) == 6.and.neighbourmat(j,i)) topo(l) = 1
-        end if
-      end if
-    end do
-  end do
-  deallocate (cn2)
-  return
-end subroutine bondtotopo_excl
 subroutine quicktopo(nat,at,xyz,ntopo,topovec)
   use iso_fortran_env,only:wp => real64
   use miscdata,only:rcov
   use crest_cn_module
+  use cregen_utils,only:bondtotopo
   implicit none
   integer :: nat
   integer :: at(nat)
   real(wp) :: xyz(3,nat) !must be in Bohrs
   integer :: ntopo
-  integer :: topovec(ntopo)
+  integer,intent(inout) :: topovec(ntopo)
   real(wp),allocatable :: cn(:),bond(:,:)
   logical,allocatable :: neighmat(:,:)
+  integer,allocatable :: tmp(:)
   allocate (bond(nat,nat),cn(nat),source=0.0_wp)
   allocate (neighmat(nat,nat),source=.false.)
   cn = 0.0d0
   bond = 0.0d0
   call calc_ncoord(nat,at,xyz,rcov,cn,900.0_wp,bond)
-  call bondtotopo(nat,at,bond,cn,ntopo,topovec,neighmat)
+  call bondtotopo(nat,at,bond,cn,ntopo,tmp,neighmat)
+  topovec(:) = tmp(:)
   deallocate (neighmat,cn,bond)
   return
 end subroutine quicktopo
diff --git a/src/strucreader.f90 b/src/strucreader.f90
deleted file mode 100644
index 01acc3b8..00000000
--- a/src/strucreader.f90
+++ /dev/null
@@ -1,2379 +0,0 @@
-!================================================================================!
-! This file is part of crest.
-!
-! Copyright (C) 2020-2023 Philipp Pracht
-!
-! crest is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! crest is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with crest.  If not, see <https://www.gnu.org/licenses/>.
-!================================================================================!
-
-!=========================================================================================!
-! STRUCRD is a module for reading and writing molecular structures.
-!
-! The source is organized as follows:
-!   0. Variable declarations
-!   1. Routines for reading and writing ensemble files/trajectories in the XYZ format
-!   2. Routines for reading single structures in various formats
-!   3. Routines for writing structures in various formats
-!   4. Utility routines mainly used only within the module
-!
-! Currently supported formats:
-!   .xyz (Xmol) files and trajectories (read and write)
-!   coord (turbomole) files (read and write)
-!   .sdf/.mol files (V2000, read only)
-!   .pdb files (in development)
-!
-!=========================================================================================!
-module strucrd
-  use iso_fortran_env,only:wp => real64
-  use iso_c_binding
-!> simple geomerty and vector operations
-  use geo
-!> element symbols
-  use miscdata,only:PSE
-  use crest_cn_module,only:calculate_cn
-  implicit none
-
-!=========================================================================================!
-!>--- private module variables and parameters
-  private
-
-!>--- some constants and name mappings
-  real(wp),parameter :: bohr = 0.52917726_wp
-  real(wp),parameter :: autokcal = 627.509541_wp
-!>-- filetypes as integers
-  integer,parameter :: tmcoord = 1
-  integer,parameter :: xmol = 2
-  integer,parameter :: sdf = 3  !currently unused
-  integer,parameter :: sdfV2000 = 31
-  integer,parameter :: sdfV3000 = 32
-  integer,parameter :: pdbfile = 4  !currently unused
-  ! [...]
-
-!>--- private utility subroutines
-  private :: upperCase,lowerCase
-  private :: convertlable,fextension,sgrep
-
-!=========================================================================================!
-!>--- public subroutines
-  public :: i2e          !> function to convert atomic number to element symbol
-  public :: asym         !> "
-  interface asym         !> "
-    module procedure i2e !> "
-  end interface asym
-  public :: e2i          !> function to convert element symbol into atomic number
-  public :: grepenergy
-  public :: checkcoordtype
-
-  public :: rdnat       !-- procedure to read number of atoms Nat
-  public :: rdcoord     !-- read an input file, determine format automatically
-  public :: rdxmol      !-- read a file in the Xmol (.xyz) format specifically
-  public :: rdxmolselec !-- read only a certain structure in Xmol file
-
-  !>--- write a TM coord file
-  public :: wrc0
-  interface wrc0
-    module procedure wrc0_file
-    module procedure wrc0_channel
-  end interface wrc0
-  public :: wrcoord
-  interface wrcoord
-    module procedure wrc0_file
-    module procedure wrc0_channel
-  end interface wrcoord
-
-  !>--- write a XYZ coord file
-  public :: wrxyz
-  interface wrxyz
-    module procedure wrxyz_file
-    module procedure wrxyz_file_mask
-    module procedure wrxyz_channel_energy
-    module procedure wrxyz_channel
-  end interface wrxyz
-
-  !>--- write a sdf molfile
-  public :: wrsdf
-  interface wrsdf
-    module procedure wrsdf_channel
-  end interface wrsdf
-
-  public :: xyz2coord
-  public :: coord2xyz
-
-  public :: rdensembleparam   !-- read Nat and Nall for a XYZ trajectory
-  public :: rdensemble        !-- read a XYZ trajectory
-  interface rdensemble
-    module procedure rdensemble_conf1
-    module procedure rdensemble_conf2
-    module procedure rdensemble_conf3
-
-    module procedure rdensemble_mixed2
-
-    module procedure rdensemble_coord_type
-  end interface rdensemble
-
-  public :: wrensemble
-  interface wrensemble
-    module procedure wrensemble_conf
-    module procedure wrensemble_conf_energy
-    module procedure wrensemble_conf_energy_comment
-
-    module procedure wrensemble_coord_name
-    module procedure wrensemble_coord_channel
-  end interface wrensemble
-
-  public :: pdbdata
-  public :: coord
-  public :: ensemble
-  public :: coordline
-  public :: get_atlist
-
-!=========================================================================================!
-  !coord class. contains a single structure in the PDB format.
-  !coordinates by definition are in Angstroem.
-  type :: pdbdata
-
-    !--- data
-    integer :: nat = 0
-    integer :: frag = 0
-    !--- arrays
-    integer,allocatable  :: athet(:) !ATOM (1) or HETATM (2)
-    character(len=4),allocatable :: pdbat(:) !PDB atom specifier
-    character(len=3),allocatable :: pdbas(:) !PDB amino acid specifier
-    integer,allocatable :: pdbfrag(:) !PDB fragment specifier
-    character(len=1),allocatable :: pdbgrp(:)  !PDB group specifier
-    real(wp),allocatable :: pdbocc(:) !PDB occupancy
-    real(wp),allocatable :: pdbtf(:)  !PDB temperature factor
-
-  contains
-    procedure :: deallocate => deallocate_pdb !clear memory space
-    procedure :: allocate => allocate_pdb
-
-  end type pdbdata
-!=========================================================================================!
-  !coord class. contains a single structure
-  !by convention coordinates are in atomic units (Bohr) for a single structure!
-  type :: coord
-
-    !********************************************!
-    !> data that's typically used in coord type <!
-    !********************************************!
-    !>-- number of atoms
-    integer :: nat = 0
-    !>-- atom types as integer, dimension will be at(nat)
-    integer,allocatable  :: at(:)
-    !>-- atomic coordinates, by convention in Bohrs
-    real(wp),allocatable :: xyz(:,:)
-
-    !**************************************!
-    !> (optional) data, often not present <!
-    !**************************************!
-    !>-- energy
-    real(wp) :: energy = 0.0_wp
-    !>-- a comment line
-    character(len=:),allocatable :: comment
-    !>-- molecular charge
-    integer :: chrg = 0
-    !>-- multiplicity information
-    integer :: uhf = 0
-    !>-- number of bonds
-    integer :: nbd = 0
-    !>-- bond info
-    integer,allocatable :: bond(:,:)
-    !>-- lattice vectors
-    real(wp),allocatable :: lat(:,:)
-
-    !>-- atomic charges
-    real(wp),allocatable :: qat(:)
-
-    !>-- (optional) PDB data
-    type(pdbdata) :: pdb
-
-  contains
-    procedure :: deallocate => deallocate_coord !> clear memory space
-    procedure :: open => opencoord              !> read an coord file
-    procedure :: write => writecoord            !> write
-    procedure :: append => appendcoord          !> append
-    procedure :: get => getcoord                !> allocate & fill with data
-    procedure :: appendlog                      !> append .log file with coordinates and energy
-    procedure :: dist => coord_getdistance      !> calculate distance between two atoms
-    procedure :: angle => coord_getangle        !> calculate angle between three atoms
-    procedure :: dihedral => coord_getdihedral  !> calculate dihedral angle between four atoms
-    procedure :: cutout => coord_getcutout      !> create a substructure
-    procedure :: get_CN => coord_get_CN         !> calculate coordination number
-    procedure :: get_z => coord_get_z           !> calculate nuclear charge
-    procedure :: cn_to_bond => coord_cn_to_bond !> generate neighbour matrix from CN
-  end type coord
-!=========================================================================================!
-  !ensemble class. contains all structures of an ensemble
-  !by convention coordinates are in Angström for an ensemble!
-  type :: ensemble
-
-    !--- data
-    integer :: nat = 0             !number of total atoms
-    integer :: nall = 0             !number of structures
-    integer,allocatable :: vnat(:)     !used instead of nat if not all structures have the same      number of atoms, in which case nat will be  =maxval(vnat,1)
-
-    integer,allocatable  :: at(:)      !atom types as integer, dimension will be at(nat)
-    real(wp),allocatable :: xyz(:,:,:) !coordinates, dimension will be xyz(3,nat,nall)
-    real(wp),allocatable :: er(:)   !energy of each structure, dimension will be eread(nall)
-
-    real(wp)            :: g         !gibbs free energy
-    real(wp)            :: s         !entropy
-    real(wp),allocatable :: gt(:)    !gibbs free energy of each member
-    real(wp),allocatable :: ht(:)    !enthalpy of each member
-    real(wp),allocatable :: svib(:)  !vibrational entropy of each member
-    real(wp),allocatable :: srot(:)  !rotational entropy of each member
-    real(wp),allocatable :: stra(:)  !translational entropy of each member
-
-  contains
-    procedure :: deallocate => deallocate_ensembletype !clear memory space
-    procedure :: open => openensemble !read an ensemble file
-    procedure :: write => write_ensemble !write to file
-
-  end type ensemble
-!=========================================================================================!
-!=========================================================================================!
-contains  !> MODULE PROCEDURES START HERE
-!=========================================================================================!
-!=========================================================================================!
-!  1. ROUTINES FOR READING ENTIRE ENSEMBLES (OR TRAJECTORIES)
-!=========================================================================================!
-!=========================================================================================!
-
-!==================================================================!
-! subroutine rdensembleparam
-! read a ensemble file and get some information from
-! it:
-! On Input: fname - name of the file, should be in
-!                   the Xmol (*.xyz) format.
-!
-! On Output: nat  - number of atoms
-!                   (if different sized structures are present,
-!                    nat is the largest)
-!            nall - number of structures
-!            conform - (optional) do all structures
-!                      have the same number of atoms?
-!=================================================================!
-  subroutine rdensembleparam(fname,nat,nall,conform)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(out) :: nat
-    integer,intent(out) :: nall
-    logical,intent(out),optional :: conform
-    logical :: conformdum
-    integer :: dum,iosum
-    integer :: natref
-    real(wp) :: x,y,z
-    integer :: i,j,k,ich,io
-    logical :: ex
-    character(len=10) :: str
-    conformdum = .true.
-    nat = 0
-    nall = 0
-    natref = 0
-    inquire (file=fname,exist=ex)
-    if (.not.ex) return
-    open (newunit=ich,file=fname)
-    do
-      read (ich,*,iostat=io) dum
-      if (io < 0) exit
-      if (io > 0) cycle
-      if (nat == 0) natref = dum
-      read (ich,*,iostat=io)
-      if (io < 0) exit
-      iosum = 0
-      do i = 1,dum
-        read (ich,*,iostat=io) str,x,y,z
-        if (io < 0) exit
-        iosum = iosum+io
-      end do
-      if (iosum > 0) cycle
-      nat = max(dum,nat)
-      if (dum .ne. natref) conformdum = .false.
-      nall = nall+1
-    end do
-    close (ich)
-    if (present(conform)) conform = conformdum
-    return
-  end subroutine rdensembleparam
-
-!==================================================================!
-! subroutine rdensemble_conf1
-! read a conformer ensemble/a MD trajectory, i.e.,
-! all structures have the same number and order of atoms.
-! version 1 also reads the energy
-!=================================================================!
-  subroutine rdensemble_conf1(fname,nat,nall,at,xyz,eread)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(inout) :: nat
-    integer,intent(inout) :: nall
-    integer,intent(inout),allocatable :: at(:)
-    real(wp),intent(inout),allocatable :: xyz(:,:,:)
-    real(wp),intent(inout),allocatable :: eread(:)
-    integer :: i,j,k,ich,io
-    logical :: ex
-    integer :: dum
-    character(len=512) :: line
-    character(len=6) :: sym
-    if (.not.allocated(xyz).or..not.allocated(at)) then
-      call rdensembleparam(fname,nat,nall)
-    end if
-    if (.not.allocated(xyz)) allocate (xyz(3,nat,nall))
-    if (.not.allocated(at)) allocate (at(nat))
-    if (.not.allocated(eread)) allocate (eread(nall))
-
-    eread = 0.0_wp
-    xyz = 0.0_wp
-    open (newunit=ich,file=fname)
-    do i = 1,nall
-      read (ich,*,iostat=io) dum
-      if (io < 0) exit
-      if (io > 0) cycle
-      if (dum .ne. nat) then
-        call ensemble_strucskip(ich,nat,io)
-        if (io < 0) exit
-      end if
-      read (ich,'(a)',iostat=io) line
-      if (io < 0) exit
-      eread(i) = grepenergy(line)
-      do j = 1,dum
-        read (ich,'(a)',iostat=io) line
-        if (io < 0) exit
-        call coordline(line,sym,xyz(1:3,j,i),io)
-        if (io .ne. 0) then
-          backspace (ich)
-          exit
-        end if
-        at(j) = e2i(sym)
-      end do
-    end do
-    close (ich)
-
-    if (io < 0) then
-      error stop 'error while reading ensemble file.'
-    end if
-
-    return
-  end subroutine rdensemble_conf1
-
-!==================================================================!
-! subroutine rdensemble_conf2
-! read a conformer ensemble/a MD trajectory, i.e.,
-! all structures have the same number and order of atoms.
-! version 2 does not read the energy
-!=================================================================!
-  subroutine rdensemble_conf2(fname,nat,nall,at,xyz)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(inout) :: nat
-    integer,intent(inout) :: nall
-    integer,intent(inout),allocatable :: at(:)
-    real(wp),intent(inout),allocatable :: xyz(:,:,:)
-    integer :: i,j,k,ich,io
-    logical :: ex
-    integer :: dum,nallnew
-    character(len=512) :: line
-    character(len=6) :: sym
-    if (.not.allocated(xyz).or..not.allocated(at)) then
-      call rdensembleparam(fname,nat,nall)
-    end if
-    if (.not.allocated(xyz)) allocate (xyz(3,nat,nall))
-    if (.not.allocated(at)) allocate (at(nat))
-    io = 0
-    xyz = 0.0_wp
-    open (newunit=ich,file=fname)
-    do i = 1,nall
-      read (ich,*,iostat=io) dum
-      if (io < 0) exit
-      if (io > 0) cycle
-      if (dum .ne. nat) then
-        call ensemble_strucskip(ich,nat,io)
-        if (io < 0) exit
-      end if
-      read (ich,'(a)',iostat=io) line
-      if (io < 0) exit
-      do j = 1,dum
-        read (ich,'(a)',iostat=io) line
-        if (io < 0) exit
-        call coordline(line,sym,xyz(1:3,j,i),io)
-        if (io .ne. 0) then
-          backspace (ich)
-          exit
-        end if
-        at(j) = e2i(sym)
-      end do
-    end do
-    close (ich)
-
-    if (io < 0) then
-      error stop 'error while reading ensemble file.'
-    end if
-
-    return
-  end subroutine rdensemble_conf2
-
-!==================================================================!
-! subroutine rdensemble_conf3
-! read a conformer ensemble/a MD trajectory, i.e.,
-! all structures have the same number and order of atoms.
-! version 3 saves the comment line for each structure
-!=================================================================!
-  subroutine rdensemble_conf3(fname,nat,nall,at,xyz,comments)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(inout) :: nat
-    integer,intent(inout) :: nall
-    integer :: at(nat)
-    integer,allocatable :: atdum(:)
-    real(wp) :: xyz(3,nat,nall)
-    character(len=*) :: comments(nall)
-    integer :: i,j,k,ich,io
-    logical :: ex
-    integer :: dum,nallnew
-    character(len=512) :: line
-    character(len=6) :: sym
-    io = 0
-    xyz = 0.0_wp
-    k = 0
-    open (newunit=ich,file=fname)
-    do i = 1,nall
-      read (ich,*,iostat=io) dum
-      if (io < 0) exit
-      if (io > 0) cycle
-      if (dum .ne. nat) then
-        call ensemble_strucskip(ich,nat,io)
-        if (io < 0) exit
-      end if
-      read (ich,'(a)',iostat=io) line
-      if (io < 0) exit
-      comments(i) = trim(line)
-      do j = 1,dum
-        k = k+1
-        read (ich,'(a)',iostat=io) line
-        if (io < 0) exit
-        call coordline(line,sym,xyz(1:3,j,i),io)
-        if (io .ne. 0) then
-          backspace (ich)
-          exit
-        end if
-        at(j) = e2i(sym)
-      end do
-    end do
-    close (ich)
-
-    if (io < 0) then
-      error stop 'error while reading ensemble file.'
-    end if
-
-    return
-  end subroutine rdensemble_conf3
-
-  subroutine ensemble_strucskip(ich,nat,io)
-    implicit none
-    integer,intent(in) :: ich
-    integer,intent(in) :: nat
-    integer,intent(out) :: io
-    integer :: io2,dum,k
-    io = 0
-    dum = 0
-    k = 0
-    do while (dum .ne. nat)
-      read (ich,*,iostat=io) dum
-      if (io < 0) exit
-      k = k+1
-      if (io > 0) cycle
-    end do
-  end subroutine ensemble_strucskip
-
-!==================================================================!
-! subroutine rdensemble_mixed2
-! read an ensemble of mixed strcutres, i.e., all stuctures
-! can have a diferent number and order of atoms.
-! version 2 does not read energies
-!=================================================================!
-  subroutine rdensemble_mixed2(fname,natmax,nall,nats,ats,xyz,comments)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: natmax
-    integer,intent(in) :: nall
-    integer  :: nats(nall)
-    integer  :: ats(natmax,nall)
-    real(wp) :: xyz(3,natmax,nall)
-    character(len=*) :: comments(nall)
-    integer :: i,j,k,ich,io
-    logical :: ex
-    integer :: dum
-    character(len=512) :: line
-    character(len=6) :: sym
-    open (newunit=ich,file=fname)
-    do i = 1,nall
-      read (ich,*,iostat=io) dum
-      if (io < 0) exit
-      if (io > 0) cycle
-      nats(i) = dum
-      read (ich,'(a)',iostat=io) line
-      if (io < 0) exit
-      comments(i) = trim(line)
-      do j = 1,dum
-        read (ich,'(a)',iostat=io) line
-        if (io < 0) exit
-        call coordline(line,sym,xyz(1:3,j,i),io)
-        if (io < 0) exit
-        ats(j,i) = e2i(sym)
-      end do
-    end do
-    close (ich)
-
-    if (io < 0) then
-      error stop 'error while reading ensemble file.'
-    end if
-
-    return
-  end subroutine rdensemble_mixed2
-
-!========================================================================================!
-  subroutine rdensemble_coord_type(fname,nall,structures)
-!*********************************************************
-!* subroutine rdensemble_coord_type
-!* A variant of the rdensemble routine that automatically
-!* produces an array of coord containers
-!*********************************************************
-    implicit none
-    character(len=*),intent(in) :: fname !> name of the ensemble file
-    integer,intent(out) :: nall  !> number of structures in ensemble
-    type(coord),intent(out),allocatable :: structures(:)
-
-    real(wp),allocatable :: xyz(:,:,:)
-    integer :: nat
-    integer,allocatable :: nats(:)
-    integer,allocatable :: at(:)
-    integer,allocatable :: ats(:,:)
-    real(wp),allocatable :: eread(:)
-    character(len=512),allocatable :: comments(:)
-    integer :: i,j,k,ich,io,nat_i
-    logical :: ex,multiple_sizes
-
-    call rdensembleparam(fname,nat,nall,multiple_sizes)
-    !>--- multiple sizes
-    allocate (structures(nall))
-    allocate (xyz(3,nat,nall),ats(nat,nall),nats(nall),eread(nall))
-    allocate (comments(nall))
-    call rdensemble_mixed2(fname,nat,nall,nats,ats,xyz,comments)
-    !>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<!
-    !>--- Important: coord types must be in Bohrs
-    xyz = xyz/bohr
-    !>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<!
-    do i = 1,nall
-      nat_i = nats(i)
-      structures(i)%nat = nats(i)
-      allocate (structures(i)%at(nat_i))
-      structures(i)%at(:) = ats(1:nat_i,i)
-      allocate (structures(i)%xyz(3,nat_i))
-      structures(i)%xyz(:,:) = xyz(1:3,1:nat_i,i)
-      eread(i) = grepenergy(comments(i))
-      structures(i)%energy = eread(i)
-      structures(i)%comment = trim(comments(i))
-    end do
-
-    deallocate (comments,eread,nats,ats,xyz)
-  end subroutine rdensemble_coord_type
-
-!=================================================================!
-! subroutine wrensemble_conf
-! write a ensemble file/a trajectory from memory.
-!=================================================================!
-  subroutine wrensemble_conf(fname,nat,nall,at,xyz)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: nat
-    integer,intent(in) :: nall
-    integer :: at(nat)
-    real(wp) :: xyz(3,nat,nall)
-    integer :: i,j,k,ich,io
-    logical :: ex
-
-    open (newunit=ich,file=fname,status='replace')
-    do i = 1,nall
-      call wrxyz(ich,nat,at,xyz(:,:,i))
-    end do
-    close (ich)
-
-    return
-  end subroutine wrensemble_conf
-
-!=================================================================!
-! subroutine wrensemble_conf_energy
-! write a ensemble file/a trajectory from memory.
-!=================================================================!
-  subroutine wrensemble_conf_energy(fname,nat,nall,at,xyz,er)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: nat
-    integer,intent(in) :: nall
-    integer :: at(nat)
-    real(wp) :: xyz(3,nat,nall)
-    real(wp) :: er(nall)
-    integer :: i,j,k,ich,io
-    logical :: ex
-
-    open (newunit=ich,file=fname,status='replace')
-    do i = 1,nall
-      call wrxyz(ich,nat,at,xyz(:,:,i),er(i))
-    end do
-    close (ich)
-
-    return
-  end subroutine wrensemble_conf_energy
-
-!=================================================================!
-! subroutine wrensemble_conf_energy_comment
-! write a ensemble file/a trajectory from memory.
-!=================================================================!
-  subroutine wrensemble_conf_energy_comment(fname,nat,nall,at,xyz,er,comments)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: nat
-    integer,intent(in) :: nall
-    integer :: at(nat)
-    real(wp) :: xyz(3,nat,nall)
-    real(wp) :: er(nall)
-    character(len=*) :: comments(nall)
-    character(len=512) :: line
-    integer :: i,j,k,ich,io
-    logical :: ex
-
-    open (newunit=ich,file=fname,status='replace')
-    do i = 1,nall
-      write (line,'(2x,f18.8,2x,a)') er(i),trim(comments(i))
-      call wrxyz(ich,nat,at,xyz(:,:,i),trim(line))
-    end do
-    close (ich)
-
-    return
-  end subroutine wrensemble_conf_energy_comment
-
-!==================================================================!
-! subroutine write_ensemble
-! wrapper to write an ensemble from the "ensemble" class
-!==================================================================!
-  subroutine write_ensemble(self,fname)
-    implicit none
-    class(ensemble) :: self
-    character(len=*),intent(in) :: fname
-    call wrensemble_conf_energy(fname,self%nat,self%nall,self%at,self%xyz,self%er)
-    return
-  end subroutine write_ensemble
-
-  subroutine wrensemble_coord_name(fname,nall,structures)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: nall
-    type(coord) :: structures(nall)
-    integer :: ich,i
-    open (newunit=ich,file=fname,status='replace')
-    do i = 1,nall
-      call structures(i)%append(ich)
-    end do
-    close (ich)
-    return
-  end subroutine wrensemble_coord_name
-
-  subroutine wrensemble_coord_channel(ich,nall,structures)
-    implicit none
-    integer,intent(in) :: ich
-    integer,intent(in) :: nall
-    type(coord) :: structures(nall)
-    integer :: i
-    do i = 1,nall
-      call structures(i)%append(ich)
-    end do
-    return
-  end subroutine wrensemble_coord_channel
-
-!==================================================================!
-! subroutine deallocate_ensembletype
-! is used to clear memory for the ensemble type
-!==================================================================!
-  subroutine deallocate_ensembletype(self)
-    implicit none
-    class(ensemble) :: self
-    self%nat = 0
-    self%nall = 0
-    if (allocated(self%vnat)) deallocate (self%vnat)
-    if (allocated(self%at)) deallocate (self%at)
-    if (allocated(self%xyz)) deallocate (self%xyz)
-    if (allocated(self%er)) deallocate (self%er)
-    if (allocated(self%gt)) deallocate (self%gt)
-    if (allocated(self%ht)) deallocate (self%ht)
-    if (allocated(self%svib)) deallocate (self%svib)
-    if (allocated(self%srot)) deallocate (self%srot)
-    if (allocated(self%stra)) deallocate (self%stra)
-
-    return
-  end subroutine deallocate_ensembletype
-
-!==================================================================!
-! subroutine openensemble
-! is the open procedure for the "ensemble" class.
-! a ensemble (trajectory) fname is read into a new ensemble object
-!==================================================================!
-  subroutine openensemble(self,fname)
-    implicit none
-    class(ensemble) :: self
-    character(len=*),intent(in) :: fname
-    integer :: nat
-    integer,allocatable :: at(:)
-    real(wp),allocatable :: xyz(:,:,:)
-    real(wp),allocatable :: eread(:)
-    integer :: nall
-    integer :: i,j,k,ich,io
-    logical :: ex
-
-    inquire (file=fname,exist=ex)
-    if (.not.ex) then
-      error stop 'ensemble file does not exist.'
-    end if
-
-    call rdensembleparam(fname,nat,nall)
-
-    if (nat > 0.and.nall > 0) then
-      call self%deallocate()
-      allocate (at(nat),xyz(3,nat,nall),eread(nall))
-      call rdensemble(fname,nat,nall,at,xyz,eread)
-
-      self%nat = nat
-      self%nall = nall
-      call move_alloc(at,self%at)
-      call move_alloc(xyz,self%xyz)
-      call move_alloc(eread,self%er)
-    else
-      error stop 'format error while reading ensemble file.'
-    end if
-
-    return
-  end subroutine openensemble
-
-!=========================================================================================!
-!=========================================================================================!
-!  2. ROUTINES FOR READING SINGLE STRUCTURES (COORDS)
-!=========================================================================================!
-!=========================================================================================!
-
-!============================================================!
-! subroutine checkcoordtype
-! try to identify the filetype of the coord type.
-! first based on file extension, if that fails by
-! a keyword within the file.
-!============================================================!
-  subroutine checkcoordtype(fname,typint)
-    implicit none
-    character(len=*) :: fname
-    integer,intent(out) :: typint
-    typint = 0
-    !-- check file extension first
-    select case (fextension(fname))
-    case ('.coord','.COORD')
-      typint = tmcoord
-    case ('.xyz','.XYZ','.trj','.TRJ','.sorted')
-      typint = xmol
-    case ('.sd','.sdf','.SDF','.mol','.MOL')
-      typint = sdf
-      if (sgrep(fname,'V2000')) then
-        typint = sdfV2000
-      end if
-      if (sgrep(fname,'V3000')) then
-        typint = sdfV3000
-      end if
-    case ('.pdb','.PDB')
-      typint = pdbfile
-    case default
-      typint = 0
-    end select
-    if (typint .ne. 0) return !-- file extension was recognized
-    !-- grep for keywords otherwise
-    if (sgrep(fname,'$coord')) then
-      typint = tmcoord
-    else !--no match found
-      typint = 0
-    end if
-    return
-  end subroutine checkcoordtype
-
-!============================================================!
-! subroutine rdnat
-! read number of atoms "nat" form file
-!
-! On Input: fname  - name of the coord file
-!           ftype  - (OPTIONAL) format of the input coord file
-!                    if ftype is not present, it is determined
-! On Output: nat   - number of atoms
-!============================================================!
-  subroutine rdnat(fname,nat,ftype)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(out) :: nat
-    integer,optional :: ftype
-    integer :: ftypedum
-    integer :: ich,i,j,io,k
-    logical :: ex
-    character(len=256) :: atmp
-    nat = 0
-    inquire (file=fname,exist=ex)
-    if (.not.ex) then
-      error stop 'file does not exist.'
-    end if
-    if (present(ftype)) then
-      ftypedum = ftype
-    else
-      call checkcoordtype(fname,ftypedum)
-    end if
-    open (newunit=ich,file=fname)
-    select case (ftypedum)
-      !--- *.xyz files
-    case (xmol)
-      read (ich,*,iostat=io) nat
-      !--- TM coord file
-    case (tmcoord)
-      do
-        read (ich,'(a)',iostat=io) atmp
-        if (io < 0) exit
-        atmp = adjustl(atmp)
-        if (index(atmp,"$coord") .eq. 1) exit
-      end do
-      do
-        read (ich,'(a)',iostat=io) atmp
-        if (io < 0) exit
-        atmp = adjustl(atmp)
-        if (atmp(1:1) == '$') exit
-        nat = nat+1
-      end do
-      !--- sdf V2000 (or *.mol) file
-    case (sdfV2000)
-      do i = 1,3 !-- first three comment lines
-        read (ich,'(a)',iostat=io) atmp
-        if (io < 0) exit
-      end do
-      read (ich,'(a)',iostat=io) atmp
-      if (index(atmp,'V2000') .ne. 0) then
-        read (atmp,'(i3)') nat !- first argument is nat
-      end if
-      !--- sdf V3000 file
-    case (sdfV3000)
-      do
-        read (ich,'(a)',iostat=io) atmp
-        if (io < 0) exit
-        if ((index(atmp,'V30') .ne. 0).and. &
-        &  (index(atmp,'COUNTS') .ne. 0)) then
-          j = index(atmp,'COUNTS')+6
-          k = len_trim(atmp)
-          atmp = atmp(j:k)
-          atmp = adjustl(atmp)
-          read (atmp,*) nat
-        end if
-      end do
-      !--- pdb file
-    case (pdbfile)
-      !write(*,*) 'PDB file format not supported yet.'
-      nat = 0
-      do
-        read (ich,'(a)',iostat=io) atmp
-        if (io < 0) exit
-        if ((index(atmp,'ATOM') .eq. 1).or. &
-        &  (index(atmp,'HETATM') .eq. 1)) then
-          nat = nat+1
-        end if
-      end do
-    case default
-      continue
-    end select
-    close (ich)
-    return
-  end subroutine rdnat
-
-!============================================================!
-! subroutine rdcoord
-! read in a structure. The format is determined automatically
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!
-! On Output: at   - atom number as integer
-!            xyz  - coordinates (always in Bohr)
-!            energy - (OPTIONAL) if present, try to get energy
-!                      mainly from xyz files
-!============================================================!
-  subroutine rdcoord(fname,nat,at,xyz,energy)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: nat
-    integer,intent(inout)  :: at(nat)
-    real(wp),intent(inout) :: xyz(3,nat)
-    real(wp),optional :: energy
-    character(len=256) :: atmp
-    integer :: ftype
-    type(pdbdata) :: pdbdummy
-
-    !--- determine the file type
-    call checkcoordtype(fname,ftype)
-
-    select case (ftype)
-    case (tmcoord)  !-- TM coord file, is already in Bohr
-      call rdtmcoord(fname,nat,at,xyz)
-    case (xmol)     !-- XYZ file, is Angström, needs conversion
-      if (present(energy)) then
-        call rdxmol(fname,nat,at,xyz,atmp)
-        energy = grepenergy(atmp)
-      else
-        call rdxmol(fname,nat,at,xyz)
-      end if
-      xyz = xyz/bohr
-    case (sdfV2000)      !-- SDF/MOL V2000 file, also Angström
-      call rdsdf(fname,nat,at,xyz)
-      xyz = xyz/bohr
-    case (sdfV3000)     !-- SDF V3000 file, Angström
-      call rdsdfV3000(fname,nat,at,xyz)
-      xyz = xyz/bohr
-    case (pdbfile)  !-- PDB file, Angström
-      !error stop 'PDB file format not supported yet.'
-      call rdPDB(fname,nat,at,xyz,pdbdummy)
-      xyz = xyz/bohr
-      call pdbdummy%deallocate()
-    case default
-      continue
-    end select
-
-    return
-  end subroutine rdcoord
-
-!============================================================!
-! subroutine rdtmcoord
-! read a struncture in the TM coord style.
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!
-! On Output: at   - atom number as integer
-!            xyz  - coordinates (always in Bohr)
-!============================================================!
-  subroutine rdtmcoord(fname,nat,at,xyz)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: nat
-    integer,intent(inout)  :: at(nat)
-    real(wp),intent(inout) :: xyz(3,nat)
-    character(len=6) :: sym
-    integer :: ich,io,i
-    character(len=256) :: atmp
-    open (newunit=ich,file=fname)
-    do
-      read (ich,'(a)',iostat=io) atmp
-      if (io < 0) exit
-      atmp = adjustl(atmp)
-      if (index(atmp,"$coord") .eq. 1) exit
-    end do
-    do i = 1,nat
-      read (ich,'(a)',iostat=io) atmp
-      if (io < 0) exit
-      atmp = adjustl(atmp)
-      if (atmp(1:1) == '$') exit
-      call coordline(atmp,sym,xyz(1:3,i),io)
-      if (io < 0) then
-        write (*,*) 'error while reading coord line. EOF'
-        exit
-      end if
-      at(i) = e2i(sym)
-    end do
-    close (ich)
-    return
-  end subroutine rdtmcoord
-
-!============================================================!
-! subroutine rdxmol
-! read a struncture in the *.xyz (Xmol) style.
-! The commentary (second) line is ignored
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!
-! On Output: at   - atom number as integer
-!            xyz  - coordinates (in Angström)
-!            comment - (OPTIONAL) commentary line of the file
-!============================================================!
-  subroutine rdxmol(fname,nat,at,xyz,comment)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: nat
-    integer,intent(inout)  :: at(nat)
-    real(wp),intent(inout) :: xyz(3,nat)
-    character(len=*),optional :: comment
-    character(len=6) :: sym
-    integer :: ich,io,i
-    integer :: dum
-    character(len=256) :: atmp
-    open (newunit=ich,file=fname)
-    read (ich,*,iostat=io) dum
-    if (nat .ne. dum) then
-      error stop 'error while reading input coordinates'
-    end if
-    read (ich,'(a)') atmp !--commentary line
-    if (present(comment)) comment = trim(adjustl(atmp))
-    do i = 1,nat
-      read (ich,'(a)',iostat=io) atmp
-      if (io < 0) exit
-      atmp = adjustl(atmp)
-      call coordline(atmp,sym,xyz(1:3,i),io)
-      if (io < 0) then
-        write (*,*) 'error while reading coord line. EOF'
-        exit
-      end if
-      at(i) = e2i(sym)
-    end do
-    close (ich)
-    return
-  end subroutine rdxmol
-
-!============================================================!
-! subroutine rdsdf
-! read a struncture in the .sdf/.mol V2000 style.
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!
-! On Output: at   - atom number as integer
-!            xyz  - coordinates (in Angström)
-!            comment - (OPTIONAL) commentary line of the file
-!============================================================!
-  subroutine rdsdf(fname,nat,at,xyz,comment)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: nat
-    integer,intent(inout)  :: at(nat)
-    real(wp),intent(inout) :: xyz(3,nat)
-    character(len=*),optional :: comment
-    character(len=6) :: sym
-    integer :: ich,io,i
-    integer :: dum
-    character(len=256) :: atmp
-    open (newunit=ich,file=fname)
-    read (ich,'(a)',iostat=io) atmp
-    read (ich,'(a)',iostat=io) atmp
-    read (ich,'(a)',iostat=io) atmp
-    if (present(comment)) comment = trim(adjustl(atmp))
-    read (ich,'(i3)',iostat=io) dum
-    if (nat .ne. dum) then
-      error stop 'error while reading input coordinates'
-    end if
-    do i = 1,nat
-      read (ich,'(a)',iostat=io) atmp
-      if (io < 0) exit
-      atmp = adjustl(atmp)
-      call coordline(atmp,sym,xyz(1:3,i),io)
-      if (io < 0) then
-        write (*,*) 'error while reading coord line. EOF'
-        exit
-      end if
-      at(i) = e2i(sym)
-    end do
-    close (ich)
-    return
-  end subroutine rdsdf
-
-!============================================================!
-! subroutine rdsdfV3000
-! read a struncture in the .sdf/.mol V3000 style.
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!
-! On Output: at   - atom number as integer
-!            xyz  - coordinates (in Angström)
-!            comment - (OPTIONAL) commentary line of the file
-!============================================================!
-  subroutine rdsdfV3000(fname,nat,at,xyz,comment)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: nat
-    integer,intent(inout)  :: at(nat)
-    real(wp),intent(inout) :: xyz(3,nat)
-    character(len=*),optional :: comment
-    character(len=6) :: sym
-    integer :: ich,io,i,j,k,l
-    integer :: dum
-    character(len=256) :: atmp
-    character(len=32) :: btmp
-    open (newunit=ich,file=fname)
-    read (ich,'(a)',iostat=io) atmp
-    read (ich,'(a)',iostat=io) atmp
-    read (ich,'(a)',iostat=io) atmp
-    if (present(comment)) comment = trim(adjustl(atmp))
-    do
-      read (ich,'(a)',iostat=io) atmp
-      if (io < 0) exit
-      if ((index(atmp,'V30') .ne. 0).and. &
-      &  (index(atmp,'COUNTS') .ne. 0)) then
-        j = index(atmp,'COUNTS')+6
-        k = len_trim(atmp)
-        atmp = atmp(j:k)
-        atmp = adjustl(atmp)
-        read (atmp,*) dum
-      end if
-      if ((index(atmp,'V30') .ne. 0).and. &
-      &  (index(atmp,'ATOM') .ne. 0)) then
-        exit
-      end if
-    end do
-    if (nat .ne. dum) then
-      error stop 'error while reading input coordinates'
-    end if
-    do i = 1,nat
-      read (ich,'(a)',iostat=io) atmp
-      if (io < 0) exit
-      write (btmp,'(i0)') i
-      l = len_trim(btmp)+1
-      j = index(atmp,'V30')+3
-      k = len_trim(atmp)
-      atmp = atmp(j:k)
-      atmp = adjustl(atmp)
-      atmp = atmp(l:k)
-      call coordline(atmp,sym,xyz(1:3,i),io)
-      if (io < 0) then
-        write (*,*) 'error while reading coord line. EOF'
-        exit
-      end if
-      at(i) = e2i(sym)
-    end do
-    close (ich)
-    return
-  end subroutine rdsdfV3000
-
-!============================================================!
-! subroutine rdPDB
-! read a struncture in the .PDB style.
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!
-! On Output: at   - atom number as integer
-!            xyz  - coordinates (in Angström)
-!            pdb  - pdbdata object
-!============================================================!
-  subroutine rdPDB(fname,nat,at,xyz,pdb)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: nat
-    integer,intent(inout)  :: at(nat)
-    real(wp),intent(inout) :: xyz(3,nat)
-    type(pdbdata) :: pdb
-    character(len=2) :: sym
-    integer :: ich,io,i,j,k
-    character(len=256) :: atmp
-    character(len=6) :: dum1
-    character(len=1) :: dum2,dum3,pdbgp
-    character(len=3) :: pdbas
-    character(len=2) :: dum4
-    character(len=4) :: pdbat
-    real(wp) :: r1,r2
-    call pdb%allocate(nat)
-    open (newunit=ich,file=fname)
-    k = 0
-    do
-      read (ich,'(a)',iostat=io) atmp
-      if (io < 0) exit
-      if ((index(atmp,'ATOM') .eq. 1).or. &
-      &  (index(atmp,'HETATM') .eq. 1)) then
-        k = k+1
-        read (atmp,'(A6,I5,1X,A4,A1,A3,1X,A1,I4,A1,3X,3F8.3,2F6.2,10X,A2,A2)') &
-        &  dum1,i,pdbat,dum2,pdbas,pdbgp,j,dum3,xyz(1:3,k),r1,r2,sym,dum4
-        at(k) = e2i(sym)
-        pdb%pdbat(k) = pdbat
-        pdb%pdbas(k) = pdbas
-        pdb%pdbgrp(k) = pdbgp
-        pdb%pdbfrag(k) = j
-        pdb%pdbocc(k) = r1
-        pdb%pdbtf(k) = r2
-      end if
-    end do
-    close (ich)
-    return
-  end subroutine rdPDB
-
-!============================================================!
-! subroutine rdxmolselec
-! Read a file with multiple structures in the *.xyz (Xmol) style.
-! Picks one structure.
-! The commentary (second) line is ignored
-!
-! On Input: fname  - name of the coord file
-!           m      - position of the desired structure
-!           nat    - number of atoms
-!
-! On Output: at   - atom number as integer
-!            xyz  - coordinates (in Angström)
-!============================================================!
-
-  subroutine rdxmolselec(fname,m,nat,at,xyz,comment)
-    implicit none
-    character(len=*),intent(in) :: fname
-    integer,intent(in) :: nat,m
-    integer,intent(inout)  :: at(nat)
-    real(wp),intent(inout) :: xyz(3,nat)
-    character(len=*),optional :: comment
-    character(len=6) :: sym
-    integer :: ich,io,i,j
-    integer :: dum
-    character(len=256) :: atmp
-
-    open (newunit=ich,file=fname)
-
-    do j = 1,m
-      read (ich,*,iostat=io) dum
-      if (nat .ne. dum) then
-        error stop 'error while reading input coordinates'
-      end if
-      read (ich,'(a)') atmp !--commentary line
-      if (present(comment)) comment = trim(adjustl(atmp))
-      do i = 1,nat
-        read (ich,'(a)',iostat=io) atmp
-        if (io < 0) exit
-        atmp = adjustl(atmp)
-        call coordline(atmp,sym,xyz(1:3,i),io)
-        if (io < 0) then
-          write (*,*) 'error while reading coord line. EOF'
-          exit
-        end if
-        at(i) = e2i(sym)
-      end do
-    end do
-    close (ich)
-    xyz = xyz/bohr
-    return
-  end subroutine rdxmolselec
-
-!==================================================================!
-! subroutine deallocate_coord
-! is used to clear memory for the coord type
-!==================================================================!
-  subroutine deallocate_coord(self)
-    implicit none
-    class(coord) :: self
-    self%nat = 0
-    if (allocated(self%at)) deallocate (self%at)
-    if (allocated(self%xyz)) deallocate (self%xyz)
-    call self%pdb%deallocate()
-    return
-  end subroutine deallocate_coord
-
-!==================================================================!
-! subroutine deallocate_pdb
-! is used to clear memory for the pdbdata type
-!==================================================================!
-  subroutine deallocate_pdb(self)
-    implicit none
-    class(pdbdata) :: self
-    self%nat = 0
-    self%frag = 0
-    if (allocated(self%athet)) deallocate (self%athet)
-    if (allocated(self%pdbat)) deallocate (self%pdbat)
-    if (allocated(self%pdbas)) deallocate (self%pdbas)
-    if (allocated(self%pdbfrag)) deallocate (self%pdbfrag)
-    if (allocated(self%pdbgrp)) deallocate (self%pdbgrp)
-    if (allocated(self%pdbocc)) deallocate (self%pdbocc)
-    if (allocated(self%pdbtf)) deallocate (self%pdbtf)
-    return
-  end subroutine deallocate_pdb
-
-!==================================================================!
-! subroutine allocate_pdb
-! is used to clear memory for the pdbdata type
-!==================================================================!
-  subroutine allocate_pdb(self,nat)
-    implicit none
-    class(pdbdata) :: self
-    integer :: nat
-    call deallocate_pdb(self)
-    self%nat = nat
-    allocate (self%athet(nat))
-    allocate (self%pdbat(nat))
-    allocate (self%pdbas(nat))
-    allocate (self%pdbfrag(nat))
-    allocate (self%pdbgrp(nat))
-    allocate (self%pdbocc(nat))
-    allocate (self%pdbtf(nat))
-    return
-  end subroutine allocate_pdb
-
-!==================================================================!
-! subroutine opencoord
-! is the open procedure for the "coord" class.
-!==================================================================!
-  subroutine opencoord(self,fname)
-    implicit none
-    class(coord) :: self
-    character(len=*),intent(in) :: fname
-    integer :: nat
-    integer,allocatable :: at(:)
-    real(wp),allocatable :: xyz(:,:)
-    integer :: ftype
-    integer :: i,j,k,ich,io
-    logical :: ex
-    real(wp) :: en
-
-    inquire (file=fname,exist=ex)
-    if (.not.ex) then
-      error stop 'coord file does not exist.'
-    end if
-
-    call self%deallocate()
-
-    call checkcoordtype(fname,ftype)
-    call rdnat(fname,nat)
-
-    if (nat > 0) then
-      en = 0.0_wp
-      allocate (at(nat),xyz(3,nat))
-      if (ftype == pdbfile) then
-        call rdPDB(fname,nat,at,xyz,self%pdb)
-        xyz = xyz/bohr
-      else
-        call rdcoord(fname,nat,at,xyz,energy=en)
-      end if
-
-      self%nat = nat
-      self%energy = en
-      call move_alloc(at,self%at)
-      call move_alloc(xyz,self%xyz)
-    else
-      error stop 'format error while reading coord file.'
-    end if
-
-    return
-  end subroutine opencoord
-!==================================================================!
-! subroutine getcoord
-! allocate "coord" class and fill with data
-!==================================================================!
-  subroutine getcoord(self,convfac,nat,at,xyz)
-    implicit none
-    class(coord) :: self
-    real(wp),intent(in) :: convfac
-    integer,intent(in)  :: nat
-    integer,intent(in)  :: at(nat)
-    real(wp),intent(in) :: xyz(3,nat)
-    call self%deallocate()
-    allocate (self%at(nat))
-    allocate (self%xyz(3,nat))
-    self%nat = nat
-    self%at = at
-    self%xyz = xyz/convfac
-    return
-  end subroutine getcoord
-
-!==================================================================!
-! function coord_getdistance
-! calculate the distance for a given pair of atoms
-!==================================================================!
-  function coord_getdistance(self,a1,a2) result(d)
-    implicit none
-    class(coord) :: self
-    integer,intent(in) :: a1,a2
-    real(wp) :: d
-    d = 0.0_wp
-    if (allocated(self%xyz)) then
-      d = (self%xyz(1,a1)-self%xyz(1,a2))**2+ &
-      &   (self%xyz(2,a1)-self%xyz(2,a2))**2+ &
-      &   (self%xyz(3,a1)-self%xyz(3,a2))**2
-      d = sqrt(d)
-    end if
-    return
-  end function coord_getdistance
-
-!==================================================================!
-! function coord_getangle
-! calculate the angle for a given trio of atoms in rad
-! A1-A2-A3
-!==================================================================!
-  function coord_getangle(self,a1,a2,a3) result(angle)
-    implicit none
-    class(coord) :: self
-    integer,intent(in) :: a1,a2,a3
-    real(wp) :: angle,u(3),v(3),o(3)
-    real(wp) :: d2ij,d2jk,d2ik,xy,temp
-    angle = 0.0_wp
-    if (allocated(self%xyz)) then
-      u(1:3) = self%xyz(1:3,a1)-self%xyz(1:3,a2)
-      v(1:3) = self%xyz(1:3,a3)-self%xyz(1:3,a2)
-      angle = tangle(u,v)
-    end if
-    return
-  end function coord_getangle
-
-!==================================================================!
-! function coord_getdihedral
-! calculate the dihedral angle for a given quartet of atoms in rad
-! A1-A2-A3-A4
-!==================================================================!
-  function coord_getdihedral(self,a1,a2,a3,a4) result(dihed)
-    implicit none
-    class(coord) :: self
-    integer,intent(in) :: a1,a2,a3,a4
-    real(wp) :: dihed
-    real(wp) :: u(3),v(3),w(3)
-    real(wp) :: n1(3),n2(3)
-    real(wp) :: u1(3),u2(3),u3(3)
-
-    dihed = 0.0_wp
-    if (allocated(self%xyz)) then
-
-      u(1:3) = self%xyz(1:3,a2)-self%xyz(1:3,a1)
-      v(1:3) = self%xyz(1:3,a3)-self%xyz(1:3,a2)
-      w(1:3) = self%xyz(1:3,a4)-self%xyz(1:3,a3)
-      dihed = dihedral(u,v,w)
-    end if
-    return
-  end function coord_getdihedral
-
-!==================================================================!
-! function coord_getgutout
-! create a cutout mol object
-!==================================================================!
-  function coord_getcutout(self,atlist) result(molout)
-    implicit none
-    class(coord) :: self
-    logical,intent(in) :: atlist(self%nat)
-    type(coord) :: molout
-    integer :: newnat,i,j,k,l
-
-    newnat = count(atlist,1)
-    if (newnat == self%nat) then
-      molout = self
-    else
-      allocate (molout%at(newnat),source=0)
-      allocate (molout%xyz(3,newnat),source=0.0_wp)
-      k = 0
-      do i = 1,self%nat
-        if (atlist(i)) then
-          k = k+1
-          molout%at(k) = self%at(i)
-          molout%xyz(1:3,k) = self%xyz(1:3,i)
-        end if
-      end do
-    end if
-    return
-  end function coord_getcutout
-
-!==================================================================!
-
-  subroutine coord_get_CN(self,cn,cn_type,cn_thr,dcndr)
-    implicit none
-    class(coord) :: self
-    real(wp),intent(out),allocatable :: cn(:)
-    real(wp),intent(in),optional :: cn_thr
-    character(len=*),intent(in),optional :: cn_type
-    real(wp),intent(out),optional :: dcndr(3,self%nat,self%nat)
-    if (self%nat <= 0) return
-    if (.not.allocated(self%xyz).or..not.allocated(self%at)) return
-    allocate (cn(self%nat),source=0.0_wp)
-    call calculate_CN(self%nat,self%at,self%xyz,cn, &
-    & cntype=cn_type,cnthr=cn_thr,dcndr=dcndr)
-  end subroutine coord_get_CN
-
-!==================================================================!
-
-  subroutine coord_get_z(self,z)
-    implicit none
-    class(coord) :: self
-    real(wp),intent(out),allocatable :: z(:)
-    integer :: i,j,k
-    if (self%nat <= 0) return
-    if (.not.allocated(self%xyz).or..not.allocated(self%at)) return
-    allocate (z(self%nat),source=0.0_wp)
-    do i = 1,self%nat
-      z(i) = real(self%at(i),wp)-real(ncore(self%at(i)))
-      if (self%at(i) > 57.and.self%at(i) < 72) z(i) = 3.0_wp
-    end do
-  end subroutine coord_get_z
-
-!==================================================================!
-
-  subroutine coord_cn_to_bond(self,cn,bond,cn_type,cn_thr)
-    implicit none
-    class(coord) :: self
-    real(wp),intent(out),allocatable :: cn(:)
-    real(wp),intent(out),allocatable,optional :: bond(:,:)
-    real(wp),intent(in),optional :: cn_thr
-    character(len=*),intent(in),optional :: cn_type
-    if (self%nat <= 0) return
-    if (.not.allocated(self%xyz).or..not.allocated(self%at)) return
-    allocate (cn(self%nat),source=0.0_wp)
-    call calculate_CN(self%nat,self%at,self%xyz,cn, &
-    & cntype=cn_type,cnthr=cn_thr,bond=bond)
-  end subroutine coord_cn_to_bond
-
-!=========================================================================================!
-!=========================================================================================!
-!  3. ROUTINES FOR WRITING STRUCTURES AND CONVERTING THEM
-!=========================================================================================!
-!=========================================================================================!
-
-!============================================================!
-! subroutine wrc0_file
-! this is the typical quick write routine for TM coord files
-! version for writing directly to a new file
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!           at   - atom number as integer
-!           xyz  - coordinates (in Bohr)
-!
-! On Output: file written to "fname"
-!============================================================!
-  subroutine wrc0_file(fname,nat,at,xyz)
-    implicit none
-    character(len=*) :: fname
-    integer :: nat
-    integer :: at(nat)
-    real(wp) ::  xyz(3,nat)
-    integer :: i,j,k,ich,io
-    logical :: ex
-    open (newunit=ich,file=fname,status='replace')
-    write (ich,'(''$coord'')')
-    do j = 1,nat
-      write (ich,'(3F24.12,5x,a2)') xyz(1:3,j),i2e(at(j),'lc')
-    end do
-    write (ich,'(''$end'')')
-    close (ich)
-    return
-  end subroutine wrc0_file
-
-!============================================================!
-! subroutine wrc0_channel
-! this is the typical quick write routine for TM coord files
-! version for writing to a output channel
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!           at   - atom number as integer
-!           xyz  - coordinates (in Bohr)
-!
-! On Output: file written to "fname"
-!============================================================!
-  subroutine wrc0_channel(ch,nat,at,xyz)
-    implicit none
-    integer :: ch
-    integer :: nat
-    integer :: at(nat)
-    real(wp) ::  xyz(3,nat)
-    integer :: i,j,k,ich,io
-    logical :: ex
-    write (ch,'(''$coord'')')
-    do j = 1,nat
-      write (ch,'(3F24.12,5x,a2)') xyz(1:3,j),i2e(at(j),'lc')
-    end do
-    write (ch,'(''$end'')')
-    return
-  end subroutine wrc0_channel
-
-!============================================================!
-! subroutine wrxyz_file
-! this is the typical quick write routine for TM coord files
-! version for writing directly to a new file
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!           at   - atom number as integer
-!           xyz  - coordinates (in Angström)
-!           comment - (OPTIONAL) comment line
-!
-! On Output: file written to "fname"
-!============================================================!
-  subroutine wrxyz_file(fname,nat,at,xyz,comment)
-    implicit none
-    character(len=*) :: fname
-    integer :: nat
-    integer :: at(nat)
-    real(wp) ::  xyz(3,nat)
-    character(len=*),optional :: comment
-    integer :: i,j,k,ich,io
-    logical :: ex
-    open (newunit=ich,file=fname,status='replace')
-    write (ich,'(2x,i0)') nat
-    if (present(comment)) then
-      write (ich,'(a)') trim(comment)
-    else
-      write (ich,*)
-    end if
-    do j = 1,nat
-      write (ich,'(1x,a2,1x,3f20.10)') i2e(at(j),'nc'),xyz(1:3,j)
-    end do
-    close (ich)
-    return
-  end subroutine wrxyz_file
-
-!============================================================!
-! subroutine wrxyz_file_mask
-! this is the typical quick write routine for TM coord files
-! version for writing directly to a new file
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!           at   - atom number as integer
-!           xyz  - coordinates (in Angström)
-!           mask - a mask to determine to write which atoms
-!           comment - (OPTIONAL) comment line
-!
-! On Output: file written to "fname"
-!============================================================!
-  subroutine wrxyz_file_mask(fname,nat,at,xyz,mask,comment)
-    implicit none
-    character(len=*) :: fname
-    integer :: nat
-    integer :: at(nat)
-    real(wp) ::  xyz(3,nat)
-    logical :: mask(nat)
-    integer :: maskednat
-    character(len=*),optional :: comment
-    integer :: i,j,k,ich,io
-    logical :: ex
-    open (newunit=ich,file=fname,status='replace')
-    maskednat = count(mask(:))
-    write (ich,'(2x,i0)') maskednat
-    if (present(comment)) then
-      write (ich,'(a)') trim(comment)
-    else
-      write (ich,*)
-    end if
-    do j = 1,nat
-      if (mask(j)) then
-        write (ich,'(1x,a2,1x,3f20.10)') i2e(at(j),'nc'),xyz(1:3,j)
-      end if
-    end do
-    close (ich)
-    return
-  end subroutine wrxyz_file_mask
-
-!============================================================!
-! subroutine wrxyz_channel
-! this is the typical quick write routine for xyz files
-! version for writing to a output channel
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!           at   - atom number as integer
-!           xyz  - coordinates (in Angström)
-!           comment - (OPTIONAL) the comment line
-!
-! On Output: file written to "fname"
-!============================================================!
-  subroutine wrxyz_channel(ch,nat,at,xyz,comment)
-    implicit none
-    integer :: ch
-    integer :: nat
-    integer :: at(nat)
-    real(wp) ::  xyz(3,nat)
-    character(len=*),optional :: comment
-    integer :: i,j,k,ich,io
-    logical :: ex
-    write (ch,'(2x,i0)') nat
-    if (present(comment)) then
-      write (ch,'(a)') trim(comment)
-    else
-      write (ch,*)
-    end if
-    do j = 1,nat
-      write (ch,'(1x,a2,1x,3f20.10)') i2e(at(j),'nc'),xyz(1:3,j)
-    end do
-    return
-  end subroutine wrxyz_channel
-
-!============================================================!
-! subroutine wrxyz_channel
-! this is the typical quick write routine for xyz files
-! version for writing to a output channel
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!           at   - atom number as integer
-!           xyz  - coordinates (in Angström)
-!           er   - energy
-!
-! On Output: file written to "fname"
-!============================================================!
-  subroutine wrxyz_channel_energy(ch,nat,at,xyz,er)
-    implicit none
-    integer :: ch
-    integer :: nat
-    integer :: at(nat)
-    real(wp) ::  xyz(3,nat)
-    real(wp) :: er
-    integer :: i,j,k,ich,io
-    logical :: ex
-    write (ch,'(2x,i0)') nat
-    write (ch,'(2x,f18.8)') er
-    do j = 1,nat
-      write (ch,'(1x,a2,1x,3f20.10)') i2e(at(j),'nc'),xyz(1:3,j)
-    end do
-    return
-  end subroutine wrxyz_channel_energy
-
-!============================================================!
-! subroutine wrsdf_channel
-! this is the quick write routine for sdf files
-! version for writing to a output channel
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!           at   - atom number as integer
-!           xyz  - coordinates (in Angström)
-!           er   - energy
-!           wbo  - bond order matrix
-!
-! On Output: written to channel "ch"
-!============================================================!
-  subroutine wrsdf_channel(ch,nat,at,xyz,er,chrg,wbo,comment,icharges)
-    implicit none
-    integer,intent(in) :: ch
-    integer,intent(in) :: nat
-    integer,intent(in) :: at(nat)
-    real(wp),intent(in) ::  xyz(3,nat)
-    real(wp),intent(in) :: er
-    integer,intent(in) :: chrg
-    real(wp),intent(in) :: wbo(nat,nat)
-    character(len=*),intent(in) :: comment
-    real(wp),intent(in),optional :: icharges(nat)
-    character(len=8)  :: date
-    character(len=10) :: time
-    integer :: list12(12),nbd
-    integer,parameter :: list4(4) = 0
-    integer,parameter :: list8(8) = 0
-    character(len=*),parameter :: countsfmt = '(3i3, 8i3, 1x, a5)'
-    character(len=*),parameter :: atmfmt = '(3f10.4, 1x, a2, 12i3)'
-    character(len=*),parameter :: bndfmt = '(7i3)'
-    integer :: i,j,k,ich,io
-    logical :: ex
-
-    !>--- generate data
-    call date_and_time(date,time)
-    nbd = countbonds(nat,wbo)
-    list12 = 0
-    !>--- comment lines
-    call date_and_time(date,time)
-    write (ch,'(a)') trim(comment)
-    write (ch,'(1x,a, 3a2, a4, "3D",1x,a,f18.8,5x)') &
-    & 'crest',date(5:6),date(7:8),date(3:4),time(:4),'Energy =',er
-    write (ch,'(a)')
-    !>--- counts line
-    write (ch,countsfmt) nat,nbd,list8,999,'V2000'
-    !>--- atom block
-    do j = 1,nat
-      write (ch,atmfmt) xyz(1:3,j),i2e(at(j),'nc'),list12
-    end do
-    !>--- bonds block
-    do i = 1,nat
-      do j = i+1,nat
-        k = nint(wbo(j,i))
-        if (k > 0) then
-          write (ch,bndfmt) i,j,k,list4
-        end if
-      end do
-    end do
-    !>--- other
-    if (present(icharges)) then
-      do i = 1,nat
-        if (abs(nint(icharges(i))) /= 0) then
-          write (ch,'(a, *(i3, 1x, i3, 1x, i3))') "M  CHG",1,i,nint(icharges(i))
-        end if
-      end do
-    else if (chrg .ne. 0) then
-      write (ch,'(a, *(i3, 1x, i3, 1x, i3))') "M  CHG",1,1,chrg
-    end if
-    write (ch,'(a)') 'M  END'
-    write (ch,'(a)') '$$$$'
-    return
-  end subroutine wrsdf_channel
-
-!============================================================!
-! subroutine wrsdfV3000_channel
-! this is the quick write routine for sdf files
-! version for writing to a output channel
-!
-! On Input: fname  - name of the coord file
-!           nat    - number of atoms
-!           at   - atom number as integer
-!           xyz  - coordinates (in Angström)
-!           er   - energy
-!           wbo  - bond order matrix
-!
-! On Output: written to channel "ch"
-!============================================================!
-  subroutine wrsdfV3000_channel(ch,nat,at,xyz,er,chrg,wbo,comment)
-    implicit none
-    integer,intent(in) :: ch
-    integer,intent(in) :: nat
-    integer,intent(in) :: at(nat)
-    real(wp),intent(in) ::  xyz(3,nat)
-    real(wp),intent(in) :: er
-    real(wp),intent(in) :: chrg
-    real(wp),intent(in) :: wbo(nat,nat)
-    character(len=*),intent(in),optional :: comment
-    character(len=8)  :: date
-    character(len=10) :: time
-    integer :: list12(12),nbd,b
-    integer,parameter :: list4(4) = 0
-    character(len=*),parameter :: countsfmt = '(3i3, 8i3, 1x, a5)'
-    character(len=*),parameter :: countsfmt2 = '(a,2i3, 3i3)'
-    character(len=*),parameter :: atmfmt = '(a,1x,i0,1x, a,3f10.4, i2, 11i3)'
-    character(len=*),parameter :: bndfmt = '(a,1x,i0,1x,7i3)'
-    integer :: i,j,k,ich,io
-    logical :: ex
-
-    !>--- generate data
-    call date_and_time(date,time)
-    nbd = countbonds(nat,wbo)
-    !>--- comment lines
-    call date_and_time(date,time)
-    if (present(comment)) then
-      write (ch,'(1x,a)') comment
-    else
-      write (ch,'(1x,a)') 'structure written by crest'
-    end if
-    write (ch,'(1x,a,f18.8,5x, 3a2, a4, "3D")') &
-    & 'Energy =',er,date(5:6),date(7:8),date(3:4),time(:4)
-    write (ch,'(a)')
-    !>--- counts line
-    write (ch,countsfmt) nat,nbd,0,0,0,999,'V2000'
-    write (ch,'("M V30 BEGIN CTAB")')
-    write (ch,countsfmt2) "M V30 COUNTS",nat,nbd,0,0,0
-    !>--- atom block
-    write (ch,'("M V30 BEGIN ATOM")')
-    do j = 1,nat
-      write (ch,atmfmt) 'M V30',j, &
-      &     i2e(at(j),'nc'),xyz(1:3,j),list12
-    end do
-    write (ch,'("M V30 END ATOM")')
-    !>--- bonds block
-    write (ch,'("M V30 BEGIN BOND")')
-    b = 0
-    do i = 1,nat
-      do j = i+1,nat
-        k = nint(wbo(j,i))
-        if (k > 0) then
-          b = b+1
-          write (ch,bndfmt) "M V30",b,i,j,k,list4
-        end if
-      end do
-    end do
-    write (ch,'("M V30 END BOND")')
-    !>--- other
-    if (chrg .ne. 0) then
-      write (ch,'(a, *(i3, 1x, i3, 1x, i3))') "M V30 CHG",1,1,chrg
-    end if
-    write (ch,'(a)') 'M V30 END CTAB'
-    write (ch,'(a)') 'M  END'
-    write (ch,'(a)') '$$$$'
-    return
-  end subroutine wrsdfV3000_channel
-
-!============================================================!
-! subroutine xyz2coord
-! simple conversion of a xyz to a coord file.
-!
-! On Input: iname  - name of the xyz file
-!           oname  - name of the coord file
-!
-! On Output: file written to "oname"
-!============================================================!
-  subroutine xyz2coord(iname,oname)
-    implicit none
-    character(len=*) :: iname
-    character(len=*) :: oname
-    type(coord) :: struc
-    call struc%open(iname)
-    call wrc0(oname,struc%nat,struc%at,struc%xyz)
-    call struc%deallocate()
-    return
-  end subroutine xyz2coord
-
-!============================================================!
-! subroutine coord2xyz
-! simple conversion of a coord to a xyz file.
-!
-! On Input: iname  - name of the coord file
-!           oname  - name of the xyz file
-!
-! On Output: file written to "oname"
-!============================================================!
-  subroutine coord2xyz(iname,oname)
-    implicit none
-    character(len=*) :: iname
-    character(len=*) :: oname
-    type(coord) :: struc
-    call struc%open(trim(iname))
-    struc%xyz = struc%xyz*bohr !to Angström
-    call wrxyz(oname,struc%nat,struc%at,struc%xyz)
-    call struc%deallocate()
-    return
-  end subroutine coord2xyz
-
-!==================================================================!
-! subroutine writecoord
-! is the write procedure for the "coord" class.
-!==================================================================!
-  subroutine writecoord(self,fname)
-    implicit none
-    class(coord) :: self
-    character(len=*),intent(in) :: fname
-    character(len=80) :: comment
-    if (.not.allocated(self%xyz)) then
-      write (*,*) 'Cannot write ',trim(fname),'. not allocated'
-    end if
-    if (index(fname,'.xyz') .ne. 0) then
-      write (comment,'(a,G0.12)') '  energy= ',self%energy
-      self%xyz = self%xyz*bohr !to Angström
-      call wrxyz(fname,self%nat,self%at,self%xyz,comment)
-      self%xyz = self%xyz/bohr !back
-    else
-      call wrc0(fname,self%nat,self%at,self%xyz)
-    end if
-    return
-  end subroutine writecoord
-
-!==================================================================!
-! subroutine appendcoord
-! is the write procedure for the "coord" class.
-! coords will be written out in XYZ format!
-!==================================================================!
-  subroutine appendcoord(self,io)
-    implicit none
-    class(coord) :: self
-    integer :: io
-    character(len=64) :: atmp
-    self%xyz = self%xyz*bohr !to Angström
-    if (allocated(self%comment)) then
-      call wrxyz(io,self%nat,self%at,self%xyz,trim(self%comment))
-    else if (self%energy .ne. 0.0_wp) then
-      write (atmp,'(a,f22.10)') ' Etot= ',self%energy
-      call wrxyz(io,self%nat,self%at,self%xyz,trim(atmp))
-    else
-      call wrxyz(io,self%nat,self%at,self%xyz)
-    end if
-    self%xyz = self%xyz/bohr !back
-    return
-  end subroutine appendcoord
-
-  subroutine appendlog(self,io,energy,gnorm)
-    implicit none
-    class(coord) :: self
-    integer :: io
-    real(wp),optional :: energy
-    real(wp),optional :: gnorm
-    character(len=64) :: atmp
-    self%xyz = self%xyz*bohr !to Angström
-    if (present(gnorm).and.present(energy)) then
-      write (atmp,'(a,f22.10,a,f16.8)') ' Etot= ',energy,' grad.norm.= ',gnorm
-    else if (present(energy)) then
-      write (atmp,'(a,f22.10)') ' Etot= ',energy
-    else
-      atmp = ''
-    end if
-    call wrxyz(io,self%nat,self%at,self%xyz,trim(atmp))
-    self%xyz = self%xyz/bohr !back
-    return
-  end subroutine appendlog
-
-!=========================================================================================!
-!=========================================================================================!
-!  4. GENERAL UTILITY ROUTINES
-!=========================================================================================!
-!=========================================================================================!
-
-!============================================================!
-! read a line of coordinates and determine by itself
-! if the format is x,y,z,at or at,x,y,z
-!============================================================!
-  subroutine coordline(line,sym,xyz,io)
-    implicit none
-    character(len=*) :: line
-    character(len=*) :: sym
-    real(wp) :: xyz(3)
-    integer,intent(out) :: io
-
-    io = 0
-    read (line,*,iostat=io) xyz(1:3),sym
-    if (io .ne. 0) then
-      read (line,*,iostat=io) sym,xyz(1:3)
-      !if(io.ne.0)then
-      !  error stop 'error while reading coord line'
-      !endif
-    end if
-
-    return
-  end subroutine coordline
-
-!============================================================!
-! convert a string into uppercase
-!============================================================!
-  function upperCase(s)
-    implicit none
-    character(len=*),intent(in) :: s
-    character(len=:),allocatable :: sout
-    character(len=:),allocatable :: upperCase
-    integer :: ic,i
-    character(26),Parameter :: high = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-    character(26),Parameter :: low = 'abcdefghijklmnopqrstuvwxyz'
-    sout = s
-    do i = 1,LEN_TRIM(s)
-      ic = INDEX(low,s(i:i))
-      if (ic > 0) sout(i:i) = high(ic:ic)
-    end do
-    call move_alloc(sout,upperCase)
-  end function upperCase
-
-!============================================================!
-! convert a string into lowercase
-!============================================================!
-  function lowerCase(s)
-    implicit none
-    character(len=*),intent(in) :: s
-    character(len=:),allocatable :: sout
-    character(len=:),allocatable :: lowerCase
-    integer :: ic,i
-    character(26),Parameter :: high = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-    character(26),Parameter :: low = 'abcdefghijklmnopqrstuvwxyz'
-    sout = s
-    do i = 1,LEN_TRIM(s)
-      ic = INDEX(high,s(i:i))
-      if (ic > 0) sout(i:i) = low(ic:ic)
-    end do
-    call move_alloc(sout,lowerCase)
-  end function lowerCase
-
-!============================================================!
-! split element lable if some isotope indicator was given
-! and convert to uppercase
-!============================================================!
-  function convertlable(s)
-    implicit none
-    character(len=*),intent(in) :: s
-    character(len=:),allocatable :: sout
-    character(len=:),allocatable :: convertlable
-    integer :: ic,i
-    character(14),parameter :: lab = '0123456789*_+-'
-    character(26),parameter :: high = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-    character(26),parameter :: low = 'abcdefghijklmnopqrstuvwxyz'
-    sout = s
-    do i = 1,len_trim(s)
-      ic = index(lab,s(i:i))
-      if (ic > 0) sout(i:i) = ' '
-      ic = index(low,s(i:i))
-      if (ic > 0) sout(i:i) = high(ic:ic)
-    end do
-    sout = trim(adjustl(sout))
-    if (len_trim(sout) .gt. 1) then
-      sout(2:2) = lowerCase(sout(2:2))
-    else
-      sout = sout//' '
-    end if
-    call move_alloc(sout,convertlable)
-  end function convertlable
-
-!=============================================================!
-  pure elemental integer function ncore(at)
-    integer,intent(in) :: at
-    if (at .le. 2) then
-      ncore = 0
-    elseif (at .le. 10) then
-      ncore = 2
-    elseif (at .le. 18) then
-      ncore = 10
-    elseif (at .le. 29) then   !zn
-      ncore = 18
-    elseif (at .le. 36) then
-      ncore = 28
-    elseif (at .le. 47) then
-      ncore = 36
-    elseif (at .le. 54) then
-      ncore = 46
-    elseif (at .le. 71) then
-      ncore = 54
-    elseif (at .le. 79) then
-      ncore = 68
-    elseif (at .le. 86) then
-      ncore = 78
-    end if
-  end function ncore
-
-!============================================================!
-! e2i is used to map the element (as a string) to integer
-!============================================================!
-  integer function e2i(cin)
-    implicit none
-    character(len=*),intent(in) :: cin
-    character(len=:),allocatable :: c
-    integer :: iout
-    integer :: i,j,k,ich,io,Z
-    logical :: ex
-    c = trim(convertlable(cin))
-    read (cin,*,iostat=io) j
-    if (io == 0) Z = j
-    if (any(PSE(:) .eq. c)) then
-      do i = 1,118
-        if (trim(PSE(i)) .eq. c) then
-          iout = i
-          exit
-        end if
-      end do
-    else if (io == 0.and.Z <= 118) then
-      iout = Z
-    else !> special cases
-      select case (trim(c))
-      case ('D'); iout = 1
-      case ('T'); iout = 1
-      case default; iout = 0
-      end select
-    end if
-    e2i = iout
-  end function e2i
-
-!============================================================!
-! i2e is used to map the element (as a integer) to a string
-!============================================================!
-  character(len=2) function i2e(iin,oformat)
-    implicit none
-    integer,intent(in) :: iin
-    character(len=:),allocatable :: c
-    character(len=*),optional :: oformat
-    if (iin <= 118) then
-      c = uppercase(PSE(iin))
-    else
-      c = 'XX'
-    end if
-    i2e = trim(c)
-    if (present(oformat)) then
-      select case (oformat)
-      case ('lc','lowercase')
-        i2e = lowerCase(trim(c))
-      case ('nc','nicecase')
-        if (len_trim(c) .gt. 1) then
-          c(2:2) = lowerCase(c(2:2))
-          i2e = trim(c)
-        end if
-      case default
-        continue
-      end select
-    end if
-  end function i2e
-
-!============================================================!
-! get the file extension
-!============================================================!
-  function fextension(s)
-    implicit none
-    character(len=*),intent(in) :: s !filename
-    character(len=:),allocatable :: sout
-    character(len=:),allocatable :: fextension !output
-    integer :: ic,i
-    sout = trim(adjustl(s))
-    i = len_trim(sout)
-    ic = index(sout,'.',.true.)
-    if (ic .ne. 0) then
-      fextension = sout(ic:i)
-    else
-      fextension = 'none'
-    end if
-    return
-  end function fextension
-
-!============================================================!
-! grep for a keyword within the file
-!============================================================!
-  function sgrep(fname,key)
-    implicit none
-    character(len=*),intent(in) :: fname
-    character(len=*),intent(in) :: key
-    logical :: sgrep
-    character(len=256) :: atmp
-    integer :: ic,io
-    sgrep = .false.
-    open (newunit=ic,file=fname)
-    do
-      read (ic,'(a)',iostat=io) atmp
-      if (io < 0) exit !EOF
-      if (index(atmp,key) .ne. 0) then
-        sgrep = .true.
-        exit
-      end if
-    end do
-    close (ic)
-    return
-  end function sgrep
-
-!============================================================!
-! grep the energy from a line of strings
-!============================================================!
-  function grepenergy(line)
-    implicit none
-    real(wp) :: grepenergy
-    character(len=*),intent(in) :: line
-    real(wp) :: energy
-    character(len=:),allocatable :: atmp
-    integer :: i,io,k
-    atmp = trim(line)
-    energy = 0.0_wp
-    if (index(atmp,'energy=') .ne. 0) then
-      k = index(atmp,'energy=')
-      atmp = atmp(k+7:)
-      read (atmp,*,iostat=io) energy
-      if (io .ne. 0) energy = 0.0_wp
-    else if (index(atmp,'energy:') .ne. 0) then
-      k = index(atmp,'energy:')
-      atmp = atmp(k+7:)
-      read (atmp,*,iostat=io) energy
-      if (io .ne. 0) energy = 0.0_wp
-    else
-      !> assumes that the first float in the line is the energy
-      do i = 1,len_trim(atmp)
-        if (len_trim(atmp) .lt. 1) exit
-        read (atmp,*,iostat=io) energy
-        if (io > 0) then
-          atmp = atmp(2:)
-          atmp = adjustl(atmp)
-          cycle
-        else
-          exit
-        end if
-      end do
-    end if
-    grepenergy = energy
-    return
-  end function grepenergy
-
-!============================================================!
-! count number of bonds from an wbo matrix
-!============================================================!
-  function countbonds(nat,wbo) result(nbd)
-    implicit none
-    integer,intent(in)  :: nat
-    real(wp),intent(in) :: wbo(nat,nat)
-    integer :: nbd
-    integer :: i,j,k
-    nbd = 0
-    do i = 1,nat
-      do j = 1,i-1
-        k = nint(wbo(i,j))
-        if (k > 0) nbd = nbd+1
-      end do
-    end do
-    return
-  end function countbonds
-
-!=========================================================================================!
-
-  subroutine get_atlist(nat,atlist,line,at)
-!******************************************************
-!* Analyze a string containing atom specifications.
-!* "atlist" is a array of booleans for each atom,
-!* which is set to .true. should the atom be contained
-!* in atlist.
-!******************************************************
-    implicit none
-    integer,intent(in) :: nat
-    logical,intent(out),allocatable :: atlist(:)
-    character(len=*),intent(in) :: line
-    integer,intent(in),optional :: at(nat)
-    character(len=:),allocatable :: substr(:)
-    integer :: i,j,k,l,io,ns,ll,i1,i2,io1,io2,i3,i4
-    character(len=:),allocatable :: atmp,btmp
-
-    allocate (atlist(nat),source=.false.)
-!>-- count stuff
-    ll = len_trim(line)
-    ns = 1
-    do i = 1,ll
-      if (line(i:i) .eq. ',') ns = ns+1
-    end do
-    allocate (substr(ns),source=repeat(' ',ll))
-!>-- cut stuff
-    if (ns > 1) then
-      j = 1
-      k = 1
-      do i = 1,ll
-        if (k == ns) then
-          substr(k) = lowercase(adjustl(line(j:)))
-          exit
-        end if
-        if (line(i:i) .eq. ',') then
-          substr(k) = lowercase(adjustl(line(j:i-1)))
-          k = k+1
-          j = i+1
-        end if
-      end do
-    else
-      substr(1) = trim(line)
-    end if
-!>--- analyze stuff
-    do i = 1,ns
-      atmp = trim(substr(i))
-      if (atmp .eq. 'all') then
-        atlist(:) = .true.
-        exit
-      end if
-      if (index(atmp,'.') .ne. 0) cycle !> exclude floats
-      l = index(atmp,'-')
-      if (l .eq. 0) then
-        read (atmp,*,iostat=io) i1
-        !> check if it is an element symbol
-        if (io /= 0) then
-          if (len_trim(atmp) > 2) then
-            if (index(trim(atmp),'heavy') .ne. 0) then !> all heavy atoms
-              if (present(at)) then
-                do j = 1,nat
-                  if (at(j) > 1) atlist(j) = .true.
-                end do
-              end if
-            end if
-          else !> element symbols
-            k = e2i(atmp)
-            if (present(at)) then
-              do j = 1,nat
-                if (at(j) == k) atlist(j) = .true.
-              end do
-            end if
-          end if
-        else
-          atlist(i1) = .true.
-        end if
-      else
-        btmp = atmp(:l-1)
-        read (btmp,*,iostat=io1) i1
-        btmp = atmp(l+1:)
-        read (btmp,*,iostat=io2) i2
-        if (io1 .eq. 0.and.io2 .eq. 0) then
-          i4 = max(i1,i2)
-          i3 = min(i1,i2)
-          do j = 1,nat
-            if (i3 <= j.and.j <= i4) atlist(j) = .true.
-          end do
-        end if
-      end if
-    end do
-    deallocate (substr)
-  end subroutine get_atlist
-
-!=========================================================================================!
-!=========================================================================================!
-! end of the module
-!=========================================================================================!
-!=========================================================================================!
-end module strucrd
diff --git a/src/symmetry2.f90 b/src/symmetry2.f90
deleted file mode 100644
index 1083c3cc..00000000
--- a/src/symmetry2.f90
+++ /dev/null
@@ -1,136 +0,0 @@
-! This file is part of xtb, modified for crest
-!
-! Copyright (C) 2017-2020 Stefan Grimme
-!
-! xtb is free software: you can redistribute it and/or modify it under
-! the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! xtb is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU Lesser General Public License for more details.
-!
-! You should have received a copy of the GNU Lesser General Public License
-! along with xtb.  If not, see <https://www.gnu.org/licenses/>.
-
-Subroutine get_schoenflies(n,iat,xyz,sfsym,paramar)
-  Use iso_c_binding
-  Implicit None
-  integer,parameter :: wp = selected_real_kind(15,307)
-
-  Interface c_interface
-    !Interface to c routine for symmetry recognition
-    !attypes are Atom types as integers (e.g 6 for Carbon etc...)
-    !coord must be ``one dimensional'' sequential(!) arrays of doubles
-    !symbol is the recognized schoenflies symbol
-    Subroutine schoenflies(natoms,attypes,coord,symbol,paramar) &
-          &    bind(C,name="schoenflies")
-      Use iso_c_binding
-      import
-      Implicit None
-      Integer(c_int),Intent(In),value :: natoms
-      integer(c_int),intent(in) :: attypes(*)
-      real(c_double),intent(in) :: coord(3,*)
-      Character(kind=c_char),Intent(out)  :: symbol(*)
-      real(c_double),intent(in) :: paramar(*)
-    End Subroutine schoenflies
-  End Interface c_interface
-
-  !Dummy Arguments
-  Character(Len=*) :: sfsym
-  Integer,Intent(In)  :: n
-  Integer,Intent(In)  :: iat(n)
-  Real(wp),Intent(In) :: xyz(3,n)
-  Real(wp),Intent(In) :: paramar(11)
-
-  !local variables for passing to c routine:
-  Integer(c_int) :: natoms
-  Integer(c_int),Allocatable,Dimension(:) :: attypes
-  Real(c_double),Allocatable,Dimension(:,:) :: coord
-  Real(c_double),Allocatable,Dimension(:) :: c_paramar
-  character(kind=c_char) :: symbol(6)
-
-  !local stack:
-  Integer :: i
-
-  Allocate (attypes(n))
-  Allocate (coord(3,n))
-  Allocate (c_paramar(11))
-
-  !now, copy contents
-  natoms = n
-  attypes = iat
-  coord = xyz
-  c_paramar = paramar
-  symbol = C_NULL_CHAR
-
-  Call schoenflies(natoms,attypes,coord,symbol,c_paramar)
-
-  sfsym = ""
-  do i = 1,size(symbol)
-    if (symbol(i) .eq. c_null_char) exit
-    sfsym(i:i) = symbol(i)
-  end do
-
-  !deallocate arrays:
-  Deallocate (attypes,coord,c_paramar)
-End Subroutine get_schoenflies
-
-subroutine getsymmetry2(pr,iunit,n,iat,xyz,symthr,maxatdesy,sfsym)
-  use iso_c_binding,only:c_char,c_null_char
-  use iso_fortran_env,only:wp => real64
-  implicit none
-  integer,intent(in) :: iunit
-  integer n,iat(n),maxatdesy
-  real(wp) xyz(3,n)
-  real(wp) symthr
-  Character(len=*) sfsym
-  logical pr
-  Character(len=4) atmp
-
-  Real(wp) :: paramar(11)  !parameter array for get_schoenflies_
-
-  if (n .gt. maxatdesy) then
-    if (pr) write (iunit,*) 'symmetry recognition skipped because # atoms >',maxatdesy
-    sfsym = 'none'
-    return
-  end if
-
-  if (pr) write (iunit,'(a)')
-  !parameters for symmetry recognition:
-  paramar(1) = -1         ! verbose, increase for more detailed output (to stdout)
-  paramar(2) = 10          ! MaxAxisOrder
-  paramar(3) = 100         ! MaxOptCycles
-  paramar(4) = 0.001d0     ! ToleranceSame
-  paramar(5) = 0.5d0       ! TolerancePrimary
-  paramar(6) = symthr      ! ToleranceFinal, THIS IS THE IMPORTANT VALUE
-  paramar(7) = 0.5d0       ! MaxOptStep
-  paramar(8) = 1.0D-7      ! MinOptStep
-  paramar(9) = 1.0D-7      ! GradientStep
-  paramar(10) = 1.0D-8     ! OptChangeThreshold
-  paramar(11) = 5          ! OptChangeHits
-
-  atmp = '    '
-  Call get_schoenflies(n,iat,xyz,atmp,paramar)
-  !call flush(iunit)
-
-  !TM stuff (trafo table)
-  sfsym(1:3) = atmp(1:3)
-  if (sfsym(1:1) .eq. 'D') sfsym(1:1) = 'd'
-  if (sfsym(1:1) .eq. 'C') sfsym(1:1) = 'c'
-  if (sfsym(1:1) .eq. 'T') sfsym(1:1) = 't'
-  if (sfsym(1:1) .eq. 'O') sfsym(1:1) = 'o'
-  if (sfsym(1:1) .eq. 'I') sfsym(1:1) = 'i'
-  if (sfsym(1:1) .eq. 'S') sfsym(1:1) = 's'
-  if (sfsym .eq. 'dih') sfsym = 'd6h'
-  if (sfsym .eq. 'civ') sfsym = 'c6v'
-  if (sfsym(3:3) .gt. 'v'.or.sfsym(3:3) .lt. 'a') sfsym(3:3) = ' '
-
-  if (pr) then
-    write (iunit,'(a3,'' symmetry found (for desy threshold: '',e9.2,'')'')') sfsym,symthr
-  end if
-
-End subroutine getsymmetry2
-
diff --git a/src/symmetry_i.c b/src/symmetry_i.c
deleted file mode 100644
index 06532c48..00000000
--- a/src/symmetry_i.c
+++ /dev/null
@@ -1,2006 +0,0 @@
-/*
- *  Brute force symmetry analyzer.
- *  This is actually C++ program, masquerading as a C one!
- *
- *  (C) 1996, 2003 S. Patchkovskii, Serguei.Patchkovskii@sympatico.ca
- *  modifications by S. Dohm and S. Ehlert and P. Pracht
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program. If not, see <https://www.gnu.org/licenses/>.
- *
- * $Log: symmetry.c,v $
- * Revision 1.16  2003/04/04  13:05:03  patchkov
- * Revision 1.15  2000/01/25  16:47:17  patchkov
- * Revision 1.14  2000/01/25  16:39:08  patchkov
- * Revision 1.13  1996/05/24  12:32:08  ps
- * Revision 1.12  1996/05/23  16:10:47  ps
- * First reasonably stable version.
- *
- */
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <math.h>
-
-#ifndef M_PI
-#define M_PI 3.1415926535897932384626433832795028841971694
-#endif
-
-#define	DIMENSION 3
-#define MAXPARAM  7
-
-typedef struct {
-        int     type ;
-        double  x[ DIMENSION ] ;
-    } ATOM ;
-
-/*
- *  All specific structures should have corresponding elements in the
- *  same position generic structure does.
- *
- *  Planes are characterized by the surface normal direction
- *  (taken in the direction *from* the coordinate origin)
- *  and distance from the coordinate origin to the plane
- *  in the direction of the surface normal.
- *
- *  Inversion is characterized by location of the inversion center.
- *
- *  Rotation is characterized by a vector (distance+direction) from the origin
- *  to the rotation axis, axis direction and rotation order. Rotations
- *  are in the clockwise direction looking opposite to the direction
- *  of the axis. Note that this definition of the rotation axis
- *  is *not* unique, since an arbitrary multiple of the axis direction
- *  can be added to the position vector without changing actual operation.
- *
- *  Mirror rotation is defined by the same parameters as normal rotation,
- *  but the origin is now unambiguous since it defines the position of the
- *  plane associated with the axis.
- *
- */
-
-typedef struct _SYMMETRY_ELEMENT_ {
-        void    (*transform_atom)( struct _SYMMETRY_ELEMENT_ *el, ATOM *from, ATOM *to ) ;
-        int *   transform ;     /*   Correspondence table for the transformation         */
-        int     order ;         /*   Applying transformation this many times is identity */
-        int     nparam ;        /*   4 for inversion and planes, 7 for axes              */
-        double  maxdev ;        /*   Larges error associated with the element            */
-        double  distance ;
-        double  normal[ DIMENSION ] ;
-        double  direction[ DIMENSION ] ;
-    } SYMMETRY_ELEMENT ;
-
-typedef struct {
-        char *  group_name ;        /* Canonical group name                              */
-        char *  symmetry_code ;     /* Group symmetry code                               */
-        int     (*check)( void ) ;  /* Additional verification routine, not used         */
-    } POINT_GROUP ;
-
-double                 ToleranceSame         = 1e-3 ;
-double                 TolerancePrimary      = 5e-2 ;
-double                 ToleranceFinal        = 1e-4 ;
-double                 MaxOptStep            = 5e-1 ;
-double                 MinOptStep            = 1e-7 ;
-double                 GradientStep          = 1e-7 ;
-double                 OptChangeThreshold    = 1e-10 ;
-double                 CenterOfSomething[ DIMENSION ] ;
-double *               DistanceFromCenter    = NULL ;
-int                    verbose               = 0 ;
-int                    MaxOptCycles          = 200 ;
-int                    OptChangeHits         = 5 ;
-int                    MaxAxisOrder          = 20 ;
-int                    AtomsCount            = 0 ;
-ATOM *                 Atoms                 = NULL ;
-int                    PlanesCount           = 0 ;
-SYMMETRY_ELEMENT **    Planes                = NULL ;
-SYMMETRY_ELEMENT *     MolecularPlane        = NULL ;
-int                    InversionCentersCount = 0 ;
-SYMMETRY_ELEMENT **    InversionCenters      = NULL ;
-int                    NormalAxesCount       = 0 ;
-SYMMETRY_ELEMENT **    NormalAxes            = NULL ;
-int                    ImproperAxesCount     = 0 ;
-SYMMETRY_ELEMENT **    ImproperAxes          = NULL ;
-int *                  NormalAxesCounts      = NULL ;
-int *                  ImproperAxesCounts    = NULL ;
-int                    BadOptimization       = 0 ;
-char *                 SymmetryCode          = "" ;
-char  		       MaxRotAxis[2]	     = "" ;
-/*
- *    Statistics
- */
-long                   StatTotal             = 0 ;
-long                   StatEarly             = 0 ;
-long                   StatPairs             = 0 ;
-long                   StatDups              = 0 ;
-long                   StatOrder             = 0 ;
-long                   StatOpt               = 0 ;
-long                   StatAccept            = 0 ;
-
-/*
- *    Point groups I know about
- */
-int true_func(void){ return 1 ; }
-POINT_GROUP            PointGroups[]         = {
-    {  "C1",    "",                                                          true_func  },
-    {  "Cs",    "(sigma) ",                                                  true_func  },
-    {  "Ci",    "(i) ",                                                      true_func  },
-    {  "C2",    "(C2) ",                                                     true_func  },
-    {  "C3",    "(C3) ",                                                     true_func  },
-    {  "C4",    "(C4) (C2) ",                                                true_func  },
-    {  "C5",    "(C5) ",                                                     true_func  },
-    {  "C6",    "(C6) (C3) (C2) ",                                           true_func  },
-    {  "C7",    "(C7) ",                                                     true_func  },
-    {  "C8",    "(C8) (C4) (C2) ",                                           true_func  },
-    {  "D2",    "3*(C2) ",                                                   true_func  },
-    {  "D3",    "(C3) 3*(C2) ",                                              true_func  },
-    {  "D4",    "(C4) 5*(C2) ",                                              true_func  },
-    {  "D5",    "(C5) 5*(C2) ",                                              true_func  },
-    {  "D6",    "(C6) (C3) 7*(C2) ",                                         true_func  },
-    {  "D7",    "(C7) 7*(C2) ",                                              true_func  },
-    {  "D8",    "(C8) (C4) 9*(C2) ",                                         true_func  },
-    {  "C2v",   "(C2) 2*(sigma) ",                                           true_func  },
-    {  "C3v",   "(C3) 3*(sigma) ",                                           true_func  },
-    {  "C4v",   "(C4) (C2) 4*(sigma) ",                                      true_func  },
-    {  "C5v",   "(C5) 5*(sigma) ",                                           true_func  },
-    {  "C6v",   "(C6) (C3) (C2) 6*(sigma) ",                                 true_func  },
-    {  "C7v",   "(C7) 7*(sigma) ",                                           true_func  },
-    {  "C8v",   "(C8) (C4) (C2) 8*(sigma) ",                                 true_func  },
-    {  "C2h",   "(i) (C2) (sigma) ",                                         true_func  },
-    {  "C3h",   "(C3) (S3) (sigma) ",                                        true_func  },
-    {  "C4h",   "(i) (C4) (C2) (S4) (sigma) ",                               true_func  },
-    {  "C5h",   "(C5) (S5) (sigma) ",                                        true_func  },
-    {  "C6h",   "(i) (C6) (C3) (C2) (S6) (S3) (sigma) ",                     true_func  },
-    {  "C7h",   "(C7) (S7) (sigma) ",                                        true_func  },
-    {  "C8h",   "(i) (C8) (C4) (C2) (S8) (S4) (sigma) ",                     true_func  },
-    {  "D2h",   "(i) 3*(C2) 3*(sigma) ",                                     true_func  },
-    {  "D3h",   "(C3) 3*(C2) (S3) 4*(sigma) ",                               true_func  },
-    {  "D4h",   "(i) (C4) 5*(C2) (S4) 5*(sigma) ",                           true_func  },
-    {  "D5h",   "(C5) 5*(C2) (S5) 6*(sigma) ",                               true_func  },
-    {  "D6h",   "(i) (C6) (C3) 7*(C2) (S6) (S3) 7*(sigma) ",                 true_func  },
-    {  "D7h",   "(C7) 7*(C2) (S7) 8*(sigma) ",                               true_func  },
-    {  "D8h",   "(i) (C8) (C4) 9*(C2) (S8) (S4) 9*(sigma) ",                 true_func  },
-    {  "D2d",   "3*(C2) (S4) 2*(sigma) ",                                    true_func  },
-    {  "D3d",   "(i) (C3) 3*(C2) (S6) 3*(sigma) ",                           true_func  },
-    {  "D4d",   "(C4) 5*(C2) (S8) 4*(sigma) ",                               true_func  },
-    {  "D5d",   "(i) (C5) 5*(C2) (S10) 5*(sigma) ",                          true_func  },
-    {  "D6d",   "(C6) (C3) 7*(C2) (S12) (S4) 6*(sigma) ",                    true_func  },
-    {  "D7d",   "(i) (C7) 7*(C2) (S14) 7*(sigma) ",                          true_func  },
-    {  "D8d",   "(C8) (C4) 9*(C2) (S16) 8*(sigma) ",                         true_func  },
-    {  "S4",    "(C2) (S4) ",                                                true_func  },
-    {  "S6",    "(i) (C3) (S6) ",                                            true_func  },
-    {  "S8",    "(C4) (C2) (S8) ",                                           true_func  },
-    {  "T",     "4*(C3) 3*(C2) ",                                            true_func  },
-    {  "Th",    "(i) 4*(C3) 3*(C2) 4*(S6) 3*(sigma) ",                       true_func  },
-    {  "Td",    "4*(C3) 3*(C2) 3*(S4) 6*(sigma) ",                           true_func  },
-    {  "O",     "3*(C4) 4*(C3) 9*(C2) ",                                     true_func  },
-    {  "Oh",    "(i) 3*(C4) 4*(C3) 9*(C2) 4*(S6) 3*(S4) 9*(sigma) ",         true_func  },
-    {  "Cinfv", "(Cinf) (sigma) ",                                           true_func  },
-    {  "Dinfh", "(i) (Cinf) (C2) 2*(sigma) ",                                true_func  },
-    {  "I",     "6*(C5) 10*(C3) 15*(C2) ",                                   true_func  },
-    {  "Ih",    "(i) 6*(C5) 10*(C3) 15*(C2) 6*(S10) 10*(S6) 15*(sigma) ",    true_func  },
-    {  "Kh",    "(i) (Cinf) (sigma) ",                                       true_func  },
-    } ;
-#define PointGroupsCount (sizeof(PointGroups)/sizeof(POINT_GROUP))
-char *                 PointGroupRejectionReason = NULL ;
-
-/*
- *   Generic functions
- */
-
-double
-pow2( double x )
-{
-return x * x ;
-}
-
-int
-establish_pairs( SYMMETRY_ELEMENT *elem )
-{
-        int               i, j, k, best_j ;
-        char *            atom_used = calloc( AtomsCount, 1 ) ;
-        double            distance, best_distance ;
-        ATOM              symmetric ;
-
-if( atom_used == NULL ){
-    fprintf( stderr, "Out of memory for tagging array in establish_pairs()\n" ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-for( i = 0 ; i < AtomsCount ; i++ ){
-    if( elem->transform[i] >= AtomsCount ){ /* No symmetric atom yet          */
-        if( verbose > 2 ) printf( "        looking for a pair for %d\n", i ) ;
-        elem->transform_atom( elem, Atoms+i, &symmetric ) ;
-        if( verbose > 2 ) printf( "        new coordinates are: (%g,%g,%g)\n", 
-                              symmetric.x[0], symmetric.x[1], symmetric.x[2] ) ;
-        best_j        = i ;
-        best_distance = 2*TolerancePrimary ;/* Performance value we'll reject */
-        for( j = 0 ; j < AtomsCount ; j++ ){
-            if( Atoms[j].type != symmetric.type || atom_used[j] )
-                continue ;
-            for( k = 0, distance = 0 ; k < DIMENSION ; k++ ){
-                distance += pow2( symmetric.x[k] - Atoms[j].x[k] ) ;
-                }
-            distance = sqrt( distance ) ;
-            if( verbose > 2 ) printf( "        distance to %d is %g\n", j, distance ) ;
-            if( distance < best_distance ){
-                best_j        = j ;
-                best_distance = distance ;
-                }
-            }
-        if( best_distance > TolerancePrimary ){ /* Too bad, there is no symmetric atom */
-            if( verbose > 0 ) 
-                printf( "        no pair for atom %d - best was %d with err = %g\n", i, best_j, best_distance ) ;
-            free( atom_used ) ;
-            return -1 ;
-            }
-        elem->transform[i] = best_j ;
-        atom_used[best_j]  = 1 ;
-        if( verbose > 1 ) printf( "        atom %d transforms to the atom %d, err = %g\n", i, best_j, best_distance ) ;
-        }
-    }
-free( atom_used ) ;
-return 0 ;
-}
-
-int
-check_transform_order( SYMMETRY_ELEMENT *elem )
-{
-        int             i, j, k ;
-        void            rotate_reflect_atom( SYMMETRY_ELEMENT *, ATOM *, ATOM *) ;
-
-for( i = 0 ; i < AtomsCount ; i++ ){
-    if( elem->transform[i] == i )   /* Identity transform is Ok for any order */
-        continue ;
-    if( elem->transform_atom == rotate_reflect_atom ){
-        j = elem->transform[i] ;
-        if( elem->transform[j] == i )
-            continue ; /* Second-order transform is Ok for improper axis */
-        }
-    for( j = elem->order - 1, k = elem->transform[i] ; j > 0 ; j--, k = elem->transform[k] ){
-        if( k == i ){
-            if( verbose > 0 ) printf( "        transform looped %d steps too early from atom %d\n", j, i ) ;
-            return -1 ;
-            }
-        }
-    if( k != i && elem->transform_atom == rotate_reflect_atom ){
-        /* For improper axes, the complete loop may also take twice the order */
-        for( j = elem->order ; j > 0 ; j--, k = elem->transform[k] ){
-            if( k == i ){
-                if( verbose > 0 ) printf( "        (improper) transform looped %d steps too early from atom %d\n", j, i ) ;
-                return -1 ;
-                }
-            }
-        }
-    if( k != i ){
-        if( verbose > 0 ) printf( "        transform failed to loop after %d steps from atom %d\n", elem->order, i ) ;
-        return -1 ;
-        }
-    }
-return 0 ;
-}
-
-int
-same_transform( SYMMETRY_ELEMENT *a, SYMMETRY_ELEMENT *b )
-{
-        int               i, j ;
-        int               code ;
-
-if( ( a->order != b->order ) || ( a->nparam != b->nparam ) || ( a->transform_atom != b->transform_atom ) )
-    return 0 ;
-for( i = 0, code = 1 ; i < AtomsCount ; i++ ){
-    if( a->transform[i] != b->transform[i] ){
-        code = 0 ;
-        break ;
-        }
-    }
-if( code == 0 && a->order > 2 ){  /* b can also be a reverse transformation for a */
-    for( i = 0 ; i < AtomsCount ; i++ ){
-        j = a->transform[i] ;
-        if( b->transform[j] != i )
-            return 0 ;
-        }
-    return 1 ;
-    }
-return code ;
-}
-
-SYMMETRY_ELEMENT *
-alloc_symmetry_element( void )
-{
-        SYMMETRY_ELEMENT * elem = calloc( 1, sizeof( SYMMETRY_ELEMENT ) ) ;
-        int                i ;
-
-if( elem == NULL ){
-    fprintf( stderr, "Out of memory allocating symmetry element\n" ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-elem->transform = calloc( AtomsCount, sizeof( int ) ) ;
-if( elem->transform == NULL ){
-    fprintf( stderr, "Out of memory allocating transform table for symmetry element\n" ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-for( i = 0 ; i < AtomsCount ; i++ ){
-    elem->transform[i] = AtomsCount + 1 ; /* An impossible value */
-    }
-return elem ;
-}
-
-void
-destroy_symmetry_element( SYMMETRY_ELEMENT *elem )
-{
-if( elem != NULL ){
-    if( elem->transform != NULL )
-        free( elem->transform ) ;
-    free( elem ) ;
-    }
-}
-
-int
-check_transform_quality( SYMMETRY_ELEMENT *elem )
-{
-        int               i, j, k ;
-        ATOM              symmetric ;
-        double            r, max_r ;
-
-for( i = 0, max_r = 0 ; i < AtomsCount ; i++ ){
-    j = elem->transform[i] ;
-    elem->transform_atom( elem, Atoms + i, &symmetric ) ;
-    for( k = 0, r = 0 ; k < DIMENSION ; k++ ){
-        r += pow2( symmetric.x[k] - Atoms[j].x[k] ) ;
-        }
-    r = sqrt( r ) ;
-    if( r > ToleranceFinal ){
-        if( verbose > 0 ) printf( "        distance to symmetric atom (%g) is too big for %d\n", r, i ) ;
-        return -1 ;
-        }
-    if( r > max_r ) max_r = r ;
-    }
-elem->maxdev = max_r ;
-return 0 ;
-}
-
-double
-eval_optimization_target_function( SYMMETRY_ELEMENT *elem, int *finish )
-{
-        int               i, j, k ;
-        ATOM              symmetric ;
-        double            target, r, maxr ;
-
-if( elem->nparam >= 4 ){
-    for( k = 0, r = 0 ; k < DIMENSION ; k++ ){
-        r += elem->normal[k]*elem->normal[k] ;
-        }
-    r = sqrt( r ) ;
-    if( r < ToleranceSame ){
-        fprintf( stderr, "Normal collapced!\n" ) ;
-        exit( EXIT_FAILURE ) ;
-        }
-    for( k = 0 ; k < DIMENSION ; k++ ){
-        elem->normal[k] /= r ;
-        }
-    if( elem->distance < 0 ){
-        elem->distance = -elem->distance ;
-        for( k = 0 ; k < DIMENSION ; k++ ){
-            elem->normal[k] = -elem->normal[k] ;
-            }
-        }
-    }
-if( elem->nparam >= 7 ){
-    for( k = 0, r = 0 ; k < DIMENSION ; k++ ){
-        r += elem->direction[k]*elem->direction[k] ;
-        }
-    r = sqrt( r ) ;
-    if( r < ToleranceSame ){
-        fprintf( stderr, "Direction collapced!\n" ) ;
-        exit( EXIT_FAILURE ) ;
-        }
-    for( k = 0 ; k < DIMENSION ; k++ ){
-        elem->direction[k] /= r ;
-        }
-    }
-for( i = 0, target = maxr = 0 ; i < AtomsCount ; i++ ){
-    elem->transform_atom( elem, Atoms + i, &symmetric ) ;
-    j = elem->transform[i] ;
-    for( k = 0, r = 0 ; k < DIMENSION ; k++ ){
-        r += pow2( Atoms[j].x[k] - symmetric.x[k] ) ;
-        }
-    if( r > maxr ) maxr = r ;
-    target += r ;
-    }
-if( finish != NULL ){
-    *finish = 0 ;
-    if( sqrt( maxr ) < ToleranceFinal )
-        *finish = 1 ;
-    }
-return target ;
-}
-
-void
-get_params( SYMMETRY_ELEMENT *elem, double values[] )
-{
-memcpy( values, &elem->distance, elem->nparam * sizeof( double ) ) ;
-}
-
-void
-set_params( SYMMETRY_ELEMENT *elem, double values[] )
-{
-memcpy( &elem->distance, values, elem->nparam * sizeof( double ) ) ;
-}
-
-void
-optimize_transformation_params( SYMMETRY_ELEMENT *elem )
-{
-        double            values[ MAXPARAM ] ;
-        double            grad  [ MAXPARAM ] ;
-        double            force [ MAXPARAM ] ;
-        double            step  [ MAXPARAM ] ;
-        double            f, fold, fnew, fnew2, fdn, fup, snorm ;
-        double            a, b, x ;
-        int               vars  = elem->nparam ;
-        int               cycle = 0 ;
-        int               i, finish ;
-        int               hits = 0 ;
-
-if( vars > MAXPARAM ){
-    fprintf( stderr, "Catastrophe in optimize_transformation_params()!\n" ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-f = 0 ;
-do {
-    fold = f ;
-    f    = eval_optimization_target_function( elem, &finish ) ;
-    /* Evaluate function, gradient and diagonal force constants */
-    if( verbose > 1 ) printf( "            function value = %g\n", f ) ;
-    if( finish ){
-        if( verbose > 1 ) printf( "        function value is small enough\n" ) ;
-        break ;
-        }
-    if( cycle > 0 ){
-        if( fabs( f-fold ) > OptChangeThreshold )
-             hits = 0 ;
-        else hits++ ;
-        if( hits >= OptChangeHits ){
-            if( verbose > 1 ) printf( "        no progress is made, stop optimization\n" ) ;
-            break ;
-            }
-        }
-    get_params( elem, values ) ;
-    for( i = 0 ; i < vars ; i++ ){
-        values[i] -= GradientStep ;
-        set_params( elem, values ) ;
-        fdn        = eval_optimization_target_function( elem, NULL ) ;
-        values[i] += 2*GradientStep ;
-        set_params( elem, values ) ;
-        fup        = eval_optimization_target_function( elem, NULL ) ;
-        values[i] -= GradientStep ;
-        grad[i]    = ( fup - fdn ) / ( 2 * GradientStep ) ;
-        force[i]   = ( fup + fdn - 2*f ) / ( GradientStep * GradientStep ) ;
-        if( verbose > 1 ) printf( "        i = %d, grad = %12.6e, force = %12.6e\n", i, grad[i], force[i] ) ;
-        }
-    /* Do a quasy-Newton step */
-    for( i = 0, snorm = 0 ; i < vars ; i++ ){
-        if( force[i] <  0   ) force[i] = -force[i] ;
-        if( force[i] < 1e-3 ) force[i] = 1e-3 ;
-        if( force[i] > 1e3  ) force[i] = 1e3 ;
-        step[i] = - grad[i]/force[i] ;
-        snorm += step[i] * step[i] ;
-        }
-    snorm = sqrt( snorm ) ;
-    if( snorm > MaxOptStep ){ /* Renormalize step */
-        for( i = 0 ; i < vars ; i++ )
-            step[i] *= MaxOptStep/snorm ;
-        snorm = MaxOptStep ;
-        }
-    do {
-        for( i = 0 ; i < vars ; i++ ){
-            values[i] += step[i] ;
-            }
-        set_params( elem, values ) ;
-        fnew = eval_optimization_target_function( elem, NULL ) ;
-        if( fnew < f )
-            break ;
-        for( i = 0 ; i < vars ; i++ ){
-            values[i] -= step[i] ;
-            step  [i] /= 2 ;
-            }
-        set_params( elem, values ) ;
-        snorm /= 2 ;
-        } while( snorm > MinOptStep ) ;
-        if( (snorm > MinOptStep) && (snorm < MaxOptStep / 2) ){  /* try to do quadratic interpolation */
-            for( i = 0 ; i < vars ; i++ )
-                values[i] += step[i] ;
-            set_params( elem, values ) ;
-            fnew2 = eval_optimization_target_function( elem, NULL ) ;
-            if( verbose > 1 ) printf( "        interpolation base points: %g, %g, %g\n", f, fnew, fnew2 ) ;
-            for( i = 0 ; i < vars ; i++ )
-                values[i] -= 2*step[i] ;
-            a     = ( 4*f - fnew2 - 3*fnew ) / 2 ;
-            b     = ( f + fnew2 - 2*fnew ) / 2 ;
-            if( verbose > 1 ) printf( "        linear interpolation coefficients %g, %g\n", a, b ) ;
-            if( b > 0 ){
-                x = -a/(2*b) ;
-                if( x > 0.2 && x < 1.8 ){
-                    if( verbose > 1 ) printf( "        interpolated: %g\n", x ) ;
-                    for( i = 0 ; i < vars ; i++ )
-                        values[i] += x*step[i] ;
-                    }
-                else b = 0 ;
-                }
-            if( b <= 0 ){
-                if( fnew2 < fnew ){
-                    for( i = 0 ; i < vars ; i++ )
-                        values[i] += 2*step[i] ;
-                    }
-                else {
-                    for( i = 0 ; i < vars ; i++ )
-                        values[i] += step[i] ;
-                    }
-                }
-            set_params( elem, values ) ;
-            }
-    } while( snorm > MinOptStep && ++cycle < MaxOptCycles ) ;
-f = eval_optimization_target_function( elem, NULL ) ;
-if( cycle >= MaxOptCycles ) BadOptimization = 1 ;
-if( verbose > 0 ) {
-    if( cycle >= MaxOptCycles ){
-        printf( "        maximum number of optimization cycles made\n" ) ;
-    }
-        printf( "        optimization completed after %d cycles with f = %g\n", cycle, f ) ;
-    }
-}
-
-int
-refine_symmetry_element( SYMMETRY_ELEMENT *elem, int build_table )
-{
-        int               i ;
-
-
-if( build_table && (establish_pairs( elem ) < 0) ){
-    StatPairs++ ;
-    if( verbose > 0 ) printf( "        no transformation correspondence table can be constructed\n" ) ;
-    return -1 ;
-    }
-for( i = 0 ; i < PlanesCount ; i++ ){
-    if( same_transform( Planes[i], elem ) ){
-        StatDups++ ;
-        if( verbose > 0 ) printf( "        transformation is identical to plane %d\n", i ) ;
-        return -1 ;
-        }
-    }
-for( i = 0 ; i < InversionCentersCount ; i++ ){
-    if( same_transform( InversionCenters[i], elem ) ){
-        StatDups++ ;
-        if( verbose > 0 ) printf( "        transformation is identical to inversion center %d\n", i ) ;
-        return -1 ;
-        }
-    }
-for( i = 0 ; i < NormalAxesCount ; i++ ){
-    if( same_transform( NormalAxes[i], elem ) ){
-        StatDups++ ;
-        if( verbose > 0 ) printf( "        transformation is identical to normal axis %d\n", i ) ;
-        return -1 ;
-        }
-    }
-for( i = 0 ; i < ImproperAxesCount ; i++ ){
-    if( same_transform( ImproperAxes[i], elem ) ){
-        StatDups++ ;
-        if( verbose > 0 ) printf( "        transformation is identical to improper axis %d\n", i ) ;
-        return -1 ;
-        }
-    }
-if( check_transform_order( elem ) < 0 ){
-    StatOrder++ ;
-    if( verbose > 0 ) printf( "        incorrect transformation order\n" ) ;
-    return -1 ;
-    }
-optimize_transformation_params( elem ) ;
-if( check_transform_quality( elem ) < 0 ){
-    StatOpt++ ;
-    if( verbose > 0 ) printf( "        refined transformation does not pass the numeric threshold\n" ) ;
-    return -1 ;
-    }
-StatAccept++ ;
-return 0 ;
-}
-
-/*
- *   Plane-specific functions
- */
-
-void
-mirror_atom( SYMMETRY_ELEMENT *plane, ATOM *from, ATOM *to )
-{
-        int                i ;
-        double             r ;
-
-for( i = 0, r = plane->distance ; i < DIMENSION ; i++ ){
-    r -= from->x[i] * plane->normal[i] ;
-    }
-to->type = from->type ;
-for( i = 0 ; i < DIMENSION ; i++ ){
-    to->x[i] = from->x[i] + 2*r*plane->normal[i] ;
-    }
-}
-
-SYMMETRY_ELEMENT *
-init_mirror_plane( int i, int j )
-{
-        SYMMETRY_ELEMENT * plane = alloc_symmetry_element() ;
-        double             dx[ DIMENSION ], midpoint[ DIMENSION ], rab, r ;
-        int                k ;
-
-if( verbose > 0 ) printf( "Trying mirror plane for atoms %d,%d\n", i, j ) ;
-StatTotal++ ;
-plane->transform_atom = mirror_atom ;
-plane->order          = 2 ;
-plane->nparam         = 4 ;
-for( k = 0, rab = 0 ; k < DIMENSION ; k++ ){
-    dx[k]       = Atoms[i].x[k] - Atoms[j].x[k] ;
-    midpoint[k] = ( Atoms[i].x[k] + Atoms[j].x[k] ) / 2.0 ;
-    rab        += dx[k]*dx[k] ;
-    }
-rab = sqrt(rab) ;
-if( rab < ToleranceSame ){
-    fprintf( stderr, "Atoms %d and %d coincide (r = %g)\n", i, j, rab ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-for( k = 0, r = 0 ; k < DIMENSION ; k++ ){
-    plane->normal[k] = dx[k]/rab ;
-    r += midpoint[k]*plane->normal[k] ;
-    }
-if( r < 0 ){  /* Reverce normal direction, distance is always positive! */
-    r = -r ;
-    for( k = 0 ; k < DIMENSION ; k++ ){
-        plane->normal[k] = -plane->normal[k] ;
-        }
-    }
-plane->distance = r ;
-if( verbose > 0 ) printf( "    initial plane is at %g from the origin\n", r ) ;
-if( refine_symmetry_element( plane, 1 ) < 0 ){
-    if( verbose > 0 ) printf( "    refinement failed for the plane\n" ) ;
-    destroy_symmetry_element( plane ) ;
-    return NULL ;
-    }
-return plane ;
-}
-
-SYMMETRY_ELEMENT *
-init_ultimate_plane( void )
-{
-        SYMMETRY_ELEMENT * plane = alloc_symmetry_element() ;
-        double             d0[ DIMENSION ], d1[ DIMENSION ], d2[ DIMENSION ] ;
-        double             p[ DIMENSION ] ;
-        double             r, s0, s1, s2 ;
-        double *           d ;
-        int                i, j, k ;
-
-if( verbose > 0 ) printf( "Trying whole-molecule mirror plane\n" ) ;
-StatTotal++ ;
-plane->transform_atom = mirror_atom ;
-plane->order          = 1 ;
-plane->nparam         = 4 ;
-for( k = 0 ; k < DIMENSION ; k++ )
-    d0[k] = d1[k] = d2[k] = 0 ;
-d0[0] = 1 ; d1[1] = 1 ; d2[2] = 1 ;
-for( i = 1 ; i < AtomsCount ; i++ ){
-    for( j = 0 ; j < i ; j++ ){
-        for( k = 0, r = 0 ; k < DIMENSION ; k++ ){
-            p[k] = Atoms[i].x[k] - Atoms[j].x[k] ;
-            r   += p[k]*p[k] ;
-            }
-        r = sqrt(r) ;
-        for( k = 0, s0=s1=s2=0 ; k < DIMENSION ; k++ ){
-            p[k] /= r ;
-            s0   += p[k]*d0[k] ;
-            s1   += p[k]*d1[k] ;
-            s2   += p[k]*d2[k] ;
-            }
-        for( k = 0 ; k < DIMENSION ; k++ ){
-            d0[k] -= s0*p[k] ;
-            d1[k] -= s1*p[k] ;
-            d2[k] -= s2*p[k] ;
-            }
-        }
-    }
-for( k = 0, s0=s1=s2=0 ; k < DIMENSION ; k++ ){
-    s0 += d0[k] ;
-    s1 += d1[k] ;
-    s2 += d2[k] ;
-    }
-d = NULL ;
-if( s0 >= s1 && s0 >= s2 ) d = d0 ;
-if( s1 >= s0 && s1 >= s2 ) d = d1 ;
-if( s2 >= s0 && s2 >= s1 ) d = d2 ;
-if( d == NULL ){
-    fprintf( stderr, "Catastrophe in init_ultimate_plane(): %g, %g and %g have no ordering!\n", s0, s1, s2 ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-for( k = 0, r = 0 ; k < DIMENSION ; k++ )
-    r += d[k]*d[k] ;
-r = sqrt(r) ;
-if( r > 0 ){
-    for( k = 0 ; k < DIMENSION ; k++ )
-        plane->normal[k] = d[k]/r ;
-    }
-else {
-    for( k = 1 ; k < DIMENSION ; k++ )
-        plane->normal[k] = 0 ;
-    plane->normal[0] = 1 ;
-    }
-for( k = 0, r = 0 ; k < DIMENSION ; k++ )
-    r += CenterOfSomething[k]*plane->normal[k] ;
-plane->distance = r ;
-for( k = 0 ; k < AtomsCount ; k++ )
-    plane->transform[k] = k ;
-if( refine_symmetry_element( plane, 0 ) < 0 ){
-    if( verbose > 0 ) printf( "    refinement failed for the plane\n" ) ;
-    destroy_symmetry_element( plane ) ;
-    return NULL ;
-    }
-return plane ;
-}
-/*
- *   Inversion-center specific functions
- */
-void
-invert_atom( SYMMETRY_ELEMENT *center, ATOM *from, ATOM *to )
-{
-        int                i ;
-
-to->type = from->type ;
-for( i = 0 ; i < DIMENSION ; i++ ){
-    to->x[i] = 2*center->distance*center->normal[i] - from->x[i] ;
-    }
-}
-
-SYMMETRY_ELEMENT *
-init_inversion_center( void )
-{
-        SYMMETRY_ELEMENT * center = alloc_symmetry_element() ;
-        int                k ;
-        double             r ;
-
-if( verbose > 0 ) printf( "Trying inversion center at the center of something\n" ) ;
-StatTotal++ ;
-center->transform_atom = invert_atom ;
-center->order          = 2 ;
-center->nparam         = 4 ;
-for( k = 0, r = 0 ; k < DIMENSION ; k++ )
-    r += CenterOfSomething[k]*CenterOfSomething[k] ;
-r = sqrt(r) ;
-if( r > 0 ){
-    for( k = 0 ; k < DIMENSION ; k++ )
-        center->normal[k] = CenterOfSomething[k]/r ;
-    }
-else {
-    center->normal[0] = 1 ;
-    for( k = 1 ; k < DIMENSION ; k++ )
-        center->normal[k] = 0 ;
-    }
-center->distance = r ;
-if( verbose > 0 ) printf( "    initial inversion center is at %g from the origin\n", r ) ;
-if( refine_symmetry_element( center, 1 ) < 0 ){
-    if( verbose > 0 ) printf( "    refinement failed for the inversion center\n" ) ;
-    destroy_symmetry_element( center ) ;
-    return NULL ;
-    }
-return center ;
-}
-
-/*
- *   Normal rotation axis-specific routines.
- */
-void
-rotate_atom( SYMMETRY_ELEMENT *axis, ATOM *from, ATOM *to )
-{
-        double             x[3], y[3], a[3], b[3], c[3] ;
-        double             angle = axis->order ? 2*M_PI/axis->order : 1.0 ;
-        double             a_sin = sin( angle ) ;
-        double             a_cos = cos( angle ) ;
-        double             dot ;
-        int                i ;
-
-if( DIMENSION != 3 ){
-    fprintf( stderr, "Catastrophe in rotate_atom!\n" ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-for( i = 0 ; i < 3 ; i++ )
-    x[i] = from->x[i] - axis->distance * axis->normal[i] ;
-for( i = 0, dot = 0 ; i < 3 ; i++ )
-    dot += x[i] * axis->direction[i] ;
-for( i = 0 ; i < 3 ; i++ )
-    a[i] = axis->direction[i] * dot ;
-for( i = 0 ; i < 3 ; i++ )
-    b[i] = x[i] - a[i] ;
-c[0] = b[1]*axis->direction[2] - b[2]*axis->direction[1] ;
-c[1] = b[2]*axis->direction[0] - b[0]*axis->direction[2] ;
-c[2] = b[0]*axis->direction[1] - b[1]*axis->direction[0] ;
-for( i = 0 ; i < 3 ; i++ )
-    y[i] = a[i] + b[i]*a_cos + c[i]*a_sin ;
-for( i = 0 ; i < 3 ; i++ )
-    to->x[i] = y[i] + axis->distance * axis->normal[i] ;
-to->type = from->type ;
-}
-
-SYMMETRY_ELEMENT *
-init_ultimate_axis(void)
-{
-        SYMMETRY_ELEMENT * axis = alloc_symmetry_element() ;
-        double             dir[ DIMENSION ], rel[ DIMENSION ] ;
-        double             s ;
-        int                i, k ;
-
-if( verbose > 0 ) printf( "Trying infinity axis\n" ) ;
-StatTotal++ ;
-axis->transform_atom = rotate_atom ;
-axis->order          = 0 ;
-axis->nparam         = 7 ;
-for( k = 0 ; k < DIMENSION ; k++ )
-    dir[k] = 0 ;
-for( i = 0 ; i < AtomsCount ; i++ ){
-    for( k = 0, s = 0 ; k < DIMENSION ; k++ ){
-        rel[k] = Atoms[i].x[k] - CenterOfSomething[k] ;
-        s     += rel[k]*dir[k] ;
-        }
-    if( s >= 0 )
-         for( k = 0 ; k < DIMENSION ; k++ )
-             dir[k] += rel[k] ;
-    else for( k = 0 ; k < DIMENSION ; k++ )
-             dir[k] -= rel[k] ;
-    }
-for( k = 0, s = 0 ; k < DIMENSION ; k++ )
-    s += pow2( dir[k] ) ;
-s = sqrt(s) ;
-if( s > 0 )
-     for( k = 0 ; k < DIMENSION ; k++ )
-         dir[k] /= s ;
-else dir[0] = 1 ;
-for( k = 0 ; k < DIMENSION ; k++ )
-    axis->direction[k] = dir[k] ;
-for( k = 0, s = 0 ; k < DIMENSION ; k++ )
-    s += pow2( CenterOfSomething[k] ) ;
-s = sqrt(s) ;
-if( s > 0 )
-    for( k = 0 ; k < DIMENSION ; k++ )
-        axis->normal[k] = CenterOfSomething[k]/s ;
-else {
-    for( k = 1 ; k < DIMENSION ; k++ )
-        axis->normal[k] = 0 ;
-    axis->normal[0] = 1 ;
-    }
-axis->distance = s ;
-for( k = 0 ; k < AtomsCount ; k++ )
-    axis->transform[k] = k ;
-if( refine_symmetry_element( axis, 0 ) < 0 ){
-    if( verbose > 0 ) printf( "    refinement failed for the infinity axis\n" ) ;
-    destroy_symmetry_element( axis ) ;
-    return NULL ;
-    }
-return axis ;
-}
-
-
-SYMMETRY_ELEMENT *
-init_c2_axis( int i, int j, double support[ DIMENSION ] )
-{
-        SYMMETRY_ELEMENT * axis ;
-        int                k ;
-        double             ris, rjs ;
-        double             r, center[ DIMENSION ] ;
-
-if( verbose > 0 ) 
-    printf( "Trying c2 axis for the pair (%d,%d) with the support (%g,%g,%g)\n", 
-             i, j, support[0], support[1], support[2] ) ;
-StatTotal++ ;
-/* First, do a quick sanity check */
-for( k = 0, ris = rjs = 0 ; k < DIMENSION ; k++ ){
-    ris += pow2( Atoms[i].x[k] - support[k] ) ;
-    rjs += pow2( Atoms[j].x[k] - support[k] ) ;
-    }
-ris = sqrt( ris ) ;
-rjs = sqrt( rjs ) ;
-if( fabs( ris - rjs ) > TolerancePrimary ){
-    StatEarly++ ;
-    if( verbose > 0 ) printf( "    Support can't actually define a rotation axis\n" ) ;
-    return NULL ;
-    }
-axis                 = alloc_symmetry_element() ;
-axis->transform_atom = rotate_atom ;
-axis->order          = 2 ;
-axis->nparam         = 7 ;
-for( k = 0, r = 0 ; k < DIMENSION ; k++ )
-    r += CenterOfSomething[k]*CenterOfSomething[k] ;
-r = sqrt(r) ;
-if( r > 0 ){
-    for( k = 0 ; k < DIMENSION ; k++ )
-        axis->normal[k] = CenterOfSomething[k]/r ;
-    }
-else {
-    axis->normal[0] = 1 ;
-    for( k = 1 ; k < DIMENSION ; k++ )
-        axis->normal[k] = 0 ;
-    }
-axis->distance = r ;
-for( k = 0, r = 0 ; k < DIMENSION ; k++ ){
-    center[k] = ( Atoms[i].x[k] + Atoms[j].x[k] ) / 2 - support[k] ;
-    r        += center[k]*center[k] ;
-    }
-r = sqrt(r) ;
-if( r <= TolerancePrimary ){ /* c2 is underdefined, let's do something special */
-    if( MolecularPlane != NULL ){
-        if( verbose > 0 ) printf( "    c2 is underdefined, but there is a molecular plane\n" ) ;
-        for( k = 0 ; k < DIMENSION ; k++ )
-            axis->direction[k] = MolecularPlane->normal[k] ;
-        }
-    else {
-        if( verbose > 0 ) printf( "    c2 is underdefined, trying random direction\n" ) ;
-        for( k = 0 ; k < DIMENSION ; k++ )
-            center[k] = Atoms[i].x[k] - Atoms[j].x[k] ;
-        if( fabs( center[2] ) + fabs( center[1] ) > ToleranceSame ){
-            axis->direction[0] =  0 ;
-            axis->direction[1] =  center[2] ;
-            axis->direction[2] = -center[1] ;
-            }
-        else {
-            axis->direction[0] = -center[2] ;
-            axis->direction[1] =  0 ;
-            axis->direction[2] =  center[0] ;
-            }
-        for( k = 0, r = 0 ; k < DIMENSION ; k++ )
-            r += axis->direction[k] * axis->direction[k] ;
-        r = sqrt(r) ;
-        for( k = 0 ; k < DIMENSION ; k++ )
-            axis->direction[k] /= r ;
-        }
-    }
-else { /* direction is Ok, renormalize it */
-    for( k = 0 ; k < DIMENSION ; k++ )
-        axis->direction[k] = center[k]/r ;
-    }
-if( refine_symmetry_element( axis, 1 ) < 0 ){
-    if( verbose > 0 ) printf( "    refinement failed for the c2 axis\n" ) ;
-    destroy_symmetry_element( axis ) ;
-    return NULL ;
-    }
-return axis ;
-}
-
-SYMMETRY_ELEMENT *
-init_axis_parameters( double a[3], double b[3], double c[3] )
-{
-        SYMMETRY_ELEMENT * axis ;
-        int                i, order, sign ;
-        double             ra, rb, rc, rab, rbc, rac, r ;
-        double             angle ;
-
-ra = rb = rc = rab = rbc = rac = 0 ;
-for( i = 0 ; i < DIMENSION ; i++ ){
-    ra  += a[i]*a[i] ;
-    rb  += b[i]*b[i] ;
-    rc  += c[i]*c[i] ;
-    }
-ra = sqrt(ra) ; rb  = sqrt(rb) ; rc  = sqrt(rc) ;
-if( fabs( ra - rb ) > TolerancePrimary || fabs( ra - rc ) > TolerancePrimary || fabs( rb - rc ) > TolerancePrimary ){
-    StatEarly++ ;
-    if( verbose > 0 ) printf( "    points are not on a sphere\n" ) ;
-    return NULL ;
-    }
-for( i = 0 ; i < DIMENSION ; i++ ){
-    rab += (a[i]-b[i])*(a[i]-b[i]) ;
-    rac += (a[i]-c[i])*(a[i]-c[i]) ;
-    rbc += (c[i]-b[i])*(c[i]-b[i]) ;
-    }
-rab = sqrt(rab) ;
-rac = sqrt(rac) ;
-rbc = sqrt(rbc) ;
-if( fabs( rab - rbc ) > TolerancePrimary ){
-    StatEarly++ ;
-    if( verbose > 0 ) printf( "    points can't be rotation-equivalent\n" ) ;
-    return NULL ;
-    }
-if( rab <= ToleranceSame || rbc <= ToleranceSame || rac <= ToleranceSame ){
-    StatEarly++ ;
-    if( verbose > 0 ) printf( "    rotation is underdefined by these points\n" ) ;
-    return NULL ;
-    }
-rab   = (rab+rbc)/2 ;
-angle = M_PI - 2*asin( rac/(2*rab) ) ;
-if( verbose > 1 ) printf( "    rotation angle is %f\n", angle ) ;
-if( fabs(angle) <= M_PI/(MaxAxisOrder+1) ){
-    StatEarly++ ;
-    if( verbose > 0 ) printf( "    atoms are too close to a straight line\n" ) ;
-    return NULL ;
-    }
-order = floor( (2*M_PI)/angle + 0.5 ) ;
-if( order <= 2 || order > MaxAxisOrder ){
-    StatEarly++ ;
-    if( verbose > 0 ) printf( "    rotation axis order (%d) is not from 3 to %d\n", order, MaxAxisOrder ) ;
-    return NULL ;
-    }
-axis = alloc_symmetry_element() ;
-axis->order          = order ;
-axis->nparam         = 7 ;
-for( i = 0, r = 0 ; i < DIMENSION ; i++ )
-    r += CenterOfSomething[i]*CenterOfSomething[i] ;
-r = sqrt(r) ;
-if( r > 0 ){
-    for( i = 0 ; i < DIMENSION ; i++ )
-        axis->normal[i] = CenterOfSomething[i]/r ;
-    }
-else {
-    axis->normal[0] = 1 ;
-    for( i = 1 ; i < DIMENSION ; i++ )
-        axis->normal[i] = 0 ;
-    }
-axis->distance = r ;
-axis->direction[0] = (b[1]-a[1])*(c[2]-b[2]) - (b[2]-a[2])*(c[1]-b[1]) ;
-axis->direction[1] = (b[2]-a[2])*(c[0]-b[0]) - (b[0]-a[0])*(c[2]-b[2]) ;
-axis->direction[2] = (b[0]-a[0])*(c[1]-b[1]) - (b[1]-a[1])*(c[0]-b[0]) ;
-/*
- *  Arbitrarily select axis direction so that first non-zero component
- *  or the direction is positive.
- */
-sign = 0 ;
-if( axis->direction[0] <= 0 ) {
-  if( axis->direction[0] < 0 ){
-    sign = 1 ;
-  } else if( axis->direction[1] <= 0 ){
-     if( axis->direction[1] < 0 ){
-        sign = 1 ;
-     } else if( axis->direction[2] < 0 ){
-        sign = 1 ;
-     }
-  }
-}
-if( sign )
-    for( i = 0 ; i < DIMENSION ; i++ )
-        axis->direction[i] = -axis->direction[i] ;
-for( i = 0, r = 0 ; i < DIMENSION ; i++ )
-    r += axis->direction[i]*axis->direction[i] ;
-r = sqrt(r) ;
-for( i = 0 ; i < DIMENSION ; i++ )
-    axis->direction[i] /= r ;
-if( verbose > 1 ){
-    printf( "    axis origin is at (%g,%g,%g)\n", 
-        axis->normal[0]*axis->distance, axis->normal[1]*axis->distance, axis->normal[2]*axis->distance ) ;
-    printf( "    axis is in the direction (%g,%g,%g)\n", axis->direction[0], axis->direction[1], axis->direction[2] ) ;
-    }
-return axis ;
-}
-
-SYMMETRY_ELEMENT *
-init_higher_axis( int ia, int ib, int ic )
-{
-        SYMMETRY_ELEMENT * axis ;
-        double             a[ DIMENSION ], b[ DIMENSION ], c[ DIMENSION ] ;
-        int                i ;
-
-if( verbose > 0 ) printf( "Trying cn axis for the triplet (%d,%d,%d)\n", ia, ib, ic ) ;
-StatTotal++ ;
-/* Do a quick check of geometry validity */
-for( i = 0 ; i < DIMENSION ; i++ ){
-    a[i] = Atoms[ia].x[i] - CenterOfSomething[i] ;
-    b[i] = Atoms[ib].x[i] - CenterOfSomething[i] ;
-    c[i] = Atoms[ic].x[i] - CenterOfSomething[i] ;
-    }
-if( ( axis = init_axis_parameters( a, b, c ) ) == NULL ){
-    if( verbose > 0 ) printf( "    no coherrent axis is defined by the points\n" ) ;
-    return NULL ;
-    }
-axis->transform_atom = rotate_atom ;
-if( refine_symmetry_element( axis, 1 ) < 0 ){
-    if( verbose > 0 ) printf( "    refinement failed for the c%d axis\n", axis->order ) ;
-    destroy_symmetry_element( axis ) ;
-    return NULL ;
-    }
-return axis ;
-}
-
-/*
- *   Improper axes-specific routines.
- *   These are obtained by slight modifications of normal rotation
- *       routines.
- */
-void
-rotate_reflect_atom( SYMMETRY_ELEMENT *axis, ATOM *from, ATOM *to )
-{
-        double             x[3], y[3], a[3], b[3], c[3] ;
-        double             angle = 2*M_PI/axis->order ;
-        double             a_sin = sin( angle ) ;
-        double             a_cos = cos( angle ) ;
-        double             dot ;
-        int                i ;
-
-if( DIMENSION != 3 ){
-    fprintf( stderr, "Catastrophe in rotate_reflect_atom!\n" ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-for( i = 0 ; i < 3 ; i++ )
-    x[i] = from->x[i] - axis->distance * axis->normal[i] ;
-for( i = 0, dot = 0 ; i < 3 ; i++ )
-    dot += x[i] * axis->direction[i] ;
-for( i = 0 ; i < 3 ; i++ )
-    a[i] = axis->direction[i] * dot ;
-for( i = 0 ; i < 3 ; i++ )
-    b[i] = x[i] - a[i] ;
-c[0] = b[1]*axis->direction[2] - b[2]*axis->direction[1] ;
-c[1] = b[2]*axis->direction[0] - b[0]*axis->direction[2] ;
-c[2] = b[0]*axis->direction[1] - b[1]*axis->direction[0] ;
-for( i = 0 ; i < 3 ; i++ )
-    y[i] = -a[i] + b[i]*a_cos + c[i]*a_sin ;
-for( i = 0 ; i < 3 ; i++ )
-    to->x[i] = y[i] + axis->distance * axis->normal[i] ;
-to->type = from->type ;
-}
-
-SYMMETRY_ELEMENT *
-init_improper_axis( int ia, int ib, int ic )
-{
-        SYMMETRY_ELEMENT * axis ;
-        double             a[ DIMENSION ], b[ DIMENSION ], c[ DIMENSION ] ;
-        double             centerpoint[ DIMENSION ] ;
-        double             r ;
-        int                i ;
-
-if( verbose > 0 ) printf( "Trying sn axis for the triplet (%d,%d,%d)\n", ia, ib, ic ) ;
-StatTotal++ ;
-/* First, reduce the problem to Cn case */
-for( i = 0 ; i < DIMENSION ; i++ ){
-    a[i] = Atoms[ia].x[i] - CenterOfSomething[i] ;
-    b[i] = Atoms[ib].x[i] - CenterOfSomething[i] ;
-    c[i] = Atoms[ic].x[i] - CenterOfSomething[i] ;
-    }
-for( i = 0, r = 0 ; i < DIMENSION ; i++ ){
-    centerpoint[i] = a[i] + c[i] + 2*b[i] ;
-    r             += centerpoint[i]*centerpoint[i] ;
-    }
-r = sqrt(r) ;
-if( r <= ToleranceSame ){
-    StatEarly++ ;
-    if( verbose > 0 ) printf( "    atoms can not define improper axis of the order more than 2\n" ) ;
-    return NULL ;
-    }
-for( i = 0 ; i < DIMENSION ; i++ )
-    centerpoint[i] /= r ;
-for( i = 0, r = 0 ; i < DIMENSION ; i++ )
-    r += centerpoint[i] * b[i] ;
-for( i = 0 ; i < DIMENSION ; i++ )
-    b[i] = 2*r*centerpoint[i] - b[i] ;
-/* Do a quick check of geometry validity */
-if( ( axis = init_axis_parameters( a, b, c ) ) == NULL ){
-    if( verbose > 0 ) printf( "    no coherrent improper axis is defined by the points\n" ) ;
-    return NULL ;
-    }
-axis->transform_atom = rotate_reflect_atom ;
-if( refine_symmetry_element( axis, 1 ) < 0 ){
-    if( verbose > 0 ) printf( "    refinement failed for the s%d axis\n", axis->order ) ;
-    destroy_symmetry_element( axis ) ;
-    return NULL ;
-    }
-return axis ;
-}
-
-/*
- *   Control routines
- */
-
-void
-find_center_of_something( void )
-{
-        int                i, j ;
-        double             coord_sum[ DIMENSION ] ;
-        double             r ;
-
-for( j = 0 ; j < DIMENSION ; j++ )
-    coord_sum[j] = 0 ;
-for( i = 0 ; i < AtomsCount ; i++ ){
-    for( j = 0 ; j < DIMENSION ; j++ )
-        coord_sum[j] += Atoms[i].x[j] ;
-    }
-for( j = 0 ; j < DIMENSION ; j++ )
-    CenterOfSomething[j] = coord_sum[j]/AtomsCount ;
-if( verbose > 0 )
-    printf( "Center of something is at %15.10f, %15.10f, %15.10f\n", 
-            CenterOfSomething[0], CenterOfSomething[1], CenterOfSomething[2] ) ;
-DistanceFromCenter = (double *) calloc( AtomsCount, sizeof( double ) ) ;
-if( DistanceFromCenter == NULL ){
-    fprintf( stderr, "Unable to allocate array for the distances\n" ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-for( i = 0 ; i < AtomsCount ; i++ ){
-    for( j = 0, r = 0 ; j < DIMENSION ; j++ )
-        r += pow2( Atoms[i].x[j] - CenterOfSomething[j] ) ;
-    DistanceFromCenter[i] = r ;
-    }
-}
-
-void
-find_planes(void)
-{
-        int                i, j ;
-        SYMMETRY_ELEMENT * plane ;
-
-plane = init_ultimate_plane() ;
-if( plane != NULL ){
-    MolecularPlane = plane ;
-    PlanesCount++ ;
-    Planes = (SYMMETRY_ELEMENT **) realloc( Planes, sizeof( SYMMETRY_ELEMENT* ) * PlanesCount ) ;
-    if( Planes == NULL ){
-        perror( "Out of memory in find_planes" ) ;
-        exit( EXIT_FAILURE ) ;
-        }
-    Planes[ PlanesCount - 1 ] = plane ;
-    }
-for( i = 1 ; i < AtomsCount ; i++ ){
-    for( j = 0 ; j < i ; j++ ){
-        if( Atoms[i].type != Atoms[j].type )
-            continue ;
-        if( ( plane = init_mirror_plane( i, j ) ) != NULL ){
-            PlanesCount++ ;
-            Planes = (SYMMETRY_ELEMENT **) realloc( Planes, sizeof( SYMMETRY_ELEMENT* ) * PlanesCount ) ;
-            if( Planes == NULL ){
-                perror( "Out of memory in find_planes" ) ;
-                exit( EXIT_FAILURE ) ;
-                }
-            Planes[ PlanesCount - 1 ] = plane ;
-            }
-        }
-    }
-}
-
-void
-find_inversion_centers(void)
-{
-        SYMMETRY_ELEMENT * center ;
-
-if( ( center = init_inversion_center() ) != NULL ){
-    InversionCenters = (SYMMETRY_ELEMENT **) calloc( 1, sizeof( SYMMETRY_ELEMENT* ) ) ;
-    InversionCenters[0]   = center ;
-    InversionCentersCount = 1 ;
-    }
-}
-
-void
-find_infinity_axis(void)
-{
-        SYMMETRY_ELEMENT * axis ;
-
-if( ( axis = init_ultimate_axis() ) != NULL ){
-    NormalAxesCount++ ;
-    NormalAxes = (SYMMETRY_ELEMENT **) realloc( NormalAxes, sizeof( SYMMETRY_ELEMENT* ) * NormalAxesCount ) ;
-    if( NormalAxes == NULL ){
-        perror( "Out of memory in find_infinity_axes()" ) ;
-        exit( EXIT_FAILURE ) ;
-        }
-    NormalAxes[ NormalAxesCount - 1 ] = axis ;
-    }
-}
-
-void
-find_c2_axes(void)
-{
-        int                i, j, k, l, m ;
-        double             center[ DIMENSION ] ;
-        double *           distances = calloc( AtomsCount, sizeof( double ) ) ;
-        double             r ;
-        SYMMETRY_ELEMENT * axis ;
-
-if( distances == NULL ){
-    fprintf( stderr, "Out of memory in find_c2_axes()\n" ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-for( i = 1 ; i < AtomsCount ; i++ ){
-    for( j = 0 ; j < i ; j++ ){
-        if( Atoms[i].type != Atoms[j].type )
-            continue ;
-        if( fabs( DistanceFromCenter[i] - DistanceFromCenter[j] ) > TolerancePrimary )
-            continue ; /* A very cheap, but quite effective check */
-        /*
-         *   First, let's try to get it cheap and use CenterOfSomething
-         */
-        for( k = 0, r = 0 ; k < DIMENSION ; k++ ){
-            center[k] = ( Atoms[i].x[k] + Atoms[j].x[k] ) / 2 ;
-            r        += pow2( center[k] - CenterOfSomething[k] ) ;
-            }
-        r = sqrt(r) ;
-        if( r > 5*TolerancePrimary ){ /* It's Ok to use CenterOfSomething */
-            if( ( axis = init_c2_axis( i, j, CenterOfSomething ) ) != NULL ){
-                NormalAxesCount++ ;
-                NormalAxes = (SYMMETRY_ELEMENT **) realloc( NormalAxes, sizeof( SYMMETRY_ELEMENT* ) * NormalAxesCount ) ;
-                if( NormalAxes == NULL ){
-                    perror( "Out of memory in find_c2_axes" ) ;
-                    exit( EXIT_FAILURE ) ;
-                    }
-                NormalAxes[ NormalAxesCount - 1 ] = axis ;
-                }
-            continue ;
-            }
-        /*
-         *  Now, C2 axis can either pass through an atom, or through the
-         *  middle of the other pair.
-         */
-        for( k = 0 ; k < AtomsCount ; k++ ){
-            if( ( axis = init_c2_axis( i, j, Atoms[k].x ) ) != NULL ){
-                NormalAxesCount++ ;
-                NormalAxes = (SYMMETRY_ELEMENT **) realloc( NormalAxes, sizeof( SYMMETRY_ELEMENT* ) * NormalAxesCount ) ;
-                if( NormalAxes == NULL ){
-                    perror( "Out of memory in find_c2_axes" ) ;
-                    exit( EXIT_FAILURE ) ;
-                    }
-                NormalAxes[ NormalAxesCount - 1 ] = axis ;
-                }
-            }
-        /*
-         *  Prepare data for an additional pre-screening check
-         */
-        for( k = 0 ; k < AtomsCount ; k++ ){
-            for( l = 0, r = 0 ; l < DIMENSION ; l++ )
-                r += pow2( Atoms[k].x[l] - center[l] ) ;
-            distances[k] = sqrt(r) ;
-            }
-        for( k = 0 ; k < AtomsCount ; k++ ){
-            for( l = 0 ; l < AtomsCount ; l++ ){
-                if( Atoms[k].type != Atoms[l].type )
-                    continue ;
-                if( fabs( DistanceFromCenter[k] - DistanceFromCenter[l] ) > TolerancePrimary ||
-                    fabs( distances[k] - distances[l] ) > TolerancePrimary )
-                        continue ; /* We really need this one to run reasonably fast! */
-                for( m = 0 ; m < DIMENSION ; m++ )
-                    center[m] = ( Atoms[k].x[m] + Atoms[l].x[m] ) / 2 ;
-                if( ( axis = init_c2_axis( i, j, center ) ) != NULL ){
-                    NormalAxesCount++ ;
-                    NormalAxes = (SYMMETRY_ELEMENT **) realloc( NormalAxes, sizeof( SYMMETRY_ELEMENT* ) * NormalAxesCount ) ;
-                    if( NormalAxes == NULL ){
-                        perror( "Out of memory in find_c2_axes" ) ;
-                        exit( EXIT_FAILURE ) ;
-                        }
-                    NormalAxes[ NormalAxesCount - 1 ] = axis ;
-                    }
-                }
-            }
-        }
-    }
-free( distances ) ;
-}
-
-void
-find_higher_axes(void)
-{
-        int                i, j, k ;
-        SYMMETRY_ELEMENT * axis ;
-
-for( i = 0 ; i < AtomsCount ; i++ ){
-    for( j = i + 1 ; j < AtomsCount ; j++ ){
-        if( Atoms[i].type != Atoms[j].type )
-            continue ;
-        if( fabs( DistanceFromCenter[i] - DistanceFromCenter[j] ) > TolerancePrimary )
-            continue ; /* A very cheap, but quite effective check */
-        for( k = 0 ; k < AtomsCount ; k++ ){
-            if( Atoms[i].type != Atoms[k].type )
-                continue ;
-            if( ( fabs( DistanceFromCenter[i] - DistanceFromCenter[k] ) > TolerancePrimary ) ||
-                ( fabs( DistanceFromCenter[j] - DistanceFromCenter[k] ) > TolerancePrimary ) )
-                    continue ;
-            if( ( axis = init_higher_axis( i, j, k ) ) != NULL ){
-                NormalAxesCount++ ;
-                NormalAxes = (SYMMETRY_ELEMENT **) realloc( NormalAxes, sizeof( SYMMETRY_ELEMENT* ) * NormalAxesCount ) ;
-                if( NormalAxes == NULL ){
-                    perror( "Out of memory in find_higher_axes" ) ;
-                    exit( EXIT_FAILURE ) ;
-                    }
-                NormalAxes[ NormalAxesCount - 1 ] = axis ;
-                }
-            }
-        }
-    }
-}
-
-void
-find_improper_axes(void)
-{
-        int                i, j, k ;
-        SYMMETRY_ELEMENT * axis ;
-
-/*    
-//#pragma omp parallel for private(i,j,k, axis) \
-//shared (ImproperAxesCount, ImproperAxes) \
-//schedule (guided)
-*/
-for( i = 0 ; i < AtomsCount ; i++ ){
-    for( j = i + 1 ; j < AtomsCount ; j++ ){
-        for( k = 0 ; k < AtomsCount ; k++ ){
-	//#pragma inline
-            if( ( axis = init_improper_axis( i, j, k ) ) != NULL ){
-                //#pragma omp critical
-                 {
-        	ImproperAxesCount++ ;
-                ImproperAxes = (SYMMETRY_ELEMENT **) realloc( ImproperAxes, sizeof( SYMMETRY_ELEMENT* ) * ImproperAxesCount ) ;
-                if( ImproperAxes == NULL ){
-                    perror( "Out of memory in find_higher_axes" ) ;
-                    exit( EXIT_FAILURE ) ;
-                    }
-                ImproperAxes[ ImproperAxesCount - 1 ] = axis ;
-                }
-                }
-            }
-        }
-    }
-}
-
-void
-report_planes( void )
-{
-        int           i ;
-
-if( PlanesCount == 0 )
-    printf( "There are no planes of symmetry in the molecule\n" ) ;
-else {
-    if( PlanesCount == 1 )
-         printf( "There is a plane of symmetry in the molecule\n" ) ;
-    else printf( "There are %d planes of symmetry in the molecule\n", PlanesCount ) ;
-    printf( "     Residual          Direction of the normal           Distance\n" ) ;
-    for( i = 0 ; i < PlanesCount ; i++ ){
-        printf( "%3d %8.4e ", i, Planes[i]->maxdev ) ;
-        printf( "(%11.8f,%11.8f,%11.8f) ", Planes[i]->normal[0], Planes[i]->normal[1], Planes[i]->normal[2] ) ;
-        printf( "%14.8f\n", Planes[i]->distance ) ;
-        }
-    }
-}
-
-void
-report_inversion_centers( void )
-{
-if( InversionCentersCount == 0 )
-     printf( "There is no inversion center in the molecule\n" ) ;
-else {
-    printf( "There in an inversion center in the molecule\n" ) ;
-    printf( "     Residual                      Position\n" ) ;
-    printf( "   %8.4e ", InversionCenters[0]->maxdev ) ;
-    printf( "(%14.8f,%14.8f,%14.8f)\n",
-        InversionCenters[0]->distance * InversionCenters[0]->normal[0],
-        InversionCenters[0]->distance * InversionCenters[0]->normal[1],
-        InversionCenters[0]->distance * InversionCenters[0]->normal[2] ) ;
-    }
-}
-
-void
-report_axes( void )
-{
-        int           i ;
-
-if( NormalAxesCount == 0 )
-    printf( "There are no normal axes in the molecule\n" ) ;
-else {
-    if( NormalAxesCount == 1 )
-         printf( "There is a normal axis in the molecule\n" ) ;
-    else printf( "There are %d normal axes in the molecule\n", NormalAxesCount ) ;
-    printf( "     Residual  Order         Direction of the axis                         Supporting point\n" ) ;
-    for( i = 0 ; i < NormalAxesCount ; i++ ){
-        printf( "%3d %8.4e ", i, NormalAxes[i]->maxdev ) ;
-        if( NormalAxes[i]->order == 0 )
-             printf( "Inf " ) ;
-        else printf( "%3d ", NormalAxes[i]->order ) ;
-        printf( "(%11.8f,%11.8f,%11.8f) ", 
-            NormalAxes[i]->direction[0], NormalAxes[i]->direction[1], NormalAxes[i]->direction[2] ) ;
-        printf( "(%14.8f,%14.8f,%14.8f)\n", 
-            NormalAxes[0]->distance * NormalAxes[0]->normal[0],
-            NormalAxes[0]->distance * NormalAxes[0]->normal[1],
-            NormalAxes[0]->distance * NormalAxes[0]->normal[2] ) ;
-        }
-    }
-}
-
-void
-report_improper_axes( void )
-{
-        int           i ;
-
-if( ImproperAxesCount == 0 )
-    printf( "There are no improper axes in the molecule\n" ) ;
-else {
-    if( ImproperAxesCount == 1 )
-         printf( "There is an improper axis in the molecule\n" ) ;
-    else printf( "There are %d improper axes in the molecule\n", ImproperAxesCount ) ;
-    printf( "     Residual  Order         Direction of the axis                         Supporting point\n" ) ;
-    for( i = 0 ; i < ImproperAxesCount ; i++ ){
-        printf( "%3d %8.4e ", i, ImproperAxes[i]->maxdev ) ;
-        if( ImproperAxes[i]->order == 0 )
-             printf( "Inf " ) ;
-        else printf( "%3d ", ImproperAxes[i]->order ) ;
-        printf( "(%11.8f,%11.8f,%11.8f) ", 
-            ImproperAxes[i]->direction[0], ImproperAxes[i]->direction[1], ImproperAxes[i]->direction[2] ) ;
-        printf( "(%14.8f,%14.8f,%14.8f)\n", 
-            ImproperAxes[0]->distance * ImproperAxes[0]->normal[0],
-            ImproperAxes[0]->distance * ImproperAxes[0]->normal[1],
-            ImproperAxes[0]->distance * ImproperAxes[0]->normal[2] ) ;
-        }
-    }
-}
-
-/*
- *  General symmetry handling
- */
-void
-report_and_reset_counters( void )
-{
-printf( "  %10ld candidates examined\n"
-        "  %10ld removed early\n"
-        "  %10ld removed during initial mating stage\n"
-        "  %10ld removed as duplicates\n"
-        "  %10ld removed because of the wrong transformation order\n"
-        "  %10ld removed after unsuccessful optimization\n"
-        "  %10ld accepted\n",
-    StatTotal, StatEarly, StatPairs, StatDups, StatOrder, StatOpt, StatAccept ) ;
-StatTotal = StatEarly = StatPairs = StatDups = StatOrder = StatOpt = StatAccept = 0 ;
-}
-
-void
-find_symmetry_elements( void )
-{
-find_center_of_something() ;
-if( verbose > -1 ){
-    printf( "Looking for the inversion center\n" ) ;
-    }
-find_inversion_centers() ;
-if( verbose > -1 ){
-    report_and_reset_counters() ;
-    printf( "Looking for the planes of symmetry\n" ) ;
-    }
-find_planes() ;
-if( verbose > -1 ){
-    report_and_reset_counters() ;
-    printf( "Looking for infinity axis\n" ) ;
-    }
-find_infinity_axis() ;
-if( verbose > -1 ){
-    report_and_reset_counters() ;
-    printf( "Looking for C2 axes\n" ) ;
-    }
-find_c2_axes() ;
-if( verbose > -1 ){
-    report_and_reset_counters() ;
-    printf( "Looking for higher axes\n" ) ;
-    }
-find_higher_axes() ;
-if( verbose > -1 ){
-    report_and_reset_counters() ;
-    printf( "Looking for the improper axes\n" ) ;
-    }
-find_improper_axes() ;
-if( verbose > -1 ){
-    report_and_reset_counters() ;
-    }
-}
-
-int
-compare_axes( const void *a, const void *b )
-{
-        SYMMETRY_ELEMENT * axis_a = *(SYMMETRY_ELEMENT**) a ;
-        SYMMETRY_ELEMENT * axis_b = *(SYMMETRY_ELEMENT**) b ;
-        int                i, order_a, order_b ;
-
-order_a = axis_a->order ; if( order_a == 0 ) order_a = 10000 ;
-order_b = axis_b->order ; if( order_b == 0 ) order_b = 10000 ;
-if( ( i = order_b - order_a ) != 0 ) return i ;
-if( axis_a->maxdev > axis_b->maxdev ) return -1 ;
-if( axis_a->maxdev < axis_b->maxdev ) return  1 ;
-return 0 ;
-}
-
-void
-sort_symmetry_elements( void )
-{
-if( PlanesCount > 1 ){
-    qsort( Planes, PlanesCount, sizeof( SYMMETRY_ELEMENT * ), compare_axes ) ;
-    }
-if( NormalAxesCount > 1 ){
-    qsort( NormalAxes, NormalAxesCount, sizeof( SYMMETRY_ELEMENT * ), compare_axes ) ;
-    }
-if( ImproperAxesCount > 1 ){
-    qsort( ImproperAxes, ImproperAxesCount, sizeof( SYMMETRY_ELEMENT * ), compare_axes ) ;
-    }
-}
-
-void
-report_symmetry_elements_verbose( void )
-{
-report_inversion_centers() ;
-report_axes() ;
-report_improper_axes() ;
-report_planes() ;
-}
-
-void
-summarize_symmetry_elements( void )
-{
-        int          i ;
-
-NormalAxesCounts   = (int*) calloc( MaxAxisOrder+1, sizeof( int ) ) ;
-ImproperAxesCounts = (int*) calloc( MaxAxisOrder+1, sizeof( int ) ) ;
-for( i = 0 ; i < NormalAxesCount ; i++ )
-    NormalAxesCounts[ NormalAxes[i]->order ]++ ;
-for( i = 0 ; i < ImproperAxesCount ; i++ )
-    ImproperAxesCounts[ ImproperAxes[i]->order ]++ ;
-}
-
-void
-report_symmetry_elements_brief( void )
-{
-        int          i ;
-        char *       symmetry_code = calloc( 1, 10*(PlanesCount+NormalAxesCount+ImproperAxesCount+InversionCentersCount+2) ) ;
-        char         buf[ 100 ] ;
-
-if( symmetry_code == NULL ){
-    fprintf( stderr, "Unable to allocate memory for symmetry ID code in report_symmetry_elements_brief()\n" ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-/*if( PlanesCount + NormalAxesCount + ImproperAxesCount + InversionCentersCount == 0 )
-   printf( "Molecule has no symmetry elements\n" ) ; //PP
-else {*/
-if( PlanesCount + NormalAxesCount + ImproperAxesCount + InversionCentersCount > 0 ){
-    //printf( "Molecule has the following symmetry elements: " ) ; //PP
-    if( InversionCentersCount > 0 ) strcat( symmetry_code, "(i) " ) ;
-    if( NormalAxesCounts[0] == 1 )
-         strcat( symmetry_code, "(Cinf) " ) ;
-    if( NormalAxesCounts[0] >  1 ) {
-        sprintf( buf, "%d*(Cinf) ", NormalAxesCounts[0] ) ;
-        strcat( symmetry_code, buf ) ;
-        }
-    for( i = MaxAxisOrder ; i >= 2 ; i-- ){
-        if( NormalAxesCounts[i] == 1 ){ sprintf( buf, "(C%d) ", i ) ; strcat( symmetry_code, buf ) ; }
-        if( NormalAxesCounts[i] >  1 ){ sprintf( buf, "%d*(C%d) ", NormalAxesCounts[i], i ) ; strcat( symmetry_code, buf ) ; }
-        }
-    for( i = MaxAxisOrder ; i >= 2 ; i-- ){
-        if( ImproperAxesCounts[i] == 1 ){ sprintf( buf, "(S%d) ", i ) ; strcat( symmetry_code, buf ) ; }
-        if( ImproperAxesCounts[i] >  1 ){ sprintf( buf, "%d*(S%d) ", ImproperAxesCounts[i], i ) ; strcat( symmetry_code, buf ) ; }
-        }
-    if( PlanesCount == 1 ) strcat( symmetry_code, "(sigma) " ) ;
-    if( PlanesCount >  1 ){ sprintf( buf, "%d*(sigma) ", PlanesCount ) ; strcat( symmetry_code, buf ) ; }
-    //printf( "%s\n", symmetry_code ) ; //PP
-    }
-SymmetryCode = symmetry_code ;
-}
-
-void
-report_symmetry_elements_brief_Conly( void )
-{
-        int          i ;
-        char *       symmetry_code = calloc( 1, 10*(PlanesCount+NormalAxesCount+ImproperAxesCount+InversionCentersCount+2) ) ;
-        char         buf[ 100 ] ;
-
-if( symmetry_code == NULL ){
-    fprintf( stderr, "Unable to allocate memory for symmetry ID code in report_symmetry_elements_brief()\n" ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-if( PlanesCount + NormalAxesCount + ImproperAxesCount + InversionCentersCount == 0 )
-    printf( "Molecule still has no symmetry elements...\n" ) ;
-else {
-    for( i = MaxAxisOrder ; i >= 2 ; i-- ){
-        if( NormalAxesCounts[i] >= 1 ){ sprintf( buf, "C%d ", i ) ; strcat( MaxRotAxis, buf ) ; }
-        }
-    }
-}
-
-int
-identify_point_group( void )
-{
-        int            i ;
-        int            last_matching = -1 ;
-        int            matching_count = 0 ;
-
-for( i = 0 ; i < PointGroupsCount ; i++ ){
-    if( strcmp( SymmetryCode, PointGroups[i].symmetry_code ) == 0 ){
-        if( PointGroups[i].check() == 1 ){
-            last_matching = i ;
-            matching_count++ ;
-            }
-        else {
-            if( verbose > -2 ){
-                printf( "It looks very much like %s, but it is not since %s\n", 
-                    PointGroups[i].group_name, PointGroupRejectionReason ) ;
-                }
-            }
-        }
-    }
-if( matching_count == 0 ){
-    printf( "WARNING: These symmetry elements match no point group I know of. Sorry.\n"
-	    "Trying fallback mode to highest recognized Axis...\n" ) ;
-    return -1;    
-}
-if( matching_count >  1 ){
-    printf( "These symmetry elements match more than one group I know of.\n"
-            "SOMETHING IS VERY WRONG\n" ) ;
-    printf( "Matching groups are:\n" ) ;
-    for( i = 0 ; i < PointGroupsCount ; i++ ){
-        if( ( strcmp( SymmetryCode, PointGroups[i].symmetry_code ) == 0 ) && ( PointGroups[i].check() == 1 ) ){
-            printf( "    %s\n", PointGroups[i].group_name ) ;
-            }
-        }
-    return -1;    
-    }
-if( matching_count == 1 ){
-    //printf( "It seems to be the %s point group\n", PointGroups[last_matching].group_name ) ; //PP
-    return last_matching;  
-  }
-  else {
-    return -1;
-  }
-}
-
-/*
- *  Input/Output
- */
-
-int
-read_coordinates( FILE *in )
-{
-        int                 i ;
-
-if( fscanf( in, "%d", &AtomsCount ) != 1 ){
-    fprintf( stderr, "Error reading atom count\n" ) ;
-    return -1 ;
-    }
-if( verbose > 0 ) printf( "Atoms count = %d\n", AtomsCount ) ;
-Atoms = calloc( AtomsCount, sizeof( ATOM ) ) ;
-if( Atoms == NULL ){
-    fprintf( stderr, "Out of memory for atoms coordinates\n" ) ;
-    return -1 ;
-    }
-for( i = 0 ; i < AtomsCount ; i++ ){
-    if( fscanf( in, "%d %lg %lg %lg\n", &Atoms[i].type, &Atoms[i].x[0], &Atoms[i].x[1], &Atoms[i].x[2] ) != 4 ){
-        fprintf( stderr, "Error reading description of the atom %d\n", i ) ;
-        return -1 ;
-        }
-    }
-return 0 ;
-}
-
-
-void schoenflies(int natoms, int* attype, double* coord, char* symbol, double* paramar)
-    {
-      int last_pg ;
-      int i;
-      
-//       //re-initialize Variables:
- PlanesCount           = 0 ;
- InversionCentersCount = 0 ;
- NormalAxesCount       = 0 ;
- ImproperAxesCount     = 0 ;
- BadOptimization       = 0 ;
- SymmetryCode          = "" ;
-// *MaxRotAxis	       = "" ;
- strncpy(MaxRotAxis, "", 2);
-//       /*
-//       *    Statistics
-//       */
-StatTotal             = 0 ;
-StatEarly             = 0 ;
-StatPairs             = 0 ;
-StatDups              = 0 ;
-StatOrder             = 0 ;
-StatOpt               = 0 ;
-StatAccept            = 0 ;
-      
-      
-      setbuf(stdout, NULL);      
-      AtomsCount = natoms;
-    //Allocate space for ATOMS
-      Atoms = calloc( AtomsCount, sizeof( ATOM ) ) ;
-    // fill atoms array:
-    if( Atoms == NULL ){
-    fprintf( stderr, "Out of memory for atoms coordinates\n" ) ;
-    //return -1 ;
-    }
-    for( i = 0 ; i < AtomsCount ; i++ ){
-      Atoms[i].type = attype[i];
-      Atoms[i].x[0] = coord[3*i];
-      Atoms[i].x[1] = coord[3*i+1];
-      Atoms[i].x[2] = coord[3*i+2];
-    }     
-          
-//    if( fscanf( in, "%d %lg %lg %lg\n", &Atoms[i].type, &Atoms[i].x[0], &Atoms[i].x[1], &Atoms[i].x[2] ) != 4 ){
-//        fprintf( stderr, "Error reading description of the atom %d\n", i ) ;
-//        return -1 ;
-//        }
-
-    //get parameters from array, integers first
-    verbose = paramar[0];
-    MaxAxisOrder  = paramar[1]; 
-    MaxOptCycles = paramar[2];
-    ToleranceSame = paramar[3];
-    TolerancePrimary = paramar[4];
-    ToleranceFinal = paramar[5];
-    MaxOptStep = paramar[6];
-    MinOptStep = paramar[7];
-    GradientStep = paramar[8];
-    OptChangeThreshold = paramar[9];
-    OptChangeHits = paramar[10];       
-
-    find_symmetry_elements() ;
-    sort_symmetry_elements() ;
-    summarize_symmetry_elements() ;
-    /*
-    if( BadOptimization )
-	printf( "Refinement of some symmetry elements was terminated before convergence was reached.\n"
-		"Some symmetry elements may remain unidentified.\n" ) ;
-    */ //PP
-    report_symmetry_elements_brief() ;
-    last_pg = identify_point_group() ;
-    if(last_pg >= 0){
-      strcpy(symbol,PointGroups[last_pg].group_name);
-    }
-    else {
-      report_symmetry_elements_brief_Conly() ;
-      if(MaxRotAxis[0] == '\0') {
-         strcpy(symbol,"C1");
-      }
-      else {
-         strcpy(symbol,MaxRotAxis);
-      }
-    }
-    }
-
-int
-old_main( int argc, char **argv )
-{
-        char          *program = *argv ;
-        FILE          *in ;
-
-for( argc--, argv++ ; argc > 0 ; argc -= 2, argv += 2 ){
-    if( **argv != '-' )
-        break ;
-    if( strcmp( *argv, "-help"         ) == 0 ||
-        strcmp( *argv, "-h"            ) == 0 ||
-        strcmp( *argv, "-?"            ) == 0 ){
-        argc++ ; argv-- ;
-        printf( "%s [option value ...] [filename]\n" 
-                "Valid options are:\n"
-                "  -verbose      (%3d) Determines verbosity level\n"
-                "                      All values above 0 are intended for debugging purposes\n"
-                "  -maxaxisorder (%3d) Maximum order of rotation axis to look for\n"
-                "  -maxoptcycles (%3d) Maximum allowed number of cycles in symmetry element optimization\n"
-                "  --                  Terminates option processing\n"
-                "Defaults should be Ok for these:\n"
-                "  -same         (%8g) Atoms are colliding if distance falls below this value\n"
-                "  -primary      (%8g) Initial loose criterion for atom equivalence\n"
-                "  -final        (%8g) Final criterion for atom equivalence\n"
-                "  -maxoptstep   (%8g) Largest step allowed in symmetry element optimization\n"
-                "  -minoptstep   (%8g) Termination criterion in symmetry element optimization\n"
-                "  -gradstep     (%8g) Finite step used in numeric gradient evaluation\n" 
-                "  -minchange    (%8g) Minimum allowed change in target function\n" 
-                "  -minchgcycles (%8d)  Number of minchange cycles before optimization stops\n",
-            program, verbose, MaxAxisOrder, MaxOptCycles, ToleranceSame, TolerancePrimary,
-            ToleranceFinal, MaxOptStep, MinOptStep, GradientStep, OptChangeThreshold, OptChangeHits ) ;
-        printf( "\n"
-                "Input is expected in the following format:\n"
-                "number_of_atoms\n"
-                "AtomicNumber X Y Z\n"
-                "...\n" ) ;
-        printf( "\n"
-                "Note that only primitive rotations will be reported\n" ) ;
-        printf( "This is version $Revision: 1.16 $ ($Date: 2003/04/04 13:05:03 $)\n" ) ;
-        exit( EXIT_SUCCESS ) ;
-        }
-    else
-    if( strcmp( *argv, "--"            ) == 0 ){
-        argc-- ; argv++ ; break ;
-        }
-    if( argc < 2 ){
-        fprintf( stderr, "Missing argument for \"%s\"\n", *argv ) ;
-        exit( EXIT_FAILURE ) ;
-        }
-    if( strcmp( *argv, "-minchgcycles" ) == 0 ){
-        if( sscanf( argv[1], "%d", &OptChangeHits ) != 1 ){
-            fprintf( stderr, "Invalid parameter for -minchgcycles: \"%s\"\n", argv[1] ) ;
-            exit( EXIT_FAILURE ) ;
-            }
-        }
-    else
-    if( strcmp( *argv, "-minchange"    ) == 0 ){
-        if( sscanf( argv[1], "%lg", &OptChangeThreshold ) != 1 ){
-            fprintf( stderr, "Invalid parameter for -minchange: \"%s\"\n", argv[1] ) ;
-            exit( EXIT_FAILURE ) ;
-            }
-        }
-    else
-    if( strcmp( *argv, "-same"         ) == 0 ){
-        if( sscanf( argv[1], "%lg", &ToleranceSame ) != 1 ){
-            fprintf( stderr, "Invalid parameter for -same: \"%s\"\n", argv[1] ) ;
-            exit( EXIT_FAILURE ) ;
-            }
-        }
-    else
-    if( strcmp( *argv, "-primary"      ) == 0 ){
-        if( sscanf( argv[1], "%lg", &TolerancePrimary ) != 1 ){
-            fprintf( stderr, "Invalid parameter for -primary: \"%s\"\n", argv[1] ) ;
-            exit( EXIT_FAILURE ) ;
-            }
-        }
-    else
-    if( strcmp( *argv, "-final"        ) == 0 ){
-        if( sscanf( argv[1], "%lg", &ToleranceFinal ) != 1 ){
-            fprintf( stderr, "Invalid parameter for -final: \"%s\"\n", argv[1] ) ;
-            exit( EXIT_FAILURE ) ;
-            }
-        }
-    else
-    if( strcmp( *argv, "-maxoptstep"   ) == 0 ){
-        if( sscanf( argv[1], "%lg", &MaxOptStep ) != 1 ){
-            fprintf( stderr, "Invalid parameter for -maxoptstep: \"%s\"\n", argv[1] ) ;
-            exit( EXIT_FAILURE ) ;
-            }
-        }
-    else
-    if( strcmp( *argv, "-minoptstep"   ) == 0 ){
-        if( sscanf( argv[1], "%lg", &MinOptStep ) != 1 ){
-            fprintf( stderr, "Invalid parameter for -minoptstep: \"%s\"\n", argv[1] ) ;
-            exit( EXIT_FAILURE ) ;
-            }
-        }
-    else
-    if( strcmp( *argv, "-gradstep"     ) == 0 ){
-        if( sscanf( argv[1], "%lg", &GradientStep ) != 1 ){
-            fprintf( stderr, "Invalid parameter for -gradstep: \"%s\"\n", argv[1] ) ;
-            exit( EXIT_FAILURE ) ;
-            }
-        }
-    else
-    if( strcmp( *argv, "-verbose"      ) == 0 ){
-        if( sscanf( argv[1], "%d", &verbose ) != 1 ){
-            fprintf( stderr, "Invalid parameter for -verbose: \"%s\"\n", argv[1] ) ;
-            exit( EXIT_FAILURE ) ;
-            }
-        }
-    else
-    if( strcmp( *argv, "-maxoptcycles" ) == 0 ){
-        if( sscanf( argv[1], "%d", &MaxOptCycles ) != 1 ){
-            fprintf( stderr, "Invalid parameter for -maxoptcycles: \"%s\"\n", argv[1] ) ;
-            exit( EXIT_FAILURE ) ;
-            }
-        }
-    else
-    if( strcmp( *argv, "-maxaxisorder" ) == 0 ){
-        if( sscanf( argv[1], "%d", &MaxAxisOrder ) != 1 ){
-            fprintf( stderr, "Invalid parameter for -maxaxisorder: \"%s\"\n", argv[1] ) ;
-            exit( EXIT_FAILURE ) ;
-            }
-        }
-    else {
-        fprintf( stderr, "Unrecognized option \"%s\"\n", *argv ) ;
-        exit( EXIT_FAILURE ) ;
-        }
-    }
-if( argc > 0 ){
-    if( ( in = fopen( *argv, "rt" ) ) == NULL ){
-        perror( *argv ) ;
-        exit( EXIT_FAILURE ) ;
-        }
-    }
-else {
-    in = stdin ;
-    }
-if( read_coordinates( in ) < 0 ){
-    fprintf( stderr, "Error reading in atomic coordinates\n" ) ;
-    exit( EXIT_FAILURE ) ;
-    }
-fclose( in ) ;
-find_symmetry_elements() ;
-sort_symmetry_elements() ;
-summarize_symmetry_elements() ;
-if( BadOptimization )
-    printf( "Refinement of some symmetry elements was terminated before convergence was reached.\n"
-            "Some symmetry elements may remain unidentified.\n" ) ;
-if( verbose >= 0 )
-    report_symmetry_elements_verbose() ;
-report_symmetry_elements_brief() ;
-identify_point_group() ;
-exit( EXIT_SUCCESS ) ;
-}
diff --git a/src/symmetry_i.f90 b/src/symmetry_i.f90
new file mode 100644
index 00000000..b5d77ccf
--- /dev/null
+++ b/src/symmetry_i.f90
@@ -0,0 +1,1816 @@
+!> symmetry_i.f90
+!> Brute force symmetry analyzer - Fortran module
+!>
+!> Fortran conversion of the original C code, 2026 Philipp Pracht
+!> 
+!> Original C code: (C) 1996, 2003 S. Patchkovskii
+!>
+!>
+!> This program is free software; you can redistribute it and/or modify
+!> it under the terms of the GNU General Public License as published by
+!> the Free Software Foundation; either version 2 of the License, or
+!> (at your option) any later version.
+
+module symmetry_i
+  use iso_fortran_env,only:wp => real64
+  implicit none
+  private
+
+  ! Public interface
+  public :: schoenflies
+  public :: getsym
+  !public :: symmetry_element,atom_t,symmetry_state_t
+
+  !> Mathematical constants
+  real(wp),parameter :: PI = 3.14159265358979323846d0
+  integer,parameter :: DIMENSION = 3
+  integer,parameter :: MAXPARAM = 7
+
+  !> Atom type
+  type :: atom_t
+    integer :: atom_type
+    real(wp) :: x(DIMENSION)
+  end type atom_t
+
+  !> Symmetry element type
+  type :: symmetry_element
+    integer :: transform_type  ! 1=mirror, 2=invert, 3=rotate, 4=rotate_reflect
+    integer,allocatable :: transform(:)
+    integer :: order
+    integer :: nparam
+    real(wp) :: maxdev
+    real(wp) :: distance
+    real(wp) :: normal(DIMENSION)
+    real(wp) :: direction(DIMENSION)
+  end type symmetry_element
+
+  !> Point group type
+  type :: point_group
+    character(len=8) :: group_name
+    character(len=64) :: symmetry_code
+  end type point_group
+
+  !> Number of point groups in the lookup table
+  integer,parameter :: PointGroupsCount = 60
+
+  !> Compile-time point group lookup table
+  type(point_group),parameter :: PointGroups(PointGroupsCount) = [                &
+  &  point_group("C1",""),                                                        &
+  &  point_group("Cs","(sigma) "),                                                &
+  &  point_group("Ci","(i) "),                                                    &
+  &  point_group("C2","(C2) "),                                                   &
+  &  point_group("C3","(C3) "),                                                   &
+  &  point_group("C4","(C4) (C2) "),                                              &
+  &  point_group("C5","(C5) "),                                                   &
+  &  point_group("C6","(C6) (C3) (C2) "),                                         &
+  &  point_group("C7","(C7) "),                                                   &
+  &  point_group("C8","(C8) (C4) (C2) "),                                         &
+  &  point_group("D2","3*(C2) "),                                                 &
+  &  point_group("D3","(C3) 3*(C2) "),                                            &
+  &  point_group("D4","(C4) 5*(C2) "),                                            &
+  &  point_group("D5","(C5) 5*(C2) "),                                            &
+  &  point_group("D6","(C6) (C3) 7*(C2) "),                                       &
+  &  point_group("D7","(C7) 7*(C2) "),                                            &
+  &  point_group("D8","(C8) (C4) 9*(C2) "),                                       &
+  &  point_group("C2v","(C2) 2*(sigma) "),                                        &
+  &  point_group("C3v","(C3) 3*(sigma) "),                                        &
+  &  point_group("C4v","(C4) (C2) 4*(sigma) "),                                   &
+  &  point_group("C5v","(C5) 5*(sigma) "),                                        &
+  &  point_group("C6v","(C6) (C3) (C2) 6*(sigma) "),                              &
+  &  point_group("C7v","(C7) 7*(sigma) "),                                        &
+  &  point_group("C8v","(C8) (C4) (C2) 8*(sigma) "),                              &
+  &  point_group("C2h","(i) (C2) (sigma) "),                                      &
+  &  point_group("C3h","(C3) (S3) (sigma) "),                                     &
+  &  point_group("C4h","(i) (C4) (C2) (S4) (sigma) "),                            &
+  &  point_group("C5h","(C5) (S5) (sigma) "),                                     &
+  &  point_group("C6h","(i) (C6) (C3) (C2) (S6) (S3) (sigma) "),                  &
+  &  point_group("C7h","(C7) (S7) (sigma) "),                                     &
+  &  point_group("C8h","(i) (C8) (C4) (C2) (S8) (S4) (sigma) "),                  &
+  &  point_group("D2h","(i) 3*(C2) 3*(sigma) "),                                  &
+  &  point_group("D3h","(C3) 3*(C2) (S3) 4*(sigma) "),                            &
+  &  point_group("D4h","(i) (C4) 5*(C2) (S4) 5*(sigma) "),                        &
+  &  point_group("D5h","(C5) 5*(C2) (S5) 6*(sigma) "),                            &
+  &  point_group("D6h","(i) (C6) (C3) 7*(C2) (S6) (S3) 7*(sigma) "),              &
+  &  point_group("D7h","(C7) 7*(C2) (S7) 8*(sigma) "),                            &
+  &  point_group("D8h","(i) (C8) (C4) 9*(C2) (S8) (S4) 9*(sigma) "),              &
+  &  point_group("D2d","3*(C2) (S4) 2*(sigma) "),                                 &
+  &  point_group("D3d","(i) (C3) 3*(C2) (S6) 3*(sigma) "),                        &
+  &  point_group("D4d","(C4) 5*(C2) (S8) 4*(sigma) "),                            &
+  &  point_group("D5d","(i) (C5) 5*(C2) (S10) 5*(sigma) "),                       &
+  &  point_group("D6d","(C6) (C3) 7*(C2) (S12) (S4) 6*(sigma) "),                 &
+  &  point_group("D7d","(i) (C7) 7*(C2) (S14) 7*(sigma) "),                       &
+  &  point_group("D8d","(C8) (C4) 9*(C2) (S16) 8*(sigma) "),                      &
+  &  point_group("S4","(C2) (S4) "),                                              &
+  &  point_group("S6","(i) (C3) (S6) "),                                          &
+  &  point_group("S8","(C4) (C2) (S8) "),                                         &
+  &  point_group("T","4*(C3) 3*(C2) "),                                           &
+  &  point_group("Th","(i) 4*(C3) 3*(C2) 4*(S6) 3*(sigma) "),                     &
+  &  point_group("Td","4*(C3) 3*(C2) 3*(S4) 6*(sigma) "),                         &
+  &  point_group("O","3*(C4) 4*(C3) 9*(C2) "),                                    &
+  &  point_group("Oh","(i) 3*(C4) 4*(C3) 9*(C2) 4*(S6) 3*(S4) 9*(sigma) "),       &
+  &  point_group("Cinfv","(Cinf) (sigma) "),                                      &
+  &  point_group("Dinfh","(i) (Cinf) (C2) 2*(sigma) "),                           &
+  &  point_group("I","6*(C5) 10*(C3) 15*(C2) "),                                  &
+  &  point_group("Ih","(i) 6*(C5) 10*(C3) 15*(C2) 6*(S10) 10*(S6) 15*(sigma) "),  &
+  &  point_group("Kh","(i) (Cinf) (sigma) "),                                     &
+  &  point_group("",""),                                                          &
+  &  point_group("","")]
+
+  !> All symmetry-analysis state collected in one derived type
+  type,public :: symmetry_state_t
+    ! Tolerance / control
+    real(wp) :: ToleranceSame = 1.0d-3
+    real(wp) :: TolerancePrimary = 5.0d-2
+    real(wp) :: ToleranceFinal = 1.0d-4
+    real(wp) :: MaxOptStep = 5.0d-1
+    real(wp) :: MinOptStep = 1.0d-7
+    real(wp) :: GradientStep = 1.0d-7
+    real(wp) :: OptChangeThreshold = 1.0d-10
+    integer  :: verbose = 0
+    integer  :: MaxAxisOrder = 20
+    integer  :: MaxOptCycles = 200
+    integer  :: OptChangeHits = 5
+    ! Geometry / working data
+    real(wp)              :: CenterOfSomething(3) = 0.0_wp
+    real(wp),allocatable  :: DistanceFromCenter(:)
+    integer               :: AtomsCount = 0
+    type(atom_t),allocatable :: Atoms(:)
+    ! Symmetry elements
+    integer                            :: PlanesCount = 0
+    type(symmetry_element),allocatable :: Planes(:)
+    type(symmetry_element)             :: MolecularPlane
+    logical                            :: MolecularPlaneExists = .false.
+    integer                            :: InversionCentersCount = 0
+    type(symmetry_element),allocatable :: InversionCenters(:)
+    integer                            :: NormalAxesCount = 0
+    type(symmetry_element),allocatable :: NormalAxes(:)
+    integer                            :: ImproperAxesCount = 0
+    type(symmetry_element),allocatable :: ImproperAxes(:)
+    integer,allocatable                :: NormalAxesCounts(:)
+    integer,allocatable                :: ImproperAxesCounts(:)
+    integer                            :: BadOptimization = 0
+    character(len=256)                 :: SymmetryCode = ""
+    character(len=8)                   :: MaxRotAxis = ""
+    ! Statistics
+    integer(8) :: StatTotal = 0
+    integer(8) :: StatEarly = 0
+    integer(8) :: StatPairs = 0
+    integer(8) :: StatDups = 0
+    integer(8) :: StatOrder = 0
+    integer(8) :: StatOpt = 0
+    integer(8) :: StatAccept = 0
+  end type symmetry_state_t
+
+! ══════════════════════════════════════════════════════════════════════════════
+contains    !> MODULE PROCEDURES START HERE
+! ══════════════════════════════════════════════════════════════════════════════
+
+  !> Initialise (reset) a symmetry_state_t to its defaults
+  subroutine init_symmetry_state(state)
+    type(symmetry_state_t),intent(out) :: state
+    ! intent(out) resets all scalar fields to their type-definition defaults
+    ! and deallocates every allocatable component (transitively).
+    ! Explicitly destroy the non-allocatable MolecularPlane's inner allocatable.
+    call destroy_symmetry_element(state%MolecularPlane)
+  end subroutine init_symmetry_state
+
+  !> Square function
+  pure real(wp) function pow2(x)
+    real(wp),intent(in) :: x
+    pow2 = x*x
+  end function pow2
+
+  !> Allocate a symmetry element
+  subroutine alloc_symmetry_element(state,elem)
+    type(symmetry_state_t),intent(in) :: state
+    type(symmetry_element),intent(out) :: elem
+    integer :: i
+
+    allocate (elem%transform(state%AtomsCount))
+    do i = 1,state%AtomsCount
+      elem%transform(i) = state%AtomsCount+1  ! Impossible value
+    end do
+    elem%order = 0
+    elem%nparam = 0
+    elem%maxdev = 0.0d0
+    elem%distance = 0.0d0
+    elem%normal = 0.0d0
+    elem%direction = 0.0d0
+    elem%transform_type = 0
+  end subroutine alloc_symmetry_element
+
+  !> Deallocate a symmetry element
+  subroutine destroy_symmetry_element(elem)
+    type(symmetry_element),intent(inout) :: elem
+    if (allocated(elem%transform)) deallocate (elem%transform)
+  end subroutine destroy_symmetry_element
+
+  !> Mirror an atom through a plane
+  subroutine mirror_atom(plane,from_atom,to_atom)
+    type(symmetry_element),intent(in) :: plane
+    type(atom_t),intent(in) :: from_atom
+    type(atom_t),intent(out) :: to_atom
+    integer :: i
+    real(wp) :: r
+
+    r = plane%distance
+    do i = 1,DIMENSION
+      r = r-from_atom%x(i)*plane%normal(i)
+    end do
+
+    to_atom%atom_type = from_atom%atom_type
+    do i = 1,DIMENSION
+      to_atom%x(i) = from_atom%x(i)+2.0d0*r*plane%normal(i)
+    end do
+  end subroutine mirror_atom
+
+  !> Invert an atom through a center
+  subroutine invert_atom(center,from_atom,to_atom)
+    type(symmetry_element),intent(in) :: center
+    type(atom_t),intent(in) :: from_atom
+    type(atom_t),intent(out) :: to_atom
+    integer :: i
+
+    to_atom%atom_type = from_atom%atom_type
+    do i = 1,DIMENSION
+      to_atom%x(i) = 2.0d0*center%distance*center%normal(i)-from_atom%x(i)
+    end do
+  end subroutine invert_atom
+
+  !> Rotate an atom around an axis
+  subroutine rotate_atom(axis,from_atom,to_atom)
+    type(symmetry_element),intent(in) :: axis
+    type(atom_t),intent(in) :: from_atom
+    type(atom_t),intent(out) :: to_atom
+    real(wp) :: x(3),y(3),a(3),b(3),c(3)
+    real(wp) :: angle,a_sin,a_cos,dot_val
+    integer :: i
+
+    if (axis%order /= 0) then
+      angle = 2.0d0*PI/dble(axis%order)
+    else
+      angle = 1.0d0
+    end if
+    a_sin = sin(angle)
+    a_cos = cos(angle)
+
+    do i = 1,3
+      x(i) = from_atom%x(i)-axis%distance*axis%normal(i)
+    end do
+
+    dot_val = 0.0d0
+    do i = 1,3
+      dot_val = dot_val+x(i)*axis%direction(i)
+    end do
+
+    do i = 1,3
+      a(i) = axis%direction(i)*dot_val
+    end do
+
+    do i = 1,3
+      b(i) = x(i)-a(i)
+    end do
+
+    c(1) = b(2)*axis%direction(3)-b(3)*axis%direction(2)
+    c(2) = b(3)*axis%direction(1)-b(1)*axis%direction(3)
+    c(3) = b(1)*axis%direction(2)-b(2)*axis%direction(1)
+
+    do i = 1,3
+      y(i) = a(i)+b(i)*a_cos+c(i)*a_sin
+    end do
+
+    do i = 1,3
+      to_atom%x(i) = y(i)+axis%distance*axis%normal(i)
+    end do
+    to_atom%atom_type = from_atom%atom_type
+  end subroutine rotate_atom
+
+  !> Rotate and reflect an atom (improper rotation)
+  subroutine rotate_reflect_atom(axis,from_atom,to_atom)
+    type(symmetry_element),intent(in) :: axis
+    type(atom_t),intent(in) :: from_atom
+    type(atom_t),intent(out) :: to_atom
+    real(wp) :: x(3),y(3),a(3),b(3),c(3)
+    real(wp) :: angle,a_sin,a_cos,dot_val
+    integer :: i
+
+    angle = 2.0d0*PI/dble(axis%order)
+    a_sin = sin(angle)
+    a_cos = cos(angle)
+
+    do i = 1,3
+      x(i) = from_atom%x(i)-axis%distance*axis%normal(i)
+    end do
+
+    dot_val = 0.0d0
+    do i = 1,3
+      dot_val = dot_val+x(i)*axis%direction(i)
+    end do
+
+    do i = 1,3
+      a(i) = axis%direction(i)*dot_val
+    end do
+
+    do i = 1,3
+      b(i) = x(i)-a(i)
+    end do
+
+    c(1) = b(2)*axis%direction(3)-b(3)*axis%direction(2)
+    c(2) = b(3)*axis%direction(1)-b(1)*axis%direction(3)
+    c(3) = b(1)*axis%direction(2)-b(2)*axis%direction(1)
+
+    do i = 1,3
+      y(i) = -a(i)+b(i)*a_cos+c(i)*a_sin
+    end do
+
+    do i = 1,3
+      to_atom%x(i) = y(i)+axis%distance*axis%normal(i)
+    end do
+    to_atom%atom_type = from_atom%atom_type
+  end subroutine rotate_reflect_atom
+
+  !> Transform atom based on element type
+  subroutine transform_atom(elem,from_atom,to_atom)
+    type(symmetry_element),intent(in) :: elem
+    type(atom_t),intent(in) :: from_atom
+    type(atom_t),intent(out) :: to_atom
+
+    select case (elem%transform_type)
+    case (1)
+      call mirror_atom(elem,from_atom,to_atom)
+    case (2)
+      call invert_atom(elem,from_atom,to_atom)
+    case (3)
+      call rotate_atom(elem,from_atom,to_atom)
+    case (4)
+      call rotate_reflect_atom(elem,from_atom,to_atom)
+    case default
+      to_atom = from_atom
+    end select
+  end subroutine transform_atom
+
+  !> Establish pairs of atoms related by symmetry
+  function establish_pairs(state,elem) result(status)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element),intent(inout) :: elem
+    integer :: status
+    integer :: i,j,k,best_j
+    logical,allocatable :: atom_used(:)
+    real(wp) :: distance,best_distance
+    type(atom_t) :: symmetric
+
+    status = 0
+    allocate (atom_used(state%AtomsCount))
+    atom_used = .false.
+
+    do i = 1,state%AtomsCount
+      if (elem%transform(i) > state%AtomsCount) then
+        call transform_atom(elem,state%Atoms(i),symmetric)
+        best_j = i
+        best_distance = 2.0d0*state%TolerancePrimary
+
+        do j = 1,state%AtomsCount
+          if (state%Atoms(j)%atom_type /= symmetric%atom_type.or.atom_used(j)) cycle
+
+          distance = 0.0d0
+          do k = 1,DIMENSION
+            distance = distance+pow2(symmetric%x(k)-state%Atoms(j)%x(k))
+          end do
+          distance = sqrt(distance)
+
+          if (distance < best_distance) then
+            best_j = j
+            best_distance = distance
+          end if
+        end do
+
+        if (best_distance > state%TolerancePrimary) then
+          deallocate (atom_used)
+          status = -1
+          return
+        end if
+
+        elem%transform(i) = best_j
+        atom_used(best_j) = .true.
+      end if
+    end do
+
+    deallocate (atom_used)
+  end function establish_pairs
+
+  !> Check if transformation order is correct
+  function check_transform_order(state,elem) result(status)
+    type(symmetry_state_t),intent(in) :: state
+    type(symmetry_element),intent(in) :: elem
+    integer :: status
+    integer :: i,j,k
+
+    status = 0
+
+    do i = 1,state%AtomsCount
+      if (elem%transform(i) == i) cycle
+
+      if (elem%transform_type == 4) then  ! rotate_reflect
+        j = elem%transform(i)
+        if (elem%transform(j) == i) cycle
+      end if
+
+      k = elem%transform(i)
+      do j = elem%order-1,1,-1
+        if (k == i) then
+          status = -1
+          return
+        end if
+        k = elem%transform(k)
+      end do
+
+      if (k /= i.and.elem%transform_type == 4) then
+        do j = elem%order,1,-1
+          if (k == i) then
+            status = -1
+            return
+          end if
+          k = elem%transform(k)
+        end do
+      end if
+
+      if (k /= i) then
+        status = -1
+        return
+      end if
+    end do
+  end function check_transform_order
+
+  !> Check if two transforms are the same
+  function same_transform(state,a,b) result(is_same)
+    type(symmetry_state_t),intent(in) :: state
+    type(symmetry_element),intent(in) :: a,b
+    logical :: is_same
+    integer :: i,j,code
+
+    is_same = .false.
+
+    if (a%order /= b%order.or.a%nparam /= b%nparam.or. &
+        a%transform_type /= b%transform_type) return
+
+    code = 1
+    do i = 1,state%AtomsCount
+      if (a%transform(i) /= b%transform(i)) then
+        code = 0
+        exit
+      end if
+    end do
+
+    if (code == 0.and.a%order > 2) then
+      do i = 1,state%AtomsCount
+        j = a%transform(i)
+        if (b%transform(j) /= i) return
+      end do
+      is_same = .true.
+      return
+    end if
+
+    is_same = (code == 1)
+  end function same_transform
+
+  !> Check transform quality
+  function check_transform_quality(state,elem) result(status)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element),intent(inout) :: elem
+    integer :: status
+    integer :: i,j,k
+    type(atom_t) :: symmetric
+    real(wp) :: r,max_r
+
+    status = 0
+    max_r = 0.0d0
+
+    do i = 1,state%AtomsCount
+      j = elem%transform(i)
+      call transform_atom(elem,state%Atoms(i),symmetric)
+
+      r = 0.0d0
+      do k = 1,DIMENSION
+        r = r+pow2(symmetric%x(k)-state%Atoms(j)%x(k))
+      end do
+      r = sqrt(r)
+
+      if (r > state%ToleranceFinal) then
+        status = -1
+        return
+      end if
+      if (r > max_r) max_r = r
+    end do
+
+    elem%maxdev = max_r
+  end function check_transform_quality
+
+  !> Evaluate optimization target function
+  function eval_optimization_target_function(state,elem,finish) result(target)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element),intent(inout) :: elem
+    logical,intent(out),optional :: finish
+    real(wp) :: target
+    integer :: i,j,k
+    type(atom_t) :: symmetric
+    real(wp) :: r,maxr
+
+    ! Normalize normal vector
+    if (elem%nparam >= 4) then
+      r = 0.0d0
+      do k = 1,DIMENSION
+        r = r+elem%normal(k)*elem%normal(k)
+      end do
+      r = sqrt(r)
+      if (r < state%ToleranceSame) then
+        write (*,*) "Normal collapsed!"
+        stop
+      end if
+      elem%normal = elem%normal/r
+      if (elem%distance < 0.0d0) then
+        elem%distance = -elem%distance
+        elem%normal = -elem%normal
+      end if
+    end if
+
+    ! Normalize direction vector
+    if (elem%nparam >= 7) then
+      r = 0.0d0
+      do k = 1,DIMENSION
+        r = r+elem%direction(k)*elem%direction(k)
+      end do
+      r = sqrt(r)
+      if (r < state%ToleranceSame) then
+        write (*,*) "Direction collapsed!"
+        stop
+      end if
+      elem%direction = elem%direction/r
+    end if
+
+    target = 0.0d0
+    maxr = 0.0d0
+
+    do i = 1,state%AtomsCount
+      call transform_atom(elem,state%Atoms(i),symmetric)
+      j = elem%transform(i)
+
+      r = 0.0d0
+      do k = 1,DIMENSION
+        r = r+pow2(state%Atoms(j)%x(k)-symmetric%x(k))
+      end do
+      if (r > maxr) maxr = r
+      target = target+r
+    end do
+
+    if (present(finish)) then
+      finish = (sqrt(maxr) < state%ToleranceFinal)
+    end if
+  end function eval_optimization_target_function
+
+  !> Get parameters from element
+  subroutine get_params(elem,values)
+    type(symmetry_element),intent(in) :: elem
+    real(wp),intent(out) :: values(MAXPARAM)
+
+    values(1) = elem%distance
+    values(2:4) = elem%normal(1:3)
+    if (elem%nparam >= 7) then
+      values(5:7) = elem%direction(1:3)
+    end if
+  end subroutine get_params
+
+  !> Set parameters to element
+  subroutine set_params(elem,values)
+    type(symmetry_element),intent(inout) :: elem
+    real(wp),intent(in) :: values(MAXPARAM)
+
+    elem%distance = values(1)
+    elem%normal(1:3) = values(2:4)
+    if (elem%nparam >= 7) then
+      elem%direction(1:3) = values(5:7)
+    end if
+  end subroutine set_params
+
+  !> Optimize transformation parameters
+  subroutine optimize_transformation_params(state,elem)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element),intent(inout) :: elem
+    real(wp) :: values(MAXPARAM),grad(MAXPARAM),force(MAXPARAM),step(MAXPARAM)
+    real(wp) :: f,fold,fnew,fnew2,fdn,fup,snorm
+    real(wp) :: a,b,x
+    integer :: vars,cycle,i,hits
+    logical :: finish
+
+    values = 0.0_wp
+    grad = 0.0_wp
+    force = 0.0_wp
+    step = 0.0_wp
+
+    vars = elem%nparam
+    if (vars > MAXPARAM) then
+      write (*,*) "Catastrophe in optimize_transformation_params!"
+      stop
+    end if
+
+    f = 0.0d0
+    cycle = 0
+    hits = 0
+
+    do
+      fold = f
+      f = eval_optimization_target_function(state,elem,finish)
+
+      if (finish) exit
+
+      if (cycle > 0) then
+        if (abs(f-fold) > state%OptChangeThreshold) then
+          hits = 0
+        else
+          hits = hits+1
+        end if
+        if (hits >= state%OptChangeHits) exit
+      end if
+
+      call get_params(elem,values)
+
+      ! Calculate gradient and force constants
+      do i = 1,vars
+        values(i) = values(i)-state%GradientStep
+        call set_params(elem,values)
+        fdn = eval_optimization_target_function(state,elem)
+
+        values(i) = values(i)+2.0d0*state%GradientStep
+        call set_params(elem,values)
+        fup = eval_optimization_target_function(state,elem)
+
+        values(i) = values(i)-state%GradientStep
+        grad(i) = (fup-fdn)/(2.0d0*state%GradientStep)
+        force(i) = (fup+fdn-2.0d0*f)/(state%GradientStep*state%GradientStep)
+      end do
+
+      ! Quasi-Newton step
+      snorm = 0.0d0
+      do i = 1,vars
+        if (force(i) < 0.0d0) force(i) = -force(i)
+        if (force(i) < 1.0d-3) force(i) = 1.0d-3
+        if (force(i) > 1.0d3) force(i) = 1.0d3
+        step(i) = -grad(i)/force(i)
+        snorm = snorm+step(i)*step(i)
+      end do
+      snorm = sqrt(snorm)
+
+      if (snorm > state%MaxOptStep) then
+        step = step*state%MaxOptStep/snorm
+        snorm = state%MaxOptStep
+      end if
+
+      do while (snorm > state%MinOptStep)
+        values = values+step
+        call set_params(elem,values)
+        fnew = eval_optimization_target_function(state,elem)
+
+        if (fnew < f) exit
+
+        values = values-step
+        step = step/2.0d0
+        call set_params(elem,values)
+        snorm = snorm/2.0d0
+      end do
+
+      ! Quadratic interpolation
+      if (snorm > state%MinOptStep.and.snorm < state%MaxOptStep/2.0d0) then
+        values = values+step
+        call set_params(elem,values)
+        fnew2 = eval_optimization_target_function(state,elem)
+        values = values-2.0d0*step
+
+        a = (4.0d0*f-fnew2-3.0d0*fnew)/2.0d0
+        b = (f+fnew2-2.0d0*fnew)/2.0d0
+
+        if (b > 0.0d0) then
+          x = -a/(2.0d0*b)
+          if (x > 0.2d0.and.x < 1.8d0) then
+            values = values+x*step
+          else
+            b = 0.0d0
+          end if
+        end if
+
+        if (b <= 0.0d0) then
+          if (fnew2 < fnew) then
+            values = values+2.0d0*step
+          else
+            values = values+step
+          end if
+        end if
+        call set_params(elem,values)
+      end if
+
+      cycle = cycle+1
+      if (snorm <= state%MinOptStep.or.cycle >= state%MaxOptCycles) exit
+    end do
+
+    f = eval_optimization_target_function(state,elem)
+    if (cycle >= state%MaxOptCycles) state%BadOptimization = 1
+  end subroutine optimize_transformation_params
+
+  !> Refine symmetry element
+  function refine_symmetry_element(state,elem,build_table) result(status)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element),intent(inout) :: elem
+    logical,intent(in) :: build_table
+    integer :: status
+    integer :: i
+
+    status = 0
+
+    if (build_table) then
+      if (establish_pairs(state,elem) < 0) then
+        state%StatPairs = state%StatPairs+1
+        status = -1
+        return
+      end if
+    end if
+
+    ! Check for duplicates
+    do i = 1,state%PlanesCount
+      if (same_transform(state,state%Planes(i),elem)) then
+        state%StatDups = state%StatDups+1
+        status = -1
+        return
+      end if
+    end do
+
+    do i = 1,state%InversionCentersCount
+      if (same_transform(state,state%InversionCenters(i),elem)) then
+        state%StatDups = state%StatDups+1
+        status = -1
+        return
+      end if
+    end do
+
+    do i = 1,state%NormalAxesCount
+      if (same_transform(state,state%NormalAxes(i),elem)) then
+        state%StatDups = state%StatDups+1
+        status = -1
+        return
+      end if
+    end do
+
+    do i = 1,state%ImproperAxesCount
+      if (same_transform(state,state%ImproperAxes(i),elem)) then
+        state%StatDups = state%StatDups+1
+        status = -1
+        return
+      end if
+    end do
+
+    if (check_transform_order(state,elem) < 0) then
+      state%StatOrder = state%StatOrder+1
+      status = -1
+      return
+    end if
+
+    call optimize_transformation_params(state,elem)
+
+    if (check_transform_quality(state,elem) < 0) then
+      state%StatOpt = state%StatOpt+1
+      status = -1
+      return
+    end if
+
+    state%StatAccept = state%StatAccept+1
+  end function refine_symmetry_element
+
+  !> Initialize mirror plane
+  subroutine init_mirror_plane(state,i,j,plane,success)
+    type(symmetry_state_t),intent(inout) :: state
+    integer,intent(in) :: i,j
+    type(symmetry_element),intent(out) :: plane
+    logical,intent(out) :: success
+    real(wp) :: dx(DIMENSION),midpoint(DIMENSION),rab,r
+    integer :: k
+
+    success = .false.
+    state%StatTotal = state%StatTotal+1
+
+    call alloc_symmetry_element(state,plane)
+    plane%transform_type = 1  ! mirror
+    plane%order = 2
+    plane%nparam = 4
+
+    rab = 0.0d0
+    do k = 1,DIMENSION
+      dx(k) = state%Atoms(i)%x(k)-state%Atoms(j)%x(k)
+      midpoint(k) = (state%Atoms(i)%x(k)+state%Atoms(j)%x(k))/2.0d0
+      rab = rab+dx(k)*dx(k)
+    end do
+    rab = sqrt(rab)
+
+    if (rab < state%ToleranceSame) then
+      call destroy_symmetry_element(plane)
+      return
+    end if
+
+    r = 0.0d0
+    do k = 1,DIMENSION
+      plane%normal(k) = dx(k)/rab
+      r = r+midpoint(k)*plane%normal(k)
+    end do
+
+    if (r < 0.0d0) then
+      r = -r
+      plane%normal = -plane%normal
+    end if
+    plane%distance = r
+
+    if (refine_symmetry_element(state,plane,.true.) < 0) then
+      call destroy_symmetry_element(plane)
+      return
+    end if
+
+    success = .true.
+  end subroutine init_mirror_plane
+
+  !> Initialize ultimate (whole-molecule) plane
+  subroutine init_ultimate_plane(state,plane,success)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element),intent(out) :: plane
+    logical,intent(out) :: success
+    real(wp) :: d0(DIMENSION),d1(DIMENSION),d2(DIMENSION),p(DIMENSION)
+    real(wp) :: r,s0,s1,s2
+    real(wp),pointer :: d(:)
+    integer :: i,j,k
+
+    success = .false.
+    state%StatTotal = state%StatTotal+1
+
+    call alloc_symmetry_element(state,plane)
+    plane%transform_type = 1
+    plane%order = 1
+    plane%nparam = 4
+
+    d0 = 0.0d0; d1 = 0.0d0; d2 = 0.0d0
+    d0(1) = 1.0d0; d1(2) = 1.0d0; d2(3) = 1.0d0
+
+    do i = 2,state%AtomsCount
+      do j = 1,i-1
+        r = 0.0d0
+        do k = 1,DIMENSION
+          p(k) = state%Atoms(i)%x(k)-state%Atoms(j)%x(k)
+          r = r+p(k)*p(k)
+        end do
+        r = sqrt(r)
+
+        s0 = 0.0d0; s1 = 0.0d0; s2 = 0.0d0
+        do k = 1,DIMENSION
+          p(k) = p(k)/r
+          s0 = s0+p(k)*d0(k)
+          s1 = s1+p(k)*d1(k)
+          s2 = s2+p(k)*d2(k)
+        end do
+
+        do k = 1,DIMENSION
+          d0(k) = d0(k)-s0*p(k)
+          d1(k) = d1(k)-s1*p(k)
+          d2(k) = d2(k)-s2*p(k)
+        end do
+      end do
+    end do
+
+    s0 = sum(d0)
+    s1 = sum(d1)
+    s2 = sum(d2)
+
+    if (s0 >= s1.and.s0 >= s2) then
+      plane%normal = d0
+    else if (s1 >= s0.and.s1 >= s2) then
+      plane%normal = d1
+    else
+      plane%normal = d2
+    end if
+
+    r = sqrt(sum(plane%normal**2))
+    if (r > 0.0d0) then
+      plane%normal = plane%normal/r
+    else
+      plane%normal = [1.0d0,0.0d0,0.0d0]
+    end if
+
+    r = dot_product(state%CenterOfSomething,plane%normal)
+    plane%distance = r
+
+    do k = 1,state%AtomsCount
+      plane%transform(k) = k
+    end do
+
+    if (refine_symmetry_element(state,plane,.false.) < 0) then
+      call destroy_symmetry_element(plane)
+      return
+    end if
+
+    success = .true.
+  end subroutine init_ultimate_plane
+
+  !> Initialize inversion center
+  subroutine init_inversion_center(state,center,success)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element),intent(out) :: center
+    logical,intent(out) :: success
+    real(wp) :: r
+    integer :: k
+
+    success = .false.
+    state%StatTotal = state%StatTotal+1
+
+    call alloc_symmetry_element(state,center)
+    center%transform_type = 2  ! invert
+    center%order = 2
+    center%nparam = 4
+
+    r = sqrt(sum(state%CenterOfSomething**2))
+
+    if (r > 0.0d0) then
+      center%normal = state%CenterOfSomething/r
+    else
+      center%normal = [1.0d0,0.0d0,0.0d0]
+    end if
+    center%distance = r
+
+    if (refine_symmetry_element(state,center,.true.) < 0) then
+      call destroy_symmetry_element(center)
+      return
+    end if
+
+    success = .true.
+  end subroutine init_inversion_center
+
+  !> Initialize ultimate (infinity) axis
+  subroutine init_ultimate_axis(state,axis,success)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element),intent(out) :: axis
+    logical,intent(out) :: success
+    real(wp) :: dir(DIMENSION),rel(DIMENSION),s
+    integer :: i,k
+
+    success = .false.
+    state%StatTotal = state%StatTotal+1
+
+    call alloc_symmetry_element(state,axis)
+    axis%transform_type = 3  ! rotate
+    axis%order = 0
+    axis%nparam = 7
+
+    dir = 0.0d0
+    do i = 1,state%AtomsCount
+      s = 0.0d0
+      do k = 1,DIMENSION
+        rel(k) = state%Atoms(i)%x(k)-state%CenterOfSomething(k)
+        s = s+rel(k)*dir(k)
+      end do
+      if (s >= 0.0d0) then
+        dir = dir+rel
+      else
+        dir = dir-rel
+      end if
+    end do
+
+    s = sqrt(sum(dir**2))
+    if (s > 0.0d0) then
+      axis%direction = dir/s
+    else
+      axis%direction = [1.0d0,0.0d0,0.0d0]
+    end if
+
+    s = sqrt(sum(state%CenterOfSomething**2))
+    if (s > 0.0d0) then
+      axis%normal = state%CenterOfSomething/s
+    else
+      axis%normal = [1.0d0,0.0d0,0.0d0]
+    end if
+    axis%distance = s
+
+    do k = 1,state%AtomsCount
+      axis%transform(k) = k
+    end do
+
+    if (refine_symmetry_element(state,axis,.false.) < 0) then
+      call destroy_symmetry_element(axis)
+      return
+    end if
+
+    success = .true.
+  end subroutine init_ultimate_axis
+
+  !> Initialize axis parameters from three points
+  subroutine init_axis_parameters(state,a,b,c,axis,success)
+    type(symmetry_state_t),intent(inout) :: state
+    real(wp),intent(in) :: a(3),b(3),c(3)
+    type(symmetry_element),intent(out) :: axis
+    logical,intent(out) :: success
+    real(wp) :: ra,rb,rc,rab,rbc,rac,r,angle
+    integer :: i,order,sign_val
+
+    success = .false.
+
+    ra = sqrt(sum(a**2))
+    rb = sqrt(sum(b**2))
+    rc = sqrt(sum(c**2))
+
+    if (abs(ra-rb) > state%TolerancePrimary.or. &
+        abs(ra-rc) > state%TolerancePrimary.or. &
+        abs(rb-rc) > state%TolerancePrimary) then
+      state%StatEarly = state%StatEarly+1
+      return
+    end if
+
+    rab = sqrt(sum((a-b)**2))
+    rac = sqrt(sum((a-c)**2))
+    rbc = sqrt(sum((c-b)**2))
+
+    if (abs(rab-rbc) > state%TolerancePrimary) then
+      state%StatEarly = state%StatEarly+1
+      return
+    end if
+
+    if (rab <= state%ToleranceSame.or.rbc <= state%ToleranceSame.or. &
+        rac <= state%ToleranceSame) then
+      state%StatEarly = state%StatEarly+1
+      return
+    end if
+
+    rab = (rab+rbc)/2.0d0
+    angle = PI-2.0d0*asin(rac/(2.0d0*rab))
+
+    if (abs(angle) <= PI/(state%MaxAxisOrder+1)) then
+      state%StatEarly = state%StatEarly+1
+      return
+    end if
+
+    order = nint((2.0d0*PI)/angle)
+    if (order <= 2.or.order > state%MaxAxisOrder) then
+      state%StatEarly = state%StatEarly+1
+      return
+    end if
+
+    call alloc_symmetry_element(state,axis)
+    axis%order = order
+    axis%nparam = 7
+
+    r = sqrt(sum(state%CenterOfSomething**2))
+    if (r > 0.0d0) then
+      axis%normal = state%CenterOfSomething/r
+    else
+      axis%normal = [1.0d0,0.0d0,0.0d0]
+    end if
+    axis%distance = r
+
+    ! Cross product for direction
+    axis%direction(1) = (b(2)-a(2))*(c(3)-b(3))-(b(3)-a(3))*(c(2)-b(2))
+    axis%direction(2) = (b(3)-a(3))*(c(1)-b(1))-(b(1)-a(1))*(c(3)-b(3))
+    axis%direction(3) = (b(1)-a(1))*(c(2)-b(2))-(b(2)-a(2))*(c(1)-b(1))
+
+    ! Select direction so first non-zero component is positive
+    sign_val = 0
+    if (axis%direction(1) < 0.0d0) then
+      sign_val = 1
+    else if (axis%direction(1) == 0.0d0) then
+      if (axis%direction(2) < 0.0d0) then
+        sign_val = 1
+      else if (axis%direction(2) == 0.0d0) then
+        if (axis%direction(3) < 0.0d0) sign_val = 1
+      end if
+    end if
+
+    if (sign_val == 1) axis%direction = -axis%direction
+
+    r = sqrt(sum(axis%direction**2))
+    axis%direction = axis%direction/r
+
+    success = .true.
+  end subroutine init_axis_parameters
+
+  !> Initialize C2 axis
+  subroutine init_c2_axis(state,i,j,support,axis,success)
+    type(symmetry_state_t),intent(inout) :: state
+    integer,intent(in) :: i,j
+    real(wp),intent(in) :: support(DIMENSION)
+    type(symmetry_element),intent(out) :: axis
+    logical,intent(out) :: success
+    real(wp) :: ris,rjs,r,center(DIMENSION)
+    integer :: k
+
+    success = .false.
+    state%StatTotal = state%StatTotal+1
+
+    ! Quick sanity check
+    ris = 0.0d0
+    rjs = 0.0d0
+    do k = 1,DIMENSION
+      ris = ris+pow2(state%Atoms(i)%x(k)-support(k))
+      rjs = rjs+pow2(state%Atoms(j)%x(k)-support(k))
+    end do
+    ris = sqrt(ris)
+    rjs = sqrt(rjs)
+
+    if (abs(ris-rjs) > state%TolerancePrimary) then
+      state%StatEarly = state%StatEarly+1
+      return
+    end if
+
+    call alloc_symmetry_element(state,axis)
+    axis%transform_type = 3  ! rotate
+    axis%order = 2
+    axis%nparam = 7
+
+    r = sqrt(sum(state%CenterOfSomething**2))
+    if (r > 0.0d0) then
+      axis%normal = state%CenterOfSomething/r
+    else
+      axis%normal = [1.0d0,0.0d0,0.0d0]
+    end if
+    axis%distance = r
+
+    r = 0.0d0
+    do k = 1,DIMENSION
+      center(k) = (state%Atoms(i)%x(k)+state%Atoms(j)%x(k))/2.0d0-support(k)
+      r = r+center(k)*center(k)
+    end do
+    r = sqrt(r)
+
+    if (r <= state%TolerancePrimary) then
+      ! C2 is underdefined
+      if (state%MolecularPlaneExists) then
+        axis%direction = state%MolecularPlane%normal
+      else
+        do k = 1,DIMENSION
+          center(k) = state%Atoms(i)%x(k)-state%Atoms(j)%x(k)
+        end do
+        if (abs(center(3))+abs(center(2)) > state%ToleranceSame) then
+          axis%direction = [0.0d0,center(3),-center(2)]
+        else
+          axis%direction = [-center(3),0.0d0,center(1)]
+        end if
+        r = sqrt(sum(axis%direction**2))
+        axis%direction = axis%direction/r
+      end if
+    else
+      axis%direction = center/r
+    end if
+
+    if (refine_symmetry_element(state,axis,.true.) < 0) then
+      call destroy_symmetry_element(axis)
+      return
+    end if
+
+    success = .true.
+  end subroutine init_c2_axis
+
+  !> Initialize higher-order axis
+  subroutine init_higher_axis(state,ia,ib,ic,axis,success)
+    type(symmetry_state_t),intent(inout) :: state
+    integer,intent(in) :: ia,ib,ic
+    type(symmetry_element),intent(out) :: axis
+    logical,intent(out) :: success
+    real(wp) :: a(DIMENSION),b(DIMENSION),c(DIMENSION)
+    integer :: i
+
+    success = .false.
+    state%StatTotal = state%StatTotal+1
+
+    do i = 1,DIMENSION
+      a(i) = state%Atoms(ia)%x(i)-state%CenterOfSomething(i)
+      b(i) = state%Atoms(ib)%x(i)-state%CenterOfSomething(i)
+      c(i) = state%Atoms(ic)%x(i)-state%CenterOfSomething(i)
+    end do
+
+    call init_axis_parameters(state,a,b,c,axis,success)
+    if (.not.success) return
+
+    axis%transform_type = 3  ! rotate
+
+    if (refine_symmetry_element(state,axis,.true.) < 0) then
+      call destroy_symmetry_element(axis)
+      success = .false.
+      return
+    end if
+
+    success = .true.
+  end subroutine init_higher_axis
+
+  !> Initialize improper axis
+  subroutine init_improper_axis(state,ia,ib,ic,axis,success)
+    type(symmetry_state_t),intent(inout) :: state
+    integer,intent(in) :: ia,ib,ic
+    type(symmetry_element),intent(out) :: axis
+    logical,intent(out) :: success
+    real(wp) :: a(DIMENSION),b(DIMENSION),c(DIMENSION)
+    real(wp) :: centerpoint(DIMENSION),r
+    integer :: i
+
+    success = .false.
+    state%StatTotal = state%StatTotal+1
+
+    do i = 1,DIMENSION
+      a(i) = state%Atoms(ia)%x(i)-state%CenterOfSomething(i)
+      b(i) = state%Atoms(ib)%x(i)-state%CenterOfSomething(i)
+      c(i) = state%Atoms(ic)%x(i)-state%CenterOfSomething(i)
+    end do
+
+    r = 0.0d0
+    do i = 1,DIMENSION
+      centerpoint(i) = a(i)+c(i)+2.0d0*b(i)
+      r = r+centerpoint(i)*centerpoint(i)
+    end do
+    r = sqrt(r)
+
+    if (r <= state%ToleranceSame) then
+      state%StatEarly = state%StatEarly+1
+      return
+    end if
+
+    centerpoint = centerpoint/r
+    r = dot_product(centerpoint,b)
+    b = 2.0d0*r*centerpoint-b
+
+    call init_axis_parameters(state,a,b,c,axis,success)
+    if (.not.success) return
+
+    axis%transform_type = 4  ! rotate_reflect
+
+    if (refine_symmetry_element(state,axis,.true.) < 0) then
+      call destroy_symmetry_element(axis)
+      success = .false.
+      return
+    end if
+
+    success = .true.
+  end subroutine init_improper_axis
+
+  !> Find center of something (centroid)
+  subroutine find_center_of_something(state)
+    type(symmetry_state_t),intent(inout) :: state
+    integer :: i,j
+    real(wp) :: coord_sum(DIMENSION),r
+
+    coord_sum = 0.0d0
+    do i = 1,state%AtomsCount
+      coord_sum = coord_sum+state%Atoms(i)%x
+    end do
+    state%CenterOfSomething = coord_sum/dble(state%AtomsCount)
+
+    if (allocated(state%DistanceFromCenter)) deallocate (state%DistanceFromCenter)
+    allocate (state%DistanceFromCenter(state%AtomsCount))
+
+    do i = 1,state%AtomsCount
+      r = 0.0d0
+      do j = 1,DIMENSION
+        r = r+pow2(state%Atoms(i)%x(j)-state%CenterOfSomething(j))
+      end do
+      state%DistanceFromCenter(i) = r
+    end do
+  end subroutine find_center_of_something
+
+  !> Add plane to planes array
+  subroutine add_plane(state,plane)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element),intent(in) :: plane
+    type(symmetry_element),allocatable :: temp(:)
+
+    state%PlanesCount = state%PlanesCount+1
+    if (allocated(state%Planes)) then
+      allocate (temp(state%PlanesCount))
+      temp(1:state%PlanesCount-1) = state%Planes
+      temp(state%PlanesCount) = plane
+      call move_alloc(temp,state%Planes)
+    else
+      allocate (state%Planes(1))
+      state%Planes(1) = plane
+    end if
+  end subroutine add_plane
+
+  !> Add normal axis to array
+  subroutine add_normal_axis(state,axis)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element),intent(in) :: axis
+    type(symmetry_element),allocatable :: temp(:)
+
+    state%NormalAxesCount = state%NormalAxesCount+1
+    if (allocated(state%NormalAxes)) then
+      allocate (temp(state%NormalAxesCount))
+      temp(1:state%NormalAxesCount-1) = state%NormalAxes
+      temp(state%NormalAxesCount) = axis
+      call move_alloc(temp,state%NormalAxes)
+    else
+      allocate (state%NormalAxes(1))
+      state%NormalAxes(1) = axis
+    end if
+  end subroutine add_normal_axis
+
+  !> Add improper axis to array
+  subroutine add_improper_axis(state,axis)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element),intent(in) :: axis
+    type(symmetry_element),allocatable :: temp(:)
+
+    state%ImproperAxesCount = state%ImproperAxesCount+1
+    if (allocated(state%ImproperAxes)) then
+      allocate (temp(state%ImproperAxesCount))
+      temp(1:state%ImproperAxesCount-1) = state%ImproperAxes
+      temp(state%ImproperAxesCount) = axis
+      call move_alloc(temp,state%ImproperAxes)
+    else
+      allocate (state%ImproperAxes(1))
+      state%ImproperAxes(1) = axis
+    end if
+  end subroutine add_improper_axis
+
+  !> Find planes of symmetry
+  subroutine find_planes(state)
+    type(symmetry_state_t),intent(inout) :: state
+    integer :: i,j
+    type(symmetry_element) :: plane
+    logical :: success
+
+    call init_ultimate_plane(state,plane,success)
+    if (success) then
+      state%MolecularPlane = plane
+      state%MolecularPlaneExists = .true.
+      call add_plane(state,plane)
+    end if
+
+    do i = 2,state%AtomsCount
+      do j = 1,i-1
+        if (state%Atoms(i)%atom_type /= state%Atoms(j)%atom_type) cycle
+
+        call init_mirror_plane(state,i,j,plane,success)
+        if (success) call add_plane(state,plane)
+      end do
+    end do
+  end subroutine find_planes
+
+  !> Find inversion centers
+  subroutine find_inversion_centers(state)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element) :: center
+    logical :: success
+
+    call init_inversion_center(state,center,success)
+    if (success) then
+      state%InversionCentersCount = 1
+      allocate (state%InversionCenters(1))
+      state%InversionCenters(1) = center
+    end if
+  end subroutine find_inversion_centers
+
+  !> Find infinity axis
+  subroutine find_infinity_axis(state)
+    type(symmetry_state_t),intent(inout) :: state
+    type(symmetry_element) :: axis
+    logical :: success
+
+    call init_ultimate_axis(state,axis,success)
+    if (success) call add_normal_axis(state,axis)
+  end subroutine find_infinity_axis
+
+  !> Find C2 axes
+  subroutine find_c2_axes(state)
+    type(symmetry_state_t),intent(inout) :: state
+    integer :: i,j,k,l,m
+    real(wp) :: center(DIMENSION),r
+    real(wp),allocatable :: distances(:)
+    type(symmetry_element) :: axis
+    logical :: success
+
+    allocate (distances(state%AtomsCount))
+
+    do i = 2,state%AtomsCount
+      do j = 1,i-1
+        if (state%Atoms(i)%atom_type /= state%Atoms(j)%atom_type) cycle
+        if (abs(state%DistanceFromCenter(i)-state%DistanceFromCenter(j)) > &
+            state%TolerancePrimary) cycle
+
+        ! Try using CenterOfSomething
+        r = 0.0d0
+        do k = 1,DIMENSION
+          center(k) = (state%Atoms(i)%x(k)+state%Atoms(j)%x(k))/2.0d0
+          r = r+pow2(center(k)-state%CenterOfSomething(k))
+        end do
+        r = sqrt(r)
+
+        if (r > 5.0d0*state%TolerancePrimary) then
+          call init_c2_axis(state,i,j,state%CenterOfSomething,axis,success)
+          if (success) call add_normal_axis(state,axis)
+          cycle
+        end if
+
+        ! Try through atoms
+        do k = 1,state%AtomsCount
+          call init_c2_axis(state,i,j,state%Atoms(k)%x,axis,success)
+          if (success) call add_normal_axis(state,axis)
+        end do
+
+        ! Calculate distances for prescreening
+        do k = 1,state%AtomsCount
+          r = 0.0d0
+          do l = 1,DIMENSION
+            r = r+pow2(state%Atoms(k)%x(l)-center(l))
+          end do
+          distances(k) = sqrt(r)
+        end do
+
+        ! Try through midpoints of atom pairs
+        do k = 1,state%AtomsCount
+          do l = 1,state%AtomsCount
+            if (state%Atoms(k)%atom_type /= state%Atoms(l)%atom_type) cycle
+            if (abs(state%DistanceFromCenter(k)-state%DistanceFromCenter(l)) > &
+                state%TolerancePrimary.or. &
+                abs(distances(k)-distances(l)) > state%TolerancePrimary) cycle
+
+            do m = 1,DIMENSION
+              center(m) = (state%Atoms(k)%x(m)+state%Atoms(l)%x(m))/2.0d0
+            end do
+
+            call init_c2_axis(state,i,j,center,axis,success)
+            if (success) call add_normal_axis(state,axis)
+          end do
+        end do
+      end do
+    end do
+
+    deallocate (distances)
+  end subroutine find_c2_axes
+
+  !> Find higher-order axes
+  subroutine find_higher_axes(state)
+    type(symmetry_state_t),intent(inout) :: state
+    integer :: i,j,k
+    type(symmetry_element) :: axis
+    logical :: success
+
+    do i = 1,state%AtomsCount
+      do j = i+1,state%AtomsCount
+        if (state%Atoms(i)%atom_type /= state%Atoms(j)%atom_type) cycle
+        if (abs(state%DistanceFromCenter(i)-state%DistanceFromCenter(j)) > &
+            state%TolerancePrimary) cycle
+
+        do k = 1,state%AtomsCount
+          if (state%Atoms(i)%atom_type /= state%Atoms(k)%atom_type) cycle
+          if (abs(state%DistanceFromCenter(i)-state%DistanceFromCenter(k)) > &
+              state%TolerancePrimary.or. &
+              abs(state%DistanceFromCenter(j)-state%DistanceFromCenter(k)) > &
+              state%TolerancePrimary) cycle
+
+          call init_higher_axis(state,i,j,k,axis,success)
+          if (success) call add_normal_axis(state,axis)
+        end do
+      end do
+    end do
+  end subroutine find_higher_axes
+
+  !> Find improper axes
+  subroutine find_improper_axes(state)
+    type(symmetry_state_t),intent(inout) :: state
+    integer :: i,j,k
+    type(symmetry_element) :: axis
+    logical :: success
+
+    do i = 1,state%AtomsCount
+      do j = i+1,state%AtomsCount
+        do k = 1,state%AtomsCount
+          call init_improper_axis(state,i,j,k,axis,success)
+          if (success) call add_improper_axis(state,axis)
+        end do
+      end do
+    end do
+  end subroutine find_improper_axes
+
+  !> Find all symmetry elements
+  subroutine find_symmetry_elements(state)
+    type(symmetry_state_t),intent(inout) :: state
+    call find_center_of_something(state)
+    call find_inversion_centers(state)
+    call find_planes(state)
+    call find_infinity_axis(state)
+    call find_c2_axes(state)
+    call find_higher_axes(state)
+    call find_improper_axes(state)
+  end subroutine find_symmetry_elements
+
+  !> Compare axes for sorting
+  function compare_axes(a,b) result(cmp)
+    type(symmetry_element),intent(in) :: a,b
+    integer :: cmp
+    integer :: order_a,order_b
+
+    order_a = a%order
+    order_b = b%order
+    if (order_a == 0) order_a = 10000
+    if (order_b == 0) order_b = 10000
+
+    cmp = order_b-order_a
+    if (cmp /= 0) return
+
+    if (a%maxdev > b%maxdev) then
+      cmp = -1
+    else if (a%maxdev < b%maxdev) then
+      cmp = 1
+    else
+      cmp = 0
+    end if
+  end function compare_axes
+
+  !> Sort symmetry elements (simple bubble sort)
+  subroutine sort_symmetry_elements(state)
+    type(symmetry_state_t),intent(inout) :: state
+    integer :: i,j
+    type(symmetry_element) :: temp
+
+    ! Sort planes
+    do i = 1,state%PlanesCount-1
+      do j = i+1,state%PlanesCount
+        if (compare_axes(state%Planes(i),state%Planes(j)) < 0) then
+          temp = state%Planes(i)
+          state%Planes(i) = state%Planes(j)
+          state%Planes(j) = temp
+        end if
+      end do
+    end do
+
+    ! Sort normal axes
+    do i = 1,state%NormalAxesCount-1
+      do j = i+1,state%NormalAxesCount
+        if (compare_axes(state%NormalAxes(i),state%NormalAxes(j)) < 0) then
+          temp = state%NormalAxes(i)
+          state%NormalAxes(i) = state%NormalAxes(j)
+          state%NormalAxes(j) = temp
+        end if
+      end do
+    end do
+
+    ! Sort improper axes
+    do i = 1,state%ImproperAxesCount-1
+      do j = i+1,state%ImproperAxesCount
+        if (compare_axes(state%ImproperAxes(i),state%ImproperAxes(j)) < 0) then
+          temp = state%ImproperAxes(i)
+          state%ImproperAxes(i) = state%ImproperAxes(j)
+          state%ImproperAxes(j) = temp
+        end if
+      end do
+    end do
+  end subroutine sort_symmetry_elements
+
+  !> Summarize symmetry elements
+  subroutine summarize_symmetry_elements(state)
+    type(symmetry_state_t),intent(inout) :: state
+    integer :: i
+
+    if (allocated(state%NormalAxesCounts)) deallocate (state%NormalAxesCounts)
+    if (allocated(state%ImproperAxesCounts)) deallocate (state%ImproperAxesCounts)
+
+    allocate (state%NormalAxesCounts(0:state%MaxAxisOrder))
+    allocate (state%ImproperAxesCounts(0:state%MaxAxisOrder))
+
+    state%NormalAxesCounts = 0
+    state%ImproperAxesCounts = 0
+
+    do i = 1,state%NormalAxesCount
+      state%NormalAxesCounts(state%NormalAxes(i)%order) = &
+        state%NormalAxesCounts(state%NormalAxes(i)%order)+1
+    end do
+
+    do i = 1,state%ImproperAxesCount
+      state%ImproperAxesCounts(state%ImproperAxes(i)%order) = &
+        state%ImproperAxesCounts(state%ImproperAxes(i)%order)+1
+    end do
+  end subroutine summarize_symmetry_elements
+
+  !> Report symmetry elements brief
+  subroutine report_symmetry_elements_brief(state)
+    type(symmetry_state_t),intent(inout) :: state
+    integer :: i,n,tlen
+    character(len=32) :: buf
+
+    state%SymmetryCode = ""
+    n = 0
+
+    if (state%PlanesCount+state%NormalAxesCount+state%ImproperAxesCount+ &
+        state%InversionCentersCount > 0) then
+      if (state%InversionCentersCount > 0) then
+        state%SymmetryCode(n+1:n+4) = "(i) "
+        n = n+4
+      end if
+
+      if (state%NormalAxesCounts(0) == 1) then
+        state%SymmetryCode(n+1:n+7) = "(Cinf) "
+        n = n+7
+      else if (state%NormalAxesCounts(0) > 1) then
+        write (buf,'(I0,A)') state%NormalAxesCounts(0),"*(Cinf) "
+        tlen = len_trim(buf)+1
+        state%SymmetryCode(n+1:n+tlen) = buf(1:tlen)
+        n = n+tlen
+      end if
+
+      do i = state%MaxAxisOrder,2,-1
+        if (state%NormalAxesCounts(i) == 1) then
+          write (buf,'(A,I0,A)') "(C",i,") "
+          tlen = len_trim(buf)+1
+          state%SymmetryCode(n+1:n+tlen) = buf(1:tlen)
+          n = n+tlen
+        else if (state%NormalAxesCounts(i) > 1) then
+          write (buf,'(I0,A,I0,A)') state%NormalAxesCounts(i),"*(C",i,") "
+          tlen = len_trim(buf)+1
+          state%SymmetryCode(n+1:n+tlen) = buf(1:tlen)
+          n = n+tlen
+        end if
+      end do
+
+      do i = state%MaxAxisOrder,2,-1
+        if (state%ImproperAxesCounts(i) == 1) then
+          write (buf,'(A,I0,A)') "(S",i,") "
+          tlen = len_trim(buf)+1
+          state%SymmetryCode(n+1:n+tlen) = buf(1:tlen)
+          n = n+tlen
+        else if (state%ImproperAxesCounts(i) > 1) then
+          write (buf,'(I0,A,I0,A)') state%ImproperAxesCounts(i),"*(S",i,") "
+          tlen = len_trim(buf)+1
+          state%SymmetryCode(n+1:n+tlen) = buf(1:tlen)
+          n = n+tlen
+        end if
+      end do
+
+      if (state%PlanesCount == 1) then
+        state%SymmetryCode(n+1:n+8) = "(sigma) "
+        n = n+8
+      else if (state%PlanesCount > 1) then
+        write (buf,'(I0,A)') state%PlanesCount,"*(sigma) "
+        tlen = len_trim(buf)+1
+        state%SymmetryCode(n+1:n+tlen) = buf(1:tlen)
+        n = n+tlen
+      end if
+    end if
+  end subroutine report_symmetry_elements_brief
+
+  !> Report highest rotation axis only
+  subroutine report_symmetry_elements_brief_conly(state)
+    type(symmetry_state_t),intent(inout) :: state
+    integer :: i
+    character(len=8) :: buf
+
+    state%MaxRotAxis = ""
+
+    if (state%PlanesCount+state%NormalAxesCount+state%ImproperAxesCount+ &
+        state%InversionCentersCount > 0) then
+      do i = state%MaxAxisOrder,2,-1
+        if (state%NormalAxesCounts(i) >= 1) then
+          write (buf,'(A,I0)') "C",i
+          state%MaxRotAxis = trim(buf)
+          return
+        end if
+      end do
+    end if
+  end subroutine report_symmetry_elements_brief_conly
+
+  !> Identify point group
+  function identify_point_group(state) result(last_matching)
+    type(symmetry_state_t),intent(in) :: state
+    integer :: last_matching
+    integer :: i,matching_count
+
+    last_matching = -1
+    matching_count = 0
+
+    do i = 1,PointGroupsCount
+      if (len_trim(PointGroups(i)%group_name) == 0) cycle
+      if (trim(state%SymmetryCode) == trim(PointGroups(i)%symmetry_code)) then
+        last_matching = i
+        matching_count = matching_count+1
+      end if
+    end do
+
+    if (matching_count == 0) then
+      last_matching = -1
+    else if (matching_count > 1) then
+      last_matching = -1
+    end if
+  end function identify_point_group
+
+  !> Main entry point: determine Schoenflies symbol
+  subroutine schoenflies(natoms,attype,coord,symbol,paramar)
+    integer,intent(in)  :: natoms
+    integer,intent(in)  :: attype(natoms)
+    real(wp),intent(in) :: coord(3,natoms)
+    character(len=*),intent(out) :: symbol
+    real(wp),intent(in),optional :: paramar(11)
+    type(symmetry_state_t) :: state
+    integer :: last_pg,i
+
+    call init_symmetry_state(state)
+
+    ! Set parameters if provided
+    if (present(paramar)) then
+      state%verbose = nint(paramar(1))
+      state%MaxAxisOrder = nint(paramar(2))
+      state%MaxOptCycles = nint(paramar(3))
+      state%ToleranceSame = paramar(4)
+      state%TolerancePrimary = paramar(5)
+      state%ToleranceFinal = paramar(6)
+      state%MaxOptStep = paramar(7)
+      state%MinOptStep = paramar(8)
+      state%GradientStep = paramar(9)
+      state%OptChangeThreshold = paramar(10)
+      state%OptChangeHits = nint(paramar(11))
+    end if
+
+    ! Set up atoms
+    state%AtomsCount = natoms
+    allocate (state%Atoms(state%AtomsCount))
+
+    do i = 1,state%AtomsCount
+      state%Atoms(i)%atom_type = attype(i)
+      state%Atoms(i)%x(1) = coord(1,i)
+      state%Atoms(i)%x(2) = coord(2,i)
+      state%Atoms(i)%x(3) = coord(3,i)
+    end do
+
+    ! Find and analyze symmetry
+    call find_symmetry_elements(state)
+    call sort_symmetry_elements(state)
+    call summarize_symmetry_elements(state)
+    call report_symmetry_elements_brief(state)
+
+    last_pg = identify_point_group(state)
+
+    if (last_pg >= 1) then
+      symbol = trim(PointGroups(last_pg)%group_name)
+    else
+      call report_symmetry_elements_brief_conly(state)
+      if (len_trim(state%MaxRotAxis) == 0) then
+        symbol = "C1"
+      else
+        symbol = trim(state%MaxRotAxis)
+      end if
+    end if
+  end subroutine schoenflies
+
+! ══════════════════════════════════════════════════════════════════════════════
+
+  subroutine getsym(pr,iunit,n,iat,xyz,sfsym,symthr,maxatdesy)
+    use iso_fortran_env,only:wp => real64
+    implicit none
+    logical,intent(in)           :: pr
+    integer,intent(in)           :: iunit
+    integer,intent(in)           :: n
+    integer,intent(in)           :: iat(n)
+    real(wp),intent(in)          :: xyz(3,n)
+    character(len=*),intent(out) :: sfsym
+    real(wp),intent(in),optional :: symthr    ! default 0.1
+    integer,intent(in),optional  :: maxatdesy ! default 200
+    real(wp) :: thr
+    integer  :: maxat
+    character(len=8) :: atmp
+    real(wp) :: paramar(11)
+
+    thr = 0.1_wp; if (present(symthr)) thr = symthr
+    maxat = 200; if (present(maxatdesy)) maxat = maxatdesy
+
+    if (n > maxat) then
+      if (pr) write (iunit,*) 'symmetry recognition skipped because # atoms >',maxat
+      sfsym = 'none'
+      return
+    end if
+
+    if (pr) write (iunit,'(a)')
+    paramar(1) = -1       ! verbose
+    paramar(2) = 10       ! MaxAxisOrder
+    paramar(3) = 100      ! MaxOptCycles
+    paramar(4) = 0.001d0  ! ToleranceSame
+    paramar(5) = 0.5d0    ! TolerancePrimary
+    paramar(6) = thr      ! ToleranceFinal
+    paramar(7) = 0.5d0    ! MaxOptStep
+    paramar(8) = 1.0d-7   ! MinOptStep
+    paramar(9) = 1.0d-7   ! GradientStep
+    paramar(10) = 1.0d-8   ! OptChangeThreshold
+    paramar(11) = 5        ! OptChangeHits
+
+    atmp = '        '
+    call schoenflies(n,iat,xyz,atmp,paramar)
+
+    sfsym(1:3) = atmp(1:3)
+    if (sfsym(1:1) == 'D') sfsym(1:1) = 'd'
+    if (sfsym(1:1) == 'C') sfsym(1:1) = 'c'
+    if (sfsym(1:1) == 'T') sfsym(1:1) = 't'
+    if (sfsym(1:1) == 'O') sfsym(1:1) = 'o'
+    if (sfsym(1:1) == 'I') sfsym(1:1) = 'i'
+    if (sfsym(1:1) == 'S') sfsym(1:1) = 's'
+    ! Linear molecules: fix to correct 3-char codes
+    if (sfsym(1:3) == 'dih') sfsym(1:3) = 'din'
+    if (sfsym(1:3) == 'civ') sfsym(1:3) = 'cin'
+    if (sfsym(3:3) > 'v'.or.sfsym(3:3) < 'a') sfsym(3:3) = ' '
+
+    if (pr) write (iunit,'(a3,'' symmetry found (for desy threshold: '',e9.2,'')'')') &
+      sfsym,thr
+  end subroutine getsym
+
+! ══════════════════════════════════════════════════════════════════════════════
+end module symmetry_i
diff --git a/src/utilmod.f90 b/src/utilmod.f90
index 5ba52271..f38d0d06 100644
--- a/src/utilmod.f90
+++ b/src/utilmod.f90
@@ -49,6 +49,7 @@ module utilities
   public :: distcma
   public :: binomial
   public :: factorial
+  public :: nth_prime
 
 !========================================================================================!
 !========================================================================================!
@@ -348,13 +349,18 @@ subroutine checkname_xyz(base,fname,checkname)
 !* <base>_<X>.xyz as <fname>
 !* and <base>_<X+1>.xyz as <checkname>
 !************************************************
-    character(len=*) :: base,fname,checkname
+    character(len=*),intent(in) :: base
+    character(len=*),intent(inout) :: fname,checkname
+    character(len=256) :: atmp,btmp
     integer :: i,j
     logical :: ex
     i = 0
+    !write(*,*) trim(fname)
+    !write(*,*) trim(base)
     do
-      write (checkname,'(a,''_'',i0,''.xyz'')') trim(base),i
-      inquire (file=trim(checkname),exist=ex)
+      write (atmp,'(a,''_'',i0,''.xyz'')') trim(base),i
+      inquire (file=trim(atmp),exist=ex)
+      checkname = trim(atmp)
       if (ex) then
         i = i+1
       else
@@ -362,7 +368,8 @@ subroutine checkname_xyz(base,fname,checkname)
       end if
     end do
     j = max(0,i-1)
-    write (fname,'(a,''_'',i0,''.xyz'')') trim(base),j
+    write (btmp,'(a,''_'',i0,''.xyz'')') trim(base),j
+    fname = trim(btmp)
   end subroutine checkname_xyz
 
 !========================================================================================!
@@ -544,64 +551,199 @@ end subroutine dumpenergies
 
 !========================================================================================!
 
-  function binomial(n, k) result(res)
+  function binomial(n,k) result(res)
 !**************************************************
-!* Function to calculate the binomial coefficient 
+!* Function to calculate the binomial coefficient
 !*
 !*  ⎛ n ⎞
 !*  ⎝ k ⎠  = n! / (k! * (n - k)!)
 !*
 !**************************************************
     implicit none
-    integer, intent(in) :: n, k
+    integer,intent(in) :: n,k
     real(wp) :: reswp
     integer :: res
-    reswp = factorial(n) / (factorial(k) * factorial(n - k))
+    reswp = factorial(n)/(factorial(k)*factorial(n-k))
     res = nint(reswp)
   end function binomial
 
-
   function factorial(x) result(fact)
 !***************************************************
-!* Function to calculate the factorial of a number  
-!* factorial(x) = x! = x * (x-1) * (x-2) * ... * 1  
+!* Function to calculate the factorial of a number
+!* factorial(x) = x! = x * (x-1) * (x-2) * ... * 1
 !***************************************************
     implicit none
-    integer, intent(in) :: x
+    integer,intent(in) :: x
     integer :: i
     real(wp) :: fact
     fact = 1.0_wp
-    do i = 2, x
-      fact = fact * real(i,wp)
+    do i = 2,x
+      fact = fact*real(i,wp)
     end do
   end function factorial
 
-
-  recursive subroutine get_combinations(n, k, ntot, c, combinations, tmp, depth)
+  recursive subroutine get_combinations(n,k,ntot,c,combinations,tmp,depth)
     implicit none
-    integer, intent(in) :: n, k, ntot, depth !> depth should start out as 0
+    integer,intent(in) :: n,k,ntot,depth !> depth should start out as 0
     integer,intent(inout) :: c,tmp(k)
-    integer, intent(inout) :: combinations(k,ntot)
+    integer,intent(inout) :: combinations(k,ntot)
     integer :: i
     if (depth >= k) then
-      c=c+1
+      c = c+1
       combinations(:,c) = tmp(:)
       return
-    else if(depth==0)then
-       do i=1,n
-          tmp(depth+1) = i
-          call get_combinations(n, k, ntot, c, combinations, tmp, depth+1)
-       enddo
-    else 
-       do i=1,tmp(depth)
-          if(i==tmp(depth)) cycle
-          tmp(depth+1) = i
-          call get_combinations(n, k, ntot, c, combinations, tmp, depth+1) 
-       enddo 
+    else if (depth == 0) then
+      do i = 1,n
+        tmp(depth+1) = i
+        call get_combinations(n,k,ntot,c,combinations,tmp,depth+1)
+      end do
+    else
+      do i = 1,tmp(depth)
+        if (i == tmp(depth)) cycle
+        tmp(depth+1) = i
+        call get_combinations(n,k,ntot,c,combinations,tmp,depth+1)
+      end do
     end if
   end subroutine get_combinations
 
+!========================================================================================!
 
+  function nth_prime(n) result(prime)
+!********************************************
+!* get the n-th prime number.
+!* The first thousand are saved as a
+!* parameter to reduce computational effort.
+!********************************************
+    implicit none
+    integer,intent(in) :: n
+    integer :: prime
+    integer :: c,num,i
+    logical :: is_prime
+!&<
+    integer,parameter :: maxprimepar = 1000
+    integer, parameter :: prime_numbers(maxprimepar) = (/          &
+    &  2, 3, 5, 7, 11, 13, 17, 19, 23, 29,                         &
+    &  31, 37, 41, 43, 47, 53, 59, 61, 67, 71,                     &
+    &  73, 79, 83, 89, 97, 101, 103, 107, 109, 113,                &
+    &  127, 131, 137, 139, 149, 151, 157, 163, 167, 173,           &
+    &  179, 181, 191, 193, 197, 199, 211, 223, 227, 229,           &
+    &  233, 239, 241, 251, 257, 263, 269, 271, 277, 281,           &
+    &  283, 293, 307, 311, 313, 317, 331, 337, 347, 349,           &
+    &  353, 359, 367, 373, 379, 383, 389, 397, 401, 409,           &
+    &  419, 421, 431, 433, 439, 443, 449, 457, 461, 463,           &
+    &  467, 479, 487, 491, 499, 503, 509, 521, 523, 541,           &
+    &  547, 557, 563, 569, 571, 577, 587, 593, 599, 601,           &
+    &  607, 613, 617, 619, 631, 641, 643, 647, 653, 659,           &
+    &  661, 673, 677, 683, 691, 701, 709, 719, 727, 733,           &
+    &  739, 743, 751, 757, 761, 769, 773, 787, 797, 809,           &
+    &  811, 821, 823, 827, 829, 839, 853, 857, 859, 863,           &
+    &  877, 881, 883, 887, 907, 911, 919, 929, 937, 941,           &
+    &  947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013,         &
+    &  1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, &
+    &  1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151, &
+    &  1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223, &
+    &  1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291, &
+    &  1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, &
+    &  1381, 1399, 1409, 1423, 1427, 1429, 1433, 1439, 1447, 1451, &
+    &  1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, 1499, 1511, &
+    &  1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579, 1583, &
+    &  1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, &
+    &  1663, 1667, 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733, &
+    &  1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789, 1801, 1811, &
+    &  1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879, 1889, &
+    &  1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987, &
+    &  1993, 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, &
+    &  2063, 2069, 2081, 2083, 2087, 2089, 2099, 2111, 2113, 2129, &
+    &  2131, 2137, 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213, &
+    &  2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287, &
+    &  2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357, &
+    &  2371, 2377, 2381, 2383, 2389, 2393, 2399, 2411, 2417, 2423, &
+    &  2437, 2441, 2447, 2459, 2467, 2473, 2477, 2503, 2521, 2531, &
+    &  2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609, 2617, &
+    &  2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687, &
+    &  2689, 2693, 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741, &
+    &  2749, 2753, 2767, 2777, 2789, 2791, 2797, 2801, 2803, 2819, &
+    &  2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887, 2897, 2903, &
+    &  2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999, &
+    &  3001, 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079, &
+    &  3083, 3089, 3109, 3119, 3121, 3137, 3163, 3167, 3169, 3181, &
+    &  3187, 3191, 3203, 3209, 3217, 3221, 3229, 3251, 3253, 3257, &
+    &  3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331, &
+    &  3343, 3347, 3359, 3361, 3371, 3373, 3389, 3391, 3407, 3413, &
+    &  3433, 3449, 3457, 3461, 3463, 3467, 3469, 3491, 3499, 3511, &
+    &  3517, 3527, 3529, 3533, 3539, 3541, 3547, 3557, 3559, 3571, &
+    &  3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637, 3643, &
+    &  3659, 3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727, &
+    &  3733, 3739, 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821, &
+    &  3823, 3833, 3847, 3851, 3853, 3863, 3877, 3881, 3889, 3907, &
+    &  3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947, 3967, 3989, &
+    &  4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057, &
+    &  4073, 4079, 4091, 4093, 4099, 4111, 4127, 4129, 4133, 4139, &
+    &  4153, 4157, 4159, 4177, 4201, 4211, 4217, 4219, 4229, 4231, &
+    &  4241, 4243, 4253, 4259, 4261, 4271, 4273, 4283, 4289, 4297, &
+    &  4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409, &
+    &  4421, 4423, 4441, 4447, 4451, 4457, 4463, 4481, 4483, 4493, &
+    &  4507, 4513, 4517, 4519, 4523, 4547, 4549, 4561, 4567, 4583, &
+    &  4591, 4597, 4603, 4621, 4637, 4639, 4643, 4649, 4651, 4657, &
+    &  4663, 4673, 4679, 4691, 4703, 4721, 4723, 4729, 4733, 4751, &
+    &  4759, 4783, 4787, 4789, 4793, 4799, 4801, 4813, 4817, 4831, &
+    &  4861, 4871, 4877, 4889, 4903, 4909, 4919, 4931, 4933, 4937, &
+    &  4943, 4951, 4957, 4967, 4969, 4973, 4987, 4993, 4999, 5003, &
+    &  5009, 5011, 5021, 5023, 5039, 5051, 5059, 5077, 5081, 5087, &
+    &  5099, 5101, 5107, 5113, 5119, 5147, 5153, 5167, 5171, 5179, &
+    &  5189, 5197, 5209, 5227, 5231, 5233, 5237, 5261, 5273, 5279, &
+    &  5281, 5297, 5303, 5309, 5323, 5333, 5347, 5351, 5381, 5387, &
+    &  5393, 5399, 5407, 5413, 5417, 5419, 5431, 5437, 5441, 5443, &
+    &  5449, 5471, 5477, 5479, 5483, 5501, 5503, 5507, 5519, 5521, &
+    &  5527, 5531, 5557, 5563, 5569, 5573, 5581, 5591, 5623, 5639, &
+    &  5641, 5647, 5651, 5653, 5657, 5659, 5669, 5683, 5689, 5693, &
+    &  5701, 5711, 5717, 5737, 5741, 5743, 5749, 5779, 5783, 5791, &
+    &  5801, 5807, 5813, 5821, 5827, 5839, 5843, 5849, 5851, 5857, &
+    &  5861, 5867, 5869, 5879, 5881, 5897, 5903, 5923, 5927, 5939, &
+    &  5953, 5981, 5987, 6007, 6011, 6029, 6037, 6043, 6047, 6053, &
+    &  6067, 6073, 6079, 6089, 6091, 6101, 6113, 6121, 6131, 6133, &
+    &  6143, 6151, 6163, 6173, 6197, 6199, 6203, 6211, 6217, 6221, &
+    &  6229, 6247, 6257, 6263, 6269, 6271, 6277, 6287, 6299, 6301, &
+    &  6311, 6317, 6323, 6329, 6337, 6343, 6353, 6359, 6361, 6367, &
+    &  6373, 6379, 6389, 6397, 6421, 6427, 6449, 6451, 6469, 6473, &
+    &  6481, 6491, 6521, 6529, 6547, 6551, 6553, 6563, 6569, 6571, &
+    &  6577, 6581, 6599, 6607, 6619, 6637, 6653, 6659, 6661, 6673, &
+    &  6679, 6689, 6691, 6701, 6703, 6709, 6719, 6733, 6737, 6761, &
+    &  6763, 6779, 6781, 6791, 6793, 6803, 6823, 6827, 6829, 6833, &
+    &  6841, 6857, 6863, 6869, 6871, 6883, 6899, 6907, 6911, 6917, &
+    &  6947, 6949, 6959, 6961, 6967, 6971, 6977, 6983, 6991, 6997, &
+    &  7001, 7013, 7019, 7027, 7039, 7043, 7057, 7069, 7079, 7103, &
+    &  7109, 7121, 7127, 7129, 7151, 7159, 7177, 7187, 7193, 7207, &
+    &  7211, 7213, 7219, 7229, 7237, 7243, 7247, 7253, 7283, 7297, &
+    &  7307, 7309, 7321, 7331, 7333, 7349, 7351, 7369, 7393, 7411, &
+    &  7417, 7433, 7451, 7457, 7459, 7477, 7481, 7487, 7489, 7499, &
+    &  7507, 7517, 7523, 7529, 7537, 7541, 7547, 7549, 7559, 7561, &
+    &  7573, 7577, 7583, 7589, 7591, 7603, 7607, 7621, 7639, 7643, &
+    &  7649, 7669, 7673, 7681, 7687, 7691, 7699, 7703, 7717, 7723, &
+    &  7727, 7741, 7753, 7757, 7759, 7789, 7793, 7817, 7823, 7829, &
+    &  7841, 7853, 7867, 7873, 7877, 7879, 7883, 7901, 7907, 7919 /)
+!&>
+    if (n <= maxprimepar) then
+      prime = prime_numbers(n)
+      return
+    end if
+    c = maxprimepar
+    num = prime_numbers(maxprimepar)
+    do while (c < n)
+      num = num+1
+      is_prime = .true.
+      do i = 2,int(sqrt(real(num)))
+        if (mod(num,i) == 0) then
+          is_prime = .false.
+          exit
+        end if
+      end do
+      if (is_prime) then
+        c = c+1
+      end if
+    end do
+    prime = num
+  end function nth_prime
 
 !========================================================================================!
 !========================================================================================!
diff --git a/subprojects/.gitignore b/subprojects/.gitignore
index d9498d5d..8e910c4f 100644
--- a/subprojects/.gitignore
+++ b/subprojects/.gitignore
@@ -1,12 +1,8 @@
 /*/
 json-fortran-8.2.5.wrap
-dftd4.wrap
-mstore.wrap
-multicharge.wrap
-s-dftd3.wrap
-mctc-lib.wrap
 xhcff
 lammps*
+jonquil.wrap
 
 !lwoniom
 !gfn0
@@ -15,6 +11,13 @@ lammps*
 !tblite
 !test-drive
 !pvol
+!fmlip_relay
+!dftd4
+!mctc-lib
+!mstore
+!multicharge
+!s-dftd3
+!ddx
 
 !packagefiles
 !packagefiles/tblite
diff --git a/subprojects/ddx b/subprojects/ddx
new file mode 160000
index 00000000..4d79e3d9
--- /dev/null
+++ b/subprojects/ddx
@@ -0,0 +1 @@
+Subproject commit 4d79e3d9caeae5e602683572a71cb550414f9b09
diff --git a/subprojects/ddx.wrap b/subprojects/ddx.wrap
new file mode 100644
index 00000000..fb4d0817
--- /dev/null
+++ b/subprojects/ddx.wrap
@@ -0,0 +1,6 @@
+[wrap-git]
+url = https://github.com/ddsolvation/ddX.git
+revision = 4d79e3d9caeae5e602683572a71cb550414f9b09
+
+[provide]
+ddx = ddx_dep
diff --git a/subprojects/dftd4 b/subprojects/dftd4
new file mode 160000
index 00000000..6e1f59c3
--- /dev/null
+++ b/subprojects/dftd4
@@ -0,0 +1 @@
+Subproject commit 6e1f59c3f39d919a2dbef0601d2576727c8b30e8
diff --git a/subprojects/dftd4.wrap b/subprojects/dftd4.wrap
new file mode 100644
index 00000000..cef757a6
--- /dev/null
+++ b/subprojects/dftd4.wrap
@@ -0,0 +1,7 @@
+[wrap-git]
+url = https://github.com/dftd4/dftd4
+revision = 6e1f59c3f39d919a2dbef0601d2576727c8b30e8
+clone-recursive = true
+
+[provide]
+dftd4 = dftd4_dep
diff --git a/subprojects/fmlip_relay b/subprojects/fmlip_relay
new file mode 160000
index 00000000..06608dea
--- /dev/null
+++ b/subprojects/fmlip_relay
@@ -0,0 +1 @@
+Subproject commit 06608dea8b7deb53f4a25630f6dcb8be0cdc6e76
diff --git a/subprojects/fmlip_relay.wrap b/subprojects/fmlip_relay.wrap
new file mode 100644
index 00000000..b01dc56b
--- /dev/null
+++ b/subprojects/fmlip_relay.wrap
@@ -0,0 +1,10 @@
+# fmlip_relay: adjust the URL to your actual repository location.
+# If it lives as a git submodule, you can delete this file and instead ensure
+# the submodule is checked out under subprojects/fmlip_relay/.
+[wrap-git]
+url = https://github.com/pprcht/fmlip-relay
+revision = 06608dea8b7deb53f4a25630f6dcb8be0cdc6e76
+clone-recursive = true
+
+[provide]
+fmlip_relay = fmlip_relay_dep
diff --git a/subprojects/gfn0 b/subprojects/gfn0
index 584cec4b..4fbf39bf 160000
--- a/subprojects/gfn0
+++ b/subprojects/gfn0
@@ -1 +1 @@
-Subproject commit 584cec4b47da23bf3634ef0dd798a1639fcc5e47
+Subproject commit 4fbf39bf6790eaef74e06fbb49b98f676db66a2b
diff --git a/subprojects/gfn0.wrap b/subprojects/gfn0.wrap
index d32056dc..0b930fcc 100644
--- a/subprojects/gfn0.wrap
+++ b/subprojects/gfn0.wrap
@@ -1,4 +1,7 @@
 [wrap-git]
-directory = gfn0
 url = https://github.com/pprcht/gfn0
-revision = head
+revision = 4fbf39bf6790eaef74e06fbb49b98f676db66a2b
+clone-recursive = true
+
+[provide]
+gfn0 = gfn0_dep
diff --git a/subprojects/gfnff b/subprojects/gfnff
index 0491df2f..b846775c 160000
--- a/subprojects/gfnff
+++ b/subprojects/gfnff
@@ -1 +1 @@
-Subproject commit 0491df2ff1fe3cd80fc6a8630fea16f9b6840996
+Subproject commit b846775c42526a769242be5607d0cde6983764d1
diff --git a/subprojects/gfnff.wrap b/subprojects/gfnff.wrap
index c78f420c..9214f782 100644
--- a/subprojects/gfnff.wrap
+++ b/subprojects/gfnff.wrap
@@ -1,4 +1,7 @@
 [wrap-git]
-directory = gfnff
 url = https://github.com/pprcht/gfnff
-revision = head
+revision = b846775c42526a769242be5607d0cde6983764d1
+clone-recursive = true
+
+[provide]
+gfnff = gfnff_dep
diff --git a/subprojects/libpvol.wrap b/subprojects/libpvol.wrap
deleted file mode 100644
index 38211bfa..00000000
--- a/subprojects/libpvol.wrap
+++ /dev/null
@@ -1,4 +0,0 @@
-[wrap-git]
-directory = pvol
-url = https://github.com/neudecker-group/libpvol.git
-revision = head
diff --git a/subprojects/lwoniom.wrap b/subprojects/lwoniom.wrap
index 8aab9996..ad578b0b 100644
--- a/subprojects/lwoniom.wrap
+++ b/subprojects/lwoniom.wrap
@@ -1,4 +1,7 @@
 [wrap-git]
-directory = lwoniom
 url = https://github.com/crest-lab/lwoniom
-revision = head
+revision = ab66c7ebc3066328a8fc313dc783aec9b773cad2
+clone-recursive = true
+
+[provide]
+lwoniom = lwoniom_dep
diff --git a/subprojects/mctc-lib b/subprojects/mctc-lib
new file mode 160000
index 00000000..8cd0cb44
--- /dev/null
+++ b/subprojects/mctc-lib
@@ -0,0 +1 @@
+Subproject commit 8cd0cb4489537fd28bfb2e8094f1647f3e0da284
diff --git a/subprojects/mctc-lib.wrap b/subprojects/mctc-lib.wrap
new file mode 100644
index 00000000..cde3ba9b
--- /dev/null
+++ b/subprojects/mctc-lib.wrap
@@ -0,0 +1,7 @@
+[wrap-git]
+url = https://github.com/grimme-lab/mctc-lib
+revision = 8cd0cb4489537fd28bfb2e8094f1647f3e0da284
+clone-recursive = true
+
+[provide]
+mctc-lib = mctc_dep
diff --git a/subprojects/mstore b/subprojects/mstore
new file mode 160000
index 00000000..10a3437b
--- /dev/null
+++ b/subprojects/mstore
@@ -0,0 +1 @@
+Subproject commit 10a3437b3634dd4464557580ae36c1ed72535f6c
diff --git a/subprojects/mstore.wrap b/subprojects/mstore.wrap
new file mode 100644
index 00000000..0dc55b08
--- /dev/null
+++ b/subprojects/mstore.wrap
@@ -0,0 +1,7 @@
+[wrap-git]
+url = https://github.com/grimme-lab/mstore
+revision = 10a3437b3634dd4464557580ae36c1ed72535f6c
+clone-recursive = true
+
+[provide]
+mstore = mstore_dep
diff --git a/subprojects/multicharge b/subprojects/multicharge
new file mode 160000
index 00000000..6a5d63f9
--- /dev/null
+++ b/subprojects/multicharge
@@ -0,0 +1 @@
+Subproject commit 6a5d63f9e9e29dcf13cc47cc27f33bf9015681bf
diff --git a/subprojects/multicharge.wrap b/subprojects/multicharge.wrap
new file mode 100644
index 00000000..a201a243
--- /dev/null
+++ b/subprojects/multicharge.wrap
@@ -0,0 +1,7 @@
+[wrap-git]
+url = https://github.com/grimme-lab/multicharge
+revision = 6a5d63f9e9e29dcf13cc47cc27f33bf9015681bf
+clone-recursive = true
+
+[provide]
+multicharge = multicharge_dep
diff --git a/subprojects/pvol b/subprojects/pvol
index 55f4a736..010bddaa 160000
--- a/subprojects/pvol
+++ b/subprojects/pvol
@@ -1 +1 @@
-Subproject commit 55f4a7362ac81a119b97484f7fa0de577209146f
+Subproject commit 010bddaa8766a03e023a977aeebaa6454629c947
diff --git a/subprojects/pvol.wrap b/subprojects/pvol.wrap
new file mode 100644
index 00000000..ef60af93
--- /dev/null
+++ b/subprojects/pvol.wrap
@@ -0,0 +1,7 @@
+[wrap-git]
+url = https://github.com/pprcht/libpvol.git
+revision = 010bddaa8766a03e023a977aeebaa6454629c947
+clone-recursive = true
+
+[provide]
+libpvol = libpvol_dep
diff --git a/subprojects/s-dftd3 b/subprojects/s-dftd3
new file mode 160000
index 00000000..6f0b06fb
--- /dev/null
+++ b/subprojects/s-dftd3
@@ -0,0 +1 @@
+Subproject commit 6f0b06fbfa8653a23ca55c453772ce3af4420706
diff --git a/subprojects/s-dftd3.wrap b/subprojects/s-dftd3.wrap
new file mode 100644
index 00000000..4826da10
--- /dev/null
+++ b/subprojects/s-dftd3.wrap
@@ -0,0 +1,7 @@
+[wrap-git]
+url = https://github.com/dftd3/simple-dftd3
+revision = 6f0b06fbfa8653a23ca55c453772ce3af4420706
+clone-recursive = true
+
+[provide]
+s-dftd3 = s_dftd3_dep
diff --git a/subprojects/tblite b/subprojects/tblite
index 6f6cd7d2..5dc1c978 160000
--- a/subprojects/tblite
+++ b/subprojects/tblite
@@ -1 +1 @@
-Subproject commit 6f6cd7d20d97b22ef00d420904343c7bb8e2afdf
+Subproject commit 5dc1c97858eb585111affc6627783800bafb87cc
diff --git a/subprojects/tblite.wrap b/subprojects/tblite.wrap
index bb401a77..d26f7796 100644
--- a/subprojects/tblite.wrap
+++ b/subprojects/tblite.wrap
@@ -1,4 +1,13 @@
 [wrap-git]
-directory = tblite
-url = https://github.com/ppracht/tblite
-revision = xtb_solvation
+url = https://github.com/tblite/tblite
+revision = 5dc1c97858eb585111affc6627783800bafb87cc
+clone-recursive = true
+
+[provide]
+tblite = tblite_dep
+
+[default_options]
+api = false
+ddx = true
+hdf5 = disabled
+trexio = disabled
diff --git a/subprojects/test-drive.wrap b/subprojects/test-drive.wrap
new file mode 100644
index 00000000..1cb3242a
--- /dev/null
+++ b/subprojects/test-drive.wrap
@@ -0,0 +1,7 @@
+[wrap-git]
+url = https://github.com/fortran-lang/test-drive
+revision = e8b7ca492c647ed384c9845d2caed04192af7d02
+clone-recursive = true
+
+[provide]
+test-drive = testdrive_dep
diff --git a/subprojects/toml-f b/subprojects/toml-f
index 056d3620..d5e92701 160000
--- a/subprojects/toml-f
+++ b/subprojects/toml-f
@@ -1 +1 @@
-Subproject commit 056d3620dcc925d2f94d09b80f6b6c29b99eaab6
+Subproject commit d5e92701d28b647323ce05ecbcbf302dd19792f7
diff --git a/subprojects/toml-f.wrap b/subprojects/toml-f.wrap
index 752ba548..ddb7a97c 100644
--- a/subprojects/toml-f.wrap
+++ b/subprojects/toml-f.wrap
@@ -1,4 +1,7 @@
 [wrap-git]
-directory = toml-f
 url = https://github.com/toml-f/toml-f
-revision = head
+revision = d5e92701d28b647323ce05ecbcbf302dd19792f7
+clone-recursive = true
+
+[provide]
+toml-f = tomlf_dep
diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt
index f1e0acc6..18754bb3 100644
--- a/test/CMakeLists.txt
+++ b/test/CMakeLists.txt
@@ -7,6 +7,11 @@ set(
   "gfn0occ"
   "CN"
   "optimization"
+  "molecular_dynamics"
+  "getsym"
+  "irmsd"
+  "graphs"
+  "ddx"
 )
 set(
   test-srcs
diff --git a/test/main.f90 b/test/main.f90
index 900cf20a..dc60e69f 100644
--- a/test/main.f90
+++ b/test/main.f90
@@ -9,6 +9,11 @@ program tester
   use test_gfn0occ, only: collect_gfn0occ
   use test_cn, only: collect_cn 
   use test_optimization, only: collect_optimization
+  use test_molecular_dynamics, only: collect_mol_dynamics
+  use test_getsym, only: collect_getsym
+  use test_irmsd, only: collect_irmsd
+  use test_graphs, only: collect_graphs
+  use test_ddx, only: collect_ddx
   implicit none
   integer :: stat, is
   character(len=:), allocatable :: suite_name, test_name
@@ -30,7 +35,12 @@ program tester
     new_testsuite("gfn0", collect_gfn0),       &
     new_testsuite("gfn0occ", collect_gfn0occ), &
     new_testsuite("CN",collect_CN),            &
-    new_testsuite("optimization", collect_optimization) &
+    new_testsuite("getsym", collect_getsym),   & 
+    new_testsuite("optimization", collect_optimization), &
+    new_testsuite("molecular_dynamics", collect_mol_dynamics), &
+    new_testsuite("irmsd", collect_irmsd), &
+    new_testsuite("graphs", collect_graphs), &
+    new_testsuite("ddx", collect_ddx) &
   ]
 !&>
 
diff --git a/test/meson.build b/test/meson.build
new file mode 100644
index 00000000..21b1b62f
--- /dev/null
+++ b/test/meson.build
@@ -0,0 +1,44 @@
+# This file is part of crest.
+# SPDX-Identifier: LGPL-3.0-or-later
+
+tests = [
+  'tblite',
+  'gfnff',
+  'gfn0',
+  'gfn0occ',
+  'CN',
+  'optimization',
+  'molecular_dynamics',
+  'getsym',
+  'irmsd',
+  'graphs',
+  'ddx',
+]
+
+test_srcs = files(
+  'testmol.f90',
+  'helpers.f90',
+  'main.f90',
+)
+foreach t : tests
+  test_srcs += files('test_@0@.F90'.format(t))
+endforeach
+
+crest_tester = executable(
+  'crest-tester',
+  sources             : test_srcs,
+  include_directories : inc_dirs,
+  link_with           : lib_crest,
+  dependencies        : [testdrive_dep, lapack_dep, blas_dep]
+                        + _omp_link_dep + _optional_deps,
+  link_language       : 'fortran',
+)
+
+foreach t : tests
+  test(
+    'crest/@0@'.format(t),
+    crest_tester,
+    args    : [t],
+    timeout : 120,
+  )
+endforeach
diff --git a/test/test_ddx.F90 b/test/test_ddx.F90
new file mode 100644
index 00000000..72972b60
--- /dev/null
+++ b/test/test_ddx.F90
@@ -0,0 +1,318 @@
+module test_ddx
+  use testdrive,only:new_unittest,unittest_type,error_type,check,test_failed
+  use crest_parameters
+  use strucrd
+  use crest_testmol
+#ifdef WITH_DDX
+  use crest_ddx_pc,only:ddx_pc_engrad
+  use crest_electrostatic,only:electrostatic_core
+  use crest_surface,only:surface_engrad
+  use crest_solvation,only:solvation_data,solvation_setup,solvation_core
+#endif
+  implicit none
+  private
+
+  public :: collect_ddx
+
+  real(wp),parameter :: eps_water = 78.4_wp
+
+!========================================================================================!
+!========================================================================================!
+contains  !> Unit tests for the standalone ddX point-charge solvation engine
+!========================================================================================!
+!========================================================================================!
+
+  subroutine collect_ddx(testsuite)
+    type(unittest_type),allocatable,intent(out) :: testsuite(:)
+!&<
+    testsuite = [ &
+#ifdef WITH_DDX
+    new_unittest("ddX point-charge energy < 0  ",test_ddx_energy), &
+    new_unittest("ddX explicit grad vs finite-diff",test_ddx_fd), &
+    new_unittest("EEQ-BC grad vs finite-diff   ",test_eeq_fd), &
+    new_unittest("SASA nonpolar grad vs FD     ",test_surface_fd), &
+    new_unittest("ddX full grad (chain) vs FD  ",test_solv_full_fd), &
+    new_unittest("solvation composite grad vs FD",test_composite_fd), &
+    new_unittest("GFN2/ALPB params load + run  ",test_gfn2_params) &
+#else
+    new_unittest("ddX not compiled",test_ddx_nocompile,should_fail=.true.) &
+#endif
+    ]
+!&>
+  end subroutine collect_ddx
+
+#ifndef WITH_DDX
+  subroutine test_ddx_nocompile(error)
+    type(error_type),allocatable,intent(out) :: error
+    allocate (error)
+  end subroutine test_ddx_nocompile
+#endif
+
+#ifdef WITH_DDX
+!> Deterministic, charge-neutral set of fabricated point charges
+  subroutine fake_charges(mol,q)
+    type(coord),intent(in) :: mol
+    real(wp),allocatable,intent(out) :: q(:)
+    integer :: i
+    allocate (q(mol%nat))
+    do i = 1,mol%nat
+      q(i) = 0.1_wp*sin(real(i,wp))
+    end do
+    q(:) = q(:)-sum(q)/real(mol%nat,wp)   !> enforce neutrality
+  end subroutine fake_charges
+
+  subroutine test_ddx_energy(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(coord) :: mol
+    real(wp),allocatable :: q(:),grad(:,:)
+    real(wp) :: energy
+    integer :: io
+    call get_testmol('cytosine',mol)
+    call fake_charges(mol,q)
+    allocate (grad(3,mol%nat))
+    call ddx_pc_engrad(mol,q,'cpcm',eps_water,energy,grad,io)
+    call check(error,io,0)
+    if (allocated(error)) return
+    !> polarization of a charge distribution always lowers the energy
+    call check(error,energy < 0.0_wp)
+  end subroutine test_ddx_energy
+
+  subroutine test_ddx_fd(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(coord) :: mol
+    real(wp),allocatable :: q(:),grad(:,:)
+    real(wp) :: energy,el,er,h,dev,rms
+    integer :: io,iat,k,n
+    real(wp),parameter :: thr = 1.0e-5_wp
+    h = 5.0e-4_wp
+    call get_testmol('cytosine',mol)
+    call fake_charges(mol,q)
+    allocate (grad(3,mol%nat))
+    !> analytic explicit gradient (charges held fixed -> no dqdr term)
+    call ddx_pc_engrad(mol,q,'cpcm',eps_water,energy,grad,io)
+    call check(error,io,0)
+    if (allocated(error)) return
+    !> central finite differences at fixed charges
+    rms = 0.0_wp; n = 0
+    do iat = 1,mol%nat
+      do k = 1,3
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        call ddx_e(mol,q,er,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)-2.0_wp*h
+        call ddx_e(mol,q,el,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        dev = (er-el)/(2.0_wp*h)-grad(k,iat)
+        rms = rms+dev*dev; n = n+1
+      end do
+    end do
+    rms = sqrt(rms/real(n,wp))
+    write (*,'("       ... ddX grad RMS dev =",es12.4)') rms
+    call check(error,rms < thr)
+  end subroutine test_ddx_fd
+
+!> energy-only helper for the finite-difference loop
+  subroutine ddx_e(mol,q,energy,io)
+    type(coord),intent(in) :: mol
+    real(wp),intent(in)    :: q(:)
+    real(wp),intent(out)   :: energy
+    integer,intent(out)    :: io
+    real(wp),allocatable   :: g(:,:)
+    allocate (g(3,mol%nat))
+    call ddx_pc_engrad(mol,q,'cpcm',eps_water,energy,g,io)
+  end subroutine ddx_e
+
+!> EEQ-BC electrostatic gradient vs central finite differences
+  subroutine test_eeq_fd(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(coord) :: mol
+    real(wp),allocatable :: grad(:,:),qat(:),g(:,:)
+    real(wp) :: energy,el,er,h,dev,rms
+    integer :: io,iat,k,n
+    real(wp),parameter :: thr = 1.0e-6_wp
+    h = 1.0e-4_wp
+    call get_testmol('cytosine',mol)
+    allocate (grad(3,mol%nat),qat(mol%nat),g(3,mol%nat))
+    call electrostatic_core(mol,0,'eeqbc',energy,grad,qat,io)
+    call check(error,io,0)
+    if (allocated(error)) return
+    rms = 0.0_wp; n = 0
+    do iat = 1,mol%nat
+      do k = 1,3
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        call electrostatic_core(mol,0,'eeqbc',er,g,qat,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)-2.0_wp*h
+        call electrostatic_core(mol,0,'eeqbc',el,g,qat,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        dev = (er-el)/(2.0_wp*h)-grad(k,iat)
+        rms = rms+dev*dev; n = n+1
+      end do
+    end do
+    rms = sqrt(rms/real(n,wp))
+    write (*,'("       ... EEQ-BC grad RMS dev =",es12.4)') rms
+    call check(error,rms < thr)
+  end subroutine test_eeq_fd
+
+!> Nonpolar SASA gradient vs central finite differences
+  subroutine test_surface_fd(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(coord) :: mol
+    real(wp),allocatable :: grad(:,:),tension(:),sasa(:),g(:,:)
+    real(wp) :: energy,el,er,h,dev,rms
+    integer :: io,iat,k,n
+    !> SASA gradients are limited by the Lebedev grid + neighbour-list cutoff,
+    !> so the finite-difference consistency floors out around 1e-5
+    real(wp),parameter :: thr = 1.0e-4_wp
+    h = 1.0e-4_wp
+    call get_testmol('cytosine',mol)
+    allocate (grad(3,mol%nat),tension(mol%nat),sasa(mol%nat),g(3,mol%nat))
+    tension(:) = 0.01_wp   !> arbitrary uniform surface tension
+    call surface_engrad(mol,tension,energy,grad,io,sasa=sasa)
+    call check(error,io,0)
+    if (allocated(error)) return
+    rms = 0.0_wp; n = 0
+    do iat = 1,mol%nat
+      do k = 1,3
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        call surface_engrad(mol,tension,er,g,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)-2.0_wp*h
+        call surface_engrad(mol,tension,el,g,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        dev = (er-el)/(2.0_wp*h)-grad(k,iat)
+        rms = rms+dev*dev; n = n+1
+      end do
+    end do
+    rms = sqrt(rms/real(n,wp))
+    write (*,'("       ... SASA grad RMS dev =",es12.4)') rms
+    call check(error,rms < thr)
+  end subroutine test_surface_fd
+
+!> Full ddX gradient (explicit + dq/dR chain term) vs finite differences with
+!> geometry-dependent EEQ-BC charges -- validates the charge-response term.
+  subroutine test_solv_full_fd(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(coord) :: mol
+    real(wp),allocatable :: grad(:,:),geeq(:,:),qat(:),dqdr(:,:,:)
+    real(wp) :: energy,eeq,el,er,h,dev,rms
+    integer :: io,iat,k,n
+    real(wp),parameter :: thr = 1.0e-5_wp
+    h = 5.0e-4_wp
+    call get_testmol('cytosine',mol)
+    allocate (grad(3,mol%nat),geeq(3,mol%nat),qat(mol%nat),dqdr(3,mol%nat,mol%nat))
+    !> analytic full gradient: charges + dq/dR from EEQ-BC, fed into ddX
+    call electrostatic_core(mol,0,'eeqbc',eeq,geeq,qat,io,dqdr=dqdr)
+    call ddx_pc_engrad(mol,qat,'cpcm',eps_water,energy,grad,io,dqdr=dqdr)
+    call check(error,io,0)
+    if (allocated(error)) return
+    !> finite differences with charges recomputed at each perturbed geometry
+    rms = 0.0_wp; n = 0
+    do iat = 1,mol%nat
+      do k = 1,3
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        call solv_e(mol,er,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)-2.0_wp*h
+        call solv_e(mol,el,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        dev = (er-el)/(2.0_wp*h)-grad(k,iat)
+        rms = rms+dev*dev; n = n+1
+      end do
+    end do
+    rms = sqrt(rms/real(n,wp))
+    write (*,'("       ... ddX full grad RMS dev =",es12.4)') rms
+    call check(error,rms < thr)
+  end subroutine test_solv_full_fd
+
+!> ddX solvation energy with self-consistently recomputed EEQ-BC charges
+  subroutine solv_e(mol,energy,io)
+    type(coord),intent(in) :: mol
+    real(wp),intent(out)   :: energy
+    integer,intent(out)    :: io
+    real(wp),allocatable   :: q(:),g(:,:)
+    real(wp) :: eeq
+    allocate (q(mol%nat),g(3,mol%nat))
+    call electrostatic_core(mol,0,'eeqbc',eeq,g,q,io)
+    call ddx_e(mol,q,energy,io)
+  end subroutine solv_e
+
+!> Full solvation composite (polar + tension + hbond) gradient vs finite
+!> differences -- the end-to-end check with both charges and SASA varying
+  subroutine test_composite_fd(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(coord) :: mol
+    type(solvation_data) :: solv
+    real(wp),allocatable :: grad(:,:),g(:,:)
+    real(wp) :: energy,el,er,h,dev,rms
+    integer :: io,iat,k,n
+    real(wp),parameter :: thr = 1.0e-4_wp   !> floored by the SASA integrator
+    h = 5.0e-4_wp
+    call get_testmol('cytosine',mol)
+    allocate (grad(3,mol%nat),g(3,mol%nat))
+    !> inject amplified dummy CDS parameters to stress the nonpolar gradient
+    solv%charge_model = 'eeqbc'; solv%smodel = 'cpcm'; solv%do_hbond = .true.
+    solv%eps = eps_water; solv%probe = 1.0_wp*aatoau; solv%loaded = .true.
+    allocate (solv%tension(mol%nat),source=0.01_wp)
+    allocate (solv%hbond(mol%nat),source=0.005_wp)
+    !> analytic gradient of the full composite
+    call solvation_core(mol,0,solv,energy,grad,io)
+    call check(error,io,0)
+    if (allocated(error)) return
+    !> finite differences (charges + SASA recomputed at each geometry)
+    rms = 0.0_wp; n = 0
+    do iat = 1,mol%nat
+      do k = 1,3
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        call solvation_core(mol,0,solv,er,g,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)-2.0_wp*h
+        call solvation_core(mol,0,solv,el,g,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        dev = (er-el)/(2.0_wp*h)-grad(k,iat)
+        rms = rms+dev*dev; n = n+1
+      end do
+    end do
+    rms = sqrt(rms/real(n,wp))
+    write (*,'("       ... composite grad RMS dev =",es12.4)') rms
+    call check(error,rms < thr)
+  end subroutine test_composite_fd
+
+!> Load real GFN2/ALPB water parameters via the data object and run the
+!> composite, checking the gradient against finite differences end to end
+  subroutine test_gfn2_params(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(coord) :: mol
+    type(solvation_data) :: solv
+    real(wp),allocatable :: grad(:,:),g(:,:)
+    real(wp) :: energy,el,er,h,dev,rms
+    integer :: io,iat,k,n
+    real(wp),parameter :: thr = 1.0e-4_wp
+    h = 5.0e-4_wp
+    call get_testmol('cytosine',mol)
+    allocate (grad(3,mol%nat),g(3,mol%nat))
+    solv%charge_model = 'eeqbc'; solv%smodel = 'cpcm'
+    solv%solvent = 'water'; solv%do_hbond = .true.
+    call solvation_setup(mol,solv,io)
+    call check(error,io,0)
+    if (allocated(error)) return
+    call solvation_core(mol,0,solv,energy,grad,io)
+    call check(error,io,0)
+    if (allocated(error)) return
+    call check(error,energy < 0.0_wp)   !> aqueous solvation should stabilize
+    if (allocated(error)) return
+    rms = 0.0_wp; n = 0
+    do iat = 1,mol%nat
+      do k = 1,3
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        call solvation_core(mol,0,solv,er,g,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)-2.0_wp*h
+        call solvation_core(mol,0,solv,el,g,io)
+        mol%xyz(k,iat) = mol%xyz(k,iat)+h
+        dev = (er-el)/(2.0_wp*h)-grad(k,iat)
+        rms = rms+dev*dev; n = n+1
+      end do
+    end do
+    rms = sqrt(rms/real(n,wp))
+    write (*,'("       ... GFN2 composite E =",f12.6," grad RMS =",es12.4)') energy,rms
+    call check(error,rms < thr)
+  end subroutine test_gfn2_params
+#endif
+
+!========================================================================================!
+end module test_ddx
diff --git a/test/test_getsym.F90 b/test/test_getsym.F90
new file mode 100644
index 00000000..3f7f25e2
--- /dev/null
+++ b/test/test_getsym.F90
@@ -0,0 +1,785 @@
+module test_getsym
+  use testdrive,only:new_unittest,unittest_type,error_type,test_failed
+  use iso_fortran_env,only:wp => real64
+  use symmetry_i,only:getsym
+  implicit none
+  private
+  public :: collect_getsym
+
+!========================================================================================!
+!> Hardcoded geometries (converted from XYZ/Angstrom to Bohr)
+!========================================================================================!
+
+  integer,parameter :: nat_c1 = 5
+  integer,parameter :: at_c1(nat_c1) = [6,1,9,17,35]
+  real(wp),parameter :: xyz_c1(3,nat_c1) = reshape([ &
+    1.7686891663_wp, -0.0460904202_wp, -0.1376098564_wp, &
+    3.8326480397_wp, -0.0460904202_wp, -0.1376098564_wp, &
+    1.0806965762_wp, 1.4516120199_wp, -1.3799725025_wp, &
+    1.0806965762_wp, 0.2809833775_wp, 1.7806322355_wp, &
+    1.0806965762_wp, -1.8708666579_wp, -0.8134704049_wp], &
+    [3,nat_c1])
+
+  integer,parameter :: nat_ci = 8
+  integer,parameter :: at_ci(nat_ci) = [17,6,6,17,9,1,9,1]
+  real(wp),parameter :: xyz_ci(3,nat_ci) = reshape([ &
+    1.9984798631_wp, 0.0892139703_wp, 0.0537060165_wp, &
+    5.3641387828_wp, 0.1444128704_wp, 0.0626444210_wp, &
+    6.3141419002_wp, 2.8167312751_wp, 0.4807085316_wp, &
+    9.6797819227_wp, 2.8713254628_wp, 0.4934830802_wp, &
+    6.0032441582_wp, -0.6077548189_wp, -1.7546107067_wp, &
+    6.0030173911_wp, -1.1269192772_wp, 1.5632759366_wp, &
+    5.6729956206_wp, 3.5699572111_wp, 2.2967542346_wp, &
+    5.6772286072_wp, 4.0874209158_wp, -1.0213780731_wp], &
+    [3,nat_ci])
+
+  integer,parameter :: nat_cs = 5
+  integer,parameter :: at_cs(nat_cs) = [6,1,1,17,35]
+  real(wp),parameter :: xyz_cs(3,nat_cs) = reshape([ &
+    1.7686891663_wp, -0.0460904202_wp, -0.1376098564_wp, &
+    3.8326480397_wp, -0.0460904202_wp, -0.1376098564_wp, &
+    1.0806965762_wp, 1.4516120199_wp, -1.3799725025_wp, &
+    1.0806965762_wp, 0.2809833775_wp, 1.7806322355_wp, &
+    1.0806965762_wp, -1.8708666579_wp, -0.8134704049_wp], &
+    [3,nat_cs])
+
+  integer,parameter :: nat_c2 = 4
+  integer,parameter :: at_c2(nat_c2) = [8,8,1,1]
+  real(wp),parameter :: xyz_c2(3,nat_c2) = reshape([ &
+    -1.3413435337_wp, 0.0553519912_wp, -0.0129809434_wp, &
+    1.3413435337_wp, -0.0553519912_wp, 0.0129809434_wp, &
+    -1.7986927696_wp, -1.6645598353_wp, 0.3904096780_wp, &
+    1.7986927696_wp, -1.6645598353_wp, -0.3904096780_wp], &
+    [3,nat_c2])
+
+  integer,parameter :: nat_c2h = 6
+  integer,parameter :: at_c2h(nat_c2h) = [17,6,6,17,1,1]
+  real(wp),parameter :: xyz_c2h(3,nat_c2h) = reshape([ &
+    1.8977196661_wp, -0.2014448049_wp, -0.0710348050_wp, &
+    5.1323638737_wp, -0.1056356904_wp, -0.0379268033_wp, &
+    6.4183602960_wp, 1.9359677229_wp, 0.6678481097_wp, &
+    9.6529856062_wp, 2.0317768374_wp, 0.7009750087_wp, &
+    5.9826083489_wp, -1.8636101096_wp, -0.6456438277_wp, &
+    5.5680969235_wp, 3.6939421421_wp, 1.2755840314_wp], &
+    [3,nat_c2h])
+
+  integer,parameter :: nat_c2v = 3
+  integer,parameter :: at_c2v(nat_c2v) = [8,1,1]
+  real(wp),parameter :: xyz_c2v(3,nat_c2v) = reshape([ &
+    1.7412503430_wp, -0.0503045094_wp, 0.1594739877_wp, &
+    3.5702973618_wp, 0.0293096522_wp, 0.1225676364_wp, &
+    1.2143191104_wp, 1.5408070930_wp, -0.5779349407_wp], &
+    [3,nat_c2v])
+
+  integer,parameter :: nat_c3 = 8
+  integer,parameter :: at_c3(nat_c3) = [8,15,8,8,8,1,1,1]
+  real(wp),parameter :: xyz_c3(3,nat_c3) = reshape([ &
+    2.1838664179_wp, 0.0466527838_wp, 1.9125045432_wp, &
+    -0.2066665717_wp, -0.0189806738_wp, 0.1004614502_wp, &
+    -2.6626254324_wp, -0.0861740813_wp, 1.3747444618_wp, &
+    0.2477461752_wp, 2.3413303983_wp, -1.6955100891_wp, &
+    0.3753052019_wp, -2.3513858200_wp, -1.6952502706_wp, &
+    1.8620047872_wp, -0.9714351061_wp, 3.3672205705_wp, &
+    -0.5208961465_wp, 3.8036152890_wp, -0.9694469441_wp, &
+    -1.1456946322_wp, -2.8663836211_wp, -2.5184443558_wp], &
+    [3,nat_c3])
+
+  integer,parameter :: nat_c3v = 4
+  integer,parameter :: at_c3v(nat_c3v) = [7,1,1,1]
+  real(wp),parameter :: xyz_c3v(3,nat_c3v) = reshape([ &
+    2.0094213774_wp, 0.1277832805_wp, -0.0094864251_wp, &
+    3.9318964557_wp, 0.0784425314_wp, -0.1081112316_wp, &
+    1.4206016142_wp, -1.6941772652_wp, -0.2138414083_wp, &
+    1.4205827169_wp, 1.0563191091_wp, -1.5903557120_wp], &
+    [3,nat_c3v])
+
+  integer,parameter :: nat_c4v = 6
+  integer,parameter :: at_c4v(nat_c4v) = [54,8,9,9,9,9]
+  real(wp),parameter :: xyz_c4v(3,nat_c4v) = reshape([ &
+    0.0000000000_wp, 0.0000000000_wp, 0.0000000000_wp, &
+    2.8345891869_wp, 0.0000000000_wp, 0.0000000000_wp, &
+    0.0000000000_wp, 2.2676713496_wp, 2.2676713496_wp, &
+    0.0000000000_wp, 2.2676713496_wp, -2.2676713496_wp, &
+    0.0000000000_wp, -2.2676713496_wp, 2.2676713496_wp, &
+    0.0000000000_wp, -2.2676713496_wp, -2.2676713496_wp], &
+    [3,nat_c4v])
+
+  integer,parameter :: nat_c5 = 30
+  integer,parameter :: at_c5(nat_c5) = [6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,1,9,1,9,1,9,9,1,1,9]
+  real(wp),parameter :: xyz_c5(3,nat_c5) = reshape([ &
+    4.1506027534_wp, -2.0577782147_wp, -0.7793164178_wp, &
+    6.1034755769_wp, -0.2721278465_wp, -0.2078341373_wp, &
+    5.6677527186_wp, 2.2879313702_wp, -0.1333417100_wp, &
+    3.2287955057_wp, 3.3565846641_wp, -0.6214740288_wp, &
+    2.1555044741_wp, 5.7218229465_wp, 0.1429213557_wp, &
+    -0.4097575886_wp, 6.0946420523_wp, 0.3095743804_wp, &
+    -2.1972322554_wp, 4.1450305843_wp, -0.2688976403_wp, &
+    -4.7566213713_wp, 3.8026161128_wp, 0.5439005762_wp, &
+    -5.9057076660_wp, 1.4728953771_wp, 0.5727859198_wp, &
+    -4.6279273429_wp, -0.7822543594_wp, -0.2081874783_wp, &
+    -2.3260847824_wp, -0.3558899934_wp, -1.3645953292_wp, &
+    -0.4212128650_wp, -2.2172109020_wp, -1.5190221584_wp, &
+    1.9366611069_wp, -0.9752564488_wp, -1.6417754489_wp, &
+    1.4889571281_wp, 1.6533686360_wp, -1.5646128982_wp, &
+    -1.1457234397_wp, 2.0362307059_wp, -1.3934152450_wp, &
+    -0.7053856104_wp, -4.6162955879_wp, -0.5285699878_wp, &
+    -3.2269454839_wp, -5.1877810615_wp, 0.2742834659_wp, &
+    -5.0813249127_wp, -3.3749399931_wp, 0.4262836582_wp, &
+    1.6314970454_wp, -5.8938226986_wp, -0.0423215999_wp, &
+    3.9271679611_wp, -4.6839996881_wp, -0.1604477348_wp, &
+    7.9404810111_wp, -0.9711247579_wp, 0.3544797089_wp, &
+    7.1758252770_wp, 3.5221796708_wp, 0.4851426936_wp, &
+    3.4066392826_wp, 7.2100758904_wp, 0.7757496641_wp, &
+    -1.0969646698_wp, 7.8643592820_wp, 1.0684833919_wp, &
+    -5.7621122661_wp, 5.4024319347_wp, 1.3250328734_wp, &
+    -7.7790778971_wp, 1.3128978782_wp, 1.3759015475_wp, &
+    -3.6400790044_wp, -7.0730048337_wp, 0.9489170013_wp, &
+    -6.8954493888_wp, -3.8908471871_wp, 1.2160970832_wp, &
+    1.5754712934_wp, -7.8309868158_wp, 0.6087556096_wp, &
+    5.6057219651_wp, -5.7074640447_wp, 0.4016119744_wp], &
+    [3,nat_c5])
+
+  integer,parameter :: nat_c5v = 30
+  integer,parameter :: at_c5v(nat_c5v) = [6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,1,1,1,1,1,1,1,1,1,1]
+  real(wp),parameter :: xyz_c5v(3,nat_c5v) = reshape([ &
+    4.1506027534_wp, -2.0577782147_wp, -0.7793164178_wp, &
+    6.1034755769_wp, -0.2721278465_wp, -0.2078341373_wp, &
+    5.6677527186_wp, 2.2879313702_wp, -0.1333417100_wp, &
+    3.2287955057_wp, 3.3565846641_wp, -0.6214740288_wp, &
+    2.1555044741_wp, 5.7218229465_wp, 0.1429213557_wp, &
+    -0.4097575886_wp, 6.0946420523_wp, 0.3095743804_wp, &
+    -2.1972322554_wp, 4.1450305843_wp, -0.2688976403_wp, &
+    -4.7566213713_wp, 3.8026161128_wp, 0.5439005762_wp, &
+    -5.9057076660_wp, 1.4728953771_wp, 0.5727859198_wp, &
+    -4.6279273429_wp, -0.7822543594_wp, -0.2081874783_wp, &
+    -2.3260847824_wp, -0.3558899934_wp, -1.3645953292_wp, &
+    -0.4212128650_wp, -2.2172109020_wp, -1.5190221584_wp, &
+    1.9366611069_wp, -0.9752564488_wp, -1.6417754489_wp, &
+    1.4889571281_wp, 1.6533686360_wp, -1.5646128982_wp, &
+    -1.1457234397_wp, 2.0362307059_wp, -1.3934152450_wp, &
+    -0.7053856104_wp, -4.6162955879_wp, -0.5285699878_wp, &
+    -3.2269454839_wp, -5.1877810615_wp, 0.2742834659_wp, &
+    -5.0813249127_wp, -3.3749399931_wp, 0.4262836582_wp, &
+    1.6314970454_wp, -5.8938226986_wp, -0.0423215999_wp, &
+    3.9271679611_wp, -4.6839996881_wp, -0.1604477348_wp, &
+    7.9404810111_wp, -0.9711247579_wp, 0.3544797089_wp, &
+    7.1758252770_wp, 3.5221796708_wp, 0.4851426936_wp, &
+    3.4066392826_wp, 7.2100758904_wp, 0.7757496641_wp, &
+    -1.0969646698_wp, 7.8643592820_wp, 1.0684833919_wp, &
+    -5.7621122661_wp, 5.4024319347_wp, 1.3250328734_wp, &
+    -7.7790778971_wp, 1.3128978782_wp, 1.3759015475_wp, &
+    -3.6400790044_wp, -7.0730048337_wp, 0.9489170013_wp, &
+    -6.8954493888_wp, -3.8908471871_wp, 1.2160970832_wp, &
+    1.5754712934_wp, -7.8309868158_wp, 0.6087556096_wp, &
+    5.6057219651_wp, -5.7074640447_wp, 0.4016119744_wp], &
+    [3,nat_c5v])
+
+  integer,parameter :: nat_cinfv = 2
+  integer,parameter :: at_cinfv(nat_cinfv) = [9,1]
+  real(wp),parameter :: xyz_cinfv(3,nat_cinfv) = reshape([ &
+    1.6545119139_wp, 0.1226999173_wp, -0.0701655310_wp, &
+    3.4293237929_wp, 0.1226999173_wp, -0.0701655310_wp], &
+    [3,nat_cinfv])
+
+  integer,parameter :: nat_d2 = 22
+  integer,parameter :: at_d2(nat_d2) = [6,6,6,6,6,6,6,6,6,6,6,6,1,1,1,1,1,1,1,1,1,1]
+  real(wp),parameter :: xyz_d2(3,nat_d2) = reshape([ &
+    2.5621851661_wp, -0.4439911530_wp, -0.0436148790_wp, &
+    0.9253421914_wp, -2.5127877252_wp, 0.1502332269_wp, &
+    -1.6739005039_wp, -2.1369023017_wp, 0.1913347701_wp, &
+    -2.6332955601_wp, 0.3046994403_wp, 0.0348465497_wp, &
+    -0.9891960372_wp, 2.3654268820_wp, -0.1896340166_wp, &
+    1.6529812357_wp, 2.0499560027_wp, -0.2395794781_wp, &
+    3.3960268186_wp, 4.2370305331_wp, -0.4989632859_wp, &
+    2.7654063135_wp, 6.6565791713_wp, 0.4215601039_wp, &
+    4.3970903358_wp, 8.7186861130_wp, 0.1505166858_wp, &
+    6.7269714694_wp, 8.4139488781_wp, -1.0255921624_wp, &
+    7.4141325801_wp, 6.0515266607_wp, -1.9418447711_wp, &
+    5.7626631253_wp, 3.9991329112_wp, -1.6961614777_wp, &
+    4.5822457015_wp, -0.8214828436_wp, -0.0238294464_wp, &
+    1.6914371624_wp, -4.4146269943_wp, 0.2723851236_wp, &
+    -2.9477459873_wp, -3.7402404322_wp, 0.3445726616_wp, &
+    -4.6633527468_wp, 0.6148223946_wp, 0.0725843804_wp, &
+    -1.8237746829_wp, 4.2357833138_wp, -0.3557031484_wp, &
+    0.9789537216_wp, 6.9700847353_wp, 1.3885707564_wp, &
+    3.8407738620_wp, 10.5624352010_wp, 0.8651544144_wp, &
+    8.0008169527_wp, 10.0118257001_wp, -1.2267913028_wp, &
+    9.2341467080_wp, 5.7935979419_wp, -2.8609508664_wp, &
+    6.3573788339_wp, 2.1980160446_wp, -2.4864260457_wp], &
+    [3,nat_d2])
+
+  integer,parameter :: nat_d2d = 7
+  integer,parameter :: at_d2d(nat_d2d) = [6,6,6,1,1,1,1]
+  real(wp),parameter :: xyz_d2d(3,nat_d2d) = reshape([ &
+    -2.4443487644_wp, -0.0000022937_wp, -0.0000001336_wp, &
+    -0.0000010639_wp, -0.0000043018_wp, -0.0000001767_wp, &
+    2.4443458222_wp, -0.0000057331_wp, 0.0000012450_wp, &
+    -3.5163354416_wp, -0.4079430602_wp, -1.6837648529_wp, &
+    -3.5163315932_wp, 0.4079495522_wp, 1.6837640156_wp, &
+    3.5163309025_wp, -1.6837439760_wp, 0.4080523160_wp, &
+    3.5163297587_wp, 1.6837342434_wp, -0.4080524134_wp], &
+    [3,nat_d2d])
+
+  integer,parameter :: nat_d2h = 6
+  integer,parameter :: at_d2h(nat_d2h) = [6,6,1,1,1,1]
+  real(wp),parameter :: xyz_d2h(3,nat_d2h) = reshape([ &
+    2.0246903644_wp, 0.0223932546_wp, 0.1508190420_wp, &
+    4.5488164464_wp, 0.0223932546_wp, 0.1508190420_wp, &
+    0.9669161662_wp, -0.8803667097_wp, 1.6587637977_wp, &
+    0.9669161662_wp, 0.9251343216_wp, -1.3571446109_wp, &
+    5.6066095419_wp, -0.8803667097_wp, 1.6587637977_wp, &
+    5.6066095419_wp, 0.9251343216_wp, -1.3571446109_wp], &
+    [3,nat_d2h])
+
+  integer,parameter :: nat_d3 = 19
+  integer,parameter :: at_d3(nat_d3) = [8,6,6,8,8,8,26,8,6,6,8,8,8,8,6,6,8,8,8]
+  real(wp),parameter :: xyz_d3(3,nat_d3) = reshape([ &
+    -5.5946338021_wp, -0.8229064614_wp, 5.2053622115_wp, &
+    -3.8359811652_wp, -0.1763064438_wp, 3.8074275063_wp, &
+    -2.7745085917_wp, 2.5933383340_wp, 3.8848133004_wp, &
+    -3.5603543255_wp, 4.1325496693_wp, 5.4589836994_wp, &
+    -1.1089414828_wp, 3.0199843392_wp, 2.2154904239_wp, &
+    -2.7131559285_wp, -1.5806752624_wp, 2.2233057633_wp, &
+    -0.0134444680_wp, 0.0555107607_wp, -0.0126742790_wp, &
+    2.6937923405_wp, -1.3396015306_wp, 2.3709864194_wp, &
+    3.8108202955_wp, -3.3564374539_wp, 1.7154489832_wp, &
+    2.7271524135_wp, -4.5428355546_wp, -0.7798409646_wp, &
+    3.4884935170_wp, -6.6150723077_wp, -1.5481502414_wp, &
+    1.0689832135_wp, -3.1742433657_wp, -1.8393468833_wp, &
+    5.5813984523_wp, -4.3738859186_wp, 2.8528582093_wp, &
+    2.3849000934_wp, 2.0543474787_wp, -2.2983085914_wp, &
+    1.4354620793_wp, 3.1595785624_wp, -4.2017472655_wp, &
+    -1.4637774680_wp, 2.6289929240_wp, -4.5453833855_wp, &
+    -2.6147523355_wp, 3.4372639067_wp, -6.4129074540_wp, &
+    -2.4130858761_wp, 1.3426279459_wp, -2.7590959144_wp, &
+    2.5858890563_wp, 4.5360541927_wp, -5.7014434355_wp], &
+    [3,nat_d3])
+
+  integer,parameter :: nat_d3d = 8
+  integer,parameter :: at_d3d(nat_d3d) = [6,6,1,1,1,1,1,1]
+  real(wp),parameter :: xyz_d3d(3,nat_d3d) = reshape([ &
+    2.0104607267_wp, -0.0348843443_wp, 0.1472096651_wp, &
+    4.8678589080_wp, -0.0348843443_wp, 0.1472096651_wp, &
+    1.2842956688_wp, 0.8372809540_wp, 1.8753642061_wp, &
+    1.2842956688_wp, -1.9675828410_wp, 0.0384370294_wp, &
+    1.2842956688_wp, 1.0256866487_wp, -1.4721911374_wp, &
+    5.5940239659_wp, -1.0954364399_wp, 1.7665915703_wp, &
+    5.5940239659_wp, 1.8978330497_wp, 0.2559823008_wp, &
+    5.5940428632_wp, -0.9070307453_wp, -1.5809637731_wp], &
+    [3,nat_d3d])
+
+  integer,parameter :: nat_d3h = 4
+  integer,parameter :: at_d3h(nat_d3h) = [9,5,9,9]
+  real(wp),parameter :: xyz_d3h(3,nat_d3h) = reshape([ &
+    1.9631230873_wp, -0.1245707461_wp, 0.0334670497_wp, &
+    4.6923411455_wp, -0.1245707461_wp, 0.0334670497_wp, &
+    6.0569501747_wp, -1.5824944513_wp, -1.8268927310_wp, &
+    6.0569501747_wp, 1.3333718563_wp, 1.8938268303_wp], &
+    [3,nat_d3h])
+
+  integer,parameter :: nat_d4 = 22
+  integer,parameter :: at_d4(nat_d4) = [8,6,25,6,8,6,8,6,8,6,8,25,6,8,6,8,6,8,6,8,6,8]
+  real(wp),parameter :: xyz_d4(3,nat_d4) = reshape([ &
+    2.2841686586_wp, 0.2090037094_wp, 0.1362114591_wp, &
+    4.5444511790_wp, 0.1935646469_wp, 0.0922564294_wp, &
+    8.0752343675_wp, 0.1854010301_wp, 0.0151933980_wp, &
+    8.0120608232_wp, 1.9881619585_wp, -3.0202358814_wp, &
+    7.9811071093_wp, 3.1479246757_wp, -4.9606066662_wp, &
+    8.0751020867_wp, 3.2437337902_wp, 1.7781188997_wp, &
+    8.0761981279_wp, 5.2013388772_wp, 2.9070034920_wp, &
+    11.6050160012_wp, 0.2565681159_wp, -0.0161004666_wp, &
+    13.8652040353_wp, 0.3039435499_wp, -0.0245286451_wp, &
+    8.1379165831_wp, -1.5381803737_wp, 3.0963540497_wp, &
+    8.1691726532_wp, -2.6353931561_wp, 5.0726107336_wp, &
+    8.0741761209_wp, -4.5149147597_wp, -2.6937101043_wp, &
+    9.8948705502_wp, -3.0413819168_wp, -5.3358495828_wp, &
+    11.0515152193_wp, -2.1019990602_wp, -7.0370377319_wp, &
+    11.1000622834_wp, -5.4598912056_wp, -1.1375395380_wp, &
+    13.0420960272_wp, -6.0674948464_wp, -0.1537481175_wp, &
+    8.0747430387_wp, -7.5720380951_wp, -4.4554072840_wp, &
+    8.0736658949_wp, -9.5304179698_wp, -5.5823076639_wp, &
+    6.2539541231_wp, -6.0621280242_wp, -0.0951666076_wp, &
+    5.0967614335_wp, -7.0624734456_wp, 1.5704946904_wp, &
+    5.0491781296_wp, -3.6432029957_wp, -4.2940624675_wp, &
+    3.1068042352_wp, -3.0971855292_wp, -5.3130027939_wp], &
+    [3,nat_d4])
+
+  integer,parameter :: nat_d4h = 5
+  integer,parameter :: at_d4h(nat_d4h) = [54,9,9,9,9]
+  real(wp),parameter :: xyz_d4h(3,nat_d4h) = reshape([ &
+    0.0000000000_wp, 0.0000000000_wp, 0.0000000000_wp, &
+    0.0000000000_wp, 2.2676713496_wp, 2.2676713496_wp, &
+    0.0000000000_wp, 2.2676713496_wp, -2.2676713496_wp, &
+    0.0000000000_wp, -2.2676713496_wp, 2.2676713496_wp, &
+    0.0000000000_wp, -2.2676713496_wp, -2.2676713496_wp], &
+    [3,nat_d4h])
+
+  integer,parameter :: nat_d5d = 21
+  integer,parameter :: at_d5d(nat_d5d) = [6,6,6,6,6,1,1,1,1,1,26,6,6,6,6,6,1,1,1,1,1]
+  real(wp),parameter :: xyz_d5d(3,nat_d5d) = reshape([ &
+    1.8752508225_wp, 1.3624547413_wp, -3.2840605457_wp, &
+    1.8752508225_wp, -1.3624547413_wp, -3.2840605457_wp, &
+    -0.7162817903_wp, -2.2044978052_wp, -3.2840605457_wp, &
+    -2.3179380645_wp, 0.0000000000_wp, -3.2840605457_wp, &
+    -0.7162817903_wp, 2.2044978052_wp, -3.2840605457_wp, &
+    3.5276840377_wp, 2.5630166456_wp, -3.2695285518_wp, &
+    3.5276840377_wp, -2.5630166456_wp, -3.2695285518_wp, &
+    -1.3474503159_wp, -4.1470417750_wp, -3.2695285518_wp, &
+    -4.3604485463_wp, 0.0000000000_wp, -3.2695285518_wp, &
+    -1.3474503159_wp, 4.1470417750_wp, -3.2695285518_wp, &
+    -0.0000000000_wp, -0.0000000000_wp, -0.0000000000_wp, &
+    -1.8752508225_wp, -1.3624547413_wp, 3.2840605457_wp, &
+    -1.8752508225_wp, 1.3624547413_wp, 3.2840605457_wp, &
+    0.7162817903_wp, 2.2044978052_wp, 3.2840605457_wp, &
+    2.3179380645_wp, -0.0000000000_wp, 3.2840605457_wp, &
+    0.7162817903_wp, -2.2044978052_wp, 3.2840605457_wp, &
+    -3.5276840377_wp, -2.5630166456_wp, 3.2695285518_wp, &
+    -3.5276840377_wp, 2.5630166456_wp, 3.2695285518_wp, &
+    1.3474503159_wp, 4.1470417750_wp, 3.2695285518_wp, &
+    4.3604485463_wp, -0.0000000000_wp, 3.2695285518_wp, &
+    1.3474503159_wp, -4.1470417750_wp, 3.2695285518_wp], &
+    [3,nat_d5d])
+
+  integer,parameter :: nat_d5h = 10
+  integer,parameter :: at_d5h(nat_d5h) = [6,6,6,6,6,1,1,1,1,1]
+  real(wp),parameter :: xyz_d5h(3,nat_d5h) = reshape([ &
+    -1.8663524711_wp, 1.2366992873_wp, 0.0051139268_wp, &
+    0.6026542002_wp, 2.1530019351_wp, 0.0043775201_wp, &
+    2.2371465685_wp, 0.0880473317_wp, 0.0060344776_wp, &
+    0.7782640422_wp, -2.1045045776_wp, 0.0074568022_wp, &
+    -1.7577693293_wp, -1.3946159551_wp, 0.0071930800_wp, &
+    -3.5767552803_wp, 2.3747834075_wp, 0.0043379967_wp, &
+    1.1564942170_wp, 4.1315770941_wp, 0.0029612919_wp, &
+    4.2898362320_wp, 0.1727660771_wp, 0.0060819138_wp, &
+    1.4930016348_wp, -4.0307549451_wp, 0.0085934742_wp, &
+    -3.3686738275_wp, -2.6698661099_wp, 0.0083161327_wp], &
+    [3,nat_d5h])
+
+  integer,parameter :: nat_d6h = 12
+  integer,parameter :: at_d6h(nat_d6h) = [6,6,6,6,6,6,1,1,1,1,1,1]
+  real(wp),parameter :: xyz_d6h(3,nat_d6h) = reshape([ &
+    2.6136424084_wp, -0.4184042613_wp, 0.0100533430_wp, &
+    0.9574486383_wp, -2.4690216681_wp, -0.0142107405_wp, &
+    -1.6464616806_wp, -2.0607841334_wp, -0.0269852891_wp, &
+    -2.5945939691_wp, 0.3983353698_wp, -0.0087116374_wp, &
+    -0.9386647606_wp, 2.4494252082_wp, 0.0204657339_wp, &
+    1.6651132775_wp, 2.0409987009_wp, 0.0256813780_wp, &
+    4.6419610471_wp, -0.7366152434_wp, 0.0176122475_wp, &
+    1.6964071421_wp, -4.3853740339_wp, -0.0241884944_wp, &
+    -2.9363320415_wp, -3.6582263184_wp, -0.0521942356_wp, &
+    -4.6232338612_wp, 0.7170565780_wp, -0.0156847268_wp, &
+    -1.6777366480_wp, 4.3659287520_wp, 0.0383047485_wp, &
+    2.9553426863_wp, 3.6388377283_wp, 0.0426322214_wp], &
+    [3,nat_d6h])
+
+  integer,parameter :: nat_d7h = 14
+  integer,parameter :: at_d7h(nat_d7h) = [6,6,6,6,6,6,6,1,1,1,1,1,1,1]
+  real(wp),parameter :: xyz_d7h(3,nat_d7h) = reshape([ &
+    -3.0250909355_wp, -0.1819499680_wp, -0.0116177785_wp, &
+    -2.0295202814_wp, 2.2508838774_wp, -0.0016445251_wp, &
+    0.4931844451_wp, 2.9892921059_wp, -0.0030129336_wp, &
+    2.6435520954_wp, 1.4774985135_wp, -0.0143554973_wp, &
+    2.8021645025_wp, -1.1465948089_wp, -0.0184410880_wp, &
+    0.8494762113_wp, -2.9064326781_wp, -0.0175336090_wp, &
+    -1.7439494254_wp, -2.4770856286_wp, -0.0170237108_wp, &
+    -5.0696637259_wp, -0.3055858821_wp, -0.0130586120_wp, &
+    -3.4008719473_wp, 3.7725554171_wp, 0.0063520778_wp, &
+    0.8275050278_wp, 5.0100568745_wp, 0.0037676503_wp, &
+    4.4322977666_wp, 2.4760577858_wp, -0.0182010363_wp, &
+    4.6978588149_wp, -1.9224255016_wp, -0.0222170612_wp, &
+    1.4250021608_wp, -4.8724090140_wp, -0.0195888430_wp, &
+    -2.9223717563_wp, -4.1524896636_wp, -0.0214410923_wp], &
+    [3,nat_d7h])
+
+  integer,parameter :: nat_d8h = 16
+  integer,parameter :: at_d8h(nat_d8h) = [6,6,6,6,6,6,6,6,1,1,1,1,1,1,1,1]
+  real(wp),parameter :: xyz_d8h(3,nat_d8h) = reshape([ &
+    -3.1953385351_wp, -1.2992913342_wp, -0.0013443022_wp, &
+    -3.1782563860_wp, 1.3405447404_wp, -0.0007915785_wp, &
+    3.1781269385_wp, -1.3404545521_wp, -0.0014447561_wp, &
+    3.1950752347_wp, 1.2993923915_wp, -0.0013802919_wp, &
+    -1.3405368625_wp, -3.1782313687_wp, 0.0013485110_wp, &
+    -1.2993730227_wp, 3.1954063105_wp, 0.0015601677_wp, &
+    1.2993044510_wp, -3.1951175719_wp, 0.0009977162_wp, &
+    1.3404668185_wp, 3.1782610779_wp, 0.0007763660_wp, &
+    -5.1398876580_wp, -2.0896976163_wp, 0.0007417474_wp, &
+    -5.1121989694_wp, 2.1560890106_wp, -0.0002704245_wp, &
+    5.1124825940_wp, -2.1559398160_wp, 0.0009894776_wp, &
+    5.1396923174_wp, 2.0898768932_wp, -0.0006786475_wp, &
+    -2.1559780569_wp, -5.1130969396_wp, -0.0013939168_wp, &
+    -2.0898182036_wp, 5.1398167921_wp, 0.0002326967_wp, &
+    2.0899305811_wp, -5.1394090818_wp, 0.0007171611_wp, &
+    2.1561490482_wp, 5.1124899088_wp, -0.0000599261_wp], &
+    [3,nat_d8h])
+
+  integer,parameter :: nat_dinfh = 3
+  integer,parameter :: at_dinfh(nat_dinfh) = [8,6,8]
+  real(wp),parameter :: xyz_dinfh(3,nat_dinfh) = reshape([ &
+    1.9258198936_wp, -0.1348886508_wp, -0.0823920590_wp, &
+    4.1878220648_wp, -0.1348886508_wp, -0.0823920590_wp, &
+    6.4498242360_wp, -0.1348886508_wp, -0.0823920590_wp], &
+    [3,nat_dinfh])
+
+  integer,parameter :: nat_s4 = 13
+  integer,parameter :: at_s4(nat_s4) = [6,6,6,6,6,9,1,9,1,9,1,1,9]
+  real(wp),parameter :: xyz_s4(3,nat_s4) = reshape([ &
+    2.3072044201_wp, -1.2009776440_wp, -0.8184403846_wp, &
+    2.4025600003_wp, 1.1865779309_wp, 0.8250733233_wp, &
+    0.0157792131_wp, 0.0560870714_wp, 0.0471297695_wp, &
+    -2.3250056402_wp, -0.7273555854_wp, 1.2698014694_wp, &
+    -2.3238340100_wp, 0.9671429333_wp, -1.0852886106_wp, &
+    2.8351938993_wp, -2.9734273653_wp, 0.0561248659_wp, &
+    2.8306207621_wp, -1.0219260937_wp, -2.7883475887_wp, &
+    2.9927025718_wp, 2.9301526371_wp, -0.0707324488_wp, &
+    2.9884506880_wp, 0.9771584818_wp, 2.7741368482_wp, &
+    -2.8216634602_wp, 0.1301454382_wp, 3.0596366711_wp, &
+    -2.9424736514_wp, -2.6640791987_wp, 1.0395383412_wp, &
+    -2.8250271727_wp, 2.9347824661_wp, -0.8342762895_wp, &
+    -2.9360107880_wp, 0.1393106099_wp, -2.8526360714_wp], &
+    [3,nat_s4])
+
+  integer,parameter :: nat_td = 5
+  integer,parameter :: at_td(nat_td) = [6,1,1,1,1]
+  real(wp),parameter :: xyz_td(3,nat_td) = reshape([ &
+    1.9771448552_wp, -0.1316194246_wp, -0.1036703752_wp, &
+    4.0411037285_wp, -0.1316194246_wp, -0.1036703752_wp, &
+    1.2891522650_wp, 0.5743255638_wp, 1.7096730195_wp, &
+    1.2891522650_wp, -2.0549826742_wp, -0.3989967740_wp, &
+    1.2891522650_wp, 1.0858177339_wp, -1.6217062684_wp], &
+    [3,nat_td])
+
+  integer,parameter :: nat_oh = 7
+  integer,parameter :: at_oh(nat_oh) = [9,16,9,9,9,9,9]
+  real(wp),parameter :: xyz_oh(3,nat_oh) = reshape([ &
+    1.5011606389_wp, 0.0480557353_wp, -0.1059758411_wp, &
+    4.8021909252_wp, 0.0480557353_wp, -0.1059758411_wp, &
+    4.8021909252_wp, -3.1466396619_wp, -0.9371340825_wp, &
+    4.8021909252_wp, 0.8791950795_wp, -3.3006523411_wp, &
+    8.1032212114_wp, 0.0480557353_wp, -0.1059758411_wp, &
+    4.8021909252_wp, 3.2427322353_wp, 0.7251635031_wp, &
+    4.8021909252_wp, -0.7831025060_wp, 3.0887006589_wp], &
+    [3,nat_oh])
+
+  integer,parameter :: nat_ih = 60
+  integer,parameter :: at_ih(nat_ih) = [6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, &
+    6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6]
+  real(wp),parameter :: xyz_ih(3,nat_ih) = reshape([ &
+    0.0000000000_wp, 2.3362684079_wp, 6.2880636797_wp, &
+    -2.2219399773_wp, 0.7218753796_wp, 6.2880636797_wp, &
+    -1.3732639748_wp, -1.8901040699_wp, 6.2880636797_wp, &
+    1.3732639748_wp, -1.8901040699_wp, 6.2880636797_wp, &
+    2.2219399773_wp, 0.7218753796_wp, 6.2880636797_wp, &
+    4.3552517994_wp, 1.4152158947_wp, 4.9017605947_wp, &
+    5.7285157742_wp, -0.4748881751_wp, 3.4578208628_wp, &
+    4.9136658693_wp, -2.9829326877_wp, 3.4578208628_wp, &
+    2.6917258919_wp, -3.7048080673_wp, 4.9017605947_wp, &
+    1.3184619172_wp, -5.5949121372_wp, 3.4578208628_wp, &
+    -1.3184619172_wp, -5.5949121372_wp, 3.4578208628_wp, &
+    -2.6917258919_wp, -3.7048080673_wp, 4.9017605947_wp, &
+    -4.9136658693_wp, -2.9829326877_wp, 3.4578208628_wp, &
+    -5.7285157742_wp, -0.4748881751_wp, 3.4578208628_wp, &
+    -4.3552517994_wp, 1.4152158947_wp, 4.9017605947_wp, &
+    -4.3552517994_wp, 3.7514843026_wp, 3.4578208628_wp, &
+    -5.7285157742_wp, 3.3051309920_wp, 1.1215524550_wp, &
+    -6.5771917768_wp, 0.6931515425_wp, 1.1215524550_wp, &
+    -6.5771917768_wp, -0.6931515425_wp, -1.1215524550_wp, &
+    -5.7285157742_wp, -3.3051309920_wp, -1.1215524550_wp, &
+    -4.9136658693_wp, -4.4268724195_wp, 1.1215524550_wp, &
+    -2.6917258919_wp, -6.0410764752_wp, 1.1215524550_wp, &
+    -1.3732639748_wp, -6.4694773877_wp, -1.1215524550_wp, &
+    1.3732639748_wp, -6.4694773877_wp, -1.1215524550_wp, &
+    2.6917258919_wp, -6.0410764752_wp, 1.1215524550_wp, &
+    4.9136658693_wp, -4.4268724195_wp, 1.1215524550_wp, &
+    5.7285157742_wp, -3.3051309920_wp, -1.1215524550_wp, &
+    6.5771917768_wp, -0.6931515425_wp, -1.1215524550_wp, &
+    6.5771917768_wp, 0.6931515425_wp, 1.1215524550_wp, &
+    5.7285157742_wp, 3.3051309920_wp, 1.1215524550_wp, &
+    4.9136658693_wp, 4.4268724195_wp, -1.1215524550_wp, &
+    4.9136658693_wp, 2.9829326877_wp, -3.4578208628_wp, &
+    5.7285157742_wp, 0.4748881751_wp, -3.4578208628_wp, &
+    4.3552517994_wp, -1.4152158947_wp, -4.9017605947_wp, &
+    4.3552517994_wp, -3.7514843026_wp, -3.4578208628_wp, &
+    2.2219399773_wp, -5.3014376700_wp, -3.4578208628_wp, &
+    0.0000000000_wp, -4.5795622904_wp, -4.9017605947_wp, &
+    -2.2219399773_wp, -5.3014376700_wp, -3.4578208628_wp, &
+    -4.3552517994_wp, -3.7514843026_wp, -3.4578208628_wp, &
+    -4.3552517994_wp, -1.4152158947_wp, -4.9017605947_wp, &
+    -5.7285157742_wp, 0.4748881751_wp, -3.4578208628_wp, &
+    -4.9136658693_wp, 2.9829326877_wp, -3.4578208628_wp, &
+    -4.9136658693_wp, 4.4268724195_wp, -1.1215524550_wp, &
+    -2.6917258919_wp, 6.0410764752_wp, -1.1215524550_wp, &
+    -1.3184619172_wp, 5.5949121372_wp, -3.4578208628_wp, &
+    -2.6917258919_wp, 3.7048080673_wp, -4.9017605947_wp, &
+    -1.3732639748_wp, 1.8901040699_wp, -6.2880636797_wp, &
+    -2.2219399773_wp, -0.7218753796_wp, -6.2880636797_wp, &
+    0.0000000000_wp, -2.3362684079_wp, -6.2880636797_wp, &
+    2.2219399773_wp, -0.7218753796_wp, -6.2880636797_wp, &
+    1.3732639748_wp, 1.8901040699_wp, -6.2880636797_wp, &
+    2.6917258919_wp, 3.7048080673_wp, -4.9017605947_wp, &
+    1.3184619172_wp, 5.5949121372_wp, -3.4578208628_wp, &
+    2.6917258919_wp, 6.0410764752_wp, -1.1215524550_wp, &
+    1.3732639748_wp, 6.4694773877_wp, 1.1215524550_wp, &
+    -1.3732639748_wp, 6.4694773877_wp, 1.1215524550_wp, &
+    -2.2219399773_wp, 5.3014376700_wp, 3.4578208628_wp, &
+    0.0000000000_wp, 4.5795622904_wp, 4.9017605947_wp, &
+    2.2219399773_wp, 5.3014376700_wp, 3.4578208628_wp, &
+    4.3552517994_wp, 3.7514843026_wp, 3.4578208628_wp], &
+    [3,nat_ih])
+
+!========================================================================================!
+!========================================================================================!
+contains  !> Unit tests for getsym point-group detection
+!========================================================================================!
+!========================================================================================!
+
+  subroutine collect_getsym(testsuite)
+    type(unittest_type),allocatable,intent(out) :: testsuite(:)
+!&<
+    testsuite = [ &
+      new_unittest("symmetry c1                   ",test_c1),    &
+      new_unittest("symmetry ci                   ",test_ci),    &
+      new_unittest("symmetry cs                   ",test_cs),    &
+      new_unittest("symmetry c2                   ",test_c2),    &
+      new_unittest("symmetry c2h                  ",test_c2h),   &
+      new_unittest("symmetry c2v                  ",test_c2v),   &
+      new_unittest("symmetry c3                   ",test_c3),    &
+      new_unittest("symmetry c3v                  ",test_c3v),   &
+      new_unittest("symmetry c4v                  ",test_c4v),   &
+      new_unittest("symmetry c5                   ",test_c5),    &
+      new_unittest("symmetry c5v                  ",test_c5v),   &
+      new_unittest("symmetry cinfv                ",test_cinfv), &
+      new_unittest("symmetry d2                   ",test_d2),    &
+      new_unittest("symmetry d2d                  ",test_d2d),   &
+      new_unittest("symmetry d2h                  ",test_d2h),   &
+      new_unittest("symmetry d3                   ",test_d3),    &
+      new_unittest("symmetry d3d                  ",test_d3d),   &
+      new_unittest("symmetry d3h                  ",test_d3h),   &
+      new_unittest("symmetry d4                   ",test_d4),    &
+      new_unittest("symmetry d4h                  ",test_d4h),   &
+      new_unittest("symmetry d5d                  ",test_d5d),   &
+      new_unittest("symmetry d5h                  ",test_d5h),   &
+      new_unittest("symmetry d6h                  ",test_d6h),   &
+      new_unittest("symmetry d7h                  ",test_d7h),   &
+      new_unittest("symmetry d8h                  ",test_d8h),   &
+      new_unittest("symmetry dinfh                ",test_dinfh), &
+      new_unittest("symmetry s4                   ",test_s4),    &
+      new_unittest("symmetry td                   ",test_td),    &
+      new_unittest("symmetry oh                   ",test_oh),    &
+      new_unittest("symmetry ih                   ",test_ih)     &
+    ]
+!&>
+  end subroutine collect_getsym
+
+!========================================================================================!
+
+  subroutine test_c1(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_c1,at_c1,xyz_c1,sfsym)
+    if (sfsym /= 'c1 ') call test_failed(error,'expected c1 , got: '//sfsym)
+  end subroutine test_c1
+
+  subroutine test_ci(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_ci,at_ci,xyz_ci,sfsym)
+    if (sfsym /= 'ci ') call test_failed(error,'expected ci , got: '//sfsym)
+  end subroutine test_ci
+
+  subroutine test_cs(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_cs,at_cs,xyz_cs,sfsym)
+    if (sfsym /= 'cs ') call test_failed(error,'expected cs , got: '//sfsym)
+  end subroutine test_cs
+
+  subroutine test_c2(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_c2,at_c2,xyz_c2,sfsym)
+    if (sfsym /= 'c2 ') call test_failed(error,'expected c2 , got: '//sfsym)
+  end subroutine test_c2
+
+  subroutine test_c2h(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_c2h,at_c2h,xyz_c2h,sfsym)
+    if (sfsym /= 'c2h') call test_failed(error,'expected c2h, got: '//sfsym)
+  end subroutine test_c2h
+
+  subroutine test_c2v(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_c2v,at_c2v,xyz_c2v,sfsym)
+    if (sfsym /= 'c2v') call test_failed(error,'expected c2v, got: '//sfsym)
+  end subroutine test_c2v
+
+  subroutine test_c3(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_c3,at_c3,xyz_c3,sfsym)
+    if (sfsym /= 'c3 ') call test_failed(error,'expected c3 , got: '//sfsym)
+  end subroutine test_c3
+
+  subroutine test_c3v(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_c3v,at_c3v,xyz_c3v,sfsym)
+    if (sfsym /= 'c3v') call test_failed(error,'expected c3v, got: '//sfsym)
+  end subroutine test_c3v
+
+  subroutine test_c4v(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_c4v,at_c4v,xyz_c4v,sfsym)
+    if (sfsym /= 'c4v') call test_failed(error,'expected c4v, got: '//sfsym)
+  end subroutine test_c4v
+
+  subroutine test_c5(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_c5,at_c5,xyz_c5,sfsym)
+    if (sfsym /= 'c5 ') call test_failed(error,'expected c5 , got: '//sfsym)
+  end subroutine test_c5
+
+  subroutine test_c5v(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_c5v,at_c5v,xyz_c5v,sfsym)
+    if (sfsym /= 'c5v') call test_failed(error,'expected c5v, got: '//sfsym)
+  end subroutine test_c5v
+
+  subroutine test_cinfv(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_cinfv,at_cinfv,xyz_cinfv,sfsym)
+    if (sfsym /= 'cin') call test_failed(error,'expected cin, got: '//sfsym)
+  end subroutine test_cinfv
+
+  subroutine test_d2(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d2,at_d2,xyz_d2,sfsym)
+    if (sfsym /= 'd2 ') call test_failed(error,'expected d2 , got: '//sfsym)
+  end subroutine test_d2
+
+  subroutine test_d2d(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d2d,at_d2d,xyz_d2d,sfsym)
+    if (sfsym /= 'd2d') call test_failed(error,'expected d2d, got: '//sfsym)
+  end subroutine test_d2d
+
+  subroutine test_d2h(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d2h,at_d2h,xyz_d2h,sfsym)
+    if (sfsym /= 'd2h') call test_failed(error,'expected d2h, got: '//sfsym)
+  end subroutine test_d2h
+
+  subroutine test_d3(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d3,at_d3,xyz_d3,sfsym)
+    if (sfsym /= 'd3 ') call test_failed(error,'expected d3 , got: '//sfsym)
+  end subroutine test_d3
+
+  subroutine test_d3d(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d3d,at_d3d,xyz_d3d,sfsym)
+    if (sfsym /= 'd3d') call test_failed(error,'expected d3d, got: '//sfsym)
+  end subroutine test_d3d
+
+  subroutine test_d3h(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d3h,at_d3h,xyz_d3h,sfsym)
+    if (sfsym /= 'd3h') call test_failed(error,'expected d3h, got: '//sfsym)
+  end subroutine test_d3h
+
+  subroutine test_d4(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d4,at_d4,xyz_d4,sfsym)
+    if (sfsym /= 'd4 ') call test_failed(error,'expected d4 , got: '//sfsym)
+  end subroutine test_d4
+
+  subroutine test_d4h(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d4h,at_d4h,xyz_d4h,sfsym)
+    if (sfsym /= 'd4h') call test_failed(error,'expected d4h, got: '//sfsym)
+  end subroutine test_d4h
+
+  subroutine test_d5d(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d5d,at_d5d,xyz_d5d,sfsym)
+    if (sfsym /= 'd5d') call test_failed(error,'expected d5d, got: '//sfsym)
+  end subroutine test_d5d
+
+  subroutine test_d5h(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d5h,at_d5h,xyz_d5h,sfsym)
+    if (sfsym /= 'd5h') call test_failed(error,'expected d5h, got: '//sfsym)
+  end subroutine test_d5h
+
+  subroutine test_d6h(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d6h,at_d6h,xyz_d6h,sfsym)
+    if (sfsym /= 'd6h') call test_failed(error,'expected d6h, got: '//sfsym)
+  end subroutine test_d6h
+
+  subroutine test_d7h(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d7h,at_d7h,xyz_d7h,sfsym)
+    if (sfsym /= 'd7h') call test_failed(error,'expected d7h, got: '//sfsym)
+  end subroutine test_d7h
+
+  subroutine test_d8h(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_d8h,at_d8h,xyz_d8h,sfsym)
+    if (sfsym /= 'd8h') call test_failed(error,'expected d8h, got: '//sfsym)
+  end subroutine test_d8h
+
+  subroutine test_dinfh(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_dinfh,at_dinfh,xyz_dinfh,sfsym)
+    if (sfsym /= 'din') call test_failed(error,'expected din, got: '//sfsym)
+  end subroutine test_dinfh
+
+  subroutine test_s4(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_s4,at_s4,xyz_s4,sfsym)
+    if (sfsym /= 's4 ') call test_failed(error,'expected s4 , got: '//sfsym)
+  end subroutine test_s4
+
+  subroutine test_td(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_td,at_td,xyz_td,sfsym)
+    if (sfsym /= 'td ') call test_failed(error,'expected td , got: '//sfsym)
+  end subroutine test_td
+
+  subroutine test_oh(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_oh,at_oh,xyz_oh,sfsym)
+    if (sfsym /= 'oh ') call test_failed(error,'expected oh , got: '//sfsym)
+  end subroutine test_oh
+
+  subroutine test_ih(error)
+    type(error_type),allocatable,intent(out) :: error
+    character(len=3) :: sfsym
+    call getsym(.false.,6,nat_ih,at_ih,xyz_ih,sfsym)
+    if (sfsym /= 'ih ') call test_failed(error,'expected ih , got: '//sfsym)
+  end subroutine test_ih
+
+end module test_getsym
diff --git a/test/test_gfnff.F90 b/test/test_gfnff.F90
index 6e5c9d46..4b03cfcf 100644
--- a/test/test_gfnff.F90
+++ b/test/test_gfnff.F90
@@ -192,32 +192,35 @@ subroutine test_gfnff_sp_anion(error)
     real(wp),allocatable :: grad(:,:)
     integer :: io
 !&<
-    real(wp),parameter :: e_ref = -5.722199796041350_wp
+    !> Reference values updated for gfnff v0.1.1: the neighbour-list and
+    !> Wigner-Seitz cell (WSC) rework changed energetics for charged systems.
+    !> Both energy and gradient references were regenerated from the v0.1.1 run.
+    real(wp),parameter :: e_ref = -5.828532820056295_wp
     real(wp),parameter :: g_ref(3,24) = reshape([&
-    &   0.004468921480142_wp,  -0.000083123134016_wp,   0.000001151477114_wp, &
-    &   0.026784240021401_wp,  -0.003317301163864_wp,   0.000007330730819_wp, &
-    &  -0.004004820272010_wp,  -0.030509909771367_wp,   0.000021392716860_wp, &
-    &  -0.000751769525558_wp,   0.005889324801531_wp,  -0.000022156837684_wp, &
-    &  -0.027788611671027_wp,  -0.033864525810969_wp,  -0.000006636279691_wp, &
-    &   0.026412943164910_wp,   0.030830470039288_wp,   0.000033495772036_wp, &
-    &  -0.017689873797001_wp,  -0.023514680185829_wp,  -0.000029972119517_wp, &
-    &   0.025299322245125_wp,   0.011384898053826_wp,   0.000001507574957_wp, &
-    &  -0.009184660893020_wp,   0.023372121393537_wp,  -0.000006131704134_wp, &
-    &  -0.001241048489363_wp,   0.005561107788044_wp,  -0.000016875281359_wp, &
-    &   0.002544027763531_wp,  -0.004003045629465_wp,  -0.000031756330103_wp, &
-    &  -0.029084734620249_wp,   0.020333106964323_wp,   0.000017800756382_wp, &
-    &  -0.000069352904917_wp,  -0.003305508039344_wp,  -0.000014616855913_wp, &
-    &  -0.003685271682472_wp,   0.001732297413329_wp,  -0.000073775627784_wp, &
-    &   0.001715180720526_wp,   0.002427255238024_wp,   0.000002864449221_wp, &
-    &   0.001895835509322_wp,  -0.000518306207627_wp,   0.003050902872775_wp, &
-    &   0.001898766998976_wp,  -0.000518624553391_wp,  -0.003057577541061_wp, &
-    &  -0.002685446613991_wp,   0.000991558499999_wp,   0.000012103424716_wp, &
-    &   0.003434143710645_wp,  -0.000161577974365_wp,   0.000003107935122_wp, &
-    &  -0.000493795408284_wp,   0.000908332349694_wp,   0.003287812553032_wp, &
-    &  -0.000484391594052_wp,   0.000916710811928_wp,  -0.003278674680856_wp, &
-    &  -0.001252234734786_wp,  -0.003284602467482_wp,   0.000045301985594_wp, &
-    &   0.001987099764679_wp,  -0.000604716538950_wp,   0.002853130443235_wp, &
-    &   0.001975530827471_wp,  -0.000661261876856_wp,  -0.002799729433761_wp &
+    &  3.94230543214767e-03_wp,  3.52030063768979e-04_wp,  1.81683057095039e-06_wp, &
+    &  1.51705975544829e-02_wp, -8.59644901931333e-03_wp, -1.30289855263585e-05_wp, &
+    & -3.32620665073756e-03_wp, -1.27838095920201e-02_wp,  3.07797052876764e-05_wp, &
+    &  4.93740063275844e-03_wp,  4.06512386391377e-03_wp, -2.14659925847723e-05_wp, &
+    & -2.31495929321227e-02_wp, -2.87916805922025e-02_wp, -3.22455640084147e-06_wp, &
+    &  2.05728120146893e-02_wp,  1.07842246816042e-02_wp,  5.58592835861545e-05_wp, &
+    & -3.57568867600167e-03_wp, -1.87642796677282e-03_wp, -2.53540979489806e-05_wp, &
+    &  5.05671257009310e-03_wp,  4.08216306711967e-03_wp, -5.09893176526027e-05_wp, &
+    & -2.48954902302761e-03_wp,  1.56793979443191e-02_wp,  3.18591292280463e-05_wp, &
+    & -4.61712459034876e-03_wp,  7.38892241260220e-03_wp, -2.69984802863847e-05_wp, &
+    &  6.67104429871043e-03_wp, -7.53862115125029e-03_wp, -3.64266870952139e-05_wp, &
+    & -2.31759261766794e-02_wp,  1.91389704080971e-02_wp,  6.34113639207092e-06_wp, &
+    &  6.05908705535911e-06_wp, -3.03220605329460e-03_wp, -1.40325040899702e-05_wp, &
+    & -3.98348638058101e-03_wp,  1.54809264373304e-03_wp, -5.64650422844910e-05_wp, &
+    &  1.71517910778865e-03_wp,  2.42726129127660e-03_wp,  2.86445331615998e-06_wp, &
+    &  1.89583331406671e-03_wp, -5.18309297446946e-04_wp,  3.05090837898127e-03_wp, &
+    &  1.89876480153798e-03_wp, -5.18627636530015e-04_wp, -3.05758305240559e-03_wp, &
+    & -2.71548970167826e-03_wp,  1.07706281565603e-03_wp,  1.41909698337930e-05_wp, &
+    &  3.43414680170101e-03_wp, -1.61582876165697e-04_wp,  3.10793153391831e-06_wp, &
+    & -4.93795501029164e-04_wp,  9.08335390055891e-04_wp,  3.28781757277625e-03_wp, &
+    & -4.84391692211688e-04_wp,  9.16713856580635e-04_wp, -3.27867969575159e-03_wp, &
+    & -1.25224049764651e-03_wp, -3.28460279557860e-03_wp,  4.53019960043941e-05_wp, &
+    &  1.98710257887371e-03_wp, -6.04718036417461e-04_wp,  2.85313550792252e-03_wp, &
+    &  1.97553362815908e-03_wp, -6.61263421734836e-04_wp, -2.79973448340641e-03_wp  &
     & ], shape(g_ref))
 !&>
 
diff --git a/test/test_graphs.F90 b/test/test_graphs.F90
new file mode 100644
index 00000000..c83c1b28
--- /dev/null
+++ b/test/test_graphs.F90
@@ -0,0 +1,241 @@
+module test_graphs
+  use testdrive,only:new_unittest,unittest_type,error_type,check,test_failed
+  use crest_parameters,only:wp
+  use adjacency
+  implicit none
+  private
+
+  public :: collect_graphs
+
+  real(wp),parameter :: thr = 1.0e-2_wp
+
+!========================================================================================!
+!========================================================================================!
+contains  !> Unit tests for the graph routines in adjacency.f90
+!========================================================================================!
+!========================================================================================!
+
+!> Collect all exported unit tests
+  subroutine collect_graphs(testsuite)
+    !> Collection of tests
+    type(unittest_type),allocatable,intent(out) :: testsuite(:)
+
+!&<
+    testsuite = [ &
+    new_unittest("wbo2adjacency thresholding    ",test_wbo2adjacency), &
+    new_unittest("setup_fragments components    ",test_setup_fragments), &
+    new_unittest("check_adjacent connectivity   ",test_check_adjacent), &
+    new_unittest("check_rings_min ring edges    ",test_check_rings_min), &
+    new_unittest("get_ring_min smallest ring    ",test_get_ring_min)  &
+    ]
+!&>
+  end subroutine collect_graphs
+
+!========================================================================================!
+
+!> A linear chain 1-2-3-4 encoded as a WBO matrix. wbo2adjacency must produce
+!> the symmetric 0/1 adjacency for bonds above the threshold only.
+  subroutine test_wbo2adjacency(error)
+    type(error_type),allocatable,intent(out) :: error
+    integer,parameter :: V = 4
+    real(wp) :: wbo(V,V)
+    integer,allocatable :: A(:,:)
+    integer :: i,j
+
+    wbo = 0.0_wp
+    !> chain bonds with bond orders ~1
+    call setbond_r(wbo,1,2,0.98_wp)
+    call setbond_r(wbo,2,3,1.05_wp)
+    call setbond_r(wbo,3,4,0.97_wp)
+    !> a weak through-space contribution that must be ignored
+    call setbond_r(wbo,1,4,0.01_wp)
+
+    call wbo2adjacency(V,wbo,A,0.02_wp)
+
+    call check(error,allocated(A))
+    if (allocated(error)) return
+    call check(error,size(A,1),V)
+    if (allocated(error)) return
+
+    !> expected adjacency of the chain
+    call check(error,A(1,2),1)
+    call check(error,A(2,3),1)
+    call check(error,A(3,4),1)
+    if (allocated(error)) return
+    !> non-bonds (incl. the sub-threshold 1-4 pair) must be zero
+    call check(error,A(1,3),0)
+    call check(error,A(2,4),0)
+    call check(error,A(1,4),0)
+    if (allocated(error)) return
+
+    !> matrix must be symmetric with a zero diagonal
+    do i = 1,V
+      call check(error,A(i,i),0)
+      if (allocated(error)) return
+      do j = 1,V
+        call check(error,A(i,j),A(j,i))
+        if (allocated(error)) return
+      end do
+    end do
+  end subroutine test_wbo2adjacency
+
+!========================================================================================!
+
+!> Two disconnected triangles {1,2,3} and {4,5,6}: setup_fragments must label
+!> them as exactly two connected components.
+  subroutine test_setup_fragments(error)
+    type(error_type),allocatable,intent(out) :: error
+    integer,parameter :: V = 6
+    integer :: A(V,V)
+    integer,allocatable :: frag(:)
+
+    call two_triangles(A)
+    call setup_fragments(V,A,frag)
+
+    call check(error,allocated(frag))
+    if (allocated(error)) return
+    call check(error,maxval(frag),2)
+    if (allocated(error)) return
+
+    !> all members of a triangle share one label, the two triangles differ
+    call check(error,frag(1),frag(2))
+    call check(error,frag(2),frag(3))
+    call check(error,frag(4),frag(5))
+    call check(error,frag(5),frag(6))
+    if (allocated(error)) return
+    if (frag(1) == frag(4)) then
+      call test_failed(error,"disconnected fragments share a label")
+    end if
+  end subroutine test_setup_fragments
+
+!========================================================================================!
+
+!> check_adjacent must report connectivity within a fragment and the lack of it
+!> across fragments of the two-triangle graph.
+  subroutine test_check_adjacent(error)
+    type(error_type),allocatable,intent(out) :: error
+    integer,parameter :: V = 6
+    integer :: A(V,V)
+    integer :: tmp(V)
+    logical :: conn
+
+    call two_triangles(A)
+
+    !> 1 and 3 are in the same triangle -> connected
+    tmp = 0
+    conn = check_adjacent(1,3,V,A,tmp)
+    call check(error,conn)
+    if (allocated(error)) return
+
+    !> 1 and 4 are in different triangles -> not connected
+    tmp = 0
+    conn = check_adjacent(1,4,V,A,tmp)
+    call check(error,.not.conn)
+  end subroutine test_check_adjacent
+
+!========================================================================================!
+
+!> A six-membered ring (1-2-3-4-5-6-1) with one dangling substituent (7 on 1).
+!> Every ring bond must be flagged, the dangling bond must not.
+  subroutine test_check_rings_min(error)
+    type(error_type),allocatable,intent(out) :: error
+    integer,parameter :: V = 7
+    integer :: A(V,V)
+    logical,allocatable :: rings(:,:)
+    integer :: i
+
+    call ring6_with_tail(A)
+    call check_rings_min(V,A,rings)
+
+    call check(error,allocated(rings))
+    if (allocated(error)) return
+
+    !> all six ring edges are part of a ring
+    do i = 1,5
+      call check(error,rings(i,i+1))
+      if (allocated(error)) return
+    end do
+    call check(error,rings(6,1))
+    if (allocated(error)) return
+
+    !> the dangling bond 1-7 is not part of any ring
+    call check(error,.not.rings(1,7))
+  end subroutine test_check_rings_min
+
+!========================================================================================!
+
+!> get_ring_min must recover the six-membered ring through the edge 1-2.
+  subroutine test_get_ring_min(error)
+    type(error_type),allocatable,intent(out) :: error
+    integer,parameter :: V = 7
+    integer :: A(V,V)
+    integer :: path(V),nring
+    integer :: i
+
+    call ring6_with_tail(A)
+    call get_ring_min(V,A,1,2,path,nring)
+
+    !> the smallest ring through 1-2 contains all six ring atoms
+    call check(error,nring,6)
+    if (allocated(error)) return
+
+    !> the dangling atom 7 must not be on the ring path
+    do i = 1,nring
+      if (path(i) == 7) then
+        call test_failed(error,"dangling atom included in ring path")
+        return
+      end if
+    end do
+  end subroutine test_get_ring_min
+
+!========================================================================================!
+!========================================================================================!
+!> shared helpers for building small test graphs
+!========================================================================================!
+!========================================================================================!
+
+!> set a symmetric real bond entry
+  subroutine setbond_r(M,i,j,val)
+    real(wp),intent(inout) :: M(:,:)
+    integer,intent(in) :: i,j
+    real(wp),intent(in) :: val
+    M(i,j) = val
+    M(j,i) = val
+  end subroutine setbond_r
+
+!> set a symmetric integer adjacency entry
+  subroutine setbond_i(A,i,j)
+    integer,intent(inout) :: A(:,:)
+    integer,intent(in) :: i,j
+    A(i,j) = 1
+    A(j,i) = 1
+  end subroutine setbond_i
+
+!> two disconnected triangles {1,2,3} and {4,5,6}
+  subroutine two_triangles(A)
+    integer,intent(out) :: A(6,6)
+    A = 0
+    call setbond_i(A,1,2)
+    call setbond_i(A,2,3)
+    call setbond_i(A,3,1)
+    call setbond_i(A,4,5)
+    call setbond_i(A,5,6)
+    call setbond_i(A,6,4)
+  end subroutine two_triangles
+
+!> six-membered ring 1-2-3-4-5-6-1 with a dangling atom 7 attached to 1
+  subroutine ring6_with_tail(A)
+    integer,intent(out) :: A(7,7)
+    A = 0
+    call setbond_i(A,1,2)
+    call setbond_i(A,2,3)
+    call setbond_i(A,3,4)
+    call setbond_i(A,4,5)
+    call setbond_i(A,5,6)
+    call setbond_i(A,6,1)
+    call setbond_i(A,1,7)
+  end subroutine ring6_with_tail
+
+!========================================================================================!
+!========================================================================================!
+end module test_graphs
diff --git a/test/test_irmsd.F90 b/test/test_irmsd.F90
new file mode 100644
index 00000000..1990f550
--- /dev/null
+++ b/test/test_irmsd.F90
@@ -0,0 +1,258 @@
+module test_irmsd
+  use testdrive,only:new_unittest,unittest_type,error_type,test_failed
+  use crest_parameters,only:wp,aatoau
+  use crest_testmol,only:get_testmol
+  use strucrd,only:coord
+  use irmsd_module,only:rmsd,irmsd
+  implicit none
+  private
+
+  public :: collect_irmsd
+
+  real(wp),parameter :: thr       = 1.0e-10_wp
+  real(wp),parameter :: thr_loose = 1.0e-3_wp
+
+!========================================================================================!
+!> H2 diatomic geometries in Bohr (centered at origin)
+!========================================================================================!
+
+  integer,parameter :: nat_h2 = 2
+  integer,parameter :: at_h2(nat_h2) = [1,1]
+  !> bond = 1.0 Bohr
+  real(wp),parameter :: xyz_h2_ref(3,nat_h2) = reshape([ &
+    & 0.5_wp, 0.0_wp, 0.0_wp,  &
+    &-0.5_wp, 0.0_wp, 0.0_wp], &
+    & [3,nat_h2])
+  !> bond = 2.0 Bohr → analytical RMSD vs ref = 0.5 Bohr
+  real(wp),parameter :: xyz_h2_mol(3,nat_h2) = reshape([ &
+    & 1.0_wp, 0.0_wp, 0.0_wp,  &
+    &-1.0_wp, 0.0_wp, 0.0_wp], &
+    & [3,nat_h2])
+
+!========================================================================================!
+!> Fluoxetine (40 atoms, Angstrom) — struc1 and struc2 from the iRMSD paper example.
+!> Both represent the same conformer; struc2 has completely scrambled atom order
+!> and a random rotation applied. iRMSD must return ≈ 0.
+!========================================================================================!
+
+  integer,parameter :: nat_fluo = 40
+
+  !> struc1 atom types (Z)
+  integer,parameter :: at_fluo1(nat_fluo) = [ &
+    & 6,9,1,1,6,1,6,9,9,7, &
+    & 6,1,8,6,6,6,6,6,1,6, &
+    & 1,6,1,1,1,1,1,1,1,6, &
+    & 1,1,1,1,6,6,1,6,6,6]
+
+  !> struc1 coordinates, Angstrom
+  real(wp),parameter :: xyz_fluo1_ang(3,nat_fluo) = reshape([ &
+    &-0.0198_wp, 0.2158_wp, 0.5308_wp, &
+    &-5.0246_wp,-0.2464_wp, 0.5593_wp, &
+    &-2.0207_wp, 0.0761_wp, 3.2888_wp, &
+    & 2.0221_wp, 5.0303_wp, 0.4892_wp, &
+    &-0.4032_wp, 0.2003_wp, 1.8748_wp, &
+    & 1.4542_wp, 5.1890_wp,-1.1937_wp, &
+    & 2.1773_wp, 2.6686_wp,-0.7626_wp, &
+    &-4.6775_wp, 0.8294_wp, 2.4172_wp, &
+    &-4.3667_wp,-1.3218_wp, 2.3289_wp, &
+    & 3.0555_wp, 3.8290_wp,-0.9233_wp, &
+    & 2.3371_wp, 5.0467_wp,-0.5601_wp, &
+    & 3.7051_wp, 1.1947_wp,-0.3434_wp, &
+    & 1.3305_wp, 0.2076_wp, 0.3364_wp, &
+    &-2.3576_wp, 0.1386_wp,-0.0950_wp, &
+    & 3.3367_wp,-3.7475_wp,-2.0944_wp, &
+    &-2.7426_wp, 0.0481_wp, 1.2484_wp, &
+    &-4.1855_wp,-0.1659_wp, 1.6292_wp, &
+    & 2.4651_wp,-1.1750_wp,-1.3319_wp, &
+    & 1.7906_wp, 2.6512_wp, 0.2660_wp, &
+    & 2.8963_wp, 1.3473_wp,-1.0679_wp, &
+    & 1.3203_wp, 2.7752_wp,-1.4405_wp, &
+    & 1.8806_wp, 0.1908_wp,-0.9905_wp, &
+    &-0.7865_wp, 0.2662_wp,-1.5101_wp, &
+    & 3.3527_wp, 1.3925_wp,-2.0651_wp, &
+    & 1.1282_wp, 0.3962_wp,-1.7541_wp, &
+    & 2.8529_wp,-0.6554_wp,-3.3999_wp, &
+    & 2.9547_wp,-4.3108_wp,-0.0530_wp, &
+    & 3.8626_wp, 3.7250_wp,-0.3037_wp, &
+    & 0.3581_wp, 0.2294_wp, 2.6522_wp, &
+    &-1.7511_wp, 0.1165_wp, 2.2345_wp, &
+    & 2.9886_wp, 5.9146_wp,-0.7002_wp, &
+    & 2.1980_wp,-2.0723_wp, 0.6278_wp, &
+    & 3.6193_wp,-2.9009_wp,-4.0530_wp, &
+    &-3.1084_wp, 0.1174_wp,-0.8845_wp, &
+    & 2.5162_wp,-2.2260_wp,-0.4015_wp, &
+    &-1.0075_wp, 0.2216_wp,-0.4508_wp, &
+    & 3.6502_wp,-4.7430_wp,-2.3936_wp, &
+    & 2.9433_wp,-3.5025_wp,-0.7811_wp, &
+    & 2.8862_wp,-1.4373_wp,-2.6475_wp, &
+    & 3.3158_wp,-2.7117_wp,-3.0256_wp], &
+    & [3,nat_fluo])
+
+  !> struc2 atom types (Z) — scrambled order
+  integer,parameter :: at_fluo2(nat_fluo) = [ &
+    & 6,1,6,6,6,6,1,1,1,1, &
+    & 1,1,6,1,6,6,6,1,9,6, &
+    & 1,6,6,9,1,1,1,1,1,1, &
+    & 6,9,1,1,6,6,7,8,6,6]
+
+  !> struc2 coordinates, Angstrom — scrambled + rotated
+  real(wp),parameter :: xyz_fluo2_ang(3,nat_fluo) = reshape([ &
+    &-0.2470_wp,-1.0143_wp,-0.4213_wp, &
+    & 0.0828_wp, 4.2564_wp,-4.4517_wp, &
+    &-2.1193_wp, 2.6178_wp, 0.0144_wp, &
+    & 1.2089_wp,-1.8204_wp, 1.8160_wp, &
+    & 0.0619_wp,-0.0804_wp, 0.5643_wp, &
+    & 0.9632_wp,-2.7436_wp, 0.7925_wp, &
+    &-5.9431_wp, 1.8117_wp, 2.4085_wp, &
+    &-3.2933_wp, 0.8099_wp, 0.1366_wp, &
+    & 2.4555_wp, 4.5828_wp,-3.8102_wp, &
+    &-0.0328_wp,-3.0384_wp,-1.1072_wp, &
+    &-3.9856_wp, 3.0777_wp, 1.8789_wp, &
+    &-2.4640_wp, 1.2332_wp, 1.6473_wp, &
+    &-0.4255_wp, 3.2037_wp,-2.6383_wp, &
+    & 1.7581_wp, 2.5331_wp,-0.1112_wp, &
+    & 1.3640_wp, 2.9121_wp,-1.0521_wp, &
+    & 1.5502_wp,-4.1306_wp, 0.8575_wp, &
+    &-5.0208_wp, 1.3357_wp, 2.0622_wp, &
+    &-4.4695_wp, 0.9920_wp, 2.9447_wp, &
+    & 1.1253_wp,-4.8340_wp, 1.9430_wp, &
+    & 2.2338_wp, 3.5914_wp,-1.9111_wp, &
+    &-1.7744_wp, 3.4140_wp, 0.6847_wp, &
+    & 0.4427_wp, 3.8850_wp,-3.4947_wp, &
+    & 0.7599_wp,-0.5019_wp, 1.6995_wp, &
+    & 1.2525_wp,-4.8990_wp,-0.2270_wp, &
+    &-1.3360_wp, 1.0931_wp,-1.2358_wp, &
+    & 1.7763_wp,-2.1151_wp, 2.6974_wp, &
+    & 0.9785_wp, 0.2106_wp, 2.4926_wp, &
+    &-5.3029_wp, 0.4654_wp, 1.4587_wp, &
+    &-0.8129_wp,-0.7679_wp,-1.3112_wp, &
+    &-2.6932_wp, 3.0927_wp,-0.7916_wp, &
+    &-0.9181_wp, 1.8428_wp,-0.5615_wp, &
+    & 2.9112_wp,-4.1100_wp, 0.9336_wp, &
+    &-1.4519_wp, 3.0470_wp,-2.9556_wp, &
+    & 3.2752_wp, 3.7325_wp,-1.6299_wp, &
+    & 1.7755_wp, 4.0721_wp,-3.1352_wp, &
+    & 0.0230_wp, 2.6924_wp,-1.4078_wp, &
+    &-4.2396_wp, 2.2887_wp, 1.2797_wp, &
+    &-0.2303_wp, 1.2522_wp, 0.5528_wp, &
+    &-3.0176_wp, 1.6462_wp, 0.7923_wp, &
+    & 0.1996_wp,-2.3349_wp,-0.3081_wp], &
+    & [3,nat_fluo])
+
+!========================================================================================!
+!========================================================================================!
+contains  !> Unit tests for rmsd and irmsd
+!========================================================================================!
+!========================================================================================!
+
+  subroutine collect_irmsd(testsuite)
+    !***********************************
+    !* Register all irmsd test cases.  *
+    !***********************************
+    type(unittest_type),allocatable,intent(out) :: testsuite(:)
+!&<
+    testsuite = [ &
+      new_unittest("RMSD self comparison            ",test_rmsd_self),           &
+      new_unittest("RMSD H2 bond-stretch (known val)",test_rmsd_h2_bondstretch), &
+      new_unittest("iRMSD self comparison           ",test_irmsd_self),          &
+      new_unittest("iRMSD scrambled atom order      ",test_irmsd_scrambled)      &
+    ]
+!&>
+  end subroutine collect_irmsd
+
+!========================================================================================!
+
+  subroutine test_rmsd_self(error)
+    !*****************************************************
+    !* RMSD of a structure compared to itself must be 0. *
+    !*****************************************************
+    type(error_type),allocatable,intent(out) :: error
+    type(coord) :: mol
+    real(wp) :: rmsdval
+    call get_testmol('caffeine',mol)
+    rmsdval = rmsd(mol,mol)
+    if (abs(rmsdval) > 1.0e-6_wp) &
+      call test_failed(error,'RMSD(mol,mol) should be 0, got: '//to_str(rmsdval))
+  end subroutine test_rmsd_self
+
+!========================================================================================!
+
+  subroutine test_rmsd_h2_bondstretch(error)
+    !*************************************************************
+    !* Two H2 molecules with different bond lengths (1 and 2 Bohr).
+    !* Both centered at origin; no rotation needed for alignment.
+    !* Analytical RMSD = sqrt((0.5^2 + 0.5^2)/2) = 0.5 Bohr.
+    !*************************************************************
+    type(error_type),allocatable,intent(out) :: error
+    type(coord) :: ref,mol
+    real(wp) :: rmsdval
+    real(wp),parameter :: expected = 0.5_wp
+
+    ref%nat = nat_h2
+    allocate(ref%at(nat_h2),ref%xyz(3,nat_h2))
+    ref%at  = at_h2
+    ref%xyz = xyz_h2_ref
+
+    mol%nat = nat_h2
+    allocate(mol%at(nat_h2),mol%xyz(3,nat_h2))
+    mol%at  = at_h2
+    mol%xyz = xyz_h2_mol
+
+    rmsdval = rmsd(ref,mol)
+    if (abs(rmsdval - expected) > thr) &
+      call test_failed(error,'Expected RMSD = 0.5 Bohr, got: '//to_str(rmsdval))
+  end subroutine test_rmsd_h2_bondstretch
+
+!========================================================================================!
+
+  subroutine test_irmsd_self(error)
+    !*******************************************************
+    !* iRMSD of a structure compared to itself must be 0.  *
+    !*******************************************************
+    type(error_type),allocatable,intent(out) :: error
+    type(coord) :: mol
+    real(wp) :: rmsdval
+    call get_testmol('caffeine',mol)
+    rmsdval = irmsd(mol,mol,topocheck=.false.)
+    if (rmsdval > thr_loose) &
+      call test_failed(error,'iRMSD(mol,mol) should be ~0, got: '//to_str(rmsdval))
+  end subroutine test_irmsd_self
+
+!========================================================================================!
+
+  subroutine test_irmsd_scrambled(error)
+    !***********************************************************************
+    !* Two copies of the same fluoxetine conformer (40 atoms).             *
+    !* struc2 has fully randomised atom order and a random rotation.       *
+    !* iRMSD must find the correct permutation and return ≈ 0 Å.          *
+    !***********************************************************************
+    type(error_type),allocatable,intent(out) :: error
+    type(coord) :: mol1,mol2
+    real(wp) :: rmsdval
+
+    mol1%nat = nat_fluo
+    allocate(mol1%at(nat_fluo),mol1%xyz(3,nat_fluo))
+    mol1%at  = at_fluo1
+    mol1%xyz = xyz_fluo1_ang * aatoau
+
+    mol2%nat = nat_fluo
+    allocate(mol2%at(nat_fluo),mol2%xyz(3,nat_fluo))
+    mol2%at  = at_fluo2
+    mol2%xyz = xyz_fluo2_ang * aatoau
+
+    rmsdval = irmsd(mol1,mol2,topocheck=.false.)
+    if (rmsdval > thr_loose) &
+      call test_failed(error,'iRMSD of identical fluoxetine (scrambled) should be ~0, got: '//to_str(rmsdval))
+  end subroutine test_irmsd_scrambled
+
+!========================================================================================!
+
+  pure function to_str(x) result(s)
+    !> Minimal real→string helper for error messages.
+    real(wp),intent(in) :: x
+    character(len=32) :: s
+    write(s,'(es16.8)') x
+    s = adjustl(s)
+  end function to_str
+
+end module test_irmsd
diff --git a/test/test_molecular_dynamics.F90 b/test/test_molecular_dynamics.F90
new file mode 100644
index 00000000..47b27ed1
--- /dev/null
+++ b/test/test_molecular_dynamics.F90
@@ -0,0 +1,375 @@
+module test_molecular_dynamics
+  use testdrive,only:new_unittest,unittest_type,error_type,check,test_failed
+  use crest_parameters
+  use crest_calculator
+  use strucrd
+  use crest_testmol
+  use dynamics_module
+  use iomod,only:remove
+  implicit none
+  private
+
+  public :: collect_mol_dynamics
+
+  real(wp),parameter :: thr = 5e+6_wp*epsilon(1.0_wp)
+
+!========================================================================================!
+!========================================================================================!
+contains  !> Unit tests for using molecular dynamics routines in CREST
+!========================================================================================!
+!========================================================================================!
+
+!> Collect all exported unit tests
+  subroutine collect_mol_dynamics(testsuite)
+    !> Collection of tests
+    type(unittest_type),allocatable,intent(out) :: testsuite(:)
+
+!&<
+    testsuite = [ &
+#ifdef WITH_GFNFF
+    new_unittest("Compiled gfnff subproject     ",test_compiled_gfnff), &
+    new_unittest("molecular dynamics (SHAKE off)",test_md_shake_off), &
+    new_unittest("molecular dynamics (SHAKE on) ",test_md_shake_on), &
+    new_unittest("molecular dynamics (SHAKE H)  ",test_md_shake_honly), &
+    new_unittest("thermostat: berendsen         ",test_md_thermostat_berendsen), &
+    new_unittest("thermostat: bussi (CSVR)      ",test_md_thermostat_bussi), &
+    new_unittest("thermostat: langevin (BBK)    ",test_md_thermostat_langevin) &
+#else
+    new_unittest("Compiled gfnff subproject",test_compiled_gfnff,should_fail=.true.) &
+#endif
+    ]
+!&>
+
+  end subroutine collect_mol_dynamics
+
+!========================================================================================!
+
+  subroutine test_compiled_gfnff(error)
+    type(error_type),allocatable,intent(out) :: error
+#ifndef WITH_GFNFF
+    write (*,'("       ...")') 'gfnff not compiled, expecting fail.'
+    allocate (error)
+#endif
+  end subroutine test_compiled_gfnff
+
+!========================================================================================!
+!  The three MD tests below intentionally only set up the shared infrastructure (calcdata
+!  and a test molecule) and provide placeholders for the MD-specific calls/checks.
+!  Fill the marked sections with your MD driver + assertions.
+!========================================================================================!
+
+  subroutine test_md_shake_off(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(calcdata) :: calc
+    type(calculation_settings) :: sett
+    type(coord) :: mol
+    type(mddata) :: mdyn
+    integer :: io
+    logical :: pr
+
+    !> setup calculator backend
+    call sett%create('gfnff')
+    call calc%add(sett)
+
+    !> test molecule
+    call get_testmol('methane',mol)
+
+    !> MD setup
+    pr = .false.
+    io = 0
+    mdyn%length_ps = 200.0_wp
+    call mdyn%defaults()
+    mdyn%shake = .false.
+    mdyn%restart = .true. !> turn on restart reading (for determinic results)
+    mdyn%wrtrj = .false. !> turn off trajectory dump
+    call write_fake_restart(mol,mdyn%restartfile)
+
+    !> run
+    call dynamics(mol,mdyn,calc,pr,io)
+
+    !> cleanup
+    call remove(mdyn%restartfile)
+    call remove('crest_0.mdrestart')
+
+    !> checks
+    call check(error,io,0)
+    if (allocated(error)) return
+    !> Average temperature must be within ±50 K of thermostat target (compiler-portable)
+    call check(error,mdyn%Tavg,mdyn%tsoll,thr=50.0_wp)
+    if (allocated(error)) return
+  end subroutine test_md_shake_off
+
+!========================================================================================!
+
+  subroutine test_md_shake_on(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(calcdata) :: calc
+    type(calculation_settings) :: sett
+    type(coord) :: mol
+    type(mddata) :: mdyn
+    integer :: io,i,ia,ib
+    logical :: wr,pr
+    real(wp) :: d
+
+    !> setup calculator backend
+    call sett%create('gfnff')
+    call calc%add(sett)
+
+    !> get test molecule
+    call get_testmol('methane',mol)
+
+    !> MD setup
+    pr = .false.
+    io = 0
+    mdyn%length_ps = 50.0_wp
+    mdyn%Tsoll = 450.0_wp
+    call mdyn%defaults()
+    mdyn%shake = .true.
+    mdyn%restart = .true. !> turn on restart reading (for determinic results)
+    mdyn%wrtrj = .false. !> turn off trajectory dump
+    call write_fake_restart(mol,mdyn%restartfile)
+
+    !> run
+    call dynamics(mol,mdyn,calc,pr,io)
+
+    !> cleanup
+    call remove(mdyn%restartfile)
+    call remove('crest_0.mdrestart')
+
+    !> checks
+    call check(error,io,0)
+    if (allocated(error)) return
+    !> Average temperature must be within ±50 K of thermostat target (compiler-portable)
+    call check(error,mdyn%Tavg,mdyn%tsoll,thr=50.0_wp)
+    if (allocated(error)) return
+    !> SHAKE: all constrained bonds must satisfy their target lengths
+    do i = 1,mdyn%shk%ncons
+      ia = mdyn%shk%conslist(1,i)
+      ib = mdyn%shk%conslist(2,i)
+      d = norm2(mol%xyz(:,ia)-mol%xyz(:,ib))
+      call check(error,d**2,mdyn%shk%distcons(i),thr=1e-4_wp)
+      if (allocated(error)) return
+    end do
+  end subroutine test_md_shake_on
+
+!========================================================================================!
+
+  subroutine test_md_shake_honly(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(calcdata) :: calc
+    type(calculation_settings) :: sett
+    type(coord) :: mol
+
+    type(mddata) :: mdyn
+    integer :: io,i,ia,ib
+    logical :: wr,pr
+    real(wp) :: d
+
+    !> setup calculator backend
+    call sett%create('gfnff')
+    call calc%add(sett)
+
+    !> get test molecule
+    call get_testmol('caffeine',mol)
+
+    !> MD setup
+    pr = .false.
+    io = 0
+    mdyn%length_ps = 10.0_wp  !> shorter runtime because the mol is larger
+    call mdyn%defaults()
+    mdyn%shake = .true.
+    mdyn%shk%shake_mode = 1
+    mdyn%restart = .true. !> turn on restart reading (for determinic results)
+    mdyn%wrtrj = .false. !> turn off trajectory dump
+    call write_fake_restart(mol,mdyn%restartfile)
+
+    !> run
+    call dynamics(mol,mdyn,calc,pr,io)
+
+    !> cleanup
+    call remove(mdyn%restartfile)
+    call remove('crest_0.mdrestart')
+
+    !> checks
+    call check(error,io,0)
+    if (allocated(error)) return
+    !> Average temperature must be within ±50 K of thermostat target (compiler-portable)
+    call check(error,mdyn%Tavg,mdyn%tsoll,thr=50.0_wp)
+    if (allocated(error)) return
+    !> SHAKE: all constrained bonds must satisfy their target lengths
+    do i = 1,mdyn%shk%ncons
+      ia = mdyn%shk%conslist(1,i)
+      ib = mdyn%shk%conslist(2,i)
+      d = norm2(mol%xyz(:,ia)-mol%xyz(:,ib))
+      call check(error,d**2,mdyn%shk%distcons(i),thr=1e-4_wp)
+      if (allocated(error)) return
+    end do
+  end subroutine test_md_shake_honly
+
+!========================================================================================!
+
+  subroutine test_md_thermostat_berendsen(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(calcdata) :: calc
+    type(calculation_settings) :: sett
+    type(coord) :: mol
+    type(mddata) :: mdyn
+    integer :: io
+    logical :: pr
+
+    call sett%create('gfnff')
+    call calc%add(sett)
+    call get_testmol('methane',mol)
+
+    pr = .false.
+    io = 0
+    mdyn%length_ps = 50.0_wp
+    mdyn%tstep = 1.0_wp
+    call mdyn%defaults()
+    mdyn%shake = .false.
+    mdyn%samerand = .true.   !> deterministic RNG seed
+    mdyn%thermotype = 'berendsen'
+    mdyn%thermo_damp = 500.0_wp
+    mdyn%restart = .true.
+    mdyn%wrtrj = .false.
+    call write_fake_restart(mol,mdyn%restartfile)
+
+    call dynamics(mol,mdyn,calc,pr,io)
+
+    call remove(mdyn%restartfile)
+    call remove('crest_0.mdrestart')
+
+    !> Simulation must complete without error
+    call check(error,io,0)
+    if (allocated(error)) return
+    !> Average temperature within ±50 K of target.
+    !> Berendsen's distinguishing property is deterministic (non-stochastic) convergence;
+    !> with τ=500 fs >> dt, scal≈1 each step so variance stays near canonical — no variance check.
+    call check(error,mdyn%Tavg,mdyn%tsoll,thr=50.0_wp)
+    if (allocated(error)) return
+  end subroutine test_md_thermostat_berendsen
+
+!========================================================================================!
+
+  subroutine test_md_thermostat_bussi(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(calcdata) :: calc
+    type(calculation_settings) :: sett
+    type(coord) :: mol
+    type(mddata) :: mdyn
+    integer :: io
+    logical :: pr
+    real(wp) :: tvar
+
+    call sett%create('gfnff')
+    call calc%add(sett)
+    call get_testmol('caffeine',mol)
+
+    pr = .false.
+    io = 0
+    mdyn%length_ps = 25.0_wp
+    call mdyn%defaults()
+    mdyn%shake = .false.
+    mdyn%samerand = .true.   !> deterministic RNG seed
+    mdyn%thermotype = 'bussi'
+    mdyn%thermo_damp = 500.0_wp
+    mdyn%restart = .true.
+    mdyn%wrtrj = .false.
+    call write_fake_restart(mol,mdyn%restartfile,tstart=300.0_wp)
+
+    call dynamics(mol,mdyn,calc,pr,io)
+
+    call remove(mdyn%restartfile)
+    call remove('crest_0.mdrestart')
+
+    !> Simulation must complete without error
+    call check(error,io,0)
+    if (allocated(error)) return
+    !> Average temperature within ±50 K of target
+    call check(error,mdyn%Tavg,mdyn%tsoll,thr=50.0_wp)
+    if (allocated(error)) return
+    !> Bussi samples the canonical NVT ensemble: Tvar must be close to the
+    !> canonical reference 2*<T>^2/Ndf. We check Tvar > 10% of canonical —
+    !> 10x margin below the expected ~100%, and far above Berendsen's ~0.1%.
+    tvar = mdyn%Tvar
+    if (tvar < 0.1_wp*(2.0_wp*mdyn%Tavg**2/real(mdyn%Ndf,wp))) then
+      call test_failed(error,'Bussi thermostat does not show canonical T fluctuations: '// &
+        & 'expected Tvar ~ 2*Tavg^2/Ndf')
+      return
+    end if
+  end subroutine test_md_thermostat_bussi
+
+!========================================================================================!
+
+  subroutine test_md_thermostat_langevin(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(calcdata) :: calc
+    type(calculation_settings) :: sett
+    type(coord) :: mol
+    type(mddata) :: mdyn
+    integer :: io
+    logical :: pr
+    real(wp) :: tvar
+
+    call sett%create('gfnff')
+    call calc%add(sett)
+    call get_testmol('caffeine',mol)
+
+    pr = .false.
+    io = 0
+    mdyn%length_ps = 25.0_wp
+    call mdyn%defaults()
+    mdyn%shake = .false.
+    mdyn%samerand = .true.   !> deterministic RNG seed
+    mdyn%thermotype = 'langevin'
+    mdyn%thermo_damp = 298.15_wp
+    mdyn%restart = .true.
+    mdyn%wrtrj = .false.
+    call write_fake_restart(mol,mdyn%restartfile)
+
+    call dynamics(mol,mdyn,calc,pr,io)
+
+    call remove(mdyn%restartfile)
+    call remove('crest_0.mdrestart')
+
+    !> Simulation must complete without error
+    call check(error,io,0)
+    if (allocated(error)) return
+    !> Average temperature within ±50 K of target (equipartition theorem)
+    call check(error,mdyn%Tavg,mdyn%tsoll,thr=50.0_wp)
+    if (allocated(error)) return
+    !> Langevin (BBK) samples the canonical NVT ensemble via per-atom stochastic
+    !> friction: Tvar must be close to the canonical reference 2*<T>^2/Ndf.
+    !> We check Tvar > 10% of canonical — same criterion as for Bussi.
+    tvar = mdyn%Tvar
+    if (tvar < 0.1_wp*(2.0_wp*mdyn%Tavg**2/real(mdyn%Ndf,wp))) then
+      call test_failed(error,'Langevin thermostat does not show canonical T fluctuations: '// &
+        & 'expected Tvar ~ 2*Tavg^2/Ndf')
+      return
+    end if
+  end subroutine test_md_thermostat_langevin
+
+!========================================================================================!
+
+  subroutine write_fake_restart(mol,restartfile,tstart)
+    implicit none
+    type(coord),intent(in) :: mol
+    character(len=:),allocatable,intent(out) :: restartfile
+    real(wp),intent(in),optional :: tstart
+    integer :: ich,ii
+    restartfile = 'crest_test.mdrestart'
+    open (newunit=ich,file=restartfile)
+    if (present(tstart)) then
+      write (ich,*) tstart
+    else
+      write (ich,*) 500.0_wp
+    end if
+    do ii = 1,mol%nat
+      write (ich,'(6D22.14)') mol%xyz(1:3,ii),mol%xyz(1:3,ii)*0.00005_wp
+    end do
+    close (ich)
+  end subroutine write_fake_restart
+
+!========================================================================================!
+!========================================================================================!
+end module test_molecular_dynamics
diff --git a/test/test_optimization.F90 b/test/test_optimization.F90
index 6f01e39b..187cfd31 100644
--- a/test/test_optimization.F90
+++ b/test/test_optimization.F90
@@ -59,7 +59,7 @@ subroutine test_ancopt(error)
     integer :: io
     logical :: wr,pr
 !&<
-    real(wp),parameter :: e_ref = -4.677663337455959_wp
+    real(wp),parameter :: e_ref = -4.677661756_wp
 !&>
 
     !> setup
diff --git a/test/test_tblite.F90 b/test/test_tblite.F90
index fecefd74..97916c5f 100644
--- a/test/test_tblite.F90
+++ b/test/test_tblite.F90
@@ -33,7 +33,8 @@ subroutine collect_tblite(testsuite)
     new_unittest("GFN2-xTB singlepoint (anion)  ",test_gfn2_sp_anion), &
     new_unittest("GFN2-xTB singlepoint (S1)     ",test_gfn2_sp_uhf), &
     new_unittest("GFN2-xTB singlepoint (ALPB)   ",test_gfn2_sp_alpb), &
-    new_unittest("GFN1-xTB singlepoint          ",test_gfn1_sp) &
+    new_unittest("GFN1-xTB singlepoint          ",test_gfn1_sp), &
+    new_unittest("GFN2-xTB spin-polarized       ",test_gfn2_sp_spinpol) &
 #else
     new_unittest("Compiled tblite subproject",test_compiled_tblite,should_fail=.true.) &
 #endif
@@ -409,6 +410,50 @@ subroutine test_gfn1_sp(error)
     deallocate (grad)
   end subroutine test_gfn1_sp
 
+!========================================================================================!
+
+  subroutine test_gfn2_sp_spinpol(error)
+    type(error_type),allocatable,intent(out) :: error
+    type(calcdata) :: calc1,calc2
+    type(calculation_settings) :: sett
+    type(coord) :: mol
+    real(wp) :: e_nospin,e_spinpol
+    real(wp),allocatable :: grad(:,:)
+    integer :: io
+
+    call get_testmol('co_cnx6',mol)
+    allocate (grad(3,mol%nat))
+
+    !> without spin-polarization
+    call sett%create('gfn2')
+    sett%chrg = mol%chrg
+    sett%uhf  = mol%uhf
+    sett%spin_polarized = .false.
+    call calc1%add(sett)
+    call engrad(mol,calc1,e_nospin,grad,io)
+    call check(error,io,0)
+    if (allocated(error)) return
+
+    !> with spin-polarization
+    call sett%create('gfn2')
+    sett%chrg = mol%chrg
+    sett%uhf  = mol%uhf
+    sett%spin_polarized = .true.
+    call calc2%add(sett)
+    call engrad(mol,calc2,e_spinpol,grad,io)
+    call check(error,io,0)
+    if (allocated(error)) return
+
+    !> spin-polarization must lower the energy of this open-shell complex
+    if (e_spinpol >= e_nospin) then
+      call test_failed(error,"spin-polarized energy is not lower than non-spin-polarized energy")
+      write(*,'("  e_nospin  =",f20.10)') e_nospin
+      write(*,'("  e_spinpol =",f20.10)') e_spinpol
+    end if
+
+    deallocate (grad)
+  end subroutine test_gfn2_sp_spinpol
+
 !========================================================================================!
 !========================================================================================!
 end module test_tblite
diff --git a/test/testmol.f90 b/test/testmol.f90
index 452fef0c..375fce14 100644
--- a/test/testmol.f90
+++ b/test/testmol.f90
@@ -53,6 +53,27 @@ module crest_testmol
 !&>
 
 
+!&<
+  !> [Co(CN)6]^3- , charge=-3, high-spin uhf=4
+  integer,parameter  :: co_cnx6_nat = 13
+  integer,parameter  :: co_cnx6_at(co_cnx6_nat) = [27, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7]
+  real(wp),parameter :: co_cnx6_xyz(3,co_cnx6_nat) = reshape([ &
+    &  3.68215_wp,  0.36449_wp, -0.34727_wp, &  ! Co
+    &  3.43538_wp,  3.94151_wp, -0.25682_wp, &  ! C
+    &  7.25036_wp,  0.61671_wp, -0.60916_wp, &  ! C
+    &  0.11412_wp,  0.11336_wp, -0.08221_wp, &  ! C
+    &  3.92717_wp, -3.21273_wp, -0.43437_wp, &  ! C
+    &  3.95079_wp,  0.29514_wp,  3.22866_wp, &  ! C
+    &  3.41157_wp,  0.43202_wp, -3.92302_wp, &  ! C
+    &  9.43883_wp,  0.76955_wp, -0.77211_wp, &  ! N
+    & -2.07440_wp, -0.04270_wp,  0.07811_wp, &  ! N
+    &  3.28682_wp,  6.13570_wp, -0.20479_wp, &  ! N
+    &  4.07811_wp, -5.40669_wp, -0.48872_wp, &  ! N
+    &  4.11534_wp,  0.25224_wp,  5.42203_wp, &  ! N
+    &  3.24974_wp,  0.47806_wp, -6.12230_wp  &  ! N
+    & ], shape(co_cnx6_xyz))
+!&>
+
 !&<
   !> distorted methane
   integer,parameter ::  cytosine_nat = 13
@@ -80,6 +101,14 @@ subroutine get_testmol(name,mol)
     character(len=*),intent(in) :: name
     type(coord),intent(out) :: mol
     select case (name)
+    case ('co_cnx6')
+      mol%nat = co_cnx6_nat
+      allocate (mol%at(mol%nat))
+      mol%at(:) = co_cnx6_at(:)
+      allocate (mol%xyz(3,mol%nat))
+      mol%xyz(:,:) = co_cnx6_xyz(:,:)
+      mol%chrg = -3
+      mol%uhf = 4
     case ('methane')
       mol%nat = methane_nat
       allocate (mol%at(mol%nat))