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
|