Line data    Source code

       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2026 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief Unit tests for the detection of degenerate orbital sets split by an active space
      10              : ! **************************************************************************************************
      11            2 : PROGRAM qs_active_space_utils_unittest
      12            2 :    USE kinds,                           ONLY: dp
      13              :    USE qs_active_space_utils,           ONLY: find_degenerate_splits
      14              : #include "./base/base_uses.f90"
      15              : 
      16              :    IMPLICIT NONE
      17              : 
      18              :    REAL(KIND=dp), PARAMETER                           :: eps = 1.0E-5_dp
      19              : 
      20              :    INTEGER                                            :: first_active, first_other, npairs
      21              :    REAL(KIND=dp), DIMENSION(8)                        :: energies
      22              : 
      23              :    ! orbital energies: 1 | 2 3 4 (triplet) | 5 6 7 (triplet) | 8
      24            2 :    energies = [-0.44_dp, -0.17_dp, -0.17_dp, -0.17_dp, 0.15_dp, 0.15_dp, 0.15_dp, 0.41_dp]
      25              : 
      26              :    ! complete degenerate sets: no split
      27            2 :    CALL find_degenerate_splits(energies, [2, 3, 4, 5, 6, 7], eps, npairs, first_active, first_other)
      28            2 :    CALL check(npairs == 0 .AND. first_active == 0 .AND. first_other == 0, "complete sets")
      29              : 
      30              :    ! single orbitals that are not degenerate with anything
      31            2 :    CALL find_degenerate_splits(energies, [1, 8], eps, npairs, first_active, first_other)
      32            2 :    CALL check(npairs == 0, "non-degenerate orbitals")
      33              : 
      34              :    ! one orbital of the second triplet: two pairs (5-6, 5-7), first pair reported
      35            2 :    CALL find_degenerate_splits(energies, [4, 5], eps, npairs, first_active, first_other)
      36              :    CALL check(npairs == 4 .AND. first_active == 4 .AND. first_other == 2, &
      37            2 :               "two split triplets (4 with 2, 3 and 5 with 6, 7)")
      38              : 
      39              :    ! order of the active list does not matter for the count
      40            2 :    CALL find_degenerate_splits(energies, [5, 4], eps, npairs, first_active, first_other)
      41            2 :    CALL check(npairs == 4 .AND. first_active == 5 .AND. first_other == 6, "reversed active list")
      42              : 
      43              :    ! active indices beyond the available orbitals (virtuals computed later) are skipped
      44            2 :    CALL find_degenerate_splits(energies, [8, 9, 10], eps, npairs, first_active, first_other)
      45            2 :    CALL check(npairs == 0, "indices beyond the available orbitals")
      46              : 
      47              :    ! splitting below the tolerance counts as degenerate, above it does not
      48            2 :    energies(6) = energies(5) + 0.5_dp*eps
      49            2 :    energies(7) = energies(5) + 2.0_dp*eps
      50            2 :    CALL find_degenerate_splits(energies, [5], eps, npairs, first_active, first_other)
      51            2 :    CALL check(npairs == 1 .AND. first_other == 6, "tolerance")
      52              : 
      53            2 :    WRITE (*, '(A)') "qs_active_space_utils_unittest: all tests passed"
      54              : 
      55              : CONTAINS
      56              : 
      57              : ! **************************************************************************************************
      58              : !> \brief Stops with an error message if a test fails
      59              : !> \param condition test result
      60              : !> \param label test name
      61              : ! **************************************************************************************************
      62           12 :    SUBROUTINE check(condition, label)
      63              :       LOGICAL, INTENT(IN)                                :: condition
      64              :       CHARACTER(LEN=*), INTENT(IN)                       :: label
      65              : 
      66           12 :       IF (.NOT. condition) THEN
      67            0 :          WRITE (*, '(A,A)') "FAILED: ", label
      68            0 :          ERROR STOP 1
      69              :       END IF
      70           12 :       WRITE (*, '(A,A)') "OK: ", label
      71              : 
      72            2 :    END SUBROUTINE check
      73              : 
      74              : END PROGRAM qs_active_space_utils_unittest