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            2 : PROGRAM hfx_pair_list_methods_unittest
       9            2 :    USE hfx_pair_list_methods,           ONLY: min_image_gap_sq
      10              :    USE kinds,                           ONLY: dp
      11              : 
      12              :    IMPLICIT NONE
      13              : 
      14              :    REAL(KIND=dp), DIMENSION(3, 3)                     :: hmat
      15              : 
      16              :    ! Orthorhombic cell with two reversed cell vectors (positive determinant):
      17              :    ! moving r = (4,0,0) by the image (-10,0,0) gives |r'|**2 = 36, i.e. a gap of 20.
      18            2 :    hmat = 0.0_dp
      19            2 :    hmat(1, 1) = -10.0_dp
      20            2 :    hmat(2, 2) = -12.0_dp
      21            2 :    hmat(3, 3) = 14.0_dp
      22            2 :    IF (ABS(min_image_gap_sq([4.0_dp, 0.0_dp, 0.0_dp], hmat) - 20.0_dp) > 1.0E-12_dp) THEN
      23            0 :       ERROR STOP "Wrong minimum-image gap for reversed cell vectors"
      24              :    END IF
      25              : 
      26            2 :    CALL check_against_all_images([10.0_dp, 12.0_dp, 14.0_dp])
      27            2 :    CALL check_against_all_images([-10.0_dp, -12.0_dp, 14.0_dp])
      28            2 :    CALL check_against_all_images([-10.0_dp, 12.0_dp, 14.0_dp])
      29            2 :    CALL check_against_all_images([10.0_dp, -12.0_dp, -14.0_dp])
      30              : 
      31              : CONTAINS
      32              : 
      33              : ! **************************************************************************************************
      34              : !> \brief Compare min_image_gap_sq with an explicit search over neighbouring images.
      35              : !> \param diag diagonal entries of an orthorhombic cell matrix
      36              : ! **************************************************************************************************
      37            8 :    SUBROUTINE check_against_all_images(diag)
      38              :       REAL(KIND=dp), DIMENSION(3), INTENT(IN)            :: diag
      39              : 
      40              :       INTEGER                                            :: i, j, k, n1, n2, n3
      41              :       REAL(KIND=dp)                                      :: exact, gap
      42              :       REAL(KIND=dp), DIMENSION(3)                        :: r, shifted
      43              :       REAL(KIND=dp), DIMENSION(3, 3)                     :: cell
      44              : 
      45            8 :       cell = 0.0_dp
      46            8 :       cell(1, 1) = diag(1)
      47            8 :       cell(2, 2) = diag(2)
      48            8 :       cell(3, 3) = diag(3)
      49              : 
      50              :       ! minimum-image vectors on a grid of fractional coordinates in [-1/2, 1/2]
      51          144 :       DO i = -8, 8
      52         2456 :          DO j = -8, 8
      53        41752 :             DO k = -8, 8
      54       157216 :                r = [REAL(i, dp)*ABS(diag(1)), REAL(j, dp)*ABS(diag(2)), REAL(k, dp)*ABS(diag(3))]/16.0_dp
      55        39304 :                gap = min_image_gap_sq(r, cell)
      56        39304 :                exact = HUGE(1.0_dp)
      57       235824 :                DO n1 = -2, 2
      58      1218424 :                   DO n2 = -2, 2
      59      6092120 :                      DO n3 = -2, 2
      60      4913000 :                         IF (n1 == 0 .AND. n2 == 0 .AND. n3 == 0) CYCLE
      61     92600224 :                         shifted = r - MATMUL(cell, REAL([n1, n2, n3], dp))
      62     35098472 :                         exact = MIN(exact, SUM(shifted**2) - SUM(r**2))
      63              :                      END DO
      64              :                   END DO
      65              :                END DO
      66        41616 :                IF (ABS(gap - exact) > 1.0E-10_dp) THEN
      67            0 :                   ERROR STOP "min_image_gap_sq differs from the explicit image search"
      68              :                END IF
      69              :             END DO
      70              :          END DO
      71              :       END DO
      72              : 
      73            2 :    END SUBROUTINE check_against_all_images
      74              : 
      75              : END PROGRAM hfx_pair_list_methods_unittest