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