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 Exact inversion-subgroup EBR and symmetry-indicator analysis (spinful TR).
      10              : !> \note These are symmetry signatures, not a complete topological classification.
      11              : ! **************************************************************************************************
      12              : MODULE topology_tqc
      13              :    IMPLICIT NONE
      14              :    PRIVATE
      15              :    PUBLIC :: inversion_indicators, inversion_ebr_signature
      16              : CONTAINS
      17              : 
      18              : ! **************************************************************************************************
      19              : !> \brief Fu--Kane indices and inversion indicator with an explicit sign convention.
      20              : !> \param odd Number of odd Kramers pairs at each TRIM, x-bit fastest
      21              : !> \param pairs Number of occupied Kramers pairs
      22              : !> \param DIMENSION Two (kz=0 plane) or three (full reciprocal torus)
      23              : !> \param strong Plane index in 2D, strong index in 3D
      24              : !> \param weak Three weak indices in 3D; -1 (unavailable) in 2D
      25              : !> \param z4 sum(odd) mod 4 in 3D; -1 (unavailable) in 2D
      26              : !> \param status Zero on valid input
      27              : ! **************************************************************************************************
      28        13326 :    SUBROUTINE inversion_indicators(odd, pairs, DIMENSION, strong, weak, z4, status)
      29              :       INTEGER, INTENT(IN)                                :: odd(:), pairs, DIMENSION
      30              :       INTEGER, INTENT(OUT)                               :: strong, weak(3), z4, status
      31              : 
      32              :       INTEGER                                            :: axis, k
      33              : 
      34        13326 :       status = -1
      35        13326 :       strong = -1
      36        53304 :       weak = -1
      37        13326 :       z4 = -1
      38        13326 :       IF (DIMENSION < 2 .OR. DIMENSION > 3) RETURN
      39        13326 :       IF (SIZE(odd) /= 2**DIMENSION .OR. pairs < 1 .OR. pairs > 1000000) RETURN
      40       238540 :       IF (ANY(odd < 0) .OR. ANY(odd > pairs)) RETURN
      41       119270 :       strong = MOD(SUM(odd), 2)
      42        13326 :       IF (DIMENSION == 3) THEN
      43       118440 :          z4 = MOD(SUM(odd), 4)
      44        13160 :          weak = 0
      45        52640 :          DO axis = 1, 3
      46       368480 :             DO k = 0, 7
      47       355320 :                IF (BTEST(k, axis - 1)) weak(axis) = weak(axis) + odd(k + 1)
      48              :             END DO
      49              :          END DO
      50        52640 :          weak = MOD(weak, 2)
      51              :       END IF
      52        13326 :       status = 0
      53              :    END SUBROUTINE inversion_indicators
      54              : 
      55              : ! **************************************************************************************************
      56              : !> \brief Exact signed/nonnegative EBR-signature test for the inversion subgroup.
      57              : !> \param odd Odd Kramers pairs, x-bit fastest, 4 or 8 TRIM
      58              : !> \param pairs Selected number of Kramers pairs
      59              : !> \param signed_atomic Signature belongs to the integer lattice of atomic signatures
      60              : !> \param nonnegative_atomic A physical nonnegative EBR-signature decomposition exists
      61              : !> \param coefficients Even/odd local-parity EBR coefficients at the 2^d inversion centers
      62              : !> \param status Zero on valid input, coefficients valid only if nonnegative_atomic
      63              : !> \note EBR at r=a/2 has inversion character s*(-1)^(a.k). Fourier inversion
      64              : !>       determines the differences between even/odd multiplicities exactly.
      65              : !>       No database or floating-point integer decision is used.
      66              : ! **************************************************************************************************
      67        13328 :    SUBROUTINE inversion_ebr_signature(odd, pairs, signed_atomic, nonnegative_atomic, coefficients, status)
      68              :       INTEGER, INTENT(IN)                                :: odd(:), pairs
      69              :       LOGICAL, INTENT(OUT)                               :: signed_atomic, nonnegative_atomic
      70              :       INTEGER, INTENT(OUT)                               :: coefficients(:, :), status
      71              : 
      72              :       INTEGER                                            :: a, k, n, numerator, spare, &
      73        13328 :                                                             difference(SIZE(odd))
      74              : 
      75        13328 :       status = -1
      76        13328 :       signed_atomic = .FALSE.
      77        13328 :       nonnegative_atomic = .FALSE.
      78       331208 :       coefficients = 0
      79        13328 :       n = SIZE(odd)
      80        13328 :       IF (n /= 4 .AND. n /= 8) RETURN
      81        13328 :       IF (SIZE(coefficients, 1) /= 2 .OR. SIZE(coefficients, 2) /= n) RETURN
      82       225232 :       IF (pairs < 1 .OR. pairs > 1000000 .OR. ANY(odd < 0) .OR. ANY(odd > pairs)) RETURN
      83        13326 :       status = 0
      84        22606 :       DO a = 0, n - 1
      85              :          numerator = 0
      86       196364 :          DO k = 0, n - 1
      87       196364 :             numerator = numerator + (-1)**POPCNT(IAND(a, k))*(pairs - 2*odd(k + 1))
      88              :          END DO
      89        22004 :          IF (MOD(numerator, n) /= 0) RETURN
      90         9882 :          difference(a + 1) = numerator/n
      91              :       END DO
      92         5082 :       IF (MOD(pairs - SUM(difference), 2) /= 0) RETURN
      93          602 :       signed_atomic = .TRUE.
      94         5082 :       spare = pairs - SUM(ABS(difference))
      95          602 :       IF (spare < 0) RETURN
      96          360 :       nonnegative_atomic = .TRUE.
      97         2968 :       coefficients(1, :) = MAX(difference, 0)
      98         2968 :       coefficients(2, :) = MAX(-difference, 0)
      99         1080 :       coefficients(:, 1) = coefficients(:, 1) + spare/2
     100              :    END SUBROUTINE inversion_ebr_signature
     101              : END MODULE topology_tqc