Line data    Source code

       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief Some utility methods used in different contexts.
      10              : !> \par History
      11              : !>       2015 09 created
      12              : !> \author Patrick Seewald
      13              : ! **************************************************************************************************
      14              : 
      15              : MODULE eri_mme_util
      16              : 
      17              :    USE kinds,                           ONLY: dp
      18              :    USE mathconstants,                   ONLY: twopi
      19              : #include "../base/base_uses.f90"
      20              : 
      21              :    IMPLICIT NONE
      22              : 
      23              :    PRIVATE
      24              : 
      25              :    PUBLIC :: G_abs_min, R_abs_min
      26              : CONTAINS
      27              : ! **************************************************************************************************
      28              : !> \brief Find minimum length of R vectors, for a general (not necessarily
      29              : !>        orthorhombic) cell.
      30              : !> \param hmat ...
      31              : !> \return ...
      32              : ! **************************************************************************************************
      33          158 :    FUNCTION R_abs_min(hmat) RESULT(R_m)
      34              :       REAL(KIND=dp), DIMENSION(3, 3), INTENT(IN)         :: hmat
      35              :       REAL(KIND=dp)                                      :: R_m
      36              : 
      37              :       INTEGER                                            :: sx, sy, sz
      38              :       INTEGER, DIMENSION(3)                              :: sxyz
      39              :       REAL(KIND=dp)                                      :: R_sq
      40              :       REAL(KIND=dp), DIMENSION(3)                        :: R
      41              : 
      42          158 :       R_m = 0.0_dp
      43              : 
      44          632 :       DO sx = -1, 1
      45         2054 :       DO sy = -1, 1
      46         6162 :       DO sz = -1, 1
      47         5688 :          IF (.NOT. (sx == 0 .AND. sy == 0 .AND. sz == 0)) THEN
      48        16432 :             sxyz = [sx, sy, sz]
      49        65728 :             R = MATMUL(hmat, sxyz)
      50         4108 :             R_sq = R(1)**2 + R(2)**2 + R(3)**2
      51         4108 :             IF (R_sq < R_m .OR. R_m < EPSILON(R_m)) R_m = R_sq
      52              :          END IF
      53              :       END DO
      54              :       END DO
      55              :       END DO
      56          158 :       R_m = SQRT(R_m)
      57              : 
      58          158 :    END FUNCTION R_abs_min
      59              : 
      60              : ! **************************************************************************************************
      61              : !> \brief Find minimum length of G vectors, for a general (not necessarily
      62              : !>        orthorhombic) cell.
      63              : !> \param h_inv ...
      64              : !> \return ...
      65              : ! **************************************************************************************************
      66          158 :    FUNCTION G_abs_min(h_inv) RESULT(G_m)
      67              :       REAL(KIND=dp), DIMENSION(3, 3), INTENT(IN)         :: h_inv
      68              :       REAL(KIND=dp)                                      :: G_m
      69              : 
      70              :       INTEGER                                            :: gx, gy, gz
      71              :       INTEGER, DIMENSION(3)                              :: gxyz
      72              :       REAL(KIND=dp)                                      :: G_sq
      73              :       REAL(KIND=dp), DIMENSION(3)                        :: G
      74              :       REAL(KIND=dp), DIMENSION(3, 3)                     :: H
      75              : 
      76         2054 :       H = twopi*TRANSPOSE(h_inv)
      77              :       G_m = 0.0_dp
      78              : 
      79          632 :       DO gx = -1, 1
      80         2054 :       DO gy = -1, 1
      81         6162 :       DO gz = -1, 1
      82         5688 :          IF (.NOT. (gx == 0 .AND. gy == 0 .AND. gz == 0)) THEN
      83        16432 :             gxyz = [gx, gy, gz]
      84        65728 :             G = MATMUL(H, gxyz)
      85         4108 :             G_sq = G(1)**2 + G(2)**2 + G(3)**2
      86         4108 :             IF (G_sq < G_m .OR. G_m < EPSILON(G_m)) G_m = G_sq
      87              :          END IF
      88              :       END DO
      89              :       END DO
      90              :       END DO
      91          158 :       G_m = SQRT(G_m)
      92              : 
      93          158 :    END FUNCTION G_abs_min
      94              : 
      95              : END MODULE eri_mme_util