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