Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2023 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