eri_mme_util.F

Go to the documentation of this file.

!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
!                                                                                                  !
!   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
!--------------------------------------------------------------------------------------------------!
 
! **************************************************************************************************
!> \brief Some utility methods used in different contexts.
!> \par History
!>       2015 09 created
!> \author Patrick Seewald
! **************************************************************************************************
 
MODULE eri_mme_util
 
   USE kinds,                           ONLY: dp
   USE mathconstants,                   ONLY: twopi
#include "../base/base_uses.f90"
 
   IMPLICIT NONE
 
   PRIVATE
 
   PUBLIC :: g_abs_min, r_abs_min
CONTAINS
! **************************************************************************************************
!> \brief Find minimum length of R vectors, for a general (not necessarily
!>        orthorhombic) cell.
!> \param hmat ...
!> \return ...
! **************************************************************************************************
   FUNCTION r_abs_min(hmat) RESULT(R_m)
      REAL(kind=dp), DIMENSION(3, 3), INTENT(IN)         :: hmat
      REAL(kind=dp)                                      :: r_m
 
      INTEGER                                            :: sx, sy, sz
      INTEGER, DIMENSION(3)                              :: sxyz
      REAL(kind=dp)                                      :: r_sq
      REAL(kind=dp), DIMENSION(3)                        :: r
 
      r_m = 0.0_dp
 
      DO sx = -1, 1
      DO sy = -1, 1
      DO sz = -1, 1
         IF (.NOT. (sx == 0 .AND. sy == 0 .AND. sz == 0)) THEN
            sxyz = [sx, sy, sz]
            r = matmul(hmat, sxyz)
            r_sq = r(1)**2 + r(2)**2 + r(3)**2
            IF (r_sq < r_m .OR. r_m < epsilon(r_m)) r_m = r_sq
         END IF
      END DO
      END DO
      END DO
      r_m = sqrt(r_m)
 
   END FUNCTION r_abs_min
 
! **************************************************************************************************
!> \brief Find minimum length of G vectors, for a general (not necessarily
!>        orthorhombic) cell.
!> \param h_inv ...
!> \return ...
! **************************************************************************************************
   FUNCTION g_abs_min(h_inv) RESULT(G_m)
      REAL(kind=dp), DIMENSION(3, 3), INTENT(IN)         :: h_inv
      REAL(kind=dp)                                      :: g_m
 
      INTEGER                                            :: gx, gy, gz
      INTEGER, DIMENSION(3)                              :: gxyz
      REAL(kind=dp)                                      :: g_sq
      REAL(kind=dp), DIMENSION(3)                        :: g
      REAL(kind=dp), DIMENSION(3, 3)                     :: h
 
      h = twopi*transpose(h_inv)
      g_m = 0.0_dp
 
      DO gx = -1, 1
      DO gy = -1, 1
      DO gz = -1, 1
         IF (.NOT. (gx == 0 .AND. gy == 0 .AND. gz == 0)) THEN
            gxyz = [gx, gy, gz]
            g = matmul(h, gxyz)
            g_sq = g(1)**2 + g(2)**2 + g(3)**2
            IF (g_sq < g_m .OR. g_m < epsilon(g_m)) g_m = g_sq
         END IF
      END DO
      END DO
      END DO
      g_m = sqrt(g_m)
 
   END FUNCTION g_abs_min
 
END MODULE eri_mme_util